|
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: 14326 (0x37f6)
Notes: pts_type(SC)
Names: »DE20ST.SC«
└─⟦48601905a⟧ Bits:30009668 Philips computer tape "600121"
└─⟦this⟧ »S:DE/DE20ST.SC«
└─⟦5c22ed822⟧ Bits:30009675 Philips computer tape "600209"
└─⟦this⟧ »DEN10/DE20ST.SC«
└─⟦79fbed147⟧ Bits:30009697 Philips computer tape "600414"
└─⟦this⟧ »S:DE/DE20ST.SC«
└─⟦bf903a231⟧ Bits:30009665 Philips computer tape "600109"
└─⟦this⟧ »DEN10/DE20ST.SC«
└─⟦d2a299635⟧ Bits:30009698 Philips computer tape "600415"
└─⟦this⟧ »S:DE/DE20ST.SC«
IDENT DE20ST REL 10.0 80-04-11 80-03-23/JAER DDUM DEDDIV PDIV ENTRY DE20ST ENTRY DEAP2A * * EXTERNAL REFERENCES TO SCREEN * EXT DECLRA EXT DERROR * * EXTERNAL REFERENCES TO FORMAT-DEFINITION * EXT DE21ST USER-FORMAT HANDLING EXT DE23ST GET FORMAT EXT DE24ST COPY FORMAT * * EXTERNAL REFERENCES TO APPLICATION ROUTINE * EXT DEAOK0 RETURN TO DEAPPL =0 EXT DEANOK RETURN TO DEAPPL =3 EXT DEAOK2 RETURN TO DEAPPL =2 EXT DEAOK4 RETURN TO DEAPPL =4 * * EXTERNAL REFERENCES TO DATA-ENTRY-PACKAGE ROUTINES * EXT DEDISC DISC-ROUTINE EXT DEPOOL BUFFERPOOL ROUTINE EXT CNTNUM CONTROL VARIABLE INDEX * EXT RESTOR EXT DEPRUT EXT DEPMSK EXT CMPIND COMPERE INDEX EJECT * * KEYTABLES * * USAGE: DATA ENTRY SCREEN * CLR EQU X'8F' CLEAR CAN EQU X'91' CANCEL RET EQU X'92' RETURN CFW EQU X'86' CURSOR FORWARD * DEKTAB4 KTAB CLR,CAN,RET,CFW * * START OF PROGRAM * EJECT DE20ST PROC CBNE BIN2,W0,ENT1 DEST SET BOOL1 PART OF FORMAT DISPLAY DEST20 ATTFMT F20ST SET DEPROMPT PROMPT-TEXTS DISPLAY STA050 CLEAR DECHANGE PERF DECLRA STA100 IB DEBINW2,CANCEL,RETUR,ENTER B ERROR CANCEL CLEAR DEPROMPT B STA050 * ENTER CBNE BIN1,W2,RET2 CBNE BIN2,W0,ENT1 B DEST ENT1 CLEAR BOOL7 PERFI BIN2,DE21ST,DE21ST,DE23ST,DE24ST CLEAR DOOL3 CLEAR BOOL1 CALL RESTOR,W0,W16,PWBDB4 RESTORE ORIGINATE ADRESSES TO WORKBLOCKS AND DESCRIPTORS MOVE BIN1,W20 PERF DEPRUT,PRNUM,BIN1,BIN2 PERF DEPMSK B DEST20 * ERROR MOVE DEBINW4,DEBINW2 ERR2 PERF DERROR,DEKTAB4 B STA100 * RETUR MOVE BIN2,W1 MOVE BIN1,W0 RET2 RET EJECT * * APPL VALUE HANDLING ROUTINE * DEAP2A IB DEBINW3,DEA21,DEA22,DEA23, C DEA24,DEA25,DEA26,DEA27,DEA28, C DEA29 B DEAP2B LONG BRANCH CONSTRUCTION EJECT * * APPLE=1,DE21 * FORMAT DEFINED? * DEA21 XCOPY STR1A,W0,W1,DEINPUT,W0 FETCH 1ST CH TBT BOOL6,DE1A JUMP IF BALANCE FORMAT CBE STR1A,='*',DEE232 JUMP IF = * NOK B DE1B DE1A CBNE STR1A,='*',DEE232 JUMP IF # * NOK DE1B CBE FORMAT,DEINPUT,DEB21 MOVE FRMTPNTR,W0 FORMATPOINTER:=0 PERF DEDISC,W12 SEARCH FORMAT BOK DEE28 FOUND NOT OK CBE DEBINW4,W9,DE1C NOT FOUND OK B DEANOK NOT OK DE1C MOVE STRG10A,='F' XCOPY STRG10A,W1,W6,DEINPUT,W0 KEY = DEINPUTNAME PERF DEPOOL,W7,DEBIN3,DEBIN4,STRG10A SEARCH AMONG BUFFERS CBE DEBIN4,W0,DE1D NOT FOUND AMONG BUFFER CBE DEBIN3,PINDDB,DE1D FOUND BUT SAME CURR BUFFER B DEE28 NOT OK DE1D GETCTL 0,DEBINW3 GET APPL VALUE CBE DEBINW3,=W'118',DEB21 JUMP IF APPL 18 PERF DEPOOL,W4,PINDDB,BIN16,STRG10A SET BUFFER MOVE RNRFMCH,W2 LOAD FORMATLINKINDEX B DEAOK0 EJECT * * APPLE=2,DE21 * CHECK IF INPUT IS LESS THAN OR EQUAL 23 * DEA22 MOVE BCD3A,DEINPUT LOAD INPUT DECIMAL MOVE DEBINW3,BCD3A LOAD INPUT BINARY MOVE DEBINW4,W23 LOAD 23 BINARY CBG DEBINW3,DEBINW4,DEE26 >24 NOT OK CBL DEBINW3,W1,DEE26 <1 NOT OK B DEAOK0 OK EJECT * * APPLE=3,DE21 * CHECK IF INPUT IS Y(ES) OR N(O) * DEA23 PERF DEYN CHECK YES OR NO BOK DEAOK0 OK BNOK DEE26 ILLEGAL VALUE EJECT * * APPLE=4,DE21 * CHECK AND GET FORMAT-NAME * DEA24 MOVE FRMTPNTR,W0 FORMATPOINTER:=0 PERF DEDISC,W10 GET FORMAT BOK DE24A OK B DEANOK NOT OK DE24A MOVE DEBINW2,W17 FAKE ENTER B DEAOK0 OK EJECT * * APPLE=5,DE21 * CHECK IF INPUT IS LESS THAN 64 AND NOT > FIELDLENGTH * DEA25 MOVE BCD3A,DEINPUT LOAD INPUT DECIMAL MOVE DEBINW3,BCD3A LOAD INPUT BINARY CBG DEBINW3,BIN7,DEE26 > FIELDLENGTH NOT OK CBL DEBINW3,W64,DEB21 <64 OK B DEE26 ILLEGAL VALUE EJECT * * APPLE=6,DE21 * DUPLICATION-REFERENCE-CONTROL * DEA26 MOVE FMTWK(W4),DEBINW1 STORE NUMB OF DUPL.CHARS PERF CNTNUM,DEINPUT,FMTWK,W4 CONTROL VAR.INDEX BNOK DEAOK4 NOT OK INDICATE EDIT-MODE B DEAOK0 OK NO UPDATE OF FIELD EJECT * * APPLE=7,DE21 * CHECK IF INPUT VALUE < =32.767 * DEA27 MOVE BCD13A,DEINPUT LOAD INPUT DECIMAL CBNG BCD13A,=D'+32767',DEB21 <=32767 OK B DEE26 ILLEGAL VALUE EJECT * * APPLE=8,DE21 * KEYED INPUT YES/NO SET CTAB IF NO * DEA28 PERF DEYN CHECK YES OR NO BOK DE8A JUMP IF YES OR NO CBE STR1A,='C',DE8B C(ONDITIONAL) OK B DEE26 ILLEGAL VALUE DE8A CBE STR1A,='Y',DE8C DE8B SET CTAB B DEAOK0 DE8C CLEAR CTAB INICATE KEYED INP-FIELD B DEAOK0 EJECT * * APPL=9,DE21,DE22 * CHECK IF INPUT IS >0 AND <11 * DEA29 MOVE BCD13A,DEINPUT LOAD INPUT DECIMAL MOVE DEBINW3,BCD13A LOAD '99'BINARY CALL CMPIND,DEBINW3,ACK(W1) BNOK DEE26 OUT OF RANGE B DEAOK0 OK EJECT * * LONG BRANCHE LIST * * APPL VALUE HANDLING ROUTINE * DEAP2B SUB DEBINW3,W9 ADJUST APPLE-VALUE LONG BR IB DEBINW3,DEA210 B DEAP2C LONG BRANCHE CONSTRUCTION * DEB21 B DEAOK0 DEE22 MOVE DEBINW4,W2 UNDEFINED ERROR B DEANOK DEE26 MOVE DEBINW4,W6 ILLEGAL VALUE B DEANOK DEE28 MOVE DEBINW4,W8 ALREADY DEFINED B DEANOK DEE232 MOVE DEBINW4,W32 'ILLEGAL FORMATNAME' B DEANOK EJECT * * APPL=10,DE21 * LINE-DESIGN CONTROL * DEA210 MOVE FMTWK(W5),DEBINW1 STORE NUMB OF LDES CHS MOVE BIN5,W0 LOAD STPOINTER MOVE DEBIN4,DEBINW1 STORE NUMBER OF LDES CHRS D10A CLEAR BOOL8 MATCH DEINPUT,BIN5,DEBIN4,PICSTR,W13,W1 BNOK D10OK NO FIELD FOUND OK ADD BIN5,W1 NEXT PICSTRG-POINTER CBE BIN5,FMTWK(W5),D10NOK NO END OF FIELD = > MOVE DEBINW1,BIN5 SAVE STARTPOINTER MOVE BIN16,W0 STPOINTER PICCHRS-TABLE MATCH PICSTR,BIN16,W15,DEINPUT,BIN5,W1 BNOK D10X NUMERIC FIELD OK (E<X>) CBE BIN16,W0,D10B ALPHANUM INDICATED IB BIN16,D10B,D10D,D10D,D10D, 1 - 4 C D10D,D10D,D10D,D10NOK,D10NOK, 5 - 9 C D10D,D10D,D10NOK,D10NOK,D10D 10-14 B D10NOK UNDEFINED ERROR D10B TBT BOOL6,D10NOK JUMP IF BALANCE FORMAT MOVE BIN15,BIN16 SAV PIC-TYPE D10C ADD BIN5,W1 NEXT POS CBE BIN5,FMTWK(W5),D10NOK NO END OF FIELD = > MOVE BIN16,W0 STARTPOINTER PICCHRS-TABLE MATCH PICSTR,BIN16,W15,DEINPUT,BIN5,W1 BNOK D10Z ILLEGEAL PIC STRG CBE BIN16,BIN15,D10C PICTYPE EQUALS 1:ST CHARS D10Z CBE BIN16,W12,D10J END OF FIELD FOUND B D10NOK ILLEGAL PIC-STRG D10X ADD BIN5,W1 NEXT POS CBE BIN5,FMTWK(W5),D10NOK NO END OF FIELD = > MOVE BIN16,W0 MATCH PICSTR,BIN16,W15,DEINPUT,BIN5,W1 BNOK D10X OK IB BIN16,D10D,D10D,D10D,D10D, 1 - 4 C D10D,D10D,D10D,D10F,D10F, 5 - 9 C D10D,D10D,D10G,D10NOK,D10D 10-14 B D10NOK UNDEFINED ERROR D10D SET BOOL8 B D10X LONG BRANCH INSTRUCTION D10F ADD BIN5,W1 NEXT POS CBG BIN5,FMTWK(W5),D10NOK NO END OF FIELD = > MOVE BIN16,W0 MATCH PICSTR,BIN16,W15,DEINPUT,BIN5,W1 BNOK D10NOK +/S MUST BE LAST CHARS CBE BIN16,W12,D10J +/S IS LAST CHARS B D10NOK D10G TBF BOOL8,D10NOK JUST 'E':S NOT OK D10J ADD BIN5,W1 NEXT MATCH POS MOVE DEBIN4,FMTWK(W5) RESORE NUMB OF CHARS SUB DEBIN4,BIN5 CBE DEBIN4,W0,D10OK READY B D10A SEARCH NEXT FIELD D10NOK MOVE DEBINW4,W6 ILLEGAL VALUE PERF DERROR,DEKTAB4 ERROR MESSAGE MOVE BIN5,W0 ADD DEBINW1,W1 ADJUST STPOINTER B DEAOK4 INDICATE EDIT-MODE D10OK MOVE BIN5,W0 ERASE 2,W5,W5 CLEAR LINE DESIGN MOVE LDISP,=' ' MOVE SPACES B DEAOK0 OK EJECT * * APPL VALUE HANDLING ROUTINE * * * LONG BRANCHE LIST * DEAP2C SUB DEBINW3,W1 ADJUST APPLE-VALUE LONG BRANCH IB DEBINW3,DEA211,DEA212, C DEA213,DEA214,DEA215, C DEA216,DEA217,DEA218 B DEE22 JUMP IF APPLE-VALUE OVERFLOW EJECT * * APPL = 11,DE21 * SAVE NUMBER OF CHARS IN STRG 1 * DEA211 MOVE FMTWK(W10),DEBINW1 STORE NUMB OF VAL.-CHARS B DEAOK0 OK NO UPDATE OF FIELD EJECT * * APPL = 12,DE21 * SAVE NUMBER OF CHARS IN STRG2 * DEA212 MOVE FMTWK(W11),DEBINW1 STORE NUMB OF ACC.-CHARS B DEAOK0 OK NO UPDATE OF FIELD EJECT * * APPL = 13,DE21 * DEA213 MOVE FRMTPNTR,W0 FORMATPOINTER:=0 PERF DEDISC,W12 SEARCH FORMAT BNOK DEANOK NOT OK XCOPY STR1A,W0,W1,DEINPUT,W0 FETCH 1ST CH CBE STR1A,='*',DE13A CLEAR BOOL6 F=USER FORMAT B DE13B DE13A SET BOOL6 T=BALANCE FORMAT DE13B B DEAOK0 EJECT * * APPL=14,DE21