|
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: 3534 (0xdce)
Notes: pts_type(SC)
Names: »FSDISC.SC«
└─⟦f45ea3bc3⟧ Bits:30009713 Philips computer tape "WSM"
└─⟦this⟧ »WSM:CREA/FSDISC.SC«
IDENT FSDISC REL=2.3,830504,870155940230 ***************************************************************** * * LATEST UPDATE 830504 MADE BY CJ * * HISTORY= * 830504/CJ GIVE MESSEAGE ON SYSLINE * ****************************************************************** DDUM WSMDDV PDIV ENTRY FSDISC EXPROC WSMERR,PKTAB,PLIT ***(ERROR-)MESSAGE ROUTINE EXT ICLEAR ---ASSRUT:CLEAR ITEM EXT PCLOSE ---ASSRUT:CLOSE DISC-FILE EXT PWRITE ---ASSRUT:WRITE POOLS ON DISC EXT TESTB ---ASSRUT:TEST BIT POSITION * * DECLARATIONS * CED EQU X'B7' CHANGE ECHO-DEVICE EJECT INCLUDE WSMKEY,LIST INCLUDE KEYT5,LIST EJECT FSDISC PROC * * GET MESSAGE ON SYSLINE * FSD000 MOVE LBIN3,=X'1801' LINE:=24 COL:=01 TBF VD82,FSD010 JMP IF NOT VD82 MOVE LBIN3,=X'0101' LINE:=01 COL:=01 FSD010 CALL ICLEAR,LSTR81 ---INITIAL CLEAR MOVE LSTR81,=C'++NOW STORING ON DISC ' MOVE TB7BIN1,=W'22' MOVE LSTR1,=X'1B' 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 SYS LINE EJECT * * INITIATE PARAMETER BLOCK (LSTR81) * CALL ICLEAR,LSTR81 ---CLEAR ITEM MOVE LSTR6A,=C' DSDS' TYPE = D(EFINITION) TYPE = S(ECTION) FSD100 XCOPY LSTR81,W5,W1,LSTR6A,GBIN1 STORE TYPE OF DATA = S XCOPY LSTR81,W6,W6,BPOOL(GBIN3),W6 IDENT=DEF,SEC OR TABLE NAME MOVE LBIN1,W12 WORKPOINTER:=12 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 FSD200 XCOPY LSTR81,W12,W1,W1,W1 FILECODE:=1 CALL PWRITE,LSTR81,BPOOL(GBIN3) ---WRITE POOLS ON DISC BOK FSD500 EJECT * * ERROR AT WRITE * XCOPY LBIN3,W0,W2,LSTR81,W20 UNPACK RETCODE BIN CALL PCLOSE,LSTR81,BPOOL(GBIN3) ---CLOSE DISC-FILE MOVE LBIN2,W0 BIT-INDEX:=0 MOVE LSTR1,=X'31' LOAD '1' MOVE LSTR16,=X'30' LOAD WITH '0':S FSD210 CALL TESTB,LBIN3,LBIN2 ---TEST BIT (INDEX) BOK FSD220 JMP IF FALSE = 0 XCOPY LSTR16,LBIN2,W1,LSTR1,W0 LOAD '1' WHEN TRUE = 1 FSD220 ADD LBIN2,W1 NEXT BITINDEX CBNG LBIN2,W15,FSD210 GO ON UNTIL > 15 FSD230 MOVE LBIN1,W0 NO CLEAR MOVE LBIN4,W8 ERRORMESSAGE NO:8 PERF WSMERR,KEYT5,=W'0' ***(ERROR-)MESSAGE /ROUTINE IB LBIN2,FSD000,FSD300, CLR,CAN C FSD300,FSD500 RET,ENT DISPLAY 0,W1,W0 DISPLAY ENTIRE FORMAT B FSD230 POWER OFF FSD300 MOVE GBIN2,W1 INDICATE RETUR % CANCEL FSD500 CALL PCLOSE,LSTR81,BPOOL(GBIN3) ---CLOSE DISC-FILE MOVE LBIN3,=X'1801' LINE:=24 COL:=01 TBF VD82,FSD600 JMP IF NOT VD82 MOVE LBIN3,=X'0101' LINE:=01 COL:=01 FSD600 DSC SYSL,6,LBIN3 SET CURSOR ON LAST LINE DSC SYSL,2,TB7BIN1 CLEAR SYSLINE FSD999 RET PEND END