|
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: 14252 (0x37ac)
Notes: pts_type(SC)
Names: »DENT02.SC«
└─⟦48601905a⟧ Bits:30009668 Philips computer tape "600121"
└─⟦this⟧ »S:DE/DENT02.SC«
└─⟦d2a299635⟧ Bits:30009698 Philips computer tape "600415"
└─⟦this⟧ »S:DE/DENT02.SC«
IDENT DENT02 REL 10.0 80-04-11 UPD 80-04-23/DALI 80-04-08/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 CMPIND 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,KDUP02 JUMP IF AUTODUP CBNE DEBINW2,W11,KDUP04 JUMP IF KEEP KDUP02 B KDUP35 KDUP04 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 BNOK KDUP10 ADD BIN12,W1 XCOPY ELMNO,W1,W1,BPOOL(BIN11),BIN12 B 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 KDUP20 CBNE ELMNO,W0,KDUP15 CBE VSEIND,W0,KDUP13 MOVE ELMNO,VSEIND B KDUP15 KDUP13 VALUESETINDEX =0 MOVE DEBINW4,W9 NOT FOUND B KDUP50 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 MOVE VSEIND,ELMNO 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 PERF DEPOOL,W6,PINDTB,BIN10,STRG10A TSTCTL 0 LOOK IF ALPHA BNZ KDUP30 YES GETCTL 1,DEBINW4 GET MAXL SUB DEBINW4,DEBINW1 - LENGTH OF DEINPUT BNN KDUP30 MAXL NOT LESS MUL DEBINW4,=W'-1' DLETE DEINPUT,W0,DEBINW4 SUB DEBINW1,DEBINW4 KDUP30 CALL EMPTYT,:FMTITEM LOOK IF EMPTY BNZ KDUP32 YES! TSTCTL 0 LOOK IF ALPHA BZ KDUP27 JUMP IF BCD GETCTL 1,DEBINW4 GET MAXL MOVE DEBINW3,W0 MATCH DEINPUT,DEBINW3,DEBINW4,:FMTITEM,W0,DEBINW4 BOK KDUP33 B KDUP28 KDUP27 MOVE BCDI21(W1),DEINPUT CBE BCDI21(W1),:FMTITEM,KDUP33 KDUP28 GETABX DEBINW3 ERASE 9,DEBINW3,DEBINW3 KDUP32 UPDFLD 1,DEINPUT UPDATE FIELD WITH DISPLAYING KDUP33 MOVE DEBINW2,W3 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 MOVE DEBINW1,W0 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 CALL CMPIND,BIN8,ACK(W1) BNOK DED500 OUT OF RANGE 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 B DED390 DED150 MOVE DEINPUT,FDVBCD(ELMNO) B DED400 EJECT * * VALUE SET INDEX (ELEMENTNO) * DED160 MOVE BCD3A,VSEIND BINCONV=>BCD MOVE DEINPUT,BCD3A BCDCONV=>STRG B DED470 DED170 MOVE DEINPUT,DATE DLETE DEINPUT,W0,W1 B DED390 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.PSEU1,X.PSEU2,X.WB10,BIN8 CBE BIN7,W2,DED250 JUMP IF BCD MOVE BIN7,W0 EDSUB DEINPUT,BIN7,FORMF B DED350 DED250 CON X.MOVE,DEINPUT,X.PSEU1,X.PSEU2,X.WB10,BIN8 B DED400 DED300 CALL CMPIND,BIN8,SYSV(W1) BNOK DED500 EDSUB DEINPUT,BIN7,FORMS * B DED350 DED330 CALL CMPIND,BIN8,USEV(W1) BNOK DED500 OUT OF RANGE EDSUB DEINPUT,BIN7,FORMU DED350 MOVE DEBINW1,BIN7 B DED470 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 CMP W1,W1 EDITING OKEY RET DED500 CMP W1,W2 EDITING FAILED RET PEND EJECT ************************************* * DISPLAY AND READ OF FUNCTION-KEYS * * ENTERED ON THE LAST LINE. * ************************************* DELAST PROC FC,KEYTAB PKTAB KEYTAB MOVE BIN15,FC LASTD0 MOVE DEBINW4,W24 ERASE 0,DEBINW4,DEBINW4 EDWRT DEDSSCRN,FLAST(FC) LAST05 MOVE DEBINW1,W0 LASTD1 IB FC JUMP ON FUNCTIONKEY C LPROG FPROG = 1 C LDEL FDEL1 = 2 C LDEL FDEL2 = 3 C LINS FLIN1 = 4 C LVAL FLVAL = 5 C LINS FLINS = 6 C LASRET2 FRECOV = 7 C LASRET3 FCORR = 8 C LASVER FVER = 9 C LASRET2 FREC02 =10 C LINS FFORCE = 11 C LINS FCONVNO =12 C LINS FCONV1 =13 C LASRET2 FASD =14 C LRFBWD FRFBWD =15 B LINS LPROG MOVE DEBINW1,SYMREC(W12) GET MAX SYMB.LENGTH CBG DEBINW1,W0,LPROG2 MOVE DEBINW2,W2 SIMULATE CANCEL ERASE 0,DEBINW4,DEBINW4 B LASVER LPROG2 KI DEDSDYKB,DEINPUT,KEYTAB,DEBINW1,DEBINW2 B LAST50 LVAL MOVE DEBINW1,W2 B LPROG2 LRFBWD MOVE DEBINW1,W7 B LPROG2 LDEL LINS MOVE DEBINW1,W1 LASTD2 KI .NE,DEDSDYKB,DEINPUT,KEYTAB,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,W6 SIMULATE EOI B PROEN2 LASTD3 IB FC,LASRET,LASRET,LAST06,LASRET,LASRET C LAST06,DUMMY,DUMMY,DUMMY,DUMMY C LASRET,LASRET,LASRET,DUMMY,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 DUMMY 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,FASD C FRFBWD 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 FASD FRMT FSL FTEXT 'AUTOMATIC SKIP/DUP *O' FBF ASDFLAG,FASD2 FTEXT 'N*' FB FASDEN FASD2 FTEXT 'FF*' FASDEN FMEND FRFBWD FRMT FSL FTEXT 'ENTER WANTED RECORDNUMBER:' FMEND EJECT FORMF FRMT FCTL X'C0',X.PSEU1,X.PSEU2,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