|
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: 13685 (0x3575)
Notes: pts_type(SC)
Names: »FSUPDT.SC«
└─⟦f45ea3bc3⟧ Bits:30009713 Philips computer tape "WSM"
└─⟦this⟧ »WSM:CREA/FSUPDT.SC«
IDENT FSUPDT REL=2.3,850313,870155940230 ************************************************************ * * LATEST UPDATE 850313 MADE BY JE * * HISTORY= * * 850313/JE PERFORMANCE DIRECT MOV VAL.OBJ. CLEAR CMBOOL * 831024/CJ POINTER NOT OK VD82 & <DUPL> (FSU591C) * 830920/CJ VBBOOL :=T IF VALBUF OVERFLOW * 830630/CJ REFRESH OF FORMAT FWFSUS * 830607/CJ CHECK OFF EFF. LENGTH INSTEAD OF DEFINED LENGTH * 830526/CJ REL.NUMBER TO FWFSUS FROM WSMDDV IN "RELNUM" * ************************************************************* DDUM WSMDDV PDIV ENTRY FSUPDT EXPROC READIN,PKTAB,PKTAB,PKTAB,PLIT ***READ IN ONE FIELD EXPROC WSMERR,PKTAB,PLIT ***(ERROR-)MESSAGE ROUTINE EXPROC DISPLY,PBIN ***DISPLAY FORMAT SECTION EXPROC USMODL ***UNPACK FORMAT SECTION MODEL EXPROC PRNTFS ***PRINT FORMAT SECTION MODEL EXPROC ATTPRT ***ATTACH PRINTER EXPROC DETPRT ***DETACH PRINTER EXT ICLEAR ---ASSRUT:CLEAR ITEM EXT PREAD ---ASSRUT:READ INTO POOL-UNITS EXT PCLOSE ---ASSRUT:CLOSE DISC-FILE EXT PDLETE ---ASSRUT:DELETE FROM DISC EXT TESTB ---ASSRUT:TEST BIT POSITION EXT CHANFC ---ASSRUT:CHANGE FILE CODE * GSS EQU X'AC' GET SIZE OF SCREEN CED EQU X'B7' CHANGE ECHO-DEVICE TRP EQU X'A7' TRANSFORM PARAMETER EJECT INCLUDE WSMKEY,LIST EJECT INCLUDE KEYT1,LIST INCLUDE KEYT2,LIST INCLUDE KEYT3,LIST INCLUDE KEYT5,LIST INCLUDE KEYT12,LIST EJECT FSUPDT PROC MOVE LBIN1,W1 DSC SCRN,TRP,LBIN1 BACKGROUND:=WHITE FSU000 CLEAR LBOOL4 NOT DUPLICATION MOVE GBIN2,W0 CLEAR RETUR-CODE ATTFMT FWFSUN ATTACH FORMAT-SECTION FORMAT ERASE 5,W1,W0 ERASE OLD CONTENTS DISPLAY 0,W1,W0 DISPLAY ENTIRE FORMAT MOVE LBIN4,W0 FIELD SEQ NO:=0 B FSU405 FSU100 GETABX LBIN4 GET CURRENT INDEX FSU150 PERF READIN,KEYT1,KEYT2,KEYT3,=W'0' ***READ IN ONE FIELD IB LBIN2,FSU500,FSU200,FSU300,FSU400 B FSU100 EJECT * * CANCEL-KEY * FSU200 ERASE 5,W1,W0 ERASE OLD CONTENTS DISPLAY 1,W1,W0 DISPLAY JUST FIELD CONTENTS SETCUR B FSU100 * * RETUR-KEY * FSU300 MOVE GBIN2,W1 INDICATE RETUR-KEY B FSU999 * * POWER OFF * FSU400 DISPLAY 0,W1,W0 DISPLAY ENTIRE FORMAT FSU402 GETABX LBIN4 GET CURRENT FIELD FSU405 GETFLD 0,LBIN4,LBIN3 SEARCH CURR POS BNOK FSU410 SETCUR B FSU150 FSU410 MOVE LBIN4,LBIN3 CHANGE INDEX B FSU405 EJECT * * END OF FORMAT FOUND * * READ IN WANTED FORMAT SECTION * WITH START IN BUFFERNO:9 * INITIATE PARAMETER BLOCK (LSTR81) * FSU500 MOVE GBIN4,DPBIN STORE DIMENSION OF BPOOL ADD GBIN4,W1 ADJUST CALL ICLEAR,LSTR81 ---CLEAR ITEM MOVE LSTR6A,=C' DSDS' TYPE = DSDS XCOPY LSTR81,W5,W1,LSTR6A,GBIN1 STORE TYPE OF DATA = S XCOPY LSTR81,W6,W6,GSTR6A,W0 IDENT=DEF,SEC OR TABLE NAME MOVE LBIN1,W24 WORKPOINTER:=24 ADD LBIN1,W2 GIVING 26 XCOPY LSTR81,LBIN1,W8,GSTR8A,W0 STORE FILENAME ADD LBIN1,W8 ADJUST POINTER XCOPY LSTR81,LBIN1,W6,GSTR6C,W0 STORE VOLUME ID EJECT FSU520 XCOPY LSTR81,W14,W2,DPBIN,W0 MAX NUMB OF POOL-UNITS XCOPY LSTR81,W12,W1,W1,W1 FILECODE:=1 CLEAR LBOOLA FALSE=DISC-ERROR (IF ANY) CALL PREAD,LSTR81,BPOOL(GBIN4) ---READ POOLS FROM DISC BOK FSU590 BL FSU525 JMP IF CR=2(DISC-ERROR) SET LBOOLA TRUE=POOL-ERROR FSU525 * * ERROR AT READ * XCOPY LBIN3,W0,W2,LSTR81,W20 UNPACK RETCODE BIN CALL PCLOSE,LSTR81,BPOOL(GBIN4) --CLOSE DISC-FILE MOVE LBIN2,W0 BIT-INDEX:=0 MOVE LSTR1,=X'31' LOAD '1' MOVE LSTR16,=X'30' LOAD WITH '0':S FSU530 CALL TESTB,LBIN3,LBIN2 ---TEST BIT (INDEX) BOK FSU540 JMP IF FALSE = 0 XCOPY LSTR16,LBIN2,W1,LSTR1,W0 LOAD '1' WHEN TRUE = 1 FSU540 ADD LBIN2,W1 NEXT BITINDEX CBNG LBIN2,W15,FSU530 GO ON UNTIL > 15 FSU550 MOVE LBIN1,W0 NO CLEAR MOVE LBIN4,W8 ERRORMESSAGE NO:8 PERF WSMERR,KEYT5,=W'0' ***(ERROR-)MESSAGE /ROUTINE IB LBIN2,FSU520,FSU200, CLR,CAN C FSU300,FSU300 RET,ENT DISPLAY 0,W1,W0 DISPLAY ENTIRE FORMAT B FSU550 POWER OFF EJECT * * ENTER-KEY * FSU590 CLEAR UPBOOL MOVE GBIN3,GBIN4 LOAD STARTPOOL NUMBER CALL PCLOSE,LSTR81,BPOOL(GBIN4) --CLOSE DISC-FILE MOVE LBIN1,W24 ADD LBIN1,W2 ADJUST FOR EFF. LENGTH MOVE LBIN16,W0 CLEAR BINARY XCOPY LBIN16,W1,W1,BPOOL(GBIN4),LBIN1 LOAD SECT.SIZE LINES EFF SUB LBIN1,W2 ADJUST FOR GIVEN LENGTH TBT VD82,FSU590B JMP IF VD82 CBG LBIN16,W23,FSU591A JMP IF TOO BIG XCOPY LBIN4,W1,W1,BPOOL(GBIN4),LBIN1 LOAD DECL. LENGTH CBNG LBIN4,W23,FSU590A JMP IF < 24 LINES SET UPBOOL PREPARE UNPACK FSU590A B FSU591B CONTINUE FSU590B CBNG LBIN16,ROWS,FSU591B NOT EXEEDED EJECT FSU591A MOVE LBIN4,=W'33' MESSAGE NO =33 PERF WSMERR,KEYT5,=W'0' ***ERROR-MESSAGE ROUTINE IB LBIN2,FSU300,FSU300, C FSU300,FSU300 RETURN KEY ALWAYS B FSU400 POWER OFF FSU591B ADD LBIN1,W1 ADJUST BUFFER POINTER XCOPY LBIN16,W1,W1,BPOOL(GBIN4),LBIN1 LOAD SECT.SIZE COLS CBNG LBIN16,COLS,FSU591C NOT EXEEDED B FSU591A ERROR HANDLING FSU591C ADD LBIN1,W1 GIVING 26 DLETE LSTR81,W0,LBIN1 MOVE GSTR80,LSTR81 SAVE OLD FILE AND VOLUME ERASE 0,W1,W10 ERASE SCREEN * * UNPACK FORMAT MODELLING STATIC AND DYNAMIC FIELDS * PERF USMODL ***UNPACK SECTION MODEL BG FSU980 JUMP IF MEMORY OVERFLOW * * DISPLAY FORMAT SECTION LAYOUT * FSU592 MOVE LBIN1,W2 BACKGROUND :=BLACK CALL TESTB,GBIN10,W14 ---TEST BIT NO=14 BF FSU595 JMP IF FALSE = 0 SUB LBIN1,W1 BACKGROUND:=WHITE FSU595 DSC SCRN,TRP,LBIN1 CHANGE BACKGROUND MOVE LBIN16,W1 1ST ROW MOVE LBIN4,=X'0101' ROW:=1 COL:=1 MOVE LBIN14,W0 ATTR.TAB POINTER:=0 MOVE LBIN1,W0 PERF DISPLY,LBIN8 ***EDIT AND WRITE TO E-O-S ATTFMT FHOME SET CURSOR POSITION THOME HOME EJECT * * ASK FOR FURTHER ACTIONS * ENTER=> UPDATE * PRINT=> HARDCOPY * DEL => DELETE * DUP => DUPLICATE * FSU600 MOVE LBIN1,W0 NO CLEAR MOVE LBIN4,W22 MESSAGE NO 22 PERF WSMERR,KEYT12,=W'0' ***(ERROR-)MESSAGE ROUTINE ATTFMT FHOME THOME IB LBIN2,FSU000,FSU000, CLR,CAN C FSU300,FSU700, RET,ENT C FSU800,FSU850, PRT,DEL C FSU900 DUP B FSU592 POWER OFF FSU700 CLEAR CMBOOL FALSE=NO CHANGE OF DYN FIELDS SET LBOOL8 TRUE=UPDATE OLD MODE B FSU999 EJECT * * PRINT OUT OF FORMAT SECTION * FSU800 PERF ATTPRT ***CHECK PRINTER-DEVICE BNOK FSU810 TBF LBOOLE,FSU810 JMP IF NOT OK CBE LBIN2,W0,FSU801 JMP IF OK IB LBIN2,FSU600,FSU300 ***OK,CAN,RET B FSU600 JMP ON OTHER KEYS FSU801 PERF PRNTFS ***PRINT FORMAT SECTION TBT VBBOOL,FSU805 JMP IF VALBUF OVERFLOW PERF DETPRT ***DETACH PRINTER B FSU600 FSU805 PERF DETPRT ***DETACH PRINTER B FSU985 * * CHECK PRINTER-DEVICE * FSU810 PERF WSMERR,KEYT5,=W'0' ***ERROR/MESSAGE ROUTINE IB LBIN2,FSU800,FSU600,FSU300,FSU800 ***CLR,CAN,RET,ENT B FSU400 EJECT * * DELETE FORMAT SECTION * FSU850 MOVE LBIN1,W0 NO CLEAR MOVE LBIN4,W7 MESSAGE NO:=7 PERF WSMERR,KEYT5,=W'0' ***(ERROR/)MESSAGE ROUTINE IB LBIN2,FSU600,FSU000, CLR,CAN C FSU300,FSU860 RET ENT B FSU400 POWER OFF FSU860 * * INITIATE PARAMETER BLOCK (LSTR81) * CALL ICLEAR,LSTR81 ---CLEAR ITEM MOVE LSTR6A,=C' DSDS' TYPE = D(EFINITION) TYPE = S(ECTION) XCOPY LSTR81,W5,W1,LSTR6A,GBIN1 STORE TYPE OF DATA = S XCOPY LSTR81,W6,W6,BPOOL(GBIN4),W6 IDENT=DEF,SEC OR TABLE NAME MOVE LBIN1,W12 WORKPOINTER:=12 XCOPY LSTR81,LBIN1,W1,W1,W1 FILECODE:=1 ADD LBIN1,W14 GIVING 26 XCOPY LSTR81,LBIN1,W8,GSTR8A,W0 STORE FILENAME ADD LBIN1,W8 ADJUST POINTER XCOPY LSTR81,LBIN1,W6,GSTR6C,W0 STORE VOLUME ID FSU870 CLEAR LBOOLA FALSE=DISC-ERROR (IF ANY) CALL PDLETE,LSTR81,BPOOL(GBIN4) ---WRITE POOLS ON DISC BOK FSU890 BL FSU872 JMP IF CR=2(DISC-ERROR) SET LBOOLA TRUE=POOL-ERROR FSU872 * * ERROR AT DELETE * XCOPY LBIN3,W0,W2,LSTR81,W20 UNPACK RETCODE BIN CALL PCLOSE,LSTR81,BPOOL(GBIN4) --CLOSE DISC-FILE MOVE LBIN2,W0 BIT-INDEX:=0 MOVE LSTR1,=X'31' LOAD '1' MOVE LSTR16,=X'30' LOAD WITH '0':S FSU875 CALL TESTB,LBIN3,LBIN2 ---TEST BIT (INDEX) BOK FSU880 JMP IF FALSE = 0 XCOPY LSTR16,LBIN2,W1,LSTR1,W0 LOAD '1' WHEN TRUE = 1 FSU880 ADD LBIN2,W1 NEXT BITINDEX CBNG LBIN2,W15,FSU875 GO ON UNTIL > 15 FSU885 MOVE LBIN1,W0 NO CLEAR MOVE LBIN4,W8 ERRORMESSAGE NO:8 PERF WSMERR,KEYT5,=W'0' ***(ERROR-)MESSAGE /ROUTINE IB LBIN2,FSU870,FSU000, CLR,CAN C FSU300,FSU000 RET,ENT DISPLAY 0,W1,W0 DISPLAY ENTIRE FORMAT B FSU885 POWER OFF FSU890 CALL PCLOSE,LSTR81,BPOOL(GBIN4) --CLOSE DISC-FILE B FSU000 EJECT * * DUPLICATION OF FORMAT SECTION * FSU900 DSC KEYB,CED,SYSLFC CHANGE ECHO-DEVICE CALL CHANFC,SCRN,SYSLFC ---CHANGE FILE CODE ATTFMT FWFSDP MOVE LBIN18,W24 LINE NUMBER TBF VD82,FSU901 MOVE LBIN18,W1 VD82 SYSTEM LINE FSU901 SET LBOOL4 TRUE = DUPLICATION FSU940 POWER OFF DISPLAY 4,LBIN18,LBIN18 MOVE LBIN4,W3 FIELDNUMBER:=3 GETFLD 0,LBIN4,LBIN3 MAKE FIELD 3 CURRENT SETCUR FSU910 GETABX LBIN4 SET LBOOLD FOR WSMERR; DISPLAY COND. PERF READIN,KEYT1,KEYT2,KEYT3,=W'0' ***READ IN ONE FIELD CLEAR LBOOLD IB LBIN2,FSU950,FSU920, E-O-F,CANCEL C FSU300,FSU940 RETURN,POWER OFF B FSU910 EJECT * * CANCEL KEY * FSU920 ERASE 1,W1,W0 XCOPY GSTR6C,W0,W6,GSTR80,W8 RESTORE OLD VOLUME NAME XCOPY GSTR8A,W0,W8,GSTR80,W0 RESTORE OLD FILE NAME XCOPY GSTR6A,W0,W6,BPOOL(GBIN4),W6 RESTORE SECTION NAME DISPLAY 1,W1,W0 B FSU940 EJECT * * END OF FORMAT FOUND * FSU950 MOVE LBIN1,W0 NO CLEAR MOVE LBIN4,W7 MESSAGE NO:=7 PERF WSMERR,KEYT5,=W'0' ***(ERROR/)MESSAGE ROUTINE IB LBIN2,FSU940,FSU920, CLR,CAN C FSU300,FSU960 RET ENT B FSU940 POWER OFF * * ENTER KEY * FSU960 XCOPY BPOOL(GBIN4),W6,W6,GSTR6A,W0 RENAME FORMAT SECTION XCOPY BPOOL(GBIN4),W22,W1,W1,W1 VERSION NO:=1 MOVE GBIN2,W2 INDICATE DIRECT WRITE B FSU999 FSU985 MOVE LBIN5,W5 VALIDATION BUFFER OVERFLOW FSU980 MOVE LBIN1,W0 NO CLEAR MOVE LBIN4,W2 ERRORMESSAGE NO:=2 PERF WSMERR,KEYT5,=W'0' ***(ERROR-)MESSAGE ROUTINE MOVE GBIN2,W1 INDICATE RETURN KEY EJECT * * EXIT * FSU999 CALL CHANFC,SCRN,SCRNFC ---CHANGE FILE CODE DSC KEYB,CED,SCRNFC CHANGE ECHO-DEVIVE ATTFMT FHOME THOME CLEAR LBOOL4 NO DUPLICATION RET PEND EJECT INCLUDE FWFSUS,LIST END