|
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: 17454 (0x442e)
Notes: pts_type(SC)
Names: »WUDEN.SC«
└─⟦f45ea3bc3⟧ Bits:30009713 Philips computer tape "WSM"
└─⟦this⟧ »WSM:UTIL/WUDEN.SC«
IDENT WUDEN REL=2.3,850808,870155940230 * ********************************************* * * * A STANDARD PROGRAM PACKAGE HANDLING * * A COMPLETE PICTURE ON A DISPLAY SCREEN * * * * RUNNING UNDER: CREDIT REL 12.0 * * TOSS REL 12.0 * * * ********************************************* * ** HISTORY: ** 85-08-08 /CRBE CHANGE IN ERROR FORMATS FROM DISC TO DISK. ** 84-12-04 /CRBE START/STOP BLOCKING IMPLEMENTED ** 83-10-06 /MAER ERROR TEXT 23 ADDED. ** 83-07-01 /MAER DUPL OF OUTPUT UNIT => APPL 10 IS EXECUTED. ** 83-06-27 /MAER ERFM10 NOW COVERS ALSO FILE OVERFLOW. ** BIN13 INSTEAD OF BIN1 DESTROYED BY SUBR. "BUZZER". ** 83-06-22 /MAER ERFM19-21 ADDED. ** 83-06-17 /MAER KEYBOARD BUZZER ALWAYS USED. ** 82-08-19 /MAER ADAPTED TO VD82. DDUM WUDIV PDIV ************************* * * * ENTRIES AND EXTERNALS * * * ************************* ENTRY DECLRA CLEAR ALL VARIABLE FIELDS ENTRY DECLRS CLEAR SOME VARIABLE FIELDS ENTRY DECLRN CLEAR NO VARIABLE FIELDS ENTRY DECLRD ENTRY DERR DENTER-ERROR ENTRY DERROR ERROR/MESSAGE OUTSIDE SCREEN * EXPROC APP USER ROUTINE TO HANDLE EXPROC STPBLK ***STOP BLOCKING EXPROC STABLK ***START BLOCKING APPL VALUES EXT EMPTYT ASSEMBLY SUBROUTINE EMPTYT - EXT CHANFC CHANGE FILE CODE (VD82) TEST IF DATA ITEM IS EMPTY EXT MASK * INCLUDE WULIT,LIST EJECT * * CLEAR ALL VARIABLE FIELD BEFORE HANDLING THE PICTURE * DECLRA PROC PERF DENTER,W1 RET PEND * * CLEAR SOME VARIABLE FIELDS BEFORE HANDLING THE PICTURE * DECLRS PROC PERF DENTER,W2 RET PEND * * CLEAR NO VARIABLE FIELDS BEFORE HANDLING THE PICTURE * DECLRN PROC PERF DENTER,W3 RET PEND * * CLEAR SOME VARIABLE FIELDS AND DISPLAY THE REST * OF THE VARIABLE FIELDS BEFORE HANDLING THE PICTURE * DECLRD PROC * PERF DENTER,W4 RET PEND * * ERROR PRINTOUT * DERR PROC PERF DENTER,W0 RET PEND EJECT DENTER PROC OPT PBIN OPT PERF STABLK ***START BLOCKING MOVE DEBINW2,OPT MOVE TO VARIABLE TO ALLOW INSTR.S CMP AND IB CMP DEBINW2,W0 "DEERR" ENTRY ? BE ERRPRINT YES ! TBT DEPROMPT,ENTIRE JUMP IF ENTIRE FORMAT SHOULD BE DIDELAYED * * ONLY VARIABLE FIELDS * IB DEBINW2, C CLEARA, C CLEARS, C CONT, C CLEARD * CLEARA ERASE 2,W1,W0 ERASE ALL FROM 1 AND UP B CONT * CLEARS ERASE 5,W1,W0 ERASE SOME FROM 1 AND UP B CONT CLEARD DISPLAY 3,W1,W0 DISPLAY FROM 1 AND UP B CONT EJECT * * DISPLAY ENTIRE FORMAT * ENTIRE CLEAR DEPROMPT IB DEBINW2, JUMP C ECLRA, ON C ECLRS, ROUTINE C ECLRN, INDEX C ECLRN * * CLEAR ALL VARIABLES * ECLRA ERASE 3,W1,W0 CLEAR ALL FROM 1 AND UP IN MEMORY B ECLRN CONTINUE * * CLEAR SOME VARIABLES * ECLRS ERASE 6,W1,W0 CLEAR SOME FIELDS FROM 1 AND UP IN MEMORY * * CLEAR NO VARIABLES IN MEMORY * ECLRN DISPLAY 0,W1,W0 DISPLAY ENTIRE FORM EJECT * CONT GETABX DEBINW4 GET CURRENT INDEX BL KTHOME JUMP IF NO CURRENT FIELD CONT5 GETFLD 0,DEBINW4,DEBINW3 SEARCH CURRENT POSITION BZ SETCREAD JUMP IF FOUND BL KTHOME POSITION NOT FOUND * * COMPULSORY FIELD FOUND * MOVE DEBINW4,DEBINW3 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 PERF STPBLK ***STOP BLOCKING DYKI DEINPUT,DEKTAB1,DEKTAB2,DEBINW1, C DEBINW2,DEBINW4 DYKOUT BL ERRPRT ERROR CBNL DEBINW2,W0,DYK100 DYK050 MOVE DEBINW2,W2 B ERRCAN DYK100 CBE DEBINW2,W0,ECLRN CLEAR BOOL3 SETOFF DUPL-"SWITCH" KEY SWITCHES IB DEBINW2,UPD300,CLEA20, JUMP ON C UPDATE,ERRCAN,ERRCAN, C DUMMY,KTBWD, C DUMMY,DUMMY,DUMMY,DUMMY,DUMMY,DUMMY, C KCOPY,KDUPL,KEDIT EJECT * * HANDLE THE RESPECTIVE KEY AS EOI-KEY FIRST * UPDATE MOVE DEBINW4,W1 INDICATE COND. DIDEL GETCTL 0,DEBINW3 GET APPL-VALUE CBE DEBINW3,W0,UPD250 JUMP IF NO APPL VALUE * * APPL-VALUE DIFFERENT FROM ZERO * UPD240 PERF APP IB DEBINW3,UPD260,SETCREAD,ERRPRINT B UPD260 UPD250 CBNE DEBINW1,W0,UPD260 MOVE DEINPUT,:FMTITEM UPD260 TBT BOOL3,UPD300 JUMP IF DUPL OF OUTPUT UNIT (UPDFLD ALREADY PERFORMED!) UPDFLD 0,DEINPUT UPDATE FIELD DISPL. COND. CLEAR BOOL3 SETOFF DUPL-"SWITCH" UPD300 SET DECHANGE INDICATE CHANGED ITEM * JUMP ON FUNCTION KEY INDEX IB DEBINW2,KTFWD,DUMMY, C KEOI,DUMMY,DUMMY,KTFWD, C DUMMY,DUMMY,DUMMY,DUMMY,DUMMY, C DUMMY,DUMMY,DUMMY,DUMMY,DUMMY, C KENTER SUB DEBINW2,W14 ADJUST EOI-KEY INDEX B RETUR RETUR1 SUB DEBINW2,W1 ADJUST KEY INDEX DUMMY RETUR CLEAR DENOCHAN RET * 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 * TSTTAB TEST TAB OUTPUT BE READIN OK B SETCREAD EJECT KCOPY HARD COPY MOVE DEBINW3,W1 PRINT DEDSPRT,DEBINW3,W0 KCOP10 B SETCREAD SET CURSOR AND READ * KDUPL DUPLICATION MOVE DEBINW2,W3 INDICATE COMMON EOI-KEY DUPL DEINPUT DUPLICATION BNZ KDU500 DUPL NOT ALLOWED MOVE DEBINW4,W1 INDICATE COND. DIDEL GETCTL 0,DEBINW3 GET APPL-VALUE CBNE DEBINW3,W10,UPD260 JUMP IF APPL VALUE DIFF. FROM 10 UPDFLD 0,DEINPUT UPDATE FIELD SET BOOL3 PERFORM APPLICATION ROUTINE B UPD240 KDU500 MOVE DEBINW4,W0 INDICATE ILLEGAL EOI-KEY B ERRPRINT DUPL NOT ALLOWED EJECT * * EDIT FIELD * KEDITX MOVE DEBINW1,W1 KEDIT GETCTL 1,DEBINW3 GET MAXL CBNE DEBINW3,W0,KED100 PERF BUZZER ACOUSTIC ALARM B SETCREAD KED100 EDFLD DEINPUT,DEKTAB3,DEBINW1, C DEBINW2,DEBINW4 B DYKOUT CONTINUE AS FOR DYKI * * ERASE KEY * KERASE GETABX DEBINW4 ERASE 2,DEBINW4,W0 * * ENTER KEY * KKEEP KENTER MOVE DEBINW4,W5 INDICATE COMP.FIELD FOUND MOVE DEBINW1,W0 INDICATE NO CLEARING GETFLD 0,DEBINW1,DEBINW3 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 CBE DEBINW2,W9,KCOP10 CBE DEBINW2,W10,KCOP10 MOVE DEBINW2,W3 INDICATE ENTER KEY DEPRESSED RET * * EMPTY COMPULSORY FIELD FOUND * KENT10 MOVE DEBINW2,W0 GETFLD 0,DEBINW3,DEBINW2 GET THE COMPULSORY FIELD MOVE DEBINW1,W0 EJECT ERRPRT CBE DEBINW2,W16,KEDIT JUMP IF EDIT CBE DEBINW2,W4,ERRCAN JUMP IF ERRCANEL1 CBE DEBINW2,W5,ERRCAN JUMP IF ERRCANEL2 XSTAT DEDSDYKB,DEBINW3 CALL MASK,DEBINW3,W64 BNZ DYK050 * * ERRPRINT PERF DERROR,DEKTAB4 IB DEBINW2,SETCREAD,RETUR2,RETUR2,KEDITX B SETCREAD * * CLEAR LAST LINE * ERRCAN PERF CANC IB DEBINW2,SETCREAD,SETCREAD SUB DEBINW2,W3 ADJUST FOR CANCEL1,CANCEL2 RET CLEA20 GETABX DEBINW4 GET CURRENT TAB INDEX DISPLAY 1,DEBINW4,DEBINW4 DISPLAY FIELD B SETCREAD CONTINUE * RETUR2 SUB DEBINW2,W1 RET PEND EJECT DERROR PROC KEYT PKTAB KEYT *************************************************************** * * * ERROR HANDLING * * * *************************************************************** PERF STPBLK ***PUT CURSOR ON MOVE DEBINW3,=X'0101' ASSUME VD82 TBT VD82,DERR02 IF VD82 => BRANCH MOVE DEBINW3,=X'1801' ELSE MSG ON LINE 24 DERR02 MOVE DEBINW2,W1 INDICATE CLEAR-KEY PERF BUZZER ACOUSTIC ALARM CMP DEBINW4,W0 BZ DERR99 BP DERR03 ADD DEBINW4,=W'51' DERR03 DSC1 DEDSSYSL,6,DEBINW3 SET CURSOR ON MESSAGE ROW CBL DEBINW4,=W'50',DERR04 MOVE DEBINW4,W2 *************************************************************** * * * WRITE MESSAGE * * * *************************************************************** DERR04 EDWRT DEDSSYSL,DEFTBERR(DEBINW4) EJECT *************************************************************** * * * READ KEYBOARD FOR OPERATOR ACKNOWLEDGMENT * * * *************************************************************** SETCUR SET CURSOR AT THE BEGINNING OF THE CURRENT FIELD B DERR15 NO BELL FIRST TIME DERR10 PERF BUZZER ACOUSTIC ALARM DERR15 MOVE DEBINW3,W1 REQUESTED LENGTH NKI .NE,DEDSDYKB,STR1A,KEYT,DEBINW3,DEBINW2 BNOK DERR10 CBNE DEBINW2,W0,DERR20 DISPLAY 0,W1,W0 B DERR03 DERR20 MOVE DEBINW3,=X'0101' ASSUME VD82 TBT VD82,DERR25 IF VD82 => BRANCH... MOVE DEBINW3,=X'1801' ...ELSE USE LINE 24 (VD46) DERR25 IB DEBINW2,DERR30,DERR30, C DERR30,DERR40 B DERR10 CONTINUE *************************************************************** * * * CLEAR MESSAGE LINE AFTER OPERATOR ACKNOWLIGMENT * * * *************************************************************** DERR30 DSC1 DEDSSYSL,6,DEBINW3 SET CURSOR ON MSG LINE DSC1 DEDSSYSL,2,W80 ERASE CURRENT MESSAGE PERF CANC B DERR99 DERR40 CBE DEBINW1,W0,DERR10 DSC1 DEDSSYSL,6,DEBINW3 SET CURSOR ON MSG LINE DSC1 DEDSSYSL,2,W80 ERASE CURRENT MESSAGE DERR99 RET PEND EJECT CANC PROC MOVE DEINPUT,HEX00 MOVE DEINPUT,:FMTITEM SAVE CURRENT CONTENTS CBE DEBINW1,W0,CANC10 JUMP IF LENGTH = 0 MOVE STATSH,=X'3100' MOVE :FMTITEM,STATSH PUT SOMETHING IN THE FIELD GETABX DEBINW4 GET CURRENT INDEX ERASE 10,DEBINW4,DEBINW4 CLEAR FIELD CANC10 IB DEBINW2,CLEAR1,CLEAR2 CANC15 MOVE :FMTITEM,DEINPUT RESTORE CURRENT CONTENTS RET CLEAR1 CBE DEBINW1,W0,CANC15 JUMP IF LENGTH = 0 SET DECHANGE INDICATE CHANGED FIELD B CANC15 CONTINUE * CLEAR2 CBE DEBINW1,W0,CANC15 MOVE :FMTITEM,DEINPUT RESTORE CURRENT CONTENTS GETABX DEBINW4 GET CURRENT TAB INDEX DISPLAY 1,DEBINW4,DEBINW4 DISPLAY FIELD RET PEND EJECT ********************************** * * * ACTIVATE KEYBOARD BUZZER * * * * DESTROYED: BIN13 * * * * * ********************************** BUZZER PROC MOVE BIN13,=X'4F' F.C. FOR KEYBOARD BUZZER CALL CHANFC,DEDSSYSL,BIN13 CHANGE F.C. TO KEY BOARD BUZZER MOVE BIN13,=X'8000' BIT 0 = BUZZER DSC1 DEDSSYSL,0,BIN13 ACTIVATE BUZZER CALL CHANFC,DEDSSYSL,SYSLFC CHANGE F.C. BACK BUZZ99 RET PEND EJECT * ****************** * * * ERROR-MESSAGES * * * ****************** * DEFTBERR FTABLE ERFM01,ERFM02,ERFM03,ERFM04,ERFM05,ERFM06,ERFM07, C ERFM02,ERFM09,ERFM10,ERFM11,ERFM12,ERFM13,ERFM02, C ERFM02,ERFM02,ERFM02,ERFM18,ERFM19,ERFM20,ERFM21, C ERFM22,ERFM23 * ERFM01 FRMT FSL FTEXT 'TOO FEW INPUT CHARACTERS' FMEND * ERFM02 FRMT FSL FTEXT 'UNDEFINED ERROR' FMEND * ERFM03 FRMT FSL FTEXT 'I/O-ERROR' FMEND * ERFM04 FRMT FSL FTEXT 'FUNCTION NOT ALLOWED' FMEND * ERFM05 FRMT FSL FTEXT 'COMPULSORY FIELD NOT FILLED' FMEND * ERFM06 FRMT FSL FTEXT 'ILLEGAL VALUE' FMEND * ERFM07 FRMT FSL FTEXT 'FILENAME ALREADY USED' FMEND * ERFM09 FRMT FSL FTEXT 'WSM SYSTEM FILE NOT CREATED' FMEND * ERFM10 FRMT FSL FTEXT 'DISK/FILE OVERFLOW' FMEND * ERFM11 FRMT FSL FTEXT 'NEW VOLUME LOADED' FMEND * ERFM12 FRMT FSL FTEXT 'FILE NAME UNKNOWN' FMEND * ERFM13 FRMT FSL FTEXT 'DISK NOT IN SYSTEM' FMEND * ERFM18 FRMT FSL FTEXT 'DISK NOT OPERABLE' FMEND ERFM19 FRMT FSL FTEXT 'DISK ERROR' FTAB 31 FCOPY STR6A FMEND * ERFM20 FRMT FSL FTEXT 'POOL ERROR' FTAB 31 FCOPY STR6A FMEND ERFM21 FRMT FSL FTEXT 'NOT FOUND' FMEND ERFM22 FRMT FSL FTEXT 'I/O-ERROR' FTAB 30 FCOPY STR6A FMEND ERFM23 FRMT FSL FTEXT 'NOT A TOSS DISK!' FMEND * BELL FRMT FSL FILLR X'07',1 FMEND END