|
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: 10982 (0x2ae6)
Notes: pts_type(SC)
Names: »DE23ST.SC«
└─⟦48601905a⟧ Bits:30009668 Philips computer tape "600121"
└─⟦this⟧ »S:DE/DE23ST.SC«
└─⟦5c22ed822⟧ Bits:30009675 Philips computer tape "600209"
└─⟦this⟧ »DEN10/DE23ST.SC«
└─⟦79fbed147⟧ Bits:30009697 Philips computer tape "600414"
└─⟦this⟧ »S:DE/DE23ST.SC«
└─⟦bf903a231⟧ Bits:30009665 Philips computer tape "600109"
└─⟦this⟧ »DEN10/DE23ST.SC«
└─⟦d2a299635⟧ Bits:30009698 Philips computer tape "600415"
└─⟦this⟧ »S:DE/DE23ST.SC«
IDENT DE23ST REL 10.0 80-04-11 80-05-05/JAER * * GET FORMAT * THIS FORMAT PROCESS FOLLOWING FUNTIONS * - SEARCH AND DISPLAY FORMAT 'RFW','RBW' * - PRINT HARDCOPY OF FORMAT 'PRT' * - CHANGE FORMAT 'COR' * - DELETE FORMAT 'RDL' * - DISPLAY STATUS-LINE 'STS' * ************************************************************************ DDUM DEDDIV PDIV ENTRY DE23ST * EXT DEAPPL APPLE VALUE HANDLING EXT DECLRA EXT DERR EXT DEDISC DISC-ROUTINE EXT DESTAT STATUS-LINE LOADING EXT DERROR ERROR-MESSAGES EXT DE21ST CHANGE FORMAT DEFINITION EXT DEUNPF UNPACK NEXT FIELD EXT DEUNPL UNPACK NEXT LINE EXT PRFGUF PRINT FORMAT DEFINITION EXT FEDIT EXT ATTDB ATTACH FORMAT-DESCRIPTOR EXT ATTWB ATTACH WORKBLOCK EXT RESTOR RESTORE ORIG.-DESC-POINTER EXT DEPOOL BUFFERRESERVATION-MODUL EXT ATTPRT RESERVE PRINTER EXT DETPRT RELEASE PRINTER INCLUDE DEKEYS,LIST EJECT * * KEYTABLES * * DEKTAB6 KTAB CLR,CAN,RET * DEKTAB7 KTAB CLR,CAN,RET,ENT * DEKTAB8 KTAB CLR,CAN,RET,RFW,RBW, C COR,RDL,STS,PRT * DEKTAB9 KTAB CLR,CAN,RET,RFW,RBW * EJECT DE23ST PROC DEST23 CLEAR BOOL4 CALL RESTOR,W0,W16,PWBDB4 RESTOR ORIG.-DESC.-POINTER MOVE PINDFR,W0 ATTFMT F23GF SET DEPROMPT PROMTTEXT-DISPLAY DE23CA CLEAR DOOL3 PERF DECLRA DATA-ENTRY-SCREEN SET DEPROMPT T=PROMPTTEXT DISPLAY DE23ER IB DEBINW2,CANCEL,RETUR,ENTER,FORW,BACKW MOVE DEBINW4,W0 'FUNCTION NOT ALLOWED' PERF DERR B DE23ER CANCEL CALL RESTOR,W0,W16,PWBDB4 RESTOR ORIG.-DESC.-POINTER CLEAR DEPROMPT B DE23CA ERROR PERF DERROR,DEKTAB6 IB DEBINW2,ENT20,DEL30 B RETUR EJECT ENTER SET BOOL4 CLEAR BOOL6 F=GENERAL FORMAT XCOPY STR1A,W0,W1,FORMAT,W0 CBNE STR1A,='*',ENT05 JUMP IF GENERAL FORMAT SET BOOL6 T=BALANCE FORMAT B ENT08 JUMP BALANCE FORMAT ENT05 CALL ATTDB,BPOOL(PINDFR),W4,W10 ATTACH DESCRIPTOR ENT08 MOVE ELMNO,FLIND(W1) STORE FORMATBUFFER-POINTER ATTFMT BPOOL(ELMNO) ATTACH DEFINED FORMAT PERF FEDIT FORMAT EDITING SET DEPROMPT BZ ENT10 DISPLAY 0,W1,W0 DISPLAY FORMAT ENT10 MOVE DEBINW3,W0 GETFLD 0,DEBINW3,DEBINW4 SET CURSOR ON LAST FIELD ENT20 MOVE DEBINW4,=W'31' PERF DERROR,DEKTAB8 'MAKE YOUR CHOICE' IB DEBINW2,ENT20,DEL30,RELRET,FORW, C BACKW,DELCOR,DELCOR,STS10,PRT10 B ERROR EJECT * * GET NEXT/PREVIOUS FORMAT AND DISPLAY IT * FORW MOVE DEBINW1,=W'31' B NEPR NEXT/PREVIOUS BACKW MOVE DEBINW1,W32 LOAD FUNC-CODE = 32 NEPR PERF DEDISC,DEBINW1 GET NEXT/PREVIOUS FORMAT BOK ENTER CBE DEBINW4,W24,NEPRIU IN USE ? NEPRER PERF DERROR,DEKTAB6 IB DEBINW2,NEPRCL,DEL30,RELRET NEPRCL TBF BOOL4,CANCEL XCOPY FORMAT,W0,W6,RPOOL(PINDFR),W1 B ENT20 NEPRIU PERF DERROR,DEKTAB9 'IN USE'-HANDLING IB DEBINW2,NEPRCL,DEL30,RETUR,FORW,BACKW B ERROR EJECT * * DELETION AND CORRECTION PRE-INITIALIZATION * LOCK FORMAT IN BUFFERS * DELCOR PERF DEPOOL,W8,PINDFR,BIN16,STRG10A FORMAT LOCK BOK DC10 JUMP IF OK WITH LOCK B ERROR DC10 CBE DEBINW2,W6,COR10 JUMP IF CORR-MODE EJECT * * DELETION * MOVE DEBINW4,W17 LOAD 17 PERF DERROR,DEKTAB7 'PRESS ENTER TO CONFIRM' IB DEBINW2,ENT20,ENT20,DEL30 DEL20 PERF DEDISC,W13 DELETE FORMAT ON DISC BOK DEL30 JUMP IF OK DEL25 PERF DERROR,DEKTAB6 ERROR-MESSAGE IB DEBINW2,ENT20,ENT20 DEL30 PERF DEPOOL,W6,PINDFR,BIN16,STRG10A RELEASE BUFFERS DEL40 B DEST23 EJECT * * CORRECTION * * BOOL7 = T INDICATE CORR-MODE * DOOLA = T INDICATE CORR-MODE * COR10 CALL RESTOR,W0,W16,PWBDB4 RESTOR ORIG.-DESC.-POINTER SET BOOL7 T= CORR-MODE SET DOOLA T=CORR-MODE MOVE PINDCB,FLIND(W1) LOAD BUFFERINDEX MOVE CURSEC,W0 LOAD BUFFERPOINTER * * RELEASE DESCRIPTOR BUFFERS * MOVE DEBINW3,W0 WORK:=0 MOVE DEBINW2,W0 NUMB OF DESC.BUFFERS:=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 TBT BOOL6,COR30 JUMP IF BALANCE FORMAT XCOPY WORK(W3),W1,W1,RPOOL(PINDFR),W18 SAVE NUMB DESC BUFFERS SUB WORK(W4),WORK(W3) ADJUST NUMB OF FPOOLS COR20 XCOPY DEBINW3,W1,W1,RPOOL(PINDFR),W8 LOAD LINK TO NEXT XCOPY DEINPUT,W0,W7,RPOOL(PINDFR),W0 SAVE TYPE & NAME XCOPY RPOOL(PINDFR),W7,W2,W0,W0 XCOPY RPOOL(PINDFR),W0,W1,PICSTR,W5 'X'-FREEMARK MOVE PINDFR,DEBINW3 NEXT BUFFER ADD DEBINW2,W1 NUMB OF REL. DESC.BUFFERS+1 CBE WORK(W3),DEBINW2,COR25 JUMP IF ALL RELEASED B COR20 GO ON COR25 XCOPY RPOOL(PINDFR),W0,W7,DEINPUT,W0 RESTORE TYPE & NAME COR30 PERF DE21ST CLEAR BOOL7 F=NEW FORMAT CLEAR DOOLA F=NO CORR-MODE CBNE DEBINW4,W0,NEPRER JUMP ON ERROR CODE CBE DEBINW2,W2,DEL30 JUMP ON RET-KEY INV DEPROMPT CBE PINDFR,W0,DEL40 JUMP IF NO CURRENT FORMAT B ENTER EJECT * * PRINT STATUS LINE * STS10 PERF DESTAT LOAD STATUS-LINE MOVE DEBINW4,W19 B ERROR EJECT * * PRINT CURRENT FORMAT * PRT10 * * 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) * CLEAR DEPROMPT 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 PRT20 PERF DERROR,DEKTAB6 ERROR-MESSAGE IF NOT OK B PRT40 PRT20 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 PERF ATTPRT RESERVE PRINTER BNOK PRT30 PERF PRFGUF PRINT USER FORMAT PERF DETPRT RELEASE PRINTER B PRT35 PRT30 PERF DERROR,DEKTAB6 ERROR MESSAGE IF NOT OK PRT35 MOVE BIN4,WORK(W5) RESTORE WORKBUFFERINDEX PERF DEPOOL,W6,BIN4,BIN16,STRG10A RELEASE WORK BUFFER CALL RESTOR,W8,W4,PWBDB4 RESTOR ORIG.-DESC.-POINTER PRT40 IB DEBINW2,ENTER,DEL30,RELRET JUMP DEP ON KEY-INDEX B ENTER EJECT RELRET PERF DEPOOL,W6,PINDFR,BIN16,STRG10A RELEASE BUFFERS RETUR CALL RESTOR,W0,W16,PWBDB4 RESTOR ORIG.-DESC.-POINTER RET PEND EJECT F23GF FRMT FSL FTEXT '23 GET ' FCOPY ='FORMAT' FNL FCOPY ='FORMAT' FILLR ':',1 FKI 9,APPL=104,MINL=1,MAXL=6,ALPHA,NEOI,ME,NCLR FCOPY FORMAT FMEND END