|
DataMuseum.dkPresents historical artifacts from the history of: Philips Data Systems |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Philips Data Systems Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 20656 (0x50b0)
Notes: pts_type(SC)
Names: »DEPROC.SC«
└─⟦5c22ed822⟧ Bits:30009675 Philips computer tape "600209"
└─⟦this⟧ »DEN10/DEPROC.SC«
└─⟦79fbed147⟧ Bits:30009697 Philips computer tape "600414"
└─⟦this⟧ »S:DE/DEPROC.SC«
└─⟦bf903a231⟧ Bits:30009665 Philips computer tape "600109"
└─⟦this⟧ »DEN10/DEPROC.SC«
IDENT DEPROC REL 10.0 80-04-11 80-01-17/JAER * * * THIS PROGRAM-MODUL CONTAINS ENTRIES TO THE DIFFERENT * STEERING ROUTINES OF THE FORMAT GENERATION * DDUM DEDDIV PDIV ENTRY MTEXT STEERING ROUTINE ENTRY LINIT LINE INITIALIZATION ENTRY FDIR FORMAT FIELD DIRECTIVE * ENTRY DESC DESCRIPTOR STORING EXT FTEXT FORMAT TEXT EXT FKI FORMAT KEYED INPUT EXT FMELI FORMAT EDITING EXT FCOPY FORMAT COPYING EXT FVAL FORMAT VALIDATION EXT FGEN FORMAT GENERATION EXT FACC FORMAT ACCUMULATION EXT FDUPL FORMAT DUPLICATION EXT FTAB FORMAT TABULATION EXT FLINK FORMAT LINKING EXT FNL FORMAT NEW LINE EXT NOPOOL NUMBER OF USED POOLS EXT DERROR ERRORMESSAGE EXT UPDBOL UPDATE BOOLEAN/WORD EXT DEPOOL BUFFERRESERVATIN-MODUL EXT EMPTYT ASSEMBLY SUBROUTINE EMPTYT - EJECT * * KEYTABLE * CLR EQU X'8F' CLEAR CAN EQU X'91' CANCEL RET EQU X'92' RETURN NOK EQU X'FF' NO KEY TOT EQU X'93' TOTAL * DEKTAB6 KTAB CLR,CAN,RET,NOK,TOT * DEKTAB7 KTAB CLR,CAN,RET * EJECT * * MTEXT * - MAKES MATCH OF 'LINE DESIGN' UNTIL EOL OR NEXT FIELD IS FOUND * - EDIT TEXT PARTS OF 'LINE DESIGN' IN 'LINE DISPLAY' * - GENERATES 'FTEXT'- AND 'FTAB'-STATMENTS * - DISPLAYS FIELDDEPENDENT INFO WHEN FOUND IN 'MATCH' * - SIGNALS IN 'DEBINW2' AS FOLLOWS; * = 0 OK * = 1 NO AVAILABLE BUFFERS;CANCEL * = 2 NO AVAILABLE BUFFERS;RETUR * = 4 NO AVAILABLE BUFFERS/MAX LIMIT EXCEEDED;KTOT * ************************************************************************ MTEXT PROC MT10 MOVE DEBINW2,W0 SWITCH PERF MROUT MATCHROUTINE TBF BOOL3,MT20 F= NO NO FTAB * * FTAB-FTEXT * PERF FTAB GENERATE FTAB CBNE DEBINW2,W0,MT99 ERROR SIGNAL MT20 * * FTEXT * TBF BOOL4,MT35 F=NO FTEXT PERF FTEXT GENERATE FTEXT CBNE DEBINW2,W0,MT99 ERROR SIGNAL XCOPY LDISP,W0,BIN5,LDES,W0 COPY TEXT TBT DOOL8,MT35 JUMP IF NO DISPLAY DISPLAY 2,W3,W3 DISPLAY LDISP MT35 TBT BOOL2,MT40 JUMP IF FIELD IS FOUND CBE EOLINE,W1,MT99 JUMP IF EOL B MT10 GO ON MATCH MT40 ADD BIN10,W1 NEXT FIELD MOVE FDVBCD(W4),BIN10 MOVE FDVBCD(W5),BIN6 FIELDSTART MOVE FDVBCD(W6),BIN7 FIELDLENGTH TBT BOOL6,MT50 JUMP IF BALANCE FORMAT * CHECK IF RECORD LENGTH IS EXCEEDED MOVE BIN16,BIN13 LOAD LAST DISPL ADD BIN16,BIN14 ADD LAST FIELD LENGTH MOVE BIN15,BIN7 LOAD ACTUAL FIELDLENGTH TBT ALPHA,MT45 JUMP IF ALPHA ADD BIN15,W2 DIV BIN15,W2 NUMBER OF BYTES MT45 ADD BIN16,BIN15 ADD ACTUAL FIELD LENGTH MOVE FDVBCD(W8),BIN16 STORE USED RECORDSPACE MT50 TBT DOOL8,MT55 JUMP IF NO ERASE DISPLAY 2,W4,W7 DISPLAY FIELDNR,-LENGTH,-START MT55 TBT BOOL6,MT58 JUMP IF BALANCE FORMAT CBG BIN10,=X'FD',MT90 FIELDNR MAX REACHED CBG BIN16,FMTWK(W14),MT80 MAX RECLEN EXCEEDED MT58 TBT DOOL8,MT60 JUMP IF NO ERASE ERASE 10,W4,W0 ERASE ALL FKI/NCLR-FIELDS MT60 PERF FINIT FIELD INIT WORKITEMS B MT99 OK MT80 MOVE DEBINW4,W14 'MAX RECORD LENGTH EXCEEDED' B MT95 MT90 MOVE DEBINW4,W16 MT95 PERF DERROR,DEKTAB6 CBE DEBINW2,W1,MT95 JUMP IF CLEAR-KEY CBNE DEBINW2,W5,MT98 PERF FNL FORMAT NEW LINE CBNE DEBINW2,W0,MT99 MOVE DEBINW2,W5 SIMULATE TOT-KEY MT98 SUB DEBINW2,W1 ADJUST FOR CAN,RET,---,TOT MT99 RET PEND EJECT MROUT PROC ****************************************************** * * MATCHING ROUTINE * * MATCH FOR '<' => (FKI/FINP) * * TAB = BIN6 => FKI <TABPOS> ........ * NUMB = BIN7 => 'MAXL' =FIELDLENGTH (FROM SUBROUTINE 'PICMA') * MATCH = BOOL2 T= '#'-MATCHED * BIN12 => FMELI <NUMB OF PICCHARS> (FROM SUBROUTINE 'PI * STATSH => PICTURE STRING 'FMELI' (FROM SUBROUTINE 'PICM * DEBIN5 => PICTURE STRING STARTPOSITION IN LDES * ****************************************************** * * MATCH FOR ' ':S => (FTAB) * * TAB = BIN8 => FTAB <TABPOS> * NUMB = BIN16 => NOT USED * MATCH = BOOL3 T= ' '-MATCHED * ****************************************************** * * MATCH INVERTED FOR '<':S OR ' ':S (FTEXT) * * TAB = BIN16 => NOT USED * NUMB = BIN9 => FTEXT <NUMBER OF CHARS> <CH> <CH> ..... * MATCH = BOOL4 T= TEXT MATCHED * BIN11 => STARTPOSITION OF 'FTEXT' IN ITEM 'LINE DESIGN ****************************************************** EJECT CLEAR BOOL2 F=NO # MATCH CLEAR BOOL3 F=NO ' ' MATCH CLEAR BOOL4 F=NO TEXT MATCH MOVE STR1A,=C'<' CHARACTER TO BE SEARCHED CLEAR BOOL9 F=ORIGINAL MATCH MODE PERF LININV,STR1A,BOOL9,BIN6,BIN16,BOOL2 TBT BOOL2,MR60 MATCH FOUND CBNE EOLINE,W0,MR99 END-OF-LINE MOVE STR1A,=C' ' CHARACTER TO BE SEARCHED CLEAR BOOL9 PERF LININV,STR1A,BOOL9,BIN8,BIN16,BOOL3 CBNE EOLINE,W0,MR99 END-OF-LINE TBT BOOL3,MR10 MATCH FOUND MR05 MOVE STR2A,=C'< ' CHARACTERS TO BE SEARCHED SET BOOL9 T=INVERTED MATCH PERF LININV,STR2A,BOOL9,BIN16,BIN9,BOOL4 MOVE BIN8,BIN11 ADD BIN8,W1 SET BOOL3 CBNE EOLINE,W0,MR99 END-OF-LINE TBT BOOL4,MR30 MATCH FOUND MOVE EOLINE,W1 INDICATE END-OF-LINE B MR99 * SPACE MATCH FOUND MR10 MOVE STR1A,=C'<' CHARACTER TO BESEARCHED CLEAR BOOL9 F=ORIGINAL MATCH MODE PERF LININV,STR1A,BOOL9,BIN6,BIN16,BOOL2 TBT BOOL2,MR50 MATCH FOUND CBNE EOLINE,W0,MR99 END-OF-LINE B MR05 * TEXT MATCH FOUND MR30 * * MATCH IF LESS THAN OR EQUAL 4 SPACES WITH FOLLOWING TEXT * IN THAT CASE INDICATE JUST ONE FTEXT * MOVE DEBIN4,BIN11 SAVE ST.POS FOT TEXT MR35 MOVE DEBIN5,BIN5 SAVE LINE POSITION MOVE STR1A,=' ' ' '=MATCH-CHARCTER CLEAR BOOL9 F=ORIGINAL MATCH MODE CLEAR BOOL5 PERF LININV,STR1A,BOOL9,DEBIN1,BIN16,BOOL5 TBF BOOL5,MR40 JUMP IF NO MATCH CBNE EOLINE,W0,MR45 END-OF-LINE CBG BIN16,W4,MR40 JUMP IF MORE THAN 4 SPACES MOVE STR2A,='< ' MATCH CHARCTERS SET BOOL9 T=INVERTED MATCH MODE CLEAR BOOL5 PERF LININV,STR2A,BOOL9,DEBIN1,DEBIN2,BOOL5 TBF BOOL5,MR40 JUMP IF NO INV.-MATCH ADD BIN9,BIN16 ADJUST NUMB CHARS+NUMB SPACES ADD BIN9,DEBIN2 ADJUST NUMB CHARS+NUMB CHARS CBNE EOLINE,W0,MR45 END-OF-LINE B MR35 MR40 MOVE BIN5,DEBIN5 RESTORE LINPOS WHEN NO SP+TEXT MR45 MOVE BIN11,DEBIN4 RESTORE FTEXT STARTPOS B MR99 MR50 CLEAR BOOL3 NO SP-MATCH INDICATION NEEDED MR60 MOVE DEBIN5,BIN5 SAVE STARTPOIN PICTUR PERF PICMA PICTURE STRING MATCH/CONVERT MR99 RET PEND EJECT * * LINE DESIGN INVESTIGATION PROCEDURE * * INPUT PARAMETERS : CHAR = CHARACTER(S) TO BE SEARCHED * MOD = F ORIGINAL MATCHING * = T INVERTED MATCHING * * OUTPUT PARAMETERS: TAB = TABULATION POSITION * NUMB = NUMBER OF MATCHES * MATCH = F NO MATCH FOUND * = T MATCH FOUND * *************************************************************** LININV PROC CHAR,MOD,TAB,NUMB,MATCH CBE BIN5,FMTWK(W5),LIN098 JUMP IF ENDPOS REACHED CLEAR MATCH F= NO MATCH MOVE TAB,BIN5 LOAD ACTUAL TABPOS MOVE NUMB,W0 ZEROIZE NUMBER LIN000 TBT MOD,LIN010 JUMP IF INVERTED MOD MATCH LDES,BIN5,W1,CHAR,W0,W1 BNOK LIN040 NO MATCH B LIN020 NEXT MATCH LIN010 MOVE BIN15,W0 MATCHINGPOINTER:=0 MATCH CHAR,BIN15,W2,LDES,BIN5,W1 BOK LIN050 MATCH FOUND NOK LIN020 TBT MATCH,LIN025 JUMP IF ALREADY MATCHED MOVE BIN11,TAB STORE STARTPOSITON SET MATCH INVERTED MATCH FOUNF LIN025 ADD BIN5,W1 NEXT POSITION ADD TAB,W1 NEXT TABPOS ADD NUMB,W1 NUMBER OF MATCHES CBE BIN5,FMTWK(W5),LIN098 JUMP IF ENDPOS REACHED B LIN000 NEXT MATCH INV LIN040 MOVE BIN5,TAB RESTORE ACTUAL POSITION ADD TAB,W1 ADJUST TABPOS LIN050 MOVE EOLINE,W0 NO END-OF-LINE B LIN099 LIN098 MOVE EOLINE,W1 END-OF-LINE ADD TAB,W1 NEXT TABPOS LIN099 RET PEND EJECT * * LINE INITIALIZATION OF WORKITEMS * LINIT PROC MOVE BIN5,W0 LINEPOSITION:=0 MOVE FMTWK(W5),W0 CLEAR BOOL2 F=NO MATCH '#' CLEAR BOOL3 F=NO MATCH ' ' CLEAR BOOL4 F=NO MATCH '<STRG>' CLEAR DOOL1 F=NO FIELD CONFIRM CURRLINE PERF FINIT FIELD INIT WORKITEMS RET PEND EJECT * * FIELD INITIALIZATION OF WORKITEMS * FINIT PROC MOVE FMTWK(W1),W0 NUMB OF VALID. CHARS:=0 MOVE FMTWK(W2),W0 NUMB OF GENERAT. CHARS:=0 MOVE FMTWK(W3),W0 NUMB OF ACCUMULAT. CHARS:=0 MOVE FMTWK(W4),W0 NUMB OF DUPL. CHARS:=0 MOVE FMTWK(W10),W0 NUMB OF CHARS STRG1:=0 MOVE FMTWK(W11),W0 NUMB OF CHARS STRG2:=0 MOVE FMTWK(W12),W0 NUMB OF CHARS STRG1+2:=0 RET PEND EJECT * * PICTURE STRING MATCH AND CONVERTION * * MATCHCHARCTER-TABLE WORKITEMS * 0 L FLENGTH PLENGTH INPUT : BIN5 = STPOS LDES * 1 R FLENGTH PLENGTH * 2 A FLENGTH PLENGTH WORK : BIN16= MATCHININDEX * 3 P FLENGTH PLENGTH BIN15= SAVED DITO * 4 T FLENGTH PLENGTH * 5 X FLENGTH PLENGTH * 6 Z FLENGTH PLENGTH OUTPUT: BIN5 = STPOS NEXT MATCH L * 7 Y FLENGTH PLENGTH BIN7 = FIELDLENGTH=MAXL * 8 + PLENGTH BIN12= LENGTH OF PIC.-STR * 9 S - PLENGTH STATSH=PICTURE-STRING * 10 , PLENGTH * 11 . V PLENGTH * 12 > (END OF FIELD) * 13 < * 14 0 X FLENGTH PLENGTH * NO MATCH E PLENGTH+1 * ************************************************************************ PICMA PROC MOVE STATSH,=' ' SPACES PICTURE-STRING MOVE BIN12,W0 NUMB OF LAYOUT CHARS:=0 MOVE DEBINW1,W0 SET NCLR-BIT TBF BOOL6,PIC1 JUMP IF GENERAL FORMAT ADD DEBINW1,W32 SET CTAB-BIT FOR BALANCEFORM PIC1 CALL UPDBOL,DEBINW1 INITIATE FIELDCONTROLBITS DEF MOVE BIN7,W0 FIELDLENGTH:=0 MOVE BIN16,W0 MATCH PICSTR,BIN16,W15,LDES,BIN5,W1 BNOK PICNE INSERT CBE BIN16,W0,PICA0 JUMP IF = 0 IB BIN16,PICA1,PICN2,PICN3,PICN3, 1-4 C PICN3,PICN3,PICN3,PICN8,PICN9, 5-9 C PICN10,PICN11,PICNE,PICNE,PICN14 10-14 B PICNE * ALPHANUMERIC PICA1 ALPHANUMERIC RIGHT SET REWRT INDICATE REWRITE SET SCHK2 RIGHT ADJUST ALPHANUM PICA0 ALPHANUMERIC LEFT SET ALPHA INICATE ALPANUMERIC FIELD PICA XCOPY STATSH,BIN12,W1,LDES,BIN5 ADD BIN12,W1 NEXT PICCHARS ADD BIN5,W1 NEXT LDESPOS ADD BIN7,W1 ADD 1 TO FIELDLENGTH MOVE BIN16,W0 INITIATE TABLE-INDEX MATCH PICSTR,BIN16,W15,LDES,BIN5,W1 CBE BIN16,W12,PIC99 '>' FOUND READY B PICA * NUMERIC FIELDS PICN3 SET REWRT PICN2 XCOPY STATSH,BIN12,W1,LDES,BIN5 ADD BIN7,W1 ADD 1 TO FIELD LENGTH B PICNM NEXT MATCH PICN8 SET SCHK1 INDICATE SIGN B PICN10 PICN9 XCOPY STATSH,BIN12,W1,PICCON,W0 SET SCHK1 INDICATE SIGN SET REWRT INDICATE REWRITE B PICNM NEXT MATCH PICN11 SET REWRT XCOPY STATSH,BIN12,W1,PICCON,W1 B PICNM NEXT MATCH PICN14 XCOPY STATSH,BIN12,W1,PICCON,W3 SET SCHK2 INDICATE LEFT ZERO FILL SET REWRT INDICATE REWRT ADD BIN7,W1 ADD 1 TO FIELD LENGTH B PICNM NEXT MATCH PICNE XCOPY STATSH,BIN12,W1,PICCON,W2 ADD BIN12,W1 NEXT CHARACTER PICN10 SET REWRT INDICATE REWRITE XCOPY STATSH,BIN12,W1,LDES,BIN5 PICNM ADD BIN12,W1 NEXT PICCHARS ADD BIN5,W1 NEXT LDES POSITION MOVE BIN16,W0 INITIATE TABLE-INDEX MATCH PICSTR,BIN16,W15,LDES,BIN5,W1 BNOK PICNE INSERT CBE BIN16,W0,PICNE 0=L =>EL IB BIN16,PICNE,PICN2,PICN3,PICN3, 1-4 C PICN3,PICN3,PICN3,PICN8,PICN9, 5-9 C PICN10,PICN11,PIC99,PICNE,PICN14 10-14 PIC99 ADD BIN5,W1 RET PEND EJECT * * FORMAT FIELD DIRECTIVE PROCESSING * * - PROCESSES FORMAT FIELD DIRECTIVE CODE * FKI AND FMELI/FCOPY * INPUT VARIABLES: DEBIN5 = SAVED RESTARTPOINT OF PICTURESTRING * * * OUTPUT VARIABLES: * DEBINW2 = 0 OK GO ON * = 1 NO AVAILABLE BUFFERS;CANCEL * = 2 NO AVAILABLE BUFFERS;RETUR * = 4 MAXIMUM BUFFERS USED:KTOT * *********************************************************************** * FDIR PROC * * FORMAT DIREKTIV GENERATION * MOVE DEBINW2,W0 ZEROISE OUTPUT PARAM TBF BOOL2,FDIR99 NO FIELD FOUND * * FKI + FCOPY/FMELI * SWITCH PERF FKI GENERATE FKI CBNE DEBINW2,W0,FDIR99 ERROR SIGNALS TBT BOOL6,FDIR10 JUMP IF BALANCE FORMAT PERF DESC GENERATE DESCRIPTOR CBNE DEBINW2,W0,FDIR99 ERROR SIGNALS TBT ALPHA,FDIR34 JUMP IF ALPHA FDIR10 MOVE BIN5,DEBIN5 RESTORE PIC.STARTPOINT PERF PICMA PERF FMELI GENERATE FMELI B FDIR70 FDIR34 PERF FCOPY GENERATE FCOPY FDIR70 XCOPY LDISP,W0,BIN5,LDES,W0 COPY TEXT TBT DOOL8,FDIR73 JUMP IF NO DISPLAY DISPLAY 2,W3,W3 DISPLAY LDISP EJECT * * FVAL (+) FGEN (+) FACC * FDIR73 SET BOOL1 T=FIRTS FIELD CONFIRMED SET DOOL1 T=FIELD CONFIRM CURRLINE CALL EMPTYT,JOBSPC CHECK IF ANY VAL,GEN OR ACC BNOK FDIR85 MOVE DEBIN1,W0 STARTPOSITION MOVE DEBIN4,W0 STARTPOS IN JOBSPC MOVE DEBIN5,W0 NUMB OF DELETED CHARS:=0 FDIR75 MOVE STRG10A,='#V:#G:#A:' MOVE FBIN1,W0 FUNCINDEX POINTER:=0 MATCH STRG10A,FBIN1,W9,JOBSPC,DEBIN4,W3 BNOK FDIR85 NO MORE FUNCTIONS ADD FBIN1,W3 DIV FBIN1,W3 COMPUTE FUNC-INDEX SUB FMTWK(FBIN1),DEBIN5 ADJUST ENDPOS FOR DELCHARS SWITCH PERFI FBIN1,FVAL,FGEN,FACC FVAL,FGEN,FACC CBNE DEBINW2,W0,FDIR99 ERROR SIGNALS MOVE DEBIN1,DEBIN4 STARTPOS'JOBSPC' NEXT FUNC B FDIR75 GO ON NEXT FUNCTION FDIR85 CALL EMPTYT,DUPL LOOK IF DUPL EMPTY BNOK FDIR90 JUMP IF EMPTY MOVE DEBIN1,W0 STARTPOSITION MOVE DEBIN4,W0 STARTPOS IN 'DUPL' MOVE DEBIN5,W0 NUMB OF DELETED CHARS:=0 PERF FDUPL FDIR90 TBF DOOL8,FDIR99 ERASE 11,W4,W0 CLEAR IN CORE FDIR99 RET PEND EJECT * * DESCRIPTOR-TABLE STORING * * EACH FIELD TAKES TW0 WORDS * * WORD1 * -TYPE BITS 0-3 = 0 STRG-VARIABLE * (BYTE 1) = 3 BCD-VARIABLE * -LENGTH BITS 4-15 * (BYTE 1) * BITS 0-15= - NUMBER OF MATCHED #:S WHEN STRG * (BYTE 2) - (NUMBER OF MATCHED #:S + 1)/2 WHEN BCD * * WORD2 * -DISPLACEMENT = LAST DISPLACEMENTS + LAST LENGTH * = BIN13 + BIN14 * ************************************************************************ DESC PROC MOVE BIN16,W0 WORKITEM:=0 MOVE BIN15,BIN7 LOAD NUMBER OF '#'-POS TBT ALPHA,DESC10 JUMP IF ALPHA * * NUMERIC FIELD * ADD BIN16,=X'3000' TYPE = BCD = 3 ADD BIN15,W2 DIV BIN15,W2 NUMBER OF BYTES DESC10 ADD BIN16,BIN15 LOAD TYPE AND LENGTH XCOPY BPOOL(BIN4),BIN2,W2,BIN16,W0 STORE TYPE/LENGTH ADD BIN2,W2 NEXT POS MOVE BIN16,BIN13 RESTORE LAST DISPL ADD BIN16,BIN14 ADJUST DISPLACEMENT XCOPY BPOOL(BIN4),BIN2,W2,BIN16,W0 STORE DISPLACEMENTS ADD BIN2,W2 NEXT POS MOVE BIN13,BIN16 SAVE LAST DISPL MOVE BIN14,BIN15 SAVE LAST LENGTH CBL BIN2,W188,DESC99 JUMP IF NOT END OF BUFFER DESC20 MOVE BIN16,W1 NUMBER OF WANTED BUFFERS PERF DEPOOL,W3,BIN16,BIN4,STRG10A CHAIN ANOTHER BUFFER BNOK DESC30 MOVE DEBINW2,W0 MOVE BIN4,BIN16 LOAD NEW BUFFERPOINTER ADD PINDND,W1 NUMBER OF DESC-BUFFERS+1 PERF NOPOOL NUMBER OF POOLS DISPLAY 2,W2,W2 DISPLAY DITO WHILE CHANGED MOVE BPOOL(BIN4),HEX00 MOVE BIN2,W0 BUFFER PONTER:=0 B DESC99 DESC30 PERF DERROR,DEKTAB7 CBE DEBINW2,W1,DESC20 SUB DEBINW2,W1 ADJUST FOR CANC RET DESC99 RET PEND END