|
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: 17382 (0x43e6)
Notes: pts_type(SC)
Names: »SCREEN.SC«
└─⟦d2cdd233a⟧ Bits:30009674 Philips computer tape "600204"
└─⟦this⟧ »OD-KOM/SCREEN.SC«
IDENT SCREEN 831005 EV 1.1,78-04-20,870138040310 * * A STANDARD PROGRAM PACKAGE HANDLING * A COMPLETE PICTURE ON A DISPLAY SCREEN * * RUNNING UNDER: CREDIT REL 3.1 * TOSS REL 8.1 * DDUM KMD08 PDIV * ENTRY SPCLRA CLEAR ALL VARIABLE FIELDS ENTRY SPCLRS CLEAR SOME VARIABLE FIELDS ENTRY SPCLRN CLEAR NO VARIABLE FIELDS ENTRY SPERR DISPLAY ERROR PRINTOUT AND CONTINUE HANDLING ENTRY SPLIN8 MESSAGE ON LINE 8 ENTRY SPCA AS SPCLRA-- ENTRY SPCN AS SPCLRN-- SPCA AND SPCN ARE ONLY ACTIVE BETWEEN LINES SPLINTOP AND SPLINLOW ENTRY SCREEN ENTRY SPINF1 INFORMATION ON LINE 1 ENTRY SPINF8 INFORMATION ON LINE 8 ENTRY BELL ENTRY DKTEST * EXT SPCHK1 STANDARD CHECK ROUTINE NO. 1 EXT SPCHK2 STANDARD CHECK ROUTINE NO. 2 EXT SPCHK3 STANDARD CHECK ROUTINE NO. 3 EXT SPCHK4 STANDARD CHECK ROUTINE NO. 4 EXT SPCHK5 STANDARD CHECK ROUTINE NO.5 EXT SPCHK6 STANDARD CHECK ROUTINE NO. 6 EXT SPCHK7 STANDARD CHECK ROUTINE NO. 7 EXT SPAPPL USER ROUTINE TO HANDLE APPL VALUES EXT SPTCHK USER ROUTINE TO EVALUATE CONDITIONAL TABULATION * EXT EMPTYT ASSEMBLY SUBROUTINE EMPTYT - TEST IF DATA ITEM IS EMPTY EXT CLEAR8 * INCLUDE KEY461,LIST * FIRST INCLUDE KEY VALUES, * THEN INCLUDE SPECIAL SCREEN FORMATS INCLUDE SL461,LIST EJECT SPCLRA PROC * * SPCLRA - CLEAR ALL VARABLE FIELDS BEFORE HANDLING THE PICTURE * MOVE SPERASE,=W'0' MOVE SPLINTOP,=W'1' WHOLE SCREEN MOVE SPLINLOW,=W'0' PERF SCREEN,=W'1' RET PEND SPCLRS PROC * * SPCLRS - CLEAR SOME VARIABLE FIELDS BEFORE HANDLING THE PICTURE * MOVE SPERASE,=W'0' MOVE SPLINTOP,=W'1' WHOLE SCREEN MOVE SPLINLOW,=W'0' PERF SCREEN,=W'2' RET PEND SPCLRN PROC * * SPCLRN - CLEAR NO VARIABLE FIELDS BEFORE HANDLING THE PICTURE * MOVE SPERASE,=W'0' MOVE SPLINTOP,=W'1' WHOLE SCREEN MOVE SPLINLOW,=W'0' PERF SCREEN,=W'3' RET PEND SPERR PROC * * HANDLE ERRORS DETECTED OUTSIDE THE PACKAGE * TBT TBCTASK,SPERR90 PERF SCREEN,=W'0' SPERR90 RET PEND SPCA PROC * * SPCA - AS SPCLRA, BUT ONLY BETWEEN LINES SPLINTOPAND SPLINLOW * MOVE SPERASE,=W'4' PERF SCREEN,=W'1' RET PEND SPCN PROC * * SPCN - AS SPCLRN, BUT ONLY BETWEEN LINES SPLINTOP AND SPLINLOW * MOVE SPERASE,=W'4' PERF SCREEN,=W'3' RET PEND EJECT SCREEN PROC $OPT * * SCREEN SCREEN HANDLING MODULE * * CALL: PERF SCREEN,<$OPT> * PLIT $OPT OPTIO SELECTOR CLEAR SPWARNFL CLEAR WARNING FLAG MOVE SPBINW2,$OPT MOVE TO VARIABLE TO ALLOW INSTR.S CMP AND IB CMP SPBINW2,='0' "SPERR" ENTRY ? BE ERRPRINT YES ! TBT SPPROMPT,ENTIRE JUMP IF ENTIRE FORMAT SHOULD BE DISPLAYED * * ONLY VARIABLE FIELDS * IB SPBINW2,CLEARA,CLEARS,CONT JUMP ON ROUTINE INDEX * CLEARA ERASE 10,SPLINTOP,SPLINLOW ERASE ALL FROM 1 AND UP THOME B CONT * CLEARS ERASE 5,SPLINTOP,SPLINLOW ERASE SOME FROM 1 AND UP B CONT EJECT * * DISPLAY ENTIRE FORMAT * ENTIRE IB SPBINW2,ECLRA,ECLRS,ECLRN JUMP ON ROUTINE INDEX * * CLEAR ALL VARIABLES * ECLRA ERASE 11,SPLINTOP,SPLINLOW CLEAR ALL IN MEMORY B ECLRN * * CLEAR SOME VARIABLES * ECLRS ERASE 6,SPLINTOP,SPLINLOW CLEAR SOME FIELDS FROM 1 AND UP IN MEMORY * * CLEAR NO VARIABLES IN MEMORY * ECLRN IB SPERASE,ECLRN1,ECLRN2,ECLRN3,ECLRN4 DISPLAY 0,SPLINTOP,SPLINLOW B CONT ECLRN1 DISPLAY 1,SPLINTOP,SPLINLOW B CONT ECLRN2 DISPLAY 2,SPLINTOP,SPLINLOW B CONT ECLRN3 DISPLAY 3,SPLINTOP,SPLINLOW B CONT ECLRN4 DISPLAY 4,SPLINTOP,SPLINLOW B CONT EJECT CONT GETABX SPBINW4 GET CURRENT INDEX BL KTHOME JUMP IF NO CURRENT FIELD CONT5 GETFLD 0,SPBINW4,SPBINW3 SEARCH CURRENT POSITION BZ SETCREAD JUMP IF FOUND BL KTHOME POSITION NOT FOUND * * COMPULSORY FIELD FOUND * MOVE SPBINW4,SPBINW3 CHANGE INDEX B CONT5 SEARCH AGAIN * EJECT * * SET CURSOR AND READ KEYBOARD * SETCREAD SETCUR SET CURSOR ON CURRENT FIELD * * READ TO CURRENT FIELD ON DISPLAY * READIN * SET FLAG IF AUTODUP * USES VERIF-FIELD MOVE SPBINW2,=W'3' MOVE SPBINW1,=W'1' TSTCTL 6 BOK DYKIN SET GTADUPFL B DYK20 * DYKIN IB SPKEY,DYK05,DYK10,DYK15 DYK05 DYKI SPINPUT,SPKTAB1,SPKTAB2,SPBINW1, C SPBINW2,SPBINW4 B DYKOUT DYK10 DYKI SPINPUT,SPKTAB12,SPKTAB22,SPBINW1, C SPBINW2,SPBINW4 B DYKOUT DYK15 DYKI SPINPUT,SPKTAB13,SPKTAB23,SPBINW1, C SPBINW2,SPBINW4 DYKOUT BL ERRPRT ERROR CLEAR SPDUPL CBNG SPBINW2,='0',RETUR JUMP IF POWER OFF OR * DYK20 * * PERF DKTEST BNOK SETCREAD * KEY SWITCHES IB SPBINW2,UPD300,CLEA20 JUMP ON C UPDATE,CANC,CANC, C UPDATE,UPDATE,UPDATE,UPDATE CONVERTED C UPDATE,UPDATE,UPDATE,UPDATE END-OF-ITEM-KEY C UPDATE,KDUPL,KEDIT EJECT * * HANDLE THE RESPECTIVE KEY AS EOI-KEY FIRST * UPDATE CBE SPBINW1,='0',UPD350 JUMP IF LENGTH = 0 GETCTL 3,SPBINW4 GET SCHK-NUMBER CBE SPBINW4,='0',UPD050 JUMP IF NOT STANDARD CHECK PERFI SPBINW4,SPCHK1,SPCHK2,SPCHK3 C SPCHK4,SPCHK5,SPCHK6,SPCHK7 IB SPBINW3,UPD050,UPD070,ERRPRINT * * CONDITIONAL DISPLAYING * UPD050 TBT SPDUPL,UPD100 MOVE SPBINW4,='1' INDICATE COND. DISPL B UPD200 UPD070 GETCTL 0,SPBINW3 GET APPL-VALUE CBNE SPBINW3,='0',UPD210 JUMP IF APPL VALUE B SETCREAD * * UNCONDITIONAL DISPLAYING * UPD100 MOVE SPBINW4,='2' INDICATE UNCONDITIONAL DISPLAY UPD200 GETCTL 0,SPBINW3 GET APPL-VALUE CBE SPBINW3,='0',UPD400 JUMP IF NO APPL VALUE * * APPL-VALUE DIFFERENT FROM ZERO * UPD210 PERF SPAPPL IB SPBINW3,UPD400,SETCREAD,ERRPRINT B UPD400 * * OK AFTER APPL CONTROL * UNCONDITIONAL DISPLAYING * UPD260 UPDFLD 1,SPINPUT UPDATE FIELD WITH DISPLAYING UPD300 CBE SPBINW1,='0',UPD350 SKIP NEXT IF LENGTH = 0 SET SPCHANGE INDICATE CHANGED ITEM UPD350 * TAKE CARE OF WARNING TBF SPWARNFL,UPD360 MOVE SPBINW1,SPBINW2 STORE KEY VALUE MOVE SPBINW4,=W'26' SET MESSAGE PERF SPERR CBNE SPBINW2,CBIN2,UPD360 KOR-KEY ? MOVE SPBINW2,SPBINW1 RESET OLD KEYVALUE UPD360 * JUMP ON FUNCTION KEY INDEX IB SPBINW2,READIN,DUMMY, C KEOI,DUMMY,DUMMY,KTFWD, C KTBWD,KTHOME,KTLDOWN,KTLEFT,KTRIGHT, C KTDOWN,KTUP,KCOPY,DUMMY,DUMMY,KENTER SUB SPBINW2,=W'14' ADJUST EOI-KEY INDEX DUMMY RETUR RET * UPD400 CBE SPBINW4,='2',UPD260 JUMP IF UNCONDITIONAL DISPL UPDFLD 0,SPINPUT UPDATE FIELD DISPL. COND. B UPD300 * EJECT KEOI COMMON END-OF-ITEM KEY KTFWD TAB. FORWARD 1 STEP TFWD B TSTTAB * KTBWD TABULATION 1 STEP BACKW. TBWD B TSTTAB * KTHOME TAB. TO HOME POSITION THOME B TSTTAB * KTLDOWN TAB. TO FIRST ON NEXT LINE TLDOWN B TSTTAB * KTLEFT TAB. TO LEFTMOST TLEFT B TSTTAB * KTRIGHT TAB. TO RIGHTMOST TRIGHT B TSTTAB * KTDOWN TAB 1 DOWN TDOWN B TSTTAB * KTUP TAB 1 UP TUP TSTTAB TEST TAB OUTPUT BE READIN OK BL READIN NOT FOUND BOFL SETCREAD EMPTY COMPULSORY FIELD * * * CONDITIONAL TABULATION * PERF SPTCHK CMP SPBINW3,='0' BE SETCREAD IB SPBINW2,DUMMY,DUMMY, C KTFWD,DUMMY,DUMMY,KTFWD, C KTBWD,KTFWD,KTFWD,KTFWD, C KTBWD,KTFWD,KTBWD * BRANCH LIST EXHAUSTED - SPBINW2 CLOBBERED BY SPTCHK B SETCREAD EJECT KCOPY HARD COPY MOVE SPBINW3,='1' PRINT KVOUCH,SPBINW3,='0' B SETCREAD SET CURSOR AND READ * KDUPL DUPLICATION MOVE SPBINW2,='3' INDICATE COMMON EOI-KEY DUPL SPINPUT DUPLICATION BNZ KDUPL2 COPY GSWSTR1,CBIN0,CBIN1,SPINPUT,CBIN1 GET BYTE 1 CBE GSWSTR1,=X'00',KDUPL2 MOVE SPBINW1,='10' SET LENGTH IN DUPFIELD SET SPDUPL B UPDATE DUPL ALLOWED KDUPL2 MOVE SPBINW4,='4' INDICATE ILLEGAL EOI-KEY B ERRPRINT DUPL NOT ALLOWED EJECT * * EDIT FIELD * KEDIT GETCTL 1,SPBINW3 GET MAXL CBNE SPBINW3,='0',KED100 PERF BELL B SETCREAD KED100 EDFLD SPINPUT,SPKTAB3,SPBINW1, C SPBINW2,SPBINW4 B DYKOUT CONTINUE AS FOR DYKI * * ENTER KEY * KENTER TBT SPCHANGE,KENT00 NO TESTS ON ME TBF SPME,KENT05 FIELDS ? KENT00 MOVE SPBINW4,='5' INDICATE COMP.FIELD FOUND MOVE SPBINW1,='0' INDICATE NO CLEARING MOVE SPBINW2,='0' SET INDEX TO SEARCHED FIELD GETFLD 0,SPBINW2,SPBINW3 SEARCH FOR EMPTY COMP. FIELDS BOFL KENT10 EMPTY COMP. FIELD FOUND TSTCTL 2 LOOK IF COMPULSORY FIELD BZ KENT05 NO! CALL EMPTYT,:FMTITEM LOOK IF EMPTY FIELD BP KENT10 YES! KENT05 MOVE SPBINW2,='3' INDICATE ENTER KEY DEPRESSED RET * * EMPTY COMPULSORY FIELD FOUND * KENT10 GETFLD 0,SPBINW3,SPBINW2 GET THE COMPULSORY FIELD EJECT ERRPRT * PERF DKTEST BNOK SETCREAD * CBE SPBINW2,='16',KEDIT JUMP IF EDIT CBE SPBINW2,='4',CANC JUMP IF CANCEL1 CBE SPBINW2,='5',CANC JUMP IF CANCEL2 * * ERROR HANDLING * ERRPRINT * MOVE SPBINW2,=X'40' XSTAT KEYB,SPBINW3 CBNE SPBINW2,SPBINW3,ERRPRT20 TIMEOUT EDWRT SCREEN,ERAFMT ERASE SCREEN B ERRC20 ERRPRT20 CBE SPBINW4,='0',ERRC20 PERF BELL MOVE SPBINW3,=X'0801' ROW 24 COL. 1 DSC1 SCREEN,6,SPBINW3 SET CURSOR ON LAST ROW MOVE GSWBCD4,SPBINW4 ERRORCODE * EDWRT SCREEN,SPFTBERR(SPBINW4) TBF SPKEYFLG,SPERRRET * * READ AFTER ERROR * ERREAD SETCUR SET CURSOR AT THE BEGINNING OF THE CURRENT FIELD ERR100 MOVE SPBINW3,=W'14' REQUESTED LENGTH IB SPKEY,ERR105,ERR110,ERR115 ERR105 NKI .NE,KEYB,SPINPUT,SPKTAB1,SPBINW3,SPBINW2 B ERR120 ERR110 NKI .NE,KEYB,SPINPUT,SPKTAB12,SPBINW3,SPBINW2 B ERR120 ERR115 NKI .NE,KEYB,SPINPUT,SPKTAB13,SPBINW3,SPBINW2 ERR120 BNZ ERR100 JUMP IF NOT OK * PERF DKTEST BNOK SETCREAD * CMP SPBINW2,='0' JUMP IF POWER OFF BE RETUR IB SPBINW2,ERR100,ERRCONT C ERRCONT,ERR100,ERRCONT,ERRCONT B ERR100 CONTINUE * * CLEAR ERROR PRINTOUT * ERRCONT PERF CLEAR8 ERASE LAST LINE CBNL SPBINW4,=W'26',CANC IF WARNING SUB SPBINW2,='1' ADJUST KEY INDEX CANC CBE SPBINW1,='0',ERRC10 JUMP IF LENGTH = 0 MOVE SPINPUT,:FMTITEM SAVE CURRENT CONTENTS MOVE :FMTITEM,=C'1' PUT SOMETHING IN THE FIELD GETABX SPBINW4 GET CURRENT INDEX ERASE 10,SPBINW4,SPBINW4 CLEAR FIELD ERRC10 IB SPBINW2,CLEAR1,CLEAR2,DUMMY SUB SPBINW2,='3' ADJUST FOR CANCEL1,CANCEL2 RET CLEAR1 CBE SPBINW1,='0',ERRC20 JUMP IF LENGTH = 0 SET SPCHANGE INDICATE CHANGED FIELD ERRC20 MOVE SPBINW5,$OPT CHECHK IF SPERR CBE SPBINW5,=W'0',SPERRRET B SETCREAD CONTINUE * CLEAR2 MOVE :FMTITEM,SPINPUT RESTORE CURRENT CONTENTS CLEA20 GETABX SPBINW4 GET CURRENT TAB INDEX DISPLAY 1,SPBINW4,SPBINW4 DISPLAY FIELD MOVE SPBINW5,$OPT CHECK IF SPERR CBE SPBINW5,=W'0',SPERRRET B SETCREAD CONTINUE * SPERRRET RET * PEND * BELL PROC * ACUSTIC ALARM EDWRT SCREEN,BELLFMT RET * BELLFMT FRMT FSL FILLR X'07',1 FMEND PEND * ERAFMT FRMT FILLR '1',2 FMEND * EJECT SPLIN8 PROC WRTMES,WRTTYP ******************** * * SPLIN8 - WRITE ON LINE 8 * * MESSAGE DEFINED AS FORMAT NUMBER WRTMES * IN FORMAT TABLE SPFTBMES * * WRTTYP: =0 NO WAIT * =1 WAIT * =2 RETURN * =3 WRITE .NW AND RETURN * ******************* CBNG WRTMES,CBIN0,LIN800 MOVE SPBINW1,=X'0801' DSC1 SCREEN,6,SPBINW1 SET CURSOR ON LAST ROW MOVE SPBINW1,CBIN0 CBL WRTTYP,CBIN3,LIN801 EDWRT .NW,SCREEN,SPFTBMES(WRTMES) B LINRET LIN801 EDWRT SCREEN,SPFTBMES(WRTMES) LIN800 TBT TBCTASK,LINRET CBE WRTTYP,=W'0',LIN8NW CBE WRTTYP,=W'2',LINRET * READ LIN8IN MOVE SPBINW1,=W'3' REQUESTED LENGTH IB SPKEY,LIN805,LIN810,LIN815 LIN805 NKI KEYB,SPINPUT,SPKTAB1,SPBINW1,SPBINW2 B LIN820 LIN810 NKI KEYB,SPINPUT,SPKTAB12,SPBINW1,SPBINW2 B LIN820 LIN815 NKI KEYB,SPINPUT,SPKTAB13,SPBINW1,SPBINW2 LIN820 BNOK LIN8IN JUMP IF NOT OK PERF DKTEST IB SPBINW2,LIN8IN,LIN8CT,LIN8IN B LIN8IN * CLEAR LINE LIN8CT PERF CLEAR8 ERASE LAST LINE RET * READ WITH NO WAIT LIN8NW MOVE SPBINW1,=W'3' REQUESTED LENGTH IB SPKEY,LIN855,LIN860,LIN865 LIN855 NKI .NW,KEYB,SPINPUT,SPKTAB1,SPBINW1,SPBINW2 B LIN870 LIN860 NKI .NW,KEYB,SPINPUT,SPKTAB12,SPBINW1,SPBINW2 B LIN870 LIN865 NKI .NW,KEYB,SPINPUT,SPKTAB13,SPBINW1,SPBINW2 LIN870 PERF DKTEST LINRET RET PEND EJECT SPINF1 PROC ******************** * * SPINF1 - WRITE INF ON FIRST LINE * ******************** MOVE SPBINW1,=X'0117' DSC1 SCREEN,6,SPBINW1 SET CURSOR ON FIRST LINE MOVE SPBINW1,CBIN0 EDWRT SCREEN,SPFTBMES(CBIN7) WRITE MESSAGE 7 RET PEND * * * SPINF8 PROC ******************** * * SPINF8 - WRITE INF ON LAST LINE * ******************** PERF SPLIN8,CBIN4,CBIN2 RET PEND * * EJECT ************************************ * * DKTEST TEST IF DISK IS READY * ************************************* * DKTEST PROC * TEST IF DISK IS SWITCHED OFF TBF CDKOFF,DKTRET TBT GTMASTFL,DKTRET TBF CDUOVL,DKTRET NO KI IF DISKOVL ON DU MOVE SPBINW5,=X'0801' DSC1 SCREEN,6,SPBINW5 EDWRT .NW,SCREEN,SPFTBMES(CBIN11) DKT10 DELAY CBIN10 TBT CDKOFF,DKT10 PERF CLEAR8 CMP CBIN1,CBIN0 NOK RET DKTRET CMP CBIN0,CBIN0 OK RET PEND * * END