|
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: 20764 (0x511c)
Notes: pts_type(SC)
Names: »GLSCR.SC«, »SCREEN.SC«
└─⟦26dca8ec8⟧ Bits:30009711 Philips computer tape "RÅKON-DIVFMT"
└─⟦this⟧ »REMIT2/GLSCR.SC«
└─⟦this⟧ »REMIT2/SCREEN.SC«
IDENT SCREEN 03.01.XXX.1 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-- ENTRY SCREEN ENTRY SPINF1 INFORMATION ON LINE 1 ENTRY SPINF8 INFORMATION ON LINE 8 ENTRY BELL ENTRY CLEAR8 ENTRY DKTEST TEST IF DISK READY ENTRY KBTEST TEST KB FOR MAK-KEY * 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 ABORT EXT EMPTYT ASSEMBLY SUBROUTINE EMPTYT - TEST IF DATA ITEM IS EMPTY * INCLUDE KEY461,LIST * FIRST INCLUDE KEY VALUES, * THEN INCLUDE SPECIAL SCREEN FORMATS INCLUDE SL461,LIST SPCLRA PROC * * SPCLRA - CLEAR ALL VARABLE FIELDS BEFORE HANDLING THE PICTURE * MOVE SPERASE,CBIN0 PERF SCREEN,=W'1' RET PEND SPCLRS PROC * * SPCLRS - CLEAR SOME VARIABLE FIELDS BEFORE HANDLING THE PICTURE * MOVE SPERASE,CBIN0 PERF SCREEN,=W'2' RET PEND SPCLRN PROC * * SPCLRN - CLEAR NO VARIABLE FIELDS BEFORE HANDLING THE PICTURE * MOVE SPERASE,CBIN0 PERF SCREEN,=W'3' RET PEND SPERR PROC * * HANDLE ERRORS DETECTED OUTSIDE THE PACKAGE * PERF SCREEN,=W'0' RET PEND SPCA PROC * * MOVE SPERASE,CBIN4 PERF SCREEN,=W'1' RET PEND SPCN PROC * * MOVE SPERASE,CBIN4 PERF SCREEN,=W'3' RET PEND 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,CBIN0 "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,CBIN1,CBIN0 ERASE ALL FROM 1 AND UP THOME B CONT * CLEARS ERASE 5,CBIN1,CBIN0 ERASE SOME FROM 1 AND UP B CONT * * DISPLAY ENTIRE FORMAT * ENTIRE IB SPBINW2,ECLRA,ECLRS,ECLRN JUMP ON ROUTINE INDEX * * CLEAR ALL VARIABLES * ECLRA ERASE 11,CBIN1,CBIN0 CLEAR ALL IN MEMORY B ECLRN * * CLEAR SOME VARIABLES * ECLRS ERASE 6,CBIN1,CBIN0 CLEAR SOME FIELDS FROM 1 AND UP IN MEMORY * * CLEAR NO VARIABLES IN MEMORY * ECLRN IB SPERASE,ECLRN1,ECLRN2,ECLRN3,ECLRN4 DISPLAY 0,CBIN1,CBIN0 B CONT ECLRN1 DISPLAY 1,CBIN1,CBIN0 B CONT ECLRN2 DISPLAY 2,CBIN1,CBIN0 B CONT ECLRN3 DISPLAY 3,CBIN1,CBIN0 B CONT ECLRN4 DISPLAY 4,CBIN1,CBIN0 B CONT 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 * * * 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,CBIN3 MOVE SPBINW1,CBIN1 TSTCTL 6 BOK DYKIN GETCTL 0,SPBINW3 MOVE SPBINW1,CFLTDEX(SPBINW3) CMP GSSWITCH(SPBINW1),CBIN0 BE DYKIN MOVE SPBINW1,CBIN1 BL DYK20 MOVE SPBINW2,CBIN15 B DYK20 * DYKIN IB SPKEY,DYK05,DYK10,DYK15,DYK16 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 B DYKOUT DYK16 DYKI SPINPUT,SPKTAB14,SPKTAB24,SPBINW1, C SPBINW2,SPBINW4 DYKOUT BL ERRPRT ERROR CLEAR SPDUPL CBG SPBINW2,CBIN0,DYK20 NORMAL BE RETUR POWER OFF ADD SPBINW2,CBIN9 KEYSWITCH TURNED IB SPBINW2,SET1,SET2,SET3,SET4,CLR1,CLR2,CLR3,CLR4 SET1 SET TTKEY1 B DYKIN SET2 SET TTKEY2 B DYKIN SET3 SET TTKEY3 B DYKIN SET4 SET TTKEY4 B DYKIN CLR1 CLEAR TTKEY1 B DYKIN CLR2 CLEAR TTKEY2 B DYKIN CLR3 CLEAR TTKEY3 B DYKIN CLR4 CLEAR TTKEY4 B DYKIN * DYK20 * PERF DKTEST BNOK SETCREAD * TBF TTKEYFLG,DYK80 * KEY SWITCHES TBF TTKEY1,DYKRET KEYBOARD OFF IB SPKEY,DYK30,DYK40,DYK50,DYK40 DYK30 TBF TTKEY2,DYK80 EQUAL TO KEYPOS 1 ON 6234 B DYKRET DYK40 TBT TTKEY2,DYK80 EQUAL TO KEYPOS 2 ON 6234 DYKRET PERF BELL B SETCREAD DYK50 DYK80 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 * * HANDLE THE RESPECTIVE KEY AS EOI-KEY FIRST * UPDATE CBE SPBINW1,CBIN0,UPD350 JUMP IF LENGTH = 0 GETCTL 3,SPBINW4 GET SCHK-NUMBER CBE SPBINW4,CBIN0,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,CBIN1 INDICATE COND. DISPL B UPD200 UPD070 GETCTL 0,SPBINW3 GET APPL-VALUE CBNE SPBINW3,CBIN0,UPD210 JUMP IF APPL VALUE B SETCREAD * * UNCONDITIONAL DISPLAYING * UPD100 MOVE SPBINW4,CBIN2 INDICATE UNCONDITIONAL DISPLAY UPD200 GETCTL 0,SPBINW3 GET APPL-VALUE CBE SPBINW3,CBIN0,UPD400 JUMP IF NO APPL VALUE * * APPL-VALUE DIFFERENT FROM ZERO * UPD210 PERF SPAPPL UPD212 IB SPBINW3,UPD400,SETCREAD,ERRPRINT B UPD400 * * OK AFTER APPL CONTROL * UNCONDITIONAL DISPLAYING * UPD260 UPDFLD 1,SPINPUT UPDATE FIELD WITH DISPLAYING UPD300 CBE SPBINW1,CBIN0,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,CBIN14 ADJUST EOI/KEY INDEX DUMMY RETUR RET * UPD400 CBE SPBINW4,CBIN2,UPD260 JUMP IF UNCONDITIONAL DISPL UPDFLD 0,SPINPUT UPDATE FIELD DISPL. COND. B UPD300 * 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,CBIN0 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 KCOPY HARD COPY MOVE SPBINW3,CBIN1 TBT GTGTPFLG,KCOPY05 TBT GTLPFLG,KCOPY08 B SETCREAD KCOPY05 EDWRT DSHCGP,ERAFMT PRINT DSHCGP,SPBINW3,='0' GTP B SETCREAD KCOPY08 EDWRT DSHCLP,ERAFMT PRINT DSHCLP,SPBINW3,='0' LP B SETCREAD SET CURSOR AND READ * KDUPL DUPLICATION MOVE SPBINW2,CBIN3 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,CBIN10 SET LENGTH IN DUPFIELD SET SPDUPL B UPDATE DUPL ALLOWED KDUPL2 MOVE SPBINW4,CBIN4 INDICATE ILLEGAL EOI-KEY B ERRPRINT DUPL NOT ALLOWED * * EDIT FIELD * KEDIT GETCTL 1,SPBINW3 GET MAXL CBNE SPBINW3,CBIN0,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,CBIN5 INDICATE COMP.FIELD FOUND MOVE SPBINW1,CBIN0 INDICATE NO CLEARING MOVE SPBINW2,CBIN0 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,CBIN3 INDICATE ENTER KEY DEPRESSED RET * * EMPTY COMPULSORY FIELD FOUND * KENT10 GETFLD 0,SPBINW3,SPBINW2 GET THE COMPULSORY FIELD ERRPRT PERF DKTEST BNOK SETCREAD CBE SPBINW2,CBIN16,KEDIT JUMP IF EDIT CBE SPBINW2,CBIN4,CANC JUMP IF CANCEL1 CBE SPBINW2,CBIN5,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,CBIN0,ERRC20 PERF BELL MOVE SPBINW3,=X'1801' ROW 24 COL. 1 DSC1 SCREEN,6,SPBINW3 SET CURSOR ON LAST ROW * TBT GTRKONV,ERRPRT30 MOVE GSWBCD4,SPBINW4 ERRORCODE ERRPRT30 EDWRT SCREEN,SPFTBERR(SPBINW4) TBF SPKEYFLG,SPERRRET * * READ AFTER ERROR * ERREAD SETCUR SET CURSOR AT THE BEGINNING OF THE CURRENT FIELD ERR100 MOVE SPBINW3,CBIN14 REQUESTED LENGTH IB SPKEY,ERR105,ERR110,ERR115,ERR116 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 B ERR120 ERR116 NKI .NE,KEYB,SPINPUT,SPKTAB14,SPBINW3,SPBINW2 ERR120 BNZ ERR100 JUMP IF NOT OK PERF DKTEST BNOK ERREAD CMP SPBINW2,CBIN0 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,CBIN1 ADJUST KEY INDEX CANC CBE SPBINW1,CBIN0,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,CBIN3 ADJUST FOR CANCEL1,CANCEL2 RET CLEAR1 CBE SPBINW1,CBIN0,ERRC20 JUMP IF LENGTH = 0 SET SPCHANGE INDICATE CHANGED FIELD ERRC20 MOVE SPBINW5,$OPT CHECHK IF SPERR CBE SPBINW5,CBIN0,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,CBIN0,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 KBTEST PROC * THE PROCEDURE SENSES THE KEYBOARD. * IF THE MAK-KEY HAS BEEN DEPRESSED, THE COND.REG * WILL BE SET TO ZERO, IN ORDER TO ENABLE THE CALLING * MODULE TO STOP THE LISTING (OR FOR ANY OTHER PURPOSE) PERF SPLIN8,CBIN0,CBIN0 TESTIO KEYB BOK KBT10 CALL ABORT,KEYB B KBT20 KBT10 WAIT KEYB CBNE SPBINW2,CBIN6,KBT20 CMP CBIN0,CBIN0 B KBT99 KBT20 CMP CBIN0,CBIN1 KBT99 RET PEND EJECT SPLIN8 PROC WRTMES,WRTTYP ******************** * * SPLIN8 - WRITE ON LINE 24 * * MESSAGE DEFINED AS FORMAT NUMBER WRTMES * IN FORMAT TABLE SPFTBMES * * WRTTYP: =0 NO WAIT * =1 WAIT * =2 RETURN * =3 WRITE WITH NO WAIT, RETURN * ******************* MOVE SPBINW1,=X'1801' DSC1 SCREEN,6,SPBINW1 SET CURSOR ON LAST ROW MOVE SPBINW1,CBIN0 CBE WRTMES,CBIN0,LIN800 CBL WRTTYP,CBIN3,LIN801 EDWRT .NW,SCREEN,SPFTBMES(WRTMES) B LINRET LIN801 EDWRT SCREEN,SPFTBMES(WRTMES) LIN800 CBE WRTTYP,CBIN0,LIN8NW CBE WRTTYP,CBIN2,LINRET * READ LIN8IN MOVE SPBINW1,CBIN3 REQUESTED LENGTH IB SPKEY,LIN805,LIN810,LIN815,LIN816 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 B LIN820 LIN816 NKI KEYB,SPINPUT,SPKTAB14,SPBINW1,SPBINW2 LIN820 BNOK LIN8IN JUMP IF NOT OK PERF DKTEST CBE SPBINW2,CBIN2,LIN8CT B LIN8IN * CLEAR LINE LIN8CT PERF CLEAR8 ERASE LAST LINE RET * READ WITH NO WAIT LIN8NW MOVE SPBINW1,CBIN3 REQUESTED LENGTH IB SPKEY,LIN855,LIN860,LIN865,LIN866 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 B LIN870 LIN866 NKI .NW,KEYB,SPINPUT,SPKTAB14,SPBINW1,SPBINW2 LIN870 PERF DKTEST LINRET RET PEND 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 * * CLEAR8 PROC * DELETE FIRST 14 CHARACTERS * OF LINE 24 MOVE GSWBIN2,=X'1801' INDICATE LAST LINE DSC1 SCREEN,06,GSWBIN2 MOVE GSWBIN2,CBIN14 DSC1 SCREEN,02,GSWBIN2 ERASE 14 CHARS RET PEND * * DKTEST PROC * TEST IF DISK IS SWITCHED OFF, * TBF CDKOFF,DKTRET TBT GTMASTFL,DKTRET TBF CDUOVL,DKTRET NO KI IF DISKOVERLAY ON DU * WRITE MESSAGE, AND WAIT FOR FLAG CLEARED MOVE SPBINW5,=X'1801' POSITION DSC1 SCREEN,6,SPBINW5 CURSOR EDWRT .NW,SCREEN,SPFTBMES(CBIN14) DKT10 DELAY CBIN10 TBT CDKOFF,DKT10 PERF CLEAR8 CMP CBIN1,CBIN0 NOK RET DKTRET CMP CBIN0,CBIN0 OK RET PEND * * * * END