|
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: 11044 (0x2b24)
Notes: pts_type(SC)
Names: »DENT29.SC«
└─⟦48601905a⟧ Bits:30009668 Philips computer tape "600121"
└─⟦this⟧ »S:DE/DENT29.SC«
└─⟦d2a299635⟧ Bits:30009698 Philips computer tape "600415"
└─⟦this⟧ »S:DE/DENT29.SC«
IDENT DENT29 PRR 1.0 76-10-29/DALI DDUM DEDDIV PDIV ENTRY DENDUP ENTRY DEEDIT ENTRY DELAST EXT DERECS EXT DEACC EXT DECLRN EXT DECLRD EXT DERR EXT TESTB TEST FOR A BIT IN A BIN EXT GETDUP LOOK FOR DUPLICATION- STRING FOR CURRENT FIELD EXT DEDISC DISC HANDLING ROUTINE EXT ATTDB ASSEMBLY SUBROUTINE ATTDB - ATTACH DESCRIPTORBLOCK EXT ATTWB ASSEMBLY SUBROUTINE ATTWB - ATTACH WORKBLOCK EXT EMPTYT EXT TYPET ASSEMBLY SUBROUTINE TYPET - RETURNS ITEM-TYPE. 1=BIN,2=BCD,3=STRG EXT DEPOOL POOL HANDLING ROUTINE EXT MASK EXT DELOCK EXT DEPRUT INCLUDE DELITT EJECT ****************************************** * THIS ROUTINE HANDLE THE KEY FOR * DUPLICATION AND EXECUTE THE * AUTOMATIC DUPLICATION WHEN * THE KEEP KEY HAS BEEN PRESSED ****************************************** DENDUP PROC CLEAR BOOL5 CALL GETDUP,BPOOL(W1),BIN11,BIN12,BIN13 BOK KDUP05 KDUP03 CBE DEBINW2,W3,KDUP35 JUMP IF AUTODUP DUPL DEINPUT BNZ KDUP40 SET BOOL5 B KDUP30 KDUP05 MOVE BIN9,W5 MATCH VALSTR,BIN9,W8,BPOOL(BIN11),BIN12,W1 LOOK IF DUPL FROM VALUESET BNOK KDUP40 JUMP IF NOT CBE BIN9,W5,KDUP25 JUMP IF DATE SUB BIN9,W8 ADJUST FOR THE OTHER BL KDUP40 ADD BIN12,W1 GET ITEMNUMBER MOVE BIN8,W0 XCOPY BIN8,W1,W1,BPOOL(BIN11),BIN12 ADD BIN12,W1 MOVE BCD3A,BIN8 CBNE BIN9,W4,KDUP25 JUMP IF NOT VALUESET MOVE BIN8,W18 LOOK IF ELEMENTNUMBER MATCH VALSTR,BIN8,W1,BPOOL(BIN11),BIN12,W1 BOK KDUP20 KDUP10 PERF DELAST,W5,DEKTAB7 IB DEBINW2,KDUP60,KDUP60,KDUP60,KDUP10 SUB DEBINW1,W1 BZ KDUP10 COPY DEINPUT,DEBINW1,W1,HEX00,W0 DELETE ENTER-KEY MOVE BCD13A,DEINPUT MOVE ELMNO,BCD13A CBE ELMNO,W0,KDUP10 B KDUP15 KDUP20 ADD BIN12,W1 XCOPY ELMNO,W1,W1,BPOOL(BIN11),BIN12 KDUP15 MOVE TABLE,BCD3A MOVE STR1A,=C'T' DLETE TABLE,W0,W2 INSRT TABLE,W2,W1,HEX00,W0 INSRT TABLE,W0,W1,STR1A,W0 PERF DEDISC,W24 GET VALUSET BNOK KDUP50 CALL ATTWB,BPOOL(PINDTB),W8,W11 CALL ATTDB,BPOOL(PINDTB),W0,W11 MOVE BIN10,W0 XCOPY BIN10,W1,W1,RPOOL(PINDTB),W17 SUB ELMNO,BIN10 ADD ELMNO,W1 KDUP25 PERF DEEDIT,BIN9 CBE PINDTB,W0,KDUP30 JUMP IF NOT VALUESET PERF DEPOOL,W6,PINDTB,BIN10,STRG10A MOVE PINDTB,W0 KDUP30 CALL EMPTYT,:FMTITEM BNZ KDUP32 JUMP IF EMPTY GETABX DEBINW3 ERASE 9,DEBINW3,DEBINW3 KDUP32 UPDFLD 1,DEINPUT UPDATE FIELD WITH DISPLAYING MOVE DEBINW2,W2 CLEAR BOOL5 BNZ KDUP38 KDUP35 SET DOOL5 KDUP38 CMP W1,W1 OK RET KDUP40 MOVE DEBINW4,W0 INDICATE ILLEGAL EOI-KEY KDUP50 MOVE DEBINW2,W0 KDUP60 CMP W1,W0 RET PEND EJECT ***************************************** * *THIS PROCEDURE EDIT ITEMS FOR VALIDATIONS *INTO THE ITEM DEINPUT. *LEGAL FUNCTIONCODES AREX. * <FC> = 0 ACCUMULATORS * = 1 SYSTEMVARIABELS * = 2 USERVARIABELS * = 3 FIELDS WITHIN CURRENT FORMAT * = 4 VALUESETS * = 5 DATE * = 6 VALUESETINDEX (ELEMENTNO) * ***************************************** DEEDIT PROC FC MOVE BIN10,W1 LENGTHADJUSTER MOVE DEINPUT,HEX00 MOVE BIN7,W0 IB FC,DED300,DED330,DED200,DED100,DED170,DED160 MOVE DEINPUT,ACK(BIN8) B DED390 DED100 CALL TESTB,BPOOL(PINDTB),W2 BNZ DED150 JUMP IF BCD XCOPY BIN7,W1,W1,BPOOL(PINDTB),W1 COPY DEINPUT,W0,BIN7,FDVBCD(ELMNO),W0 RET DED150 MOVE DEINPUT,FDVBCD(ELMNO) RET EJECT * * VALUE SET INDEX (ELEMENTNO) * DED160 MOVE BCD3A,VSEIND BINCONV=>BCD MOVE DEINPUT,BCD3A BCDCONV=>STRG RET DED170 MOVE DEINPUT,DATE DLETE DEINPUT,W0,W1 B DED400 DED200 TBF DOOLA,DED210 JUMP IF NOT BALANCE MOVE DEINPUT,:FMTITEM B DED400 DED210 * LOOK FOR TYPE OF ITEM BY USING TYPET CALL TYPET,BIN7,X.PSEUDO,X.WB10,BIN8 CBE BIN7,W2,DED250 JUMP IF BCD MOVE BIN7,W0 EDSUB DEINPUT,BIN7,FORMF B DED390 DED250 CON X.MOVE,DEINPUT,X.PSEUDO,X.WB10,BIN8 B DED400 DED300 EDSUB DEINPUT,BIN7,FORMS B DED350 DED330 EDSUB DEINPUT,BIN7,FORMU DED350 MOVE DEBINW1,BIN7 RET DED390 MOVE BIN10,W0 DED400 MOVE DEBINW1,W0 MOVE BIN7,=W'80' MATCH DEINPUT,DEBINW1,BIN7,HEX00,W0,W1 DED450 SUB DEBINW1,BIN10 BNN DED470 JUMP IF NOT MINUS MOVE DEBINW1,W0 DED470 RET PEND EJECT ************************************* * DISPLAY AND READ OF FUNCTION-KEYS * * ENTERED ON THE LAST LINE. * ************************************* DELAST PROC FC,$KEYT MOVE BIN15,FC LASTD0 MOVE DEBINW4,W24 ERASE 0,DEBINW4,DEBINW4 EDWRT DEDSSCRN,FLAST(FC) LAST05 MOVE DEBINW1,W0 LASTD1 IB FC,LPROG,LDEL,LDEL,LINS,LVAL,LINS,LASRET2 C LASRET3,LASVER,LASRET2 B LINS LPROG MOVE DEBINW1,SYMREC(W12) GET MAX SYMB.LENGTH CBG DEBINW1,W0,LPROG2 MOVE DEBIW2,W2 SIMULATE CANCEL ERASE 0,DEBINW4,DEBINW4 B LASVER LPROG2 KI DEDSDYKB,DEINPUT,$KEYT,DEBINW1,DEBINW2 B LAST50 LVAL MOVE DEBINW1,W2 B LPROG2 LDEL LINS MOVE DEBINW1,W1 LASTD2 KI .NE,DEDSDYKB,DEINPUT,$KEYT,DEBINW1,DEBINW2 LAST50 PERF DELOCK,W1,DEBINW2 IB DEBINW3,POWOFF,LASTER,LASTD0 B LASTD3 * * NOK. NOTICE THAT INCORRECT LENGTH IS OKEY * LASTER XSTAT DEDSDYKB,DEBINW3 CALL MASK,DEBINW3,W8 BZ LASBEL MOVE DEBINW2,W5 B PROEN2 LASTD3 IB FC,LASRET,LASRET,LAST06,LASRET,LASRET C LAST06,LAST06,LAST06,LAST06,LAST06 C LASRET,LASRET,LASRET LAST06 IB DEBINW2,LASBEL,LASBEL,LASBEL SUB DEBINW2,W3 ADJUST EOI0KEY B LASRET LASBEL EDWRT DEDSSCRN,BELL ACOUSTIC ALARM B LAST05 LASKOP MOVE DEBINW3,W1 PRINT DEDSPRT,DEBINW3,W0 B LASTD0 LASVER EDWRT DEDSSCRN,BELL ACOUSTIC ALARM B LASRET3 * * POWER OFF * POWOFF DISPLAY 0,W1,W0 B LASTD0 * PROEN2 IB FC,LASTUT,LASTD0,LASTD0,LASTD0,LASTUT LASTUT ADD DEBINW1,W1 LASRET ERASE 0,DEBINW4,DEBINW4 LASRET2 RET LASRET3 THOME RET PEND EJECT * * FORMATS * FLAST FTABLE FPROG,FDEL1,FDEL2,FLIN1,FLVAL,FLINS,FRECOV C FCORR,FVER,FRECO2,FFORCE,FCONV0,FCONV1 FPROG FRMT FSL FLOW FCOPY =C'SYMBOLIC:' FMEND FDEL1 FRMT FSL FLOW FTEXT 'CONFIRM RECORD DELETE:' FMEND FDEL2 FRMT FLINK FDEL3 FTEXT 'DELETED' FMEND FLINS FRMT FLINK FDEL3 FTEXT 'INSERTED' FMEND FDEL3 FRMT FSL FLOW FCOPY =C'RECORD' FILLR ' ',1 FMEL 'TTTT9',BCD13A FILLR ' ',1 FMEND FLVAL FRMT FSL FLOW FTEXT 'DUPL FROM ' FCOPY =C'VALUESET' FTEXT ' T:' FMEL 'XX',BCD3A FILLR ' ',1 FCOPY =C'ELEMENT' FCOPY =C'NUMBER' FILLR ':',1 FMEND FLIN1 FRMT FSL FLOW FTEXT 'CONFIRM RECORD INSERT' FMEND FRECOV FRMT FSL FLOW FTEXT 'RECOVERY OF ' FCOPY =C'JOB' FILLR ':',1 FCOPY JOBNAME FILLR ' ',1 FCOPY =C'BATCH' FILLR ':',1 FCOPY BATCH FTEXT ' RUNNING.' FMEND FCORR FRMT FSL FLOW FTEXT 'RECORD CORRECTION' FMEND FVER FRMT FSL FLOW FTEXT 'RECORD MUST BE VERIFIED' FMEND FRECO2 FRMT FSL FTEXT 'RECOVERY RUNNING.' FMEND FFORCE FRMT FSL FCOPY =C'CONFIRM ' FTEXT 'FREEZING OF BATCH ' FCOPY BATCH FMEND FCONVA FRMT FCOPY =C'CONFIRM ' FTEXT 'CONVERSION OF ALL BATCHES ' FMEND FCONV0 FRMT FSL FLINK FCONVA FTEXT 'ON UNIT:U' FMEL 'X',USERFILE FMEND FONV2 FCONV1 FRMT FSL FLINK FCONVA FTEXT 'WITHIN JOB:' FCOPY JOBNAME FMEND FORMF FRMT FCTL X'C0',X.PSEUDO,X.WB10,BIN8 FMEND FORMS FRMT FCOPY SYSV(BIN8) FMEND FORMU FRMT FCOPY USEV(BIN8) FMEND BELL FRMT FSL FILLR X'07',1 FMEND * END