|
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: 32152 (0x7d98)
Notes: pts_type(SC)
Names: »READIN.SC«
└─⟦f45ea3bc3⟧ Bits:30009713 Philips computer tape "WSM"
└─⟦this⟧ »WSM:CREA/READIN.SC«
IDENT READIN REL=2.3,831116,870155940230 ************************************************************ * * LATEST UPDATE 831116 MADE BY CJ * * HISTORY= * * 831116/CJ ERASE POS REA993 TYPECHANGE FROM 5 TO 3 * 830923/CJ STPBLK,STABLK IMPL. * 830505/CJ MESSAGE ON SYS-LINE DURING "HARDCOPY" * ************************************************************* * * A STANDARD MODULE, HANDLING * ONE FIELD OF THE CURRENT FORMAT * * OUTPUT LBIN2 = 0 OK GO ON * = 1 END OF FORMAT FOUND OR ENTER KEY * = 2 ERROR FOUND CONFIRMED WITH CANCEL * = 3 ERROR FOUND CONFIRMED WITH RETUR * = 4 POWER OFF OCCURED * LBOOL1 = FALSE TAB-FORWARD * = TRUE TAB-BACKWARD * CR /= 2 => ENTER KEY * ************************************************************* DDUM WSMDDV PDIV * ENTRY READIN ENTRY STPBLK ENTRY STABLK EXPROC WSMAPP ***APPLIC. ROUTINE (CONTROLS) EXPROC WSMERR,PKTAB,PLIT ***(ERROR-)MESSAGEROUTINE EXPROC ATTPRT ***ATTACH PRINTER EXPROC DETPRT ***DETACH PRINTER EXT EMPTYT ---ASSRUT: CHECK IF EMPTY ITEM EXT TYPET ---ASSRUT:CHECK TYPE OF ITEM EXT ICLEAR ---ASSRUT:CLEAR ITEM * STOPBLK EQU X'BE' STARTBLK EQU X'BD' EJECT INCLUDE WSMKEY,LIST INCLUDE KEYT4,LIST EJECT READIN PROC KEYT1,KEYT2,KEYT3,MSGCOL PKTAB KEYT1 PKTAB KEYT2 PKTAB KEYT3 PLIT MSGCOL * * READ TO CURRENT FIELD ON DISPLAY * GETCTL 0,LBIN2 GET APPL-VALUE CBNE LBIN2,W18,REA100 JUMP IF NOT 18 XCOPY LSTR81,W1,W3,LSTR4A,W1 COPY REST OF OLD CONT. MOVE LBIN1,W2 GO TO B REA775 EDFLD READING REA100 PERF STPBLK CLEAR LBOOL1 FALSE= TAB FORWARD DYKI LSTR81,KEYT1,KEYT2,LBIN1, C LBIN2,LBIN4 BL REA970 ERROR PERF STABLK CBG LBIN2,W0,REA120 JUMP IF POWER OFF OR B REA994 KEY SWITCHES REA120 CBNE LBIN2,W8,REA150 IF KEY = TBWD & ... CMP LBIN1,W0 ... POSITION > 0, ... BNE REA770 ... START EDIT REA150 IB LBIN2,REA500,REA650, CLR,CLR C REA200,REA993,REA993, EOI,CAN,RET C REA200,REA200,REA200, PLS,MIN,BTB C REA200,REA200,REA760, HOM,PRT,DUP C REA775 CFW 5 CBW ENT EJECT * * HANDLE THE RESPECTIVE KEY AS EOI-KEY FIRST * REA200 CBE LBIN1,W0,REA500 JUMP IF LENGTH = 0 * * CONDITIONAL DISPLAYING * CALL TYPET,LBIN3,:FMTITEM CHECK TYPE OF ITEM CBNE LBIN3,W2,REA210 JMP IF NOT BCD CBNE LBIN2,W7,REA210 JMP IF NOT MINUS-KEY TBF LBOOL6,REA210 JUMP IF NO SIGN MOVE LSTR1,=X'2D' LOAD MINUS = X'2D' INSRT LSTR81,W0,W1,LSTR1,W0 INSERT MINUS REA210 GETCTL 0,LBIN3 GET APPL-VALUE CBE LBIN3,W0,REA600 JUMP IF NO APPL-VALUE * * APPL-VALUE DIFFERENT FROM ZERO * PERF WSMAPP ***APPLICATION CONTROLS IB LBIN3,REA460,REA730, UNC DISPL,NO DISPL C REA980,REA775 ERR-MESS,ERR-EDIT B REA600 * * OK AFTER APPL CONTROL * UNCONDITIONAL DISPLAYING * REA460 UPDATE CURRENT INPUT... UPDFLD 1,LSTR81 ... FIELD & DISPLAY IT EJECT * * JUMP ON FUNCTION KEY INDEX * REA500 IB LBIN2,REA100,REA999, CLR,CLR C REA700,REA993,REA993, EOI,CAN,RET C REA705,REA705,REA710, PLS,MIN,BTB C REA980,REA755,REA999, NOK,PRT,DUP C REA999,REA790 CFW & CBW,ENT SUB LBIN2,W9 ADJUST EOI-KEY INDEX B REA999 EXIT * REA600 UPDFLD 0,LSTR81 REA200 FIELD DISPL. COND. B REA500 * REA650 GETABX LBIN4 GET CURRENT TAB INDEX DISPLAY 1,LBIN4,LBIN4 DISPLAY FIELD B REA730 EJECT REA700 COMMON END-OF-ITEM KEY REA705 TAB. FORWARD 1 STEP TFWD BE REA990 TAB OK BG REA990 CTAB BL REA991 E-O-F FOUND B REA730 REA710 TABULATION 1 STEP BACKW. SET LBOOL1 TRUE=BACKTAB TBWD BE REA990 OK BG REA990 CTAB REA730 SETCUR B REA100 EJECT REA755 HARD COPY PERF ATTPRT CHECK PRINTER-DEVICE BNOK REA980 TBF LBOOLE,REA980 CBNE LBIN2,W0,REA757 JMP IF CANCEL/RETURN MOVE LBIN3,=X'1801' ROW:=24 COL:=01 TBF VD82,REA756 JMP IF NOT VD82 MOVE LBIN3,=X'0101' ROW:=01,COL:=01 REA756 CALL ICLEAR,LSTR81 ---INITIAL CLEAR MOVE LSTR81,=C'++NOW PRINTING ' MOVE LSTR1,=X'1B' MOVE TB7BIN1,=W'15' XCOPY LSTR81,TB7BIN1,W1,LSTR1,W0 LOAD CONTROL-CODE ADD TB7BIN1,W1 ADJUST DSC SYSL,6,LBIN3 SET CURSOR ON LAST LINE DSC SYSL,2,TB7BIN1 ERASE LAST LINE DSC SYSL,6,LBIN3 SET CURSOR ON LAST LINE WRITE SYSL,LSTR81,TB7BIN1 WRITE QUESTION ON LAST LINE CALL ICLEAR,LSTR81 ---CLEAR LSTR81 EDWRT PRNT,FORMF FORM FEED/NEW PAGE BNOK REA758 MOVE LBIN3,W1 PRINT PRNT,LBIN3,W0 BNOK REA759 EJECT REA757 PERF DETPRT DETACH PRINTER MOVE LBIN3,=X'1801' ROW:=24 COL:=01 TBF VD82,REA758 JMP IF NOT VD82 MOVE LBIN3,=X'0101' ROW:=01,COL:=01 REA758 DSC SYSL,6,LBIN3 SET CURSOR ON LAST LINE DSC SYSL,2,TB7BIN1 ERASE LAST LINE B REA730 SET CURSOR AND READ * REA759 PERF DETPRT DETACH PRINTER MOVE LBIN4,=W'34' B REA980 * REA760 DUPLICATION MOVE LBIN2,W3 INDICATE COMMON EOI-KEY DUPL LSTR81 DUPLICATION BNZ REA762 DUPL ALLOWED UPDFLD 1,LSTR81 UPDATE FIELD AND DISPLAY B REA210 CHECK APPL-VALUE REA762 MOVE LBIN4,W0 INDICATE ILLEGAL EOI-KEY B REA980 DUPL NOT ALLOWED EJECT * * EDIT FIELD * REA765 EDIT AFTER ERROR CBE LBIN1,W0,REA775 REA770 EDIT AFTER TBWD MOVE LBIN1,W1 REA775 NORMAL EDIT GETCTL 1,LBIN3 GET MAXL CBNE LBIN3,W0,REA780 EDWRT SCRN,BELL ACOUSTIC ALARM B REA730 REA780 PERF STPBLK EDFLD LSTR81,KEYT3,LBIN1, C LBIN2,LBIN4 BL REA970 ERROR CBNG LBIN2,W0,REA994 POWER OFF OR KEY SWITCH B REA120 CONTINUE AS FOR DYKI EJECT * * ENTER KEY * REA790 MOVE LBIN4,W5 INDICATE COMP.FIELD FOUND MOVE LBIN1,W0 INDICATE NO CLEARING MOVE LBIN2,W0 SET INDEX TO LAST FIELD IN FORMAT GETFLD 0,LBIN2,LBIN3 SEARCH FOR EMPTY COMP. FIELDS BOFL REA796 EMPTY COMP. FIELD FOUND TSTCTL 2 LAST FIELD COMPULSORY? BZ REA991 NO! END OF FORMAT CALL EMPTYT,:FMTITEM EMPTY? BOK REA991 NO! =>EOF * * EMPTY COMPULSORY FIELD FOUND * REA796 GETFLD 0,LBIN3,LBIN2 GET THE COMPULSORY FIELD B REA980 EJECT REA970 CBE LBIN2,W12,REA775 JUMP IF EDIT CBE LBIN2,W8,REA770 JUMP IF TBWD PERF STABLK * * ERROR HANDLING * REA980 PERF WSMERR,KEYT4,MSGCOL ***(ERROR-)MESSAGE ROUTINE IB LBIN2,REA730,REA999, CLR,CAN C REA999,REA775 RET,CFW B REA994 POWER OFF EJECT * * NORMAL END OF ITEM * REA990 MOVE LBIN2,W0 OK B REA999 * * END OF FORMAT FOUND * REA991 MOVE LBIN2,W1 EOF B REA999 * * CANCEL RETUR * REA993 GETABX LBIN4 GET CURRENT INDEX CALL EMPTYT,:FMTITEM EMPTY ? BNOK REA993A NO ERASE 3,LBIN4,LBIN4 ERASE ON SCREEN B REA993B REA993A MOVE :FMTITEM,LSTR81 ERASE 13,LBIN4,LBIN4 ERASE SCREEN AND DATA ITEM REA993B SUB LBIN2,W2 ADJUST KEYINDEX B REA999 * * POWER OFF * REA994 MOVE LBIN2,W4 B REA999 * * EXIT * REA999 RET PEND EJECT * * STPBLK => PUT'S CURSOR ON AND STOP'S BLOCKING * STPBLK PROC MOVE VD82CW,=X'0080' CURSOR ON DSC SCRN,X'11',VD82CW DSC SCRN,STOPBLK STOP BLOCKING RET PEND * * STABLK => START'S BLOCKING AND TURNS CURSOR OFF * STABLK PROC DSC SCRN,STARTBLK START BLOCKING MOVE VD82CW,=X'01C0' DISCONNECT CURSOR DSC SCRN,X'11',VD82CW MOVE VD82CW,=X'0180' INVISIBLE CURSOR DSC SCRN,X'11',VD82CW RET PEND EJECT BELL FRMT FSL FILLR X'07',1 FMEND * * FORM-FEED FORMAT * FORMF FRMT FTEXT ' 1' FMEND END