|
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: 13680 (0x3570)
Notes: pts_type(SC)
Names: »DEPRFG.SC«
└─⟦48601905a⟧ Bits:30009668 Philips computer tape "600121"
└─⟦this⟧ »S:DE/DEPRFG.SC«
└─⟦5c22ed822⟧ Bits:30009675 Philips computer tape "600209"
└─⟦this⟧ »DEN10/DEPRFG.SC«
└─⟦79fbed147⟧ Bits:30009697 Philips computer tape "600414"
└─⟦this⟧ »S:DE/DEPRFG.SC«
└─⟦bf903a231⟧ Bits:30009665 Philips computer tape "600109"
└─⟦this⟧ »DEN10/DEPRFG.SC«
└─⟦d2a299635⟧ Bits:30009698 Philips computer tape "600415"
└─⟦this⟧ »S:DE/DEPRFG.SC«
IDENT DEPRFG REL 10.0 80-04-11 80-03-21/JAER * * THIS ROUTINE TAKES CARE OF PRINTOUT OF THE GENERAL USER * FORMAT DEFINITION AND OF THE BALANCE FORMAT DEFINITION. * * -USED VARIABLES : PINDCB = FORMAT BUFFER INDEX * CURSEC = FORMAT BUFFER POINTER * BIN10 = FIELDNR * BIN16 = POINTER STR64A-ITEM * DEBIN5 = LINE-COUNTER * W6 = DETAILLINE STARTLINE NUMBER * DEBINW2= 0 OK * = 1 CLEAR-KEY * = 2 CLEAR-KEY * = 3 RETURN-KEY * ************************************************************************ DDUM DEDDIV PDIV * ENTRY PRFGUF PRINT USERFORMAT DEFINITION * EXT DEUNPF UNPACK NEXT FIELD * EXT NOPOOL NUMBER OF USED POOLS * EXT EMPTYT CHECK IF EMPTY ITEM EXT DERROR ERROR-MESSAGES EJECT * * KEYTABLE * CLR EQU X'8F' CLEAR CAN EQU X'91' CANCEL RET EQU X'92' RETURN * DEKTAB6 KTAB CLR,CAN,RET EJECT * * PRINT USER FORMAT DEFINITION * PRFGUF PROC PR00 EDWRT DEDSPRT,FORMF FORMFEED BOK PR03 JUMP IF OK MOVE DEBINW4,W32 ADD DEBINW4,W3 LINE-PRINTER NOT OPERABLE PERF DERROR,DEKTAB6 ERRORMESSAGE:35 B PR50 CLR-,CAN- OR RET-KEY PR03 MOVE DEBINW3,W1 PRINT DEDSPRT,DEBINW3,W0 BNOK PR00 JUMP IF NOT OK MOVE PINDCB,FLIND(W1) LOAD BUFFERINDEX MOVE CURSEC,W0 LOAD BUFFERPOINTER MOVE BIN10,W1 LOAD FIELDNR MOVE FDVBCD(W2),W0 LINENO:=0 MOVE FDVBCD(W1),W1 PAGENO:=0 MOVE PINDND,W0 NUMB OF DESC:=0 MOVE PRECPR,W0 NUMB OF POOLS:=0 XCOPY PRECPR,W1,W1,RPOOL(PINDFR),W17 FETCH NUMB OF POOLS XCOPY PINDND,W1,W1,RPOOL(PINDFR),W18 FETCH NUMB OF DESC-POOLS SUB PRECPR,PINDND GIVING NUMB OF FORMATPOOLS PERF NOPOOL SET NUMBER OF POOLS MOVE DEBIN5,W128 LINE-COUNTER:=HIGH-VALUE PR04 ADD FDVBCD(W2),=D'1' INCREMENT 'LINNO' CLEAR BOOL5 PR05 PERF DEUNPF,CURSEC,W2 UNPACK NEXT FIELD CBE DEBINW2,W1,PR48 END-OF-FORMAT FOUND TBT BOOL5,PR04 JUMP IF END OF LINE ADD BIN10,W1 NEXT FIELDNR CLEAR BOOL8 WHOLE LINE PRINT MOVE BIN16,W0 POINTER STR64A:=0 MOVE STR64A,=' ' 'SPACES' EJECT CALL EMPTYT,STATSH CHECK IF EMPTY BNOK PR10 JUMP IF EMPTY MOVE STR6A,='#L:' PROMPT-TEXT XCOPY STR64A,BIN16,W3,STR6A,W0 COPY PROMPT-TEXT ADD BIN16,W3 ADJUST POINTER FOR TEXT MOVE FMTWK(W13),BIN12 LOAD NUMB OG PICCHARS MOVE DEBIN3,W0 POINTER 'STATSH':=0 PERF EDLINE,STATSH,FMTWK,W13 EDIT STR64A CBNE DEBINW2,W0,PR50 JUMP IF NOT OK PR10 CALL EMPTYT,JOBSPC CHECK IF EMPTY BNOK PR40 JUMP IF EMPTY MOVE DEBIN3,W0 POINTER JOBSPC :=0 MOVE FBIN2,W0 MOVE FMTWK(W12),FMTWK(W1) ADD FMTWK(W12),FMTWK(W2) ADD FMTWK(W12),FMTWK(W3) PR20 MOVE STRG10A,='#V:#G:#A:' MOVE FBIN1,W0 FUNCINDEX POINTER:=0 MATCH STRG10A,FBIN1,W9,JOBSPC,DEBIN3,W3 BNOK PR40 NO MORE FUNCTIONS ADD FBIN1,W3 DIV FBIN1,W3 COMPUTE FUNC-INDEX CBE FMTWK(FBIN1),W0,PR20 JUMP IF NO GENERATION ADD FBIN2,FMTWK(FBIN1) SAVE STARTADRESS PERF EDLINE,JOBSPC,FMTWK,FBIN1 EDIT STR64A CBNE DEBINW2,W0,PR50 JUMP IF NOT OK CBE FMTWK(W12),FBIN2,PR40 MOVE DEBIN3,FBIN2 RESTORE START ADRESS B PR20 GO ON NEXT FUNCTION PR40 TBT BOOL6,PR45 JUMP IF BALANCE FORMAT PERF PRINT,W1,W2,DEBIN5,=W'44',W6,W5 CBNE DEBINW2,W0,PR50 JUMP IF NOT OK B PR05 NEXT FIELD PR45 PERF PRINT,W3,W4,DEBIN5,=W'44',W6,W5 CBE DEBINW2,W0,PR05 NEXT FIELD B PR50 JUMP IF NOT OK PR48 EDWRT DEDSPRT,FORMF MOVE DEBINW2,W0 PR50 RET PEND EJECT * * THIS ROUTINE EDITS STR64A-ITEM WITH THE VALIDATION-, GENERATION * AND ACCUMULATIO-STRINGS. IF THERE IS NOT ENOUGH SPACE TO * EDIT ONE OF THE ABOVE MENTIONED, IT WILL BE CUT AND * CONTINUED ON THE NEXT LINE * * -INPUT FORMAL PARAMETERS:WSTRG = LDES,VSTRG,GSTRG OR ASTRG * NUMB = NUMBER OF CHARACTERS IN WSTRG * WIND = INDEX ITEM CONTAINING NUMB OF C * * -INPUT VARIABLE : STR6A = PROMPT-TEXT TO CORRESPONDING S * DEBIN3 = POINTER OF WSTRG (IF OVERFLOW * * -USED VARIABLES : BIN16 = POINTER OF STR64A-ITEM * BIN15 = WORK (TO CHECK IF OVERFLOW) * * -OUTPUT VARIABLES : BIN16 = POINTER OF STR64A-ITEM (ADJUST * BOOL8 = T JUST STR64A-PART OF LINE TO * PRINTED * ************************************************************************ EDLINE PROC WSTRG,NUMB(),WIND ED05 MOVE BIN15,BIN16 LOAD POINTER POS ADD BIN15,NUMB(WIND) ADD NUMB OF CHARS CBL BIN15,W64,ED10 JUMP IF ENOUGH SPACE SUB BIN15,W64 NUMBER OF OVERFLOW CHARS SUB NUMB(WIND),BIN15 NUMB OF CHARS TO COPY XCOPY STR64A,BIN16,NUMB(WIND),WSTRG,DEBIN3 TBT BOOL6,ED07 JUMP IF BALANCEFORMAT PERF PRINT,W1,W2,DEBIN5,=W'44',W6,W5 B ED08 ED07 PERF PRINT,W3,W4,DEBIN5,=W'44',W6,W5 ED08 CBNE DEBINW2,W0,EDRET JUMP IF NOT OK ADD DEBIN3,NUMB(WIND) LOAD NUMB OF COPIED CHARS MOVE NUMB(WIND),BIN15 NUMB OF OVERFLOW CHARS MOVE BIN16,W0 POINTER STR64A:=0 MOVE STR64A,=' ' 'SPACES' SET BOOL8 INDICATE PARTIAL PRINT B ED05 ED10 XCOPY STR64A,BIN16,NUMB(WIND),WSTRG,DEBIN3 ADD BIN16,NUMB(WIND) ADD BIN16,W3 LEAVE 3 SPACES CBNG BIN16,W64,EDRET JUMP IF OK TBT BOOL6,ED20 JUMP IF BALANCE FORMAT PERF PRINT,W1,W2,DEBIN5,=W'44',W6,W5 B ED30 ED20 PERF PRINT,W3,W4,DEBIN5,=W'44',W6,W5 ED30 MOVE BIN16,W0 POINTER STR64A:=0 MOVE STR64A,=' ' 'SPACES' SET BOOL8 INDICATE PARTIAL PRINT EDRET RET PEND EJECT * * THIS ROUTINE PRINT ONE LINE ON THE LINE PRINTER. * THE FORMAT OF THE LINE IS DECIDED OF THE * PARAMETER 'LINE'. IF PAGE OVERFLOW OCCURS, * THE HEADER FORMAT WILL BE PRINTED OUT. HEADER * FORMAT IS DECIDED OF THE PARAMETER * 'HEADER'. * * INPUT PARAMETERS: HEADER = HEADER FORMAT NUMBER * LINE = LINE FORMAT NUMBER * LINNO = ACTUAL LINE NUMBER * LINMAX= MAXIMUM NUMBER OF LINES IN ONE P * LINEST = LINE START VALUE * * HLINES = NUMBER OF LINES IN HEADER * OUTPUT VARIABLE : DEBINW2= 0 OK * (= 1 CLEAR-KEY, TRY AGAIN) * = 2 CANCEL-KEY * = 3 RET-KEY * PRINT PROC HEADER,LINE,LINNO,LINMAX,LINEST,HLINES PLIT LINMAX MOVE DEBINW2,W0 CLEAR ERROR-SIGNAL EJECT CBNG LINNO,LINMAX,P30 JUMP IF LINMAX NOT REACHED P10 EDWRT DEDSPRT,FRMTAB(HEADER) PRINT HEADER BOK P20 JUMP IF OK B P35 JUMP IF CANC OR RET-KEY P20 ADD FDVBCD(W1),=D'1' INCREMENT PAGENR MOVE LINNO,LINEST REINSTATE LINENUMBER ADD LINNO,HLINES ADJUST FOR HEADLINES P30 EDWRT DEDSPRT,FRMTAB(LINE) PRINT DETAIL-LINE BOK P40 JUMP IF OK P35 MOVE DEBINW4,W32 PRINTER NOT OPERABLE ADD DEBINW4,W3 PERF DERROR,DEKTAB6 B P99 JUMP IF CANC OR RET-KEY P40 ADD LINNO,W1 INCREMENT LINE-NUMBER MOVE DEBINW2,W0 OK P99 RET PEND EJECT FRMTAB FTABLE F21HL,F21DL,F22HL,F22DL * * PRINT FORMAT , FORMAT DEFINITION * F21HL FRMT HEADER FORMAT FTEXT ' 1' FCOPY ='FORMAT' FILLR ':',1 FCOPY FORMAT FTAB 48 FTEXT 'NUMBER OF POOL-UNITS:' FMEL 'XE+XX',FDVBCD(W3) FTAB 100 FCOPY ='PAGE' FILLR ':',1 FMEL 'ZZ9',FDVBCD(W1) FEOR 1ST HEADLINE FILLR ' ',2 FEOR 2ND HEADLINE FILLR ' ',2 FCOPY ='LINE ' FCOPY ='FIELD' FILLR '-',1 FTEXT ' MAX/MIN ' FTEXT 'K M A V I DUPLIC. SPEC. ' FTEXT '#L:<' FCOPY ='FIELD' FTEXT 'LAYOUT> #V:' FCOPY ='VALIDATION ' FTEXT ' #G:' FCOPY ='GENERATION ' FTEXT ' #A:' FCOPY ='ACCUMULATION ' FEOR 3RD HEADLINE FILLR ' ',2 FTEXT ' NO NO/POS -' FCOPY ='LENGTH' FTEXT ' I E T E C -ITEM HANDL.' FEOR 4TH HEADLINE FILLR ' ',2 FEOR 5TH HEADLINE FMEND EJECT * * PRINT FORMAT, FORMAT GENERATION * F21DL FRMT DETAIL LINE FORMAT FILLR ' ',2 FBT BOOL8,F21DA FTAB 4 FMEL 'Z9',FDVBCD(W2) LINE-NR FILLR ' ',1 FMEL 'XXX',FDVBCD(W4) FIELDNR FILLR ' ',2 FMEL 'Z9',FDVBCD(W5) FIELDSTART FILLR ' ',2 FMEL 'Z9',FDVBCD(W6) MAXLENGTH FILLR ' ',2 FMEL 'Z9',FDVBCD(W7) MINLENGTH FILLR ' ',1 FCOPY FDVSTR(W1) KEYED INPUT FILLR ' ',1 FCOPY FDVSTR(W2) MUST ENTER FILLR ' ',1 FCOPY FDVSTR(W3) AUTO.TAB FILLR ' ',1 FCOPY FDVSTR(W4) VERIFY FILLR ' ',1 FCOPY FDVSTR(W5) INIT CLEAR FILLR ' ',1 FCOPY DUPL DUPL ITEM FTAB 41 FMEL 'ZZVZZZ',SPEC SPECIAL HANDLING F21DA FTAB 48 FCOPY STR64A FEOR DETAIL-LINE FMEND EJECT * * PRINT FORMAT , BALANCE FORMAT DEFINITION * F22HL FRMT HEADER FORMAT FTEXT ' 1' FCOPY ='FORMAT' FILLR ':',1 FCOPY FORMAT FTAB 40 FTEXT 'NUMBER OF POOL-UNITS:' FMEL 'XE+XX',FDVBCD(W3) FTAB 100 FCOPY ='PAGE' FILLR ':',1 FMEL 'ZZ9',FDVBCD(W1) FEOR 1ST HEADLINE FILLR ' ',2 FEOR 2ND HEADLINE FILLR ' ',2 FCOPY ='LINE ' FTEXT 'ACCUMULATOR ' FTEXT 'POSITION ' FCOPY ='LENGTH' FTAB 40 FTEXT 'SPECIAL ' FTEXT '#L:<' FCOPY ='FIELD' FTEXT 'LAYOUT> #V:' FCOPY ='VALIDATION ' FTEXT ' #G:' FCOPY ='GENERATION ' FEOR 3RD HEADLINE FILLR ' ',2 FCOPY =' NO' FTAB 11 FCOPY =' NO' FTAB 39 FTEXT 'HANDLING' FEOR 4TH HEADLINE FILLR ' ',2 FEOR 5TH HEADLINE FMEND EJECT * * PRINT FORMAT , BALANCE FORMAT DEFINITION * F22DL FRMT DETAIL-LINEFORMAT FILLR ' ',2 FBT BOOL8,F22DA FTAB 4 FMEL 'Z9',FDVBCD(W2) LINE NR FTAB 12 FMEL 'XX',FDVBCD(W8) ACCUMULATOR NO FTAB 23 FMEL 'Z9',FDVBCD(W5) POSITION FTAB 31 FMEL 'Z9',FDVBCD(W6) LENGHT FTAB 41 FMEL 'ZZVZZ9',SPEC SPECIAL HANDLING F22DA FTAB 48 FCOPY STR64A FEOR DETAIL-LINE FMEND EJECT FORMF FRMT FTEXT ' 1' FMEND END