|
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: 14254 (0x37ae)
Notes: pts_type(SC)
Names: »DE21ST.SC«
└─⟦5c22ed822⟧ Bits:30009675 Philips computer tape "600209"
└─⟦this⟧ »DEN10/DE21ST.SC«
└─⟦79fbed147⟧ Bits:30009697 Philips computer tape "600414"
└─⟦this⟧ »S:DE/DE21ST.SC«
└─⟦bf903a231⟧ Bits:30009665 Philips computer tape "600109"
└─⟦this⟧ »DEN10/DE21ST.SC«
IDENT DE21ST REL 10.0 80-04-11 80-07-14/JAER * * FORMAT DEFINITION * THIS PROGRAM CREATE FORMATS. * USED VARIABLES : BOOL6 = F GENERAL FORMAT DEFINITION * T BALANCE FORMAT DEFINITION * BOOL7 = F NEW FORMAT DEFINITION * PRECCUR= LAST FIELDNR IN 'FORM.DEF.'-FORMAT * DDUM DEDDIV PDIV * ENTRY DE21ST * ENTRY DEFGTC * EXT PRFGUF PRINT USER FORMAT DEFINITION EXT DERROR ERROR-MESSAGES EXT DEPOOL BUFFERRESERVATIN-MODUL EXT DEDISC DISC-ROUTINE EXT DEFDSC FORMAT DEF.-SCREEN EXT MTEXT STEERING PROCEDURE * EXT FLINK FORMAT LINKING EXT FCODE FORMAT CODE GENERATION EXT FMOVE FORMAT MOVE PROCEDURE EXT FEDIT FORMAT EDITING EXT UPDBOL UPDATE BOOLEAN/WORD EXT UPDBIN UPDATE WORD/BOOLEANS EXT EMPTYT CHECK EMPTY ITEM EXT ATTDB ATTACH DESCRIPTOR EXT ATTWB ATTACH WORKBLOCK EXT RESTOR RESTOR ORIGINAL DESC.-POINTERS EXT ATTPRT RESERVE PRINTER EXT DETPRT RELEASE PRINTER * INCLUDE DEKEYS,LIST EJECT * * KEYTABLES * * DEKTAB6 KTAB CLR,CAN,RET * DEKTAB8 KTAB CLR,CAN,RET,ENT,COR,RDL,PRT * DEKTAB9 KTAB CLR,CAN,RET,ENT * EJECT * * CLEAR ALL VARIABLE FIELD BEFORE HANDLING THE PICTURE * DE21ST PROC * SET DEPROMPT T=PROMPTTEXT DISPLAY TBT BOOL7,DEFD00 JUMP IF CORRECTION MODE CLEAR DOOLA CBE BIN2,W2,DE22BF JUMP IF BALANCE FORMAT CLEAR BOOL6 INDICATE GENERAL FORMATDEF B DEFD00 DE22BF SET BOOL6 T=BALANCE FORMAT * * REDFINITION OF 'DB2'-BLK * * RESERVE ONE WORK-BUFFER FOR FORMAT GENERATION * -ATTACH RESERVED WITH NEW DESCRIPTOR * -ATTACH RESERVED BUFFER AS WORK-BLOCK * * DB2 BLK * <ITEM> BIN X'20020000' * <ITEM> BIN X'20020000' * <ITEM> BIN (12) X'A0020004000C0000' * FORTAB STRG (2),80 X'8050001C00020000' * JOBSPC STRG 160 X'00A0001C' * JOBSPC REDEFINES FORTAB(W2) * DEFD00 MOVE BIN16,W0 NUMBER OF CONSEC BUFFERS MOVE BIN4,W1 NUMBER OF WANTED BUFFERS PERF DEPOOL,W2,BIN4,BIN16,STRG10A GET BUFF WITH LOCK BOK DEFD10 JUMP IF OK PERF DERROR,DEKTAB6 IB DEBINW2,DEFD00,DEFD00 B RETEX DEFD10 MOVE WORK(W5),BIN4 SAVE POINTER TO WORK BUFFER MOVE BPOOL(BIN4),=X' MOVE IN DESCRIPTOR C 20020000 C 20020000 C A0020004000C0000 C 8050001C00020000 FORTAB (2),80 C 00A0001C00 JOBSPC 160 C ' CALL ATTDB,BPOOL(BIN4),W0,W12 CALL ATTWB,BPOOL(BIN4),W0,W12 DEFDST PERF DEFDSC CBE DEBINW2,W4,KTOT JUMP IF TOT-KEY B RETERR EJECT KTOT CBG RNRFMCH,W29,KTOT05 JUMP IF LAST BUFFER USED MOVE BIN16,W188 SUB BIN16,W8 LIMIT FOR FLINK PERF FLINK,BIN16,W0 GENERATE FLINK IF NEEDED IB DEBINW2,RETERR,RETERR,RETERR,KTOT10 KTOT05 CALL FMOVE,STRG10A,FDUM MOVE BIN15,W7 WORK:=7 MATCH STRG10A,BIN15,W3,FDIR,W0,W1 1- OR 2-BYTE ? XCOPY BPOOL(BIN3),BIN1,BIN15,STRG10A,W0 STORE DUMMY FIELD ADD BIN1,BIN15 ADJUST BUFFERPOSITION KTOT10 PERF FCODE,W12 GENERATE FEXIT=E9 ADD PRECPR,PINDND TOT NUMBERS OF BUFFERS XCOPY RPOOL(PINDDB),W17,W1,PRECPR,W1 STORE NUMB OF BUFFERS TBT BOOL6,KTOT12 JUMP IF BALANCE XCOPY RPOOL(PINDDB),W18,W1,PINDND,W1 STORE NUMB OF DESCBUFFERS ADD BIN10,W1 ADJUST NUMB OF FIELDS F0 XCOPY BPOOL(PINDDB),W2,W2,BIN10,W0 STORE DESC-LENGTH NUMBER OF FIELDS ADD BIN14,BIN13 XCOPY BPOOL(PINDDB),W4,W2,BIN14,W0 STORE TOTAL LENGTH F0 KTOT12 MOVE DEINPUT,FORMAT TBF BOOL7,KTOT18 JUMP IF NOT CORR-MODE KTOT14 PERF DEDISC,W13 DELETE FORMAT BOK KTOT16 PERF DERROR,DEKTAB6 SUB DEBINW2,W1 ADJUST KEY-INDEX IB DEBINW2,RETERR,RETERR B KTOT14 KTOT16 PERF DEPOOL,W6,PINDFR,BIN16,STRG10A RELEASE BUFFERS KTOT18 MOVE PINDFR,PINDDB PERF DEDISC,W9 STORE FORMAT ON DISC BOK KTOT20 PERF DERROR,DEKTAB6 DISPLAY ERROR SUB DEBINW2,W1 ADJUST KEY-INDEX TBT SW95PR,KTOT20 IB DEBINW2,KTOT19,KTOT19 CBE DEBINW4,W10,KTOT18 NO DISK SPACE KTOT19 B RETUR KTOT20 PERF DEPOOL,W6,PINDFR,BIN16,STRG10A RELEASE BUFFERS KTOT25 MOVE PINDFR,W0 MOVE FRMTPNTR,W0 FORMATPOINTER:=0 PERF DEDISC,W10 GET FORMAT BOK KTOT30 PERF DERROR,DEKTAB6 SUB DEBINW2,W1 ADJUST KEY-INDEX IB DEBINW2,RETERR,RETERR B KTOT25 KTOT30 PERF DEPOOL,W8,PINDFR,BIN16,STRG10A LOCK BOK KTOT35 PERF DERROR,DEKTAB6 ERROR-MESSAGE SUB DEBINW2,W1 ADJUST KEY-INDEX IB DEBINW2,RETERR,RETERR B KTOT30 KTOT35 PERF DEDISC,W13 DELETE FORMAT BOK KTOT40 PERF DERROR,DEKTAB6 SUB DEBINW2,W1 ADJUST KEY-INDEX IB DEBINW2,RETERR,RETERR B KTOT35 KTOT40 MOVE DEBINW4,PINDFR PERF DEPOOL,W11,DEBINW4,BIN16,STRG10A UNLINK FORMCHAIN TBT BOOL6,KTOT55 JUMP IF BALANCE FORMAT CALL ATTDB,BPOOL(PINDFR),W4,W10 ATTACH DESCR. KTOT55 MOVE ELMNO,FLIND(W1) LOAD FORMATBUFFER-POINTER ATTFMT BPOOL(ELMNO) ATTACH DEFINED FORMAT PERF FEDIT FORMAT EDITING DISPLAY 0,W1,W0 SET DEPROMPT T=PROMPTTEXT DISPLAY TBT BOOL6,KTOT70 JUMP IF BALANCE FORMAT MOVE DEBINW3,W1 MOVE DEBINW4,W0 GETFLD 3,DEBINW3,DEBINW4 CHECK IF ACCFIELDS BP KTOT60 NO ACCFIELDS BN KTOT60 NO ACCFIELDS SET DBOACC INDICATE ACCFIELDS IN FORMAT KTOT60 MOVE DEBINW3,W1 MOVE DEBINW4,W0 GETFLD 4,DEBINW3,DEBINW4 CHECK IF VERIFY-FIELDS BP KTOT65 NO VERIFY-FIELDS BN KTOT65 NO VERIFY-FIELDS SET DBOMVR INDICATE MUST BE VERIFY KTOT65 CALL UPDBIN,BIN1 UPDATE STATUS-WORD XCOPY BPOOL(PINDFR),W0,W1,BIN1,W1 STORE RECORD STATUS KTOT70 XCOPY FORMAT,W0,W6,RPOOL(PINDFR),W1 CALL RESTOR,W0,W2,PWBDB4 RESTOR ORIGINAL DESC.-POINTERS PERF DEDISC,W9 STORE FORMAT ON DISC BOK KTOT75 JUMP IF OK PERF DERROR,DEKTAB6 DISPLAY ERROR SUB DEBINW2,W1 ADJUST KEY-INDEX TBT SW95PR,KTOT75 IB DEBINW2,KTOT71,KTOT71 CBE DEBINW4,W10,KTOT70 NO DISC SPACE KTOT71 B RETERR KTOT75 CALL ATTDB,BPOOL(PINDFR),W4,W10 ATTACH DESCR. MOVE DEBINW3,W0 GETFLD 0,DEBINW3,DEBINW4 TBT BOOL6,KTOT78 NO WARNING WHEN BALANCE SUB BIN10,W1 ADJUST FOR DUMMY FIELD CBNG WORK(W6),BIN10,KTOT78 GENFIELD NOT GR MAXFIELD MOVE BCD13A,WORK(W6) LOAD GENFIELD BCD MOVE WORK(W6),W0 MOVE BIN10,W1 MOVE DEBINW4,=W'39' WARNING PERF DERROR,DEKTAB6 KTOT78 CALL RESTOR,W0,W2,PWBDB4 RESTOR ORIGINAL DESC.-POINTERS TBF DOOLA,KTOT79 F=CORR FROM THIS PROGRAM TBT BOOL7,RETUR JUMP IF CORR KTOT79 MOVE DEBINW4,=W'31' PERF DERROR,DEKTAB8 ' CONFIRM' SUB DEBINW2,W1 ADJUST KEY-INDEX IB DEBINW2,RETUR,RETUR, CLR,CAN,RET C RETUR,KTOT95,KTOT90,KTOT80 ENT,COR,RDL B RETUR JUMP ON CLEAR-KEY KTOT80 * PRT PRESSED CALL ATTDB,BPOOL(PINDFR),W4,W10 ATTACH DESCR. ATTFMT BPOOL(ELMNO) ATTACH DEFINED FORMAT PERF FEDIT FORMAT EDITING PERF ATTPRT RESERVE PRINTER BOK KTOT88 PERF DERROR,DEKTAB6 B KTOT78 KTOT88 PERF PRFGUF PRINT FORMAT DEFINITION PERF DETPRT RELEASE PRINTER CALL RESTOR,W0,W2,PWBDB4 RESTOR ORIGINAL DESC.-POINTERS B KTOT78 KTOT90 RDEL-KEY MOVE DEBINW4,W17 PERF DERROR,DEKTAB9 'PRESS ENT TO CONFIRM' SUB DEBINW2,W1 ADJUST KEY-INDEX IB DEBINW2,RETUR,RETUR,KTOT92 B KTOT78 KTOT92 PERF DEDISC,W13 DELETE FORMAT MOVE DEBINW2,W0 BOK RETUR PERF DERROR,DEKTAB6 SUB DEBINW1,W1 ADJUST KEY-INDEX IB DEBINW2,RETUR,RETUR B KTOT90 JUMP ON CLEAR-KEY KTOT95 COR-KEY SET BOOL7 MOVE PINDCB,FLIND(W1) LOAD BUFFERINDEX MOVE CURSEC,W0 LOAD BUFFERPOINTER:=0 MOVE WORK(W3),W0 WORK:=0 MOVE WORK(W4),W0 NUMB OF FPOOLS:=0 XCOPY WORK(W4),W1,W1,RPOOL(PINDFR),W17 SAVE NUMB POOLS XCOPY WORK(W3),W1,W1,RPOOL(PINDFR),W18 SAVE NUMB DESC BUFFERS SUB WORK(W4),WORK(W3) ADJUST NUMB OF FPOOLS B DEFDST EJECT * * ERROR IN FORMAT GENEREATION OR STOPPED BY KEYPROSSECING * RETERR PERF DEPOOL,W6,PINDFR,BIN16,STRG10A RELEASE BUFFERS CLEAR BOOL7 BZ RETEX JUMP IF NEW FORMAT MOVE PINDFR,PINDDB CHANGE BUFFERPOINTER PERF DEPOOL,W6,PINDFR,BIN16,STRG10A RELEASE BUFFERS B RETCH RETUR PERF DEPOOL,W6,PINDFR,BIN16,STRG10A RELEASE BUFFERS CLEAR BOOL7 BZ RETEX JUMP IF NEW REG. TBF DOOLA,RETEX JUMP IF CORR FROM THIS PR. RETCH MOVE DEINPUT,FORMAT RESTORE FORMAT NAME PERF DEDISC,W10 RETEX CBG DEBINW2,W1,REXIT JUMP IF NOT CANCEL-KEY TBT DOOLA,REXIT JUMP IF CORR B DEFDST JUMP ON CANCEL-KEY REXIT MOVE BIN4,WORK(W5) RESTORE WORKBUFFERINDEX PERF DEPOOL,W6,BIN4,BIN16,STRG10A RELEASE WORK BUFFER RET PEND EJECT DEFGTC PROC GETABX DEBINW4 IB DEBINW4,FNR1,FPS1,FPS1,FNR4, C FNR5,FPS1,FPS1,FPS1,FPS1,FPS1, C FPS1,FPS1,FPS1,FPS1 B DETC97 NO TAB * * FIELD 1 FORMAT NAME * FNR1 CBE DEBINW2,W7,F2BTB JUMP IF BTB CBE DEBINW2,W8,F1HOM JUMP IF HOM B DETC99 TAB OK F1HOM TBT BOOL7,DETC84 JUMP IF CORR MODE TBT DOOL1,DETC84 NO HOME ALLOWED * * HOME ALLOWED FIELD NOT CONFIRMED WITHIN LINE * F1A TBT DOOL2,F1B JUMP IF ALREADY DEL ONCE MOVE FMTWK(W8),BIN3 SAVE CURR BUFFERIND MOVE BIN3,FMTWK(W7) REESTORE LAST LINE'S BUFFIND SET DOOL2 T=LINE DELETED TBF BOOL2,F1B JUMP IF NO FIELD MATCH SUB BIN10,W1 ADJUST FIELD NR F1B MOVE BIN1,FMTWK(W6) RESTORE LASTLINE'S STPOINT TBF BOOL1,DETC99 HOME TO FIELD 1 CBE DEBINW4,W3,DETC99 JUMP FIELD ALREADY = 3 MOVE DEBINW4,W3 B DETC92 * * PRE SELECTION FIELD 2,3,6-15 * FPS1 CBE DEBINW2,W3,DETC99 JUMP IF EOI CBE DEBINW2,W6,DETC99 JUMP IF PLS * BTB IB DEBINW4,DETC97,F2BTB,F1HOM,DETC97, FIELD 1-4 C DETC99,DETC99,F3Z,DETC99, FIELD 5-8 C DETC99,DETC99,DETC99,DETC99, FIELD 9-12 C F3Z B DETC97 F2BTB TBF BOOL1,DETC99 NO FIELDS TAB OK MOVE DEBINW4,W3 FIELD 3 NO TAB => 'PEEP' B DETC90 * * FILED 3 LINE DESIGN * F3Z TBT BOOL2,DETC99 BTB OK IF FIELD FOUND B F1A * * FIELD 4 KEYED INPUT FIELD * FNR4 CBE DEBINW2,W3,F4EOI JUMP IF EOI CBE DEBINW2,W6,F4PLS JUMP IF PLS CBE DEBINW2,W7,DETC99 JUMP IF BTB B DETC97 TAB NOK F4EOI F4PLS MOVE BIN5,W0 PERF MTEXT MATCH AND EDIT TEXT SET DOOL6 T=MTEXT/DETCH PASSED ONCE CBNE DEBINW2,W0,DETC98 JUMP IF NOY OK TBT BOOL2,DETC99 TBFWD OK FIELD 4 TBT DOOL5,DETC99 JUMP IF CORR LINE MOVE DEBINW4,PRECCUR LAST FIELDNR B DETC92 TAB NOT ALLOWED * * CHECK IF ACC-FIELD EMPTY WHEN BALANCE FORMAT * FNR5 TBF BOOL6,DETC99 JUMP IF USER FORMAT CBE DEBINW2,W7,DETC99 JUMP IF BTAB CALL EMPTYT,FDVBCD(W8) BNOK DETC84 TAB NOT ALLOWED B DETC99 ACCFIELD NOT EMPTY OK DETC84 FIELD 4 NO TAB => 'PEEP' MOVE DEBINW4,W4 DETC90 GETFLD 0,DEBINW4,DEBINW3 DETC97 MOVE DEBINW2,W0 OK DETC98 MOVE DEBINW3,W2 TAB NOT ALLOWED B DETCRT DETC92 GETFLD 0,DEBINW4,DEBINW3 DETC99 MOVE DEBINW3,W0 TAB ALLOWED MOVE DEBINW2,W0 OK DETCRT RET PEND EJECT * * DUMMY FORMAT TO BE GENERATED AS DUMMY-FIELD * IN EVERY GENERATED FORMAT * FDUM FRMT FKI 1,ALPHA FCOPY HEX00 FMEND END