|
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: 29776 (0x7450)
Notes: pts_type(SC)
Names: »WUUTI.SC«
└─⟦f45ea3bc3⟧ Bits:30009713 Philips computer tape "WSM"
└─⟦this⟧ »WSM:UTIL/WUUTI.SC«
IDENT WUUTI REL=2.3,850808,870155940230
**************************************
* W S M *
* WORK STATION MANAGEMENT *
* UTILITY PROGRAMS *
* 1 CREATE VOLUME *
* 2 CREATE FILE *
* 3 DELETE FILE *
* 4 COPY VOLUME/FILE (REORGANIZE) *
* 5 EXTEND FILE *
* 6 PRINT FILE *
* 7 CHANGE VOLUME-NAME *
* 8 PRINT VTOC *
* *
**************************************
** HISTORY:
** 85-08-08 /CRBE CHANGE IN ERR.MESS FROM DISC TO DISK.
** 84-12-04 /CRBE START/STOP BLOCKING IMPLEMENTED.
** 84-12-03 /CRBE MUL&DIV NOW FROM ASSRUT.
** 84-07-12 /MAER INTERTASK COMMUNICATION IMPLEMENTED.
** CHVNAM DOES NO MORE DESTROY RETCOD.
** 84-06-01 /MAER APPL. ROUTINE A13: THE NEW VARIABLE "DMAX" IS
** USED FOR CHECK OF ENTERED TYPE IN CRV.
** 83-10-15 /MAER CHANGE VOLUME NAME (CHVNAM) USES "RETCOD"
** INSTEAD OF DEBINW4.
** SUBROUTINE "DISERR" TAKES CARE OF ERROR 23 (NEW).
** RETURN-CODE "RETRIES PERFORMED" HANDLED AS OK
** (INITIAL ATTEMPT TO PRINT ON GP74).
** EXTENDED DELAY OF PRINTER (LP REQUIREMENT).
** (W10 INSTEAD OF W4).
** 83-09-27 /MAER A13, DISK TYPES FOR CRV, CHANGED.
** 83-09-12 /MAER A13, DISK TYPES FOR CRV, CHANGED.
** 83-08-02 /MAER UNIT-MNEMO MATCH ADAPTION (W66 INSTEAD OF W48).
** 83-07-04 /MAER SET BOOL3 IN A10 TO AVOID UPDFLD OF "OUTPUT UNIT".
** (REWRT SINCE DUPLICATION NOW ALLOWED.)
** 83-06-30 /MAER WUPRF WITH SECTOR-PRINTOUT FOR MENU OPTION '9' (A7).
** ( NOT FOR PUBLIC USE!!!).
** NEW DISK TYPES (NO 16-19) ADDED (APPL=A13).
** 83-06-22 /MAER A18 & UFERR ADDED.
** PROC "HALT" ALLOWES ALSO THE RETURN-KEY.
** 83-06-17 /MAER ANSWER = "S" ALLOWED IN APPL "A1"
** (COPY SPECIFIC SECTION / DEFINITION).
** 83-03-18 /MAER STEADY CURSOR.
** CHANGED DECORATIONS.
** 83-02-09 /MAER NEW TRAILING TEXT ON MENU.
** 82-08-18 /MAER ADAPTED TO VD82/83.
** 82-07-26 /DALI NO.OF FILES IN CRV USES APPL=4
** 82-07-08 /DALI VOLUME-NAME CHANGED FOR GETTING RIGHT UNIT
** (RETCOD IS NOT SET!)
** 82-02-04 /DALI NEW ERROR-MESSAGE "DISK OVERFLOW" WHEN CREATE OR EX
** 81-11-11 /DALI CREATION
DDUM WUDIV
PDIV
ENTRY WUUTI
ENTRY APP
ENTRY DISERR
ENTRY DSKERR
ENTRY UFERR
ENTRY HALT
ENTRY CONT
ENTRY CHVNAM CHANGE VOLUME-NAME
ENTRY STPBLK
ENTRY STABLK
*
EXPROC WUCRV CRE= CREATE VOLUME
EXPROC WUCRF CRE = CREATE FILE
EXPROC WUDLF CRE= DELETE FILE
EXPROC WUCOP CRE= COPY DISK,FILE
EXPROC WUEXT CRE= EXTEND FILE
EXPROC WUEXT1 CRE= EXTEND FILE,APPL.ROUT
EXPROC WUEXT2 CRE= EXTEND FILE,APPL.ROUT
EXPROC WUPRF CRE= PRINT FILE
EXPROC WUCVN CRE= CHANGE VOLUME NAME
EXPROC WUPRV CRE= PRINT VTOC
EXPROC DECLRA
EXPROC DERR
EXT CHANFC
EXT GETVOL
EXT GETIND GET IX & DIM OF ARRAY
EXT RCGET
EXT OPENF
EXT CLOSEF
EXT CHVOL CHANGE VOLUME-NAME
EXT GETCW GET CONTROL WORD 1 OF ECB
EXT WXMUL ---ASSRUT:MULTIPLICATION
EXT WXDIV ---ASSRUT:DIVISION
*
ENT EQU X'80' ENTER
RET EQU X'99' RETURN
*
KTABEN KTAB ENT,RET
TSTAT EQU X'07'
ATTACH EQU X'0E'
DETACH EQU X'0F'
****************************************************************
* *
* ORDER CODES *
* *
****************************************************************
BRD EQU X'81' BASIC READ
TRP EQU X'A7' TRANSFORM PARAMETER
GSS EQU X'AC' GET SCREEN SIZE
CED EQU X'B7' CHANGE ECHO DEVICE
TIMOUT EQU X'0B' SET TIME-OUT
****************************************************************
* *
* START & STOP BLOCKING *
* *
****************************************************************
STOPBLK EQU X'BE'
STARTBLK EQU X'BD'
EJECT
WUUTI PROC
****************************************************************
* *
* GET NUMBER OF POOL UNITS *
* *
****************************************************************
CALL GETIND,BPOOL(W1),BIN1,BIN2 BIN2 := NO OF ELEM.
MOVE NOOFPO,BIN2 MOVE TO BCD (USED IN WUCOP)
EJECT
****************************************************************
* *
* GET SCREEN TYPE *
* *
****************************************************************
STA000
MOVE BIN1,W0 WORKITEM := 0
MOVE BIN2,W80 BUFFER LENGTH := 80
BASIC READ OF THE SCREEN SIZE:
DSC DEDSSCRN,BRD,BIN1,STATSH,BIN2
BOK STA025 OK => VD82 IS USED
****************************************************************
* *
* VD46 IS USED *
* *
****************************************************************
MOVE SCRNFC,=X'50' SET FILE CODE VD46
CALL CHANFC,DEDSSCRN,SCRNFC CHANGE FILE CODE TO VD46
CALL CHANFC,DEDSSYSL,SCRNFC CHANGE FILE CODE SYSTEM LINE
MOVE SYSLFC,SCRNFC SET SYSTEM LINE FILE CODE
B STA030
EJECT
****************************************************************
* *
* VD82 IS USED *
* *
****************************************************************
STA025
SET VD82 INDICATE VD82 BY SETTING BOOLEAN
EJECT
STA030
*********************************
* TRY INTERTASK COMMUNICATION *
*********************************
MOVE BIN1,=X'FFFF' TIME OUT VALUE
DSC1 ITCIN,TIMOUT,BIN1 IN DATA SET
DSC1 ITCOUT,TIMOUT,BIN1 OUT DATA SET
STA037
CLEAR ICEXIT
MOVE ICLEN,W21 ITC REQUESTED LENGTH
RECEIVE ITCIN,ICPOOL,ICLEN UNADDR READ FROM ANY TASK
BNOK STA040 NO ONE CALLING (DOESN'T EXIST)
SET IC INDICATE THAT ITC IS RUNNING
CALL GETCW,ITCIN,ICTASK FETCH TASK-ID (STORED IN ITCIN)
EJECT
*********************************
* SET UP FOR VD82 SCREEN *
*********************************
STA040
*********************************
* GET LENGTH OF PHYSICAL SCREEN *
*********************************
CALL GETIND,PHYSCR,BIN2,BIN1
MOVE BIN1,=X'0C81'
*********************************
* DEFINE PHYSICAL SCREEN SIZE *
*********************************
DSC DEDSSYSL,TRP,BIN1,PHYSCR,BIN2
*********************************
* CHANGE ECHO DEVICE *
*********************************
DSC DEDSDYKB,CED,SCRNFC
EJECT
****************************************************************
* *
* ATTACH INIT. MENU, GET OPTION, ACTIVATE CORRECT SUBROUTINE *
* *
****************************************************************
STA050
PERF STABLK ***START BLOCKING
MOVE BIN1,=X'0081' BACKGROUND = WHITE
DSC DEDSSCRN,TRP,BIN1 SET SCREEN BACKGROUND = WHITE
ATTFMT FPROG
SET DEPROMPT
STA100
PERF DECLRA
STA150
IB DEBINW2,STA100,ESCAPE,STA200
PERF DSKERR,W0 'BELL'
B STA150
STA200
MOVE VOLNAM,=X'00'
MOVE COPNAM,=X'17'
MOVE PBLOCK,=X'20'
MOVE BIN1,SCRNFC
XCOPY PBLOCK,W5,W1,BIN1,W1 FC2:PRINT-DEVICE
MOVE BIN1,PRNUM
PERFI BIN1,WUCRV,WUCRF,WUDLF,WUCOP, C
WUEXT,WUPRF,WUCVN,WUPRV
B STA050
ESCAPE
TBF IC,STA050 ITC DOESN'T EXIST => END
SEND .ADDR,ITCOUT,ICPOOL,ICLEN,ICTASK SEND ANSWER
B STA037
RET
PEND
EJECT
*************************
* *
* CHANGE VOLUME NAME *
* VOLYM = VOLUME NAME *
* CODE = FILE CODE *
* *
*************************
*
CHVNAM PROC VOLYM,CODE
PSTRG VOLYM
PBIN CODE
CALL CHANFC,DISK,CODE
CALL CHVOL,DISK,SYSBUF,VOLYM,BIN1
BOK CHVRET
MOVE RETCOD,BIN1
CHVRET
RET
PEND
EJECT
***********************************************
* *
* USER FRIENDLINESS ERROR MESSAGE ROUTINE *
* TO BE USED AFTER POOL- & FILE-HANDLER CALLS *
* (INTRODUCED 83-06-22) *
* *
* INPUT: CONDITION > 0 = POOL ERROR *
* < 0 = DISK ERROR *
* RETCOD = ECB RETURN CODE ("BITS") *
* DESTR: BIN13 *
* *
***********************************************
UFERR PROC
BN UFER10 DISK ERRORS
BP UFER50 POOL ERRORS
MOVE BIN13,W3 RETCOD = ZERO => "I/O-ERROR"
B UFER90
UFER10 DISK ERRORS
CBE RETCOD,W1,UFER25 ECB-RC = "0001"
MOVE BIN13,W19 "DISK ERROR"
B UFER90
UFER25
MOVE BIN13,W18 "DISK NOT OPERABLE"
B UFER90
UFER50 POOL ERRORS
CBE RETCOD,W1,UFER75 ECB-RC = "0001"
MOVE BIN13,W64 CHECK IF FILE OVERFLOW
ADD BIN13,W64 BIN6 := 128 = ECB-RC "0080"
CBNE RETCOD,BIN13,UFER60 NO, NOT FILE OVERFLOW!
MOVE BIN13,W10 "DISK/FILE OVERFLOW"
B UFER90
UFER60
MOVE BIN13,W20 "POOL ERROR"
B UFER90
UFER75
MOVE BIN13,W21 "NOT FOUND"
UFER90
MOVE STR6A,HEX00
CALL RCGET,RETCOD,STR6A CONVERT RETCOD TO A STRING
PERF DSKERR,BIN13
RET
PEND
EJECT
***************************
* *
* ERROR-MESSAGE ROUTINE *
* *
***************************
*
DISERR PROC
MOVE STR6A,HEX00
CALL RCGET,RETCOD,STR6A
MOVE BIN13,W22 ASSUME I/O ERROR
CBNE RETCOD,W66,DISER2 IF NO TOSS-DISK...
MOVE BIN13,W23 ...USE ERROR TEXT 23.
DISER2
PERF DSKERR,BIN13
RET
PEND
DSKERR PROC ERRCODE
PBIN ERRCODE
MOVE DEBINW4,ERRCODE
DISPLAY 0,W1,W0
PERF DERR
RET
PEND
EJECT
***************************
* *
* PRESS ENT TO CONTINUE *
* *
***************************
*
HALT PROC
H10
ERASE 0,W1,W1 LINE 1
MOVE BIN1,=X'0101' LINE 1 / POS 1
DSC1 DEDSSCRN,6,BIN1 SET CURSOR
EDWRT DEDSSCRN,FHALT 'PRESS ENT TO CONTINUE'
MOVE BIN1,W1
NKI .NE,DEDSDYKB,DEINPUT,KTABEN,BIN1,BIN2
BERR H10
CBE BIN2,W1,H99 "ENTER"...
CBE BIN2,W2,H99 AND "RETURN" ARE ALLOWED.
B H10
H99
RET
PEND
EJECT
***************************
* *
* DISPLAY WAIT-TEXT *
* *
***************************
*
CONT PROC
CONT10 MOVE BIN1,=X'0101' LINE 1, COLUMN 1
DSC1 DEDSSCRN,6,BIN1 SET CURSOR ON FIRST LINE
EDWRT DEDSSCRN,FCONT DISPLAY WAIT-TEXT
RET
PEND
EJECT
***************************
* *
* APPL-ROUTINES *
* *
***************************
*
APP PROC
CBNE DEBINW1,W0,APP300
MOVE DEINPUT,:FMTITEM
APP300
IB DEBINW3, APPL-VALUE C
A1,A2,A3, C
A4,A5,A6,A7,A8,A9, C
A10,A11,A12, C
A13,A6,A15,A6,A17,A18
MOVE DEBINW4,W2 'UNDEFINED ERROR'
B ANOK
****************
* APPL-ERRORS *
****************
*
A3E
MOVE DEBINW4,W3 'I/O-ERROR'
B ANOK
A6E MOVE DEBINW4,W6 'ILLEGAL VALUE'
B ANOK
A10E MOVE DEBINW4,W10 'DISK OVERFLOW'
ANOK
MOVE DEBINW3,W3 NOT OK
AERR
RET
AOK MOVE DEBINW3,W0 OK
RET
EJECT
A1
*******************
* YES OR NO *
* WITH AUTO ENTER *
*******************
*
MOVE STR1A,DEINPUT
CBE STR1A,=C'Y',AA11
CBE STR1A,=C'N',AA11
CBE STR1A,=C'S',AA11
B A6E
AA11
MOVE DEBINW2,W17 ENT-KEY
B AOK
EJECT
A2
*****************************************
* *
* TEST TYPE USED IN CREATE VOLUME. *
* *
* POSSIBLE VALUES IS A, I, Q. *
* *
* Q IS NOT VALID WHEN DTYP IS =1 OR =2 *
* AND DVER IS =3. *
* *
*****************************************
*
MOVE STR15A,=C'QAI'
MOVE DEBINW4,W0
MATCH STR15A,DEBINW4,W3,DEINPUT,W0,W1
BNOK A6E
IB DEBINW4,AOK,AOK JUMP IF NOT "Q"
IB DTYP,A20,A20
B AA11 SET ENTER-KEY
A20
CBNE DVER,W3,AOK
B A6E
EJECT
*****************************
* NO. OF RECORDS - WSMFILE *
*****************************
*
A3
MOVE BCD13A,DEINPUT
CBE BCD13A,=D'00',A34
CBE DEBINW3,W15,A32
CBL BCD13A,=D'+027',A6E
B A33
A32
CBL BCD13A,=D'+3',A6E
A33
MOVE BIN1,BCD13A
CALL WXDIV,BIN1,W3,BIN1
CALL WXMUL,BIN1,W3,BIN1
MOVE BCD13A,BIN1
MOVE DEINPUT,BCD13A
CBG BCD13A,BCDI21(W2),A10E
B AOK
A34
MOVE NOREC,BCDI21(W2)
MOVE DEINPUT,NOREC
CBG NOREC,=D'+2',A3
B A10E
EJECT
************************
* NO.OF FILES IN CRV *
* REC.NO IN PRINT FILE *
************************
*
A4
MOVE BCD13A,DEINPUT
CBE BCD13A,=D'00',A44
B AOK
A44
MOVE NOREC,W1
MOVE DEINPUT,NOREC
B AOK
EJECT
******************
* CREATE VOLUME *
* CREATE FILE *
* UNIT DU1-DU4 *
* UNIT FD1-FD4 *
******************
*
A5
PERF AUNIT,VOLNAM
A55
CBE FCOD,W0,A6E
CBNE RETCOD,W0,A56
B AOK
A56
MOVE DEBINW4,RETCOD
B ANOK
EJECT
***********************************
* *
* FILE NAME MAX 8 CHAR. *
* LEADING SPACES ARE IGNORED *
* *
***********************************
*
A6
MOVE STR15A,=X'20' SPACE
INSRT DEINPUT,DEBINW1,W8,STR15A,W0
A64
MOVE DEBIN4,W0
MATCH DEINPUT,DEBIN4,W1,STR15A,W0,W1
BNOK A66
DLETE DEINPUT,W0,W1 DELEATE LEADING SPACES
B A64
A66
CBE DEBINW3,W14,A14
CBE DEBINW3,W16,A16
B AOK
EJECT
*****************
* PROGRAM NO. *
*****************
*
A7
CLEAR BOOL1 SETOFF THE PRINT-FILE OPTION INDICATOR
OPTION=ON => SECTOR PRINTOUT
OPTION=OFF => "ORDINARY" PRINTOUT
MOVE DEBINW2,W17 IND. ENTER-KEY
MOVE BCD2A,DEINPUT PROGRAM NO.
MOVE BIN1,BCD2A
IB BIN1,AOK,AOK,AOK,AOK,AOK,AOK,AOK,AOK
A71
B A6E
A73
SET BOOL1 MENU OPTION 9 => SECTOR PRINTOUT
B AOK
EJECT
***************************
* COPY DISK OR FILE : *
* INPUT TYPE = V,F,W *
* WITH AUTO ENTER *
***************************
*
A8
MOVE STR15A,=C'VFW'
MOVE DTYP,W0
MATCH STR15A,DTYP,W3,DEINPUT,W0,W1
BNOK A6E
MOVE DEBINW2,W17 ENT
B AOK
EJECT
***************************
* COPY DISK OR FILE : *
* INPUT UNIT NO. *
***************************
*
A9
PERF AUNIT,VOLNAM
MOVE FCOD1,FCOD
B A55
EJECT
***************************
* COPY DISK OR FILE : *
* OUTPUT UNIT NO. *
***************************
*
A10
SET BOOL3 NO UPDFLD, REWRT OF OUTPUT UNIT.
PERF AUNIT,COPNAM
MOVE FCOD2,FCOD
TBT BOOL2,A55
CBNE FCOD1,FCOD2,A55 COPY DISK TO DISC
AA105 B A6E
EJECT
********************************
* *
* PRINT FILE PRINT DEVICE *
* *
* WITH AUTO ENTER *
********************************
*
A11
MOVE STR2A,DEINPUT
CBNE STR2A,=C'OP',AA111
MOVE FCOD2,SCRNFC
MOVE BIN15,W24 PAGE-SIZE:=24
MOVE BIN14,W1 LINE-START:=1
B AA114
AA111
CBE STR2A,=C'LP',AA112
CBNE STR2A,=C'GP',A71 A6E
MOVE FCOD2,=X'0030'
B AA113
AA112
MOVE FCOD2,=X'0036'
AA113
MOVE BIN15,=W'44' PAGE-SIZE:=44
MOVE BIN14,W6 LINE-START:=6
PERF ATTDEV,FCOD2
BNZ ANOK ERROR
PERF DETDEV
AA114
MOVE DEBINW2,W17
B AOK
A12
B AOK
EJECT
************************
* DISK TYPE *
************************
* INPUT: DISK TYPE, 01-DMAX
* OUTPUT: DISK TYPE IN DTYP
* STORAGE TYPE (DVER) = 0
*
A13
MOVE DVER,W0
MOVE BCD3A,DEINPUT
MOVE DTYP,BCD3A
CBL DTYP,W1,AA105 CHECK THAT TYPE IS CORRECT
CBG DTYP,DMAX,AA105
SUB DTYP,W1
ADD DTYP,DTYP
XCOPY STR2A,W0,W2,DTYPES,DTYP COPY CORRESP. TOSS...
MOVE BCD3A,STR2A ...UTILITY DISK TYPE TO...
MOVE DTYP,BCD3A ...DTYP!
B AOK
EJECT
******************************
* EXTEND FILE *
* NO. OF RECORDS IN EXISTING *
* FILE WHEN NAME ENTERED *
******************************
*
A14
MOVE :FMTITEM,DEINPUT UPDATE FILENAME
PERF WUEXT1
CMP DEBINW4,W0
BNE ANOK
ERASE 1,W4,W4
DISPLAY 3,W4,W4
B AOK
EJECT
******************************
* EXTEND FILE *
* NO. OF RECORDS IN EXTENDED *
* FILE.
******************************
*
A15
PERF WUEXT2
CMP DEBINW4,W0
BNE ANOK
B A3
EJECT
********************************************
* CHECK IF FILE IS FOUND (WUPRF ONLY) *
* A16 IS ALWAYS ACTIVATED FROM A6. *
********************************************
A16
PERF CHVNAM,VOLEX1,FCOD CHANGE VOLNAME TO TEMP.
BNOK A165
CALL OPENF,DISK,FILECODE(W1),SYSBUF,DEINPUT,VOLEX1,RETCOD
BOK A169 JMP IF FILE IS FOUND
MOVE DEBINW4,RETCOD SAVE RETCOD, DESTR. BY CHVNAM
PERF CHVNAM,VOLNAM,FCOD CHANGE VOLNAME TO ORIG.
CBNE DEBINW4,W1,A168
A163
MOVE DEBINW4,W18 "DISK NOT OPERABLE"
B ANOK
A165
MOVE STR6A,HEX00
CALL RCGET,RETCOD,STR6A
MOVE DEBINW4,W22
CBNE RETCOD,W66,A166 BRANCH IF I/O-ERROR
MOVE DEBINW4,W23 "NOT A TOSS DISK!"
A166
B ANOK
A168
MOVE DEBINW4,W12 FILE NAME UNKNOWN
B ANOK
A169
CALL CLOSEF,DISK,FILECODE(W1),SYSBUF,NOREC,RETCOD
PERF CHVNAM,VOLNAM,FCOD CHANGE VOLNAME TO ORIG.
B AOK
EJECT
********************************************************
* *
* CHECK DISK VERSION (UNPACKED OR PACKED) WHEN CRV FOR *
* 2,5MB OR 5MB CARTRIDGE/FIX DISK. *
* *
* INPUT: DISK VERSION = 1 (UNPACKED) OR = 2 (PACKED) *
* OUTPUT: DVER = 2 (UNPACKED) OR = 3 (PACKED) *
* *
********************************************************
A17
MOVE BCD2A,DEINPUT
MOVE DVER,BCD2A
CBL DVER,W1,AA105 CHECK LIMITS
CBG DVER,W2,AA105
ADD DVER,W1 ADD 1 TO KEYBOARD VALUE
B AOK
EJECT
***********************************************
* *
* FILL ENTERED FORM/SECT/DEF-NAME WITH *
* TRAILING BLANKS (COPY SPECIFIC) *
* *
***********************************************
A18
MOVE STR6B,=' ' STR6B := BLANKS
XCOPY STR6B,W0,DEBINW1,DEINPUT,W0 COPY NO OF ENTERED CHARACTERS
XCOPY DEINPUT,W0,W6,STR6B,W0 STORE IN INPUT BUFFER
B AOK
PEND
EJECT
*************************************************
* THE CONECTION BETWEEN UNIT NO AND DISK *
* IS DONE IN DATA DIVISION AND IS DESCRIBED *
* IN SYSTEM GENERATION *
*************************************************
*
AUNIT PROC VOLYM
PSTRG VOLYM
MOVE RETCOD,W0
MOVE FCOD,W0
MOVE DEBIN2,W0
AUN100
MOVE DEBIN1,DEBIN2
MATCH DUNIT,DEBIN1,W3,DEINPUT,W0,W3
BOK AUN200
ADD DEBIN2,W3
CBNE DEBIN2,W66,AUN100
RET
AUN200
CALL WXDIV,DEBIN2,W3,DEBIN2
XCOPY FCOD,W1,W1,DFCODS,DEBIN2
MOVE DEBIN1,W2
CBNE DEBINW3,W10,AUN250
MOVE DEBIN1,W4
TBF BOOL2,AUN250
MOVE DEBIN1,W5
AUN250
ERASE 1,DEBIN1,DEBIN1 ERASE ON SCREEN
CALL CHANFC,DISK,FCOD CHANGE FILE-CODE
CALL GETVOL,DISK,SYSBUF,VOLYM,RETCOD GET VOLUME-NAME
CALL WXDIV,DEBIN1,W2,DEBIN1
DISPLAY 2,DEBIN1,DEBIN1 VOL-NAME
CBE RETCOD,W0,AUN300
CBNE RETCOD,=X'20',AUN275
MOVE RETCOD,W11
B AUN300
AUN275
CBNE RETCOD,W1,AUN280
MOVE RETCOD,W18
B AUN300
AUN280
CMP RETCOD,=X'8000'
BNE AUN290
MOVE RETCOD,W13
B AUN300
AUN290
MOVE STR6A,HEX00
CALL RCGET,RETCOD,STR6A
MOVE RETCOD,W22
AUN300
MOVE DEBINW1,W0
MOVE :FMTITEM,DEINPUT
RET
PEND
EJECT
ATTDEV PROC FILCOD
PBIN FILCOD
CALL CHANFC,DEDSPRT,FILCOD
MOVE DEBINW4,W0
DSC0 .NW,DEDSPRT,TSTAT
DELAY W10 CHANGED FROM W4 TO W10 831015
TESTIO DEDSPRT
BNZ NOTOK
WAIT DEDSPRT
XSTAT DEDSPRT,DEBINW4
CBE DEBINW4,W0,ATTOK
CBE DEBINW4,SECLEN,ATTOK0 "RETRIES PERFORMED" = "OK"
B ATT100
NOTOK
ABORT DEDSPRT
B ATT100
ATTOK0
MOVE DEBINW4,W0 SET RETURN-CODE = 0 IF RETRIES PERF.
ATTOK
DSC1 DEDSPRT,ATTACH,W20
BOK ATTOUT
MOVE DEBINW4,W3
B ATTOUT
ATT100
MOVE DEBINW4,W3
ATTOUT
CMP DEBINW4,W0
RET
PEND
DETDEV PROC
DSC1 DEDSPRT,DETACH,W0
RET
PEND
EJECT
*
* STPBLK => PUT'S CURSOR ON AND STOP'S BLOCKING
*
STPBLK PROC
MOVE VD82CW,=X'0080' CURSOR ON
DSC DEDSSCRN,X'11',VD82CW
DSC DEDSSCRN,STOPBLK STOP BLOCKING
RET
PEND
*
* STABLK => START'S BLOCKING AND TURNS CURSOR OFF
*
STABLK PROC
DSC DEDSSCRN,STARTBLK START BLOCKING
MOVE VD82CW,=X'01C0' DISCONNECT CURSOR
DSC DEDSSCRN,X'11',VD82CW
MOVE VD82CW,=X'0180' INVISIBLE CURSOR
DSC DEDSSCRN,X'11',VD82CW
RET
PEND
EJECT
FPROG FRMT
FSL
FATTR .HIGH HIGH INTENSITY
FTEXT 'WSM REL '
FCOPY RELNUM
FTAB 20
FTEXT 'RELEASE DATE: '
FCOPY RELDAT
FNL
FNL
FATTR .HIGH HIGH INTENSITY
FTAB 3
FATTR .INV INVERSE VIDEO
FCOPY =C'WSM UTILITIES'
FNL
FNL
FATTR .HIGH HIGH INTENSITY
FCOPY =C' FUNCTION SELECTION:'
FKI 24,MINL=1,MAXL=1,ME,NEOI,REWRT,APPL=7
FMEL 'X',PRNUM
FATTR .HIGH HIGH INTENSITY
FTAB 26
FCOPY =C'1 ='
FTAB 31
FCOPY =C'CREATE VOLUME'
FNL
FATTR .HIGH HIGH INTENSITY
FTAB 26
FCOPY =C'2 ='
FTAB 31
FCOPY =C'CREATE WSM SYSTEM FILE'
FNL
FATTR .HIGH HIGH INTENSITY
FTAB 26
FCOPY =C'3 ='
FTAB 31
FCOPY =C'DELETE FILE'
FNL
FATTR .HIGH HIGH INTENSITY
FTAB 26
FCOPY =C'4 ='
FTAB 31
FCOPY =C'COPY VOLUME/FILE'
FNL
FATTR .HIGH HIGH INTENSITY
FTAB 26
FCOPY =C'5 ='
FTAB 31
FCOPY =C'EXTEND WSM SYSTEM FILE'
FNL
FATTR .HIGH HIGH INTENSITY
FTAB 26
FCOPY =C'6 ='
FTAB 31
FCOPY =C'PRINT FILE TABLE OF CONTENTS'
FNL
FATTR .HIGH HIGH INTENSITY
FTAB 26
FCOPY =C'7 ='
FTAB 31
FCOPY =C'CHANGE VOLUME-NAME'
FNL
FATTR .HIGH HIGH INTENSITY
FTAB 26
FCOPY =C'8 ='
FTAB 31
FCOPY =C'PRINT VTOC'
FNL 10
FATTR .HIGH HIGH INTENSITY
FATTR .INV INVERSE VIDEO
FCOPY =C'IMPORTANT: '
FCOPY =C'ALWAYS RETURN TO THIS MENU '
FCOPY =C'BEFORE UNLOADING ANY VOLUME!'
FMEND
*
FHALT FRMT
FSL
FATTR .HIGH HIGH INTENSITY
FATTR .INV INVERSE VIDEO
FATTR .FLASH BLINKING
FCOPY =C'PRESS ENT TO CONTINUE'
FMEND
*
FHEX FRMT
FNL
FKI 1,MINL=0,MAXL=0
FCOPY HEX00
FMEND
*
FCONT FRMT
FSL
FATTR .HIGH HIGH INTENSITY
FATTR .INV INVERSE VIDEO
FATTR .FLASH BLINKING
FCOPY =C'WAIT...'
FMEND
*
END