Listing of file='VCHANGE' on disk='vmedia/731-8011A.wvd.zip'
# Sector 298, program filename = 'VCHANGE'
0004 REM % (c) Copyright Wang Laboratories, Inc. 1986
0005 REM % CHANGE VDISK CONFIG-"VCHANGE" ** Nori Odoi ** Rev. 1.00 * 12/10/86
**
0010 REM %Scrn
: DIM T1$(416)1, R1, S0, T1(8),S4$80,T1$1
0020 REM %VDISKMAP,VDISK rec
: DIM F1$(50)12,F1,F$,F,F6$40,A9$3
0023 REM /Status file,#VDISKS,Disk addr, pack format,VS filename, file handle,
Exc/Sh,record buf
: DIM F2$8,F2,F2$(33)3,F3$,F3$(33)8,F4$(33)8,F5$(33)8,F7$(33)8,F7(33),F9$(8
)30
0026 REM /Current status-#entries,Disk addr,VS filename, file handle, Exc/Sh,m
arker array,curr\A0entry
: DIM G2,G2$(33)3,G3$(33)8,G4$(33)8,G5$(33)8,G5$30,G7$(33)8,G7(33)
0028 REM /Status file & config file formats
: $FORMAT F3$=A3,A8,A8,A8,A2,P1
: $FORMAT E7$=A3,A8,A8,A8,P1
0030 REM %Configfile-E2$=2200 addr;E3$(),E4$(),E5$()=file name;E7()=mode;E1=la
st Vdisk
: DIM E2$(33)3,E3$(33)8,E4$(33)8,E5$(33)8,E5$30,E7(33),E1,E7$(3)9,E8$(3)1,E
1$1
: E7$(1)="Exclusive"
: E7$(2)="Read only"
: E7$(3)="Shared"
: E8$(1)="X"
: E8$(2)="R"
: E8$(3)="S"
0040 REM %Input
: DIM D1$(4)8,D2$(15)26
0050 REM %C=EXIT,P$=Search variable,P9$='100 options,E9$=Error msg,E=error,loo
p var
: DIM C,P$16,P7$2,P9$,E9$80,E,E8,P8$1,G8
0070 REM % Scratch
: DIM I,J,D,D1$1
0080 DIM V$32,V0$1,V1$1,V2$1,V4$2,V5$2,V6$4,V7$32,V8$,V8$(16),V9$2,V9$(20)
0100 GOTO 2000
0110 REM %** DEFFN'42 - ADD\A0VDISK\A0TO\A02258 (disk addr-2 digits)-V0$=0-no
DMS,=1-bad addr,=2-already added,=5-err sending data, >=80-ok-NO $OPENS o
r $CLOSES
0112 DEFFN'42(D1$)
: STR(A$,7,1)=HEX(60)
: STR(A$,6,1) = BIN(#PART-1) AND HEX(0F) OR HEX(60)
: $GIO #2 (4660 4270 8701, A$)
0113 V0$=STR(A$,,1)
: IF V0$<>HEX(00) THEN 115
: RETURN
0115 $GIO #2(A000 8701,A$)D1$
: V0$=STR(A$,,1)
: V0$=ADD HEX(01)
: IF V0$>=HEX(80) THEN 117
: RETURN
0117 $GIO #2 (1800 A000 1801 A000 1802 A000 1803 A000 8701,A$)V7$;V9$;V2$;STR(
V9$(),1,V1)
: IF STR(A$,,1)>=HEX(80) THEN V0$=HEX(80)
: ELSE V0$=HEX(05)
: RETURN
0120 REM %** DEFFN'43 - DELETE\A0VDISK\A0FROM\A02258(disk addr-2 digits)-V0$=0
-no DMS,=1-bad addr,=2-not fnd,>=80h-ok-NO $OPENS or $CLOSES
0122 DEFFN'43(D1$)
: REM construct command
: STR(A$,7,1)=HEX(61)
: STR(A$,6,1) = BIN(#PART-1) AND HEX(0F) OR HEX(60)
: $GIO #2 (4660 4270 8701, A$)
0123 V0$=STR(A$,,1)
: IF V0$<>HEX(00) THEN 125
: RETURN
0125 $GIO #2(A000 8701,A$)D1$
: V0$=STR(A$,,1)
: IF V0$>=HEX(80) THEN RETURN
: V0$=ADD HEX(01)
: RETURN
0130 REM %** DEFFN'44-VDISK\A0STATUS(disk addr)-NO $OPENS or $CLOSES
0131 REM /** V0$=0-no DMS,=1-bad disk addr,=2-not in table,=80h-ok. ***
0132 DEFFN'44(D1$)
: REM construct command
: STR(A$,7,1)=HEX(62)
: STR(A$,6,1) = BIN(#PART-1) AND HEX(0F) OR HEX(60)
: $GIO #2 (4660 4270 8701, A$)
0133 V0$=STR(A$,,1)
: IF V0$<>HEX(00) THEN 135
: RETURN
0135 $GIO #2(A000 8701,A$)D1$
: V0$=STR(A$,,1)
: V0$=ADD HEX(01)
: IF V0$>=HEX(80) THEN 137
: RETURN
0137 REM Get status
: V9$()=" "
: $GIO #2 (1800 C340 1801 C340 1802 C340 1803 C340 1804 C340, A$) V7$;V9$;V
2$;STR(V9$(),1,2);STR(V9$(),3,VAL(STR(V9$(),1,2),2))
: V1=VAL(STR(V9$(),1,2),2)+2
0139 RETURN
0140 REM % **** DEFFN'45 - DMS\A0STATUS -- V<0=err
0141 REM /* Response-F6$,len V1-assignment,2200SRV status,disk addr,VDISK stat
us *
0142 DEFFN'45
: V=1
: REM construct command
: F6$=ALL(00)
: STR(A$,7,1)=HEX(52)
: STR(A$,6,1) = BIN(#PART-1) AND HEX(0F) OR HEX(50)
: $OPEN 148,#2,#3
: ERRORV=-1
: GOTO 149
0143 $GIO#2(4500)
: ERRORV=-1
: GOTO 149
0144 $BREAK
: FOR D=1 TO 1200
: $IF ON #2,145
: NEXT D
: V=-10
: GOTO 149
0145 $IF ON #3,147
: ERRORV=-1
: GOTO 149
0146 $GIO#3(4550 405F)
: $BREAK
: FOR D=1 TO 1200
: $IF ON #3,147
: NEXT D
: V=-10
: GOTO 149
0147 $GIO #3 (4660 4270 8703 8704 1801 C340, A$)A$;STR(F6$,1,VAL(STR(A$,3,2),2
))
: V1=VAL(STR(A$,3,2),2)
: GOTO 149
0148 V=-20
0149 $CLOSE#2,#3
: RETURN
0150 REM %** DEFFN'48 - SET\A0DEVICE\A0TABLE(comm addr) V<0=err
0152 DEFFN'48(A9$)
: V=1
: IF STR(A9$,1,1)<>"0" OR STR(A9$,2,1)="0" THEN 156
: HEXPACK T1$ FROM STR(A9$,2,2)
: IF MOD(VAL(T1$),4)>0 THEN 156
0153 REM /status addr
: T1$=ADD HEX(01)
: HEXUNPACK T1$ TO STR(A9$,2,2)
: SELECT #1 <A9$>
: ERRORGOTO 156
0154 REM /command addr
: T1$=ADD HEX(01)
: HEXUNPACK T1$ TO STR(A9$,2,2)
: SELECT #2 <A9$>
: ERRORGOTO 156
0155 REM /data addr
: T1$ =ADD HEX(01)
: HEXUNPACK T1$ TO STR(A9$,2,2)
: SELECT #3 <A9$>
: GOSUB '45
: IF V<0 THEN RETURN
: T$="D"
: HEXUNPACK STR(F6$,4,1) TO STR(T$,2,2)
: SELECT #4<T$>
: RETURN
0156 V=-1
: RETURN
0160 REM %** DEFFN'50 - READ\A0MAP
0180 DEFFN'50
: V=1
: DATA LOAD DC OPEN T"VDISKMAP"
: ERRORE=ERR
: V=0
: RETURN
0190 MAT REDIM F1$(50)12
: DATA LOAD DC F1$()
: DATA SAVE DC CLOSE
: RETURN
0200 REM %** DEFFN'51 - WRITE\A0VDISKMAP-Out=OK-V=1,open failed=-1,write faile
d=-2
0215 DEFFN '51
: V=1
: DATA LOAD DC OPEN T "VDISKMAP"
: ERRORE=ERR
: IF E=82 THEN GOSUB 222
: IF E=0 THEN 220
: V=-1
: RETURN
0220 DATA SAVE DC F1$()
: ERRORE=ERR
: V=-2
: RETURN
0221 DATA SAVE DC END
: DATA SAVE DC CLOSE
: RETURN
0222 E=0
: V=1
: DATA SAVE DC OPEN T (5)"VDISKMAP"
: ERRORE=ERR
: IF E<>83 THEN 224
: REM /if scratched
: E=0
: V=1
: DATA SAVE DC OPEN T ("VDISKMAP")"VDISKMAP"
: ERRORE=ERR
0224 RETURN
0230 REM % **** DEFFN'52 - GET\A0CTLR routine
0232 REM /**OK V=0,inv addr=-1,not attached=-2,not in VDISKMAP=-3.If fnd, F1=e
ntry, else=trailer
0235 DEFFN '52
: V=1
: D1$(1)=A0$
: GOSUB '48(A0$)
: IF V<1 OR STR(F6$,,1)=HEX(00) THEN RETURN
: D1$(2)=T$
0236 REM /Find configuration file
: MAT SEARCH F1$(),=STR(D1$(1),1,3) TO P$ STEP 12
: IF STR(P$,1,2)=HEX(0000) THEN GOSUB 238
: F=VAL(P$,2)
0237 REM /found address
: F1=F/12 + 1
: RETURN
0238 REM /gosub if controller not found
: V=-3
: RETURN
0240 REM %** DEFFN'55 - READ\A0VSTATUS
0242 REM /** Inp=cntlr addr,Out=succ-V=0,open failed=-1,read failed=-2 ***
0244 DEFFN'55(F$)
: V=1
: F2$="V"&F$
: DATA LOAD DC OPEN T F2$
: ERRORE=ERR
: V=0
: RETURN
0245 F2=0
: MAT REDIM F9$(8)30
: FOR I=1 TO 5
: DATA LOAD DC F9$()
: ERRORE=ERR
: V=0
: RETURN
0246 IF END THEN I=5
: ELSE GOSUB 247
: NEXT I
: DATA SAVE DC CLOSE
: RETURN
0247 REM /gosub to unpack records
: FOR J=1 TO 8
: IF STR(F9$(J),1,3)="ZZZ" THEN 248
: F2=F2+1
: $UNPACK(F=F3$)F9$(J) TO F2$(F2),F3$(F2),F4$(F2),F5$(F2),F7$(F2),F7(F2)
: NEXT J
: RETURN
0248 REM /End of records
: I=5
: RETURN
0250 REM %** DEFFN'56 - WRITE\A0VSTATUS
0252 REM /** Inp=cntlr addr,Out=succ-V=1,open failed=-1, write failed=-2. F2=#
of recs ***
0255 DEFFN '56(F$)
: V=1
: F2$="V"&F$
: DATA LOAD DC OPEN T F2$
: ERRORE=ERR
: IF E=82 THEN GOSUB 260
: IF E=0 THEN 256
: V=-1
: RETURN
0256 F=0
: MAT REDIM F9$(8)30
: FOR I=1 TO 5
: GOSUB 258
: DATA SAVE DC F9$()
: ERRORE=ERR
: V=-2
: RETURN
0257 IF F2$(F)="ZZZ" THEN I=5
: NEXT I
: DATA SAVE DC END
: DATA SAVE DC CLOSE
: RETURN
0258 REM /gosub to pack records
: FOR J=1 TO 8
: F=F+1
: IF F>F2 THEN F2$(F)="ZZZ"
: $PACK(F=F3$)F9$(J) FROM F2$(F),F3$(F),F4$(F),F5$(F),F7$(F),F7(F)
: IF F>F2 THEN J=8
: NEXT J
: RETURN
0260 REM /gosub opens new VDISK status file
: E=0
: V=1
: DATA SAVE DC OPEN T (7)F2$
: ERRORE=ERR
: IF E<>83 THEN 261
: REM /if status file was scratched
: E=0
: V=1
: DATA SAVE DC OPEN T (F2$)F2$
: ERRORE=ERR
0261 RETURN
0270 REM %** DEFFN'60 - READ\A0CONFIG
0272 REM /** In=config file,Out=succ-V=1,open failed=-1,wrong file type=-2 ***
0275 DEFFN'60(F$)
: V=1
: DATA LOAD DC OPEN T F$
: ERRORE=ERR
: V=-1
: RETURN
0277 E1=0
: MAT REDIM F9$(8)28
: E2$()=" "
: E3$()=" "
: E4$()=" "
: E5$()=" "
: MAT E7=ZER
: FOR I=1 TO 5
: DATA LOAD DC F9$()
: ERRORGOTO 285
0279 IF END THEN I=5
: ELSE GOSUB 281
: NEXT I
: DATA SAVE DC CLOSE
: RETURN
0281 REM /unpack recs
: FOR J=1 TO 8
: IF STR(F9$(J),1,3)="ZZZ" THEN 283
: E1=E1+1
: $UNPACK(F=E7$)F9$(J) TO E2$(E1),E3$(E1),E4$(E1),E5$(E1),E7(E1)
: ERRORGOTO 285
0282 NEXT J
: RETURN
0283 REM / End of records
: I=5
: RETURN
0285 REM /err
: E9$="Could not prefill - not a configuration file"
: V=-2
: RETURN
0460 REM %** DEFFN'74-FIND\A0ATTACHED/DETACHED-"A"=Att,"D"=Det.V=index,if err
<0
0465 DEFFN'74(F$)
: V=-2
: F1=0
: FOR I=1 TO 50
: IF STR(F1$(I),1,3)="ZZZ" THEN 468
: GOSUB '48(STR(F1$(I),1,3))
: IF V<0 THEN 469
: IF F$="A" THEN 466
: IF STR(F6$,,1)<>HEX(00)THEN 469
: ELSE V=I
: IF V>0 THEN RETURN
0466 IF STR(F6$,,1)=HEX(00)OR STR(F6$,3,1)=HEX(00)THEN 469
: F1,V=I
: RETURN
0468 I=50
0469 NEXT I
: V=-5
: RETURN
0470 REM %** DEFFN'75-SQUEEZE
0471 DEFFN'75(S4$)
: MAT REDIM T1$(416)1
: F=LEN(S4$)
: FOR I=1 TO F
: T=POS(STR(S4$,,LEN(S4$))=" ")
: IF T=0 THEN I=F
: ELSE GOSUB 473
: NEXT I
: RETURN
0473 T1$()=STR(S4$,T+1)
: IF T>1 THEN S4$=STR(S4$,1,T-1)&T1$()
: ELSE S4$=T1$()
: RETURN
0500 REM %** DEFFN'90 - DISK\A0ERR
0515 DEFFN'90(D)
: RESTORE LINE 4020,D-79
: READ E9$
: RETURN
0520 REM % **** DEFFN'91 - OPEN\A0ERR(errclass,errcode)
0525 DEFFN'91(V2$,V4$)
: V5$,V6$=" "
: CONVERT VAL(STR(V2$,,1)) TO V5$,(##)
: CONVERT VAL(STR(V4$,,2),2) TO V6$,(####)
: E9$="2200SRV err "&STR(V5$,POS(V5$<>"0"))& "/"&STR(V6$,POS(V6$<>"0"))
: RETURN
0600 REM %** DEFFN'95 - CHECK\A0TERMINAL
0606 REM /** V=1 if true,else =0. if false, print error ***
0615 DEFFN'95
: V=1
: IF #TERM=1 THEN RETURN
: ELSE V=0
: RETURN
1000 DEFFN'100(S9$,S0$)
: REM Display and Accept CHANGEV (VER 7.00)
1001 S4=1
: S3=02
: S2=0
: S1=0
: T0$=" "
1002 IF POS(S9$=F2)>0 THEN T0$=STR(S9$,POS(S9$=F2)+1,4)
1003 IF POS(S9$=F6)>0 THEN GOTO 1007
: RESTORE LINE 1022
: GOSUB '129
1004 T9=0
: FOR T4=1TO 02
1005 ON T4GOSUB 1012,1017
1006 NEXT T4
1007 T9=-1
: IF POS(S9$=F9)>0 THEN T3=VAL(STR(S9$,POS(S9$=F9)+1))
: ELSE T3=S4
1008 ON T3GOSUB 1012,1017
1009 ON R1GOTO ,,,,1010,1011
: RETURN
1010 T3=MOD(T3+1,S3+1)
: IF T3=0 THEN T3=S4
: GOTO 1008
1011 T3=MOD(T3-1,S3+1)
: IF T3<S4 THEN GOTO 1011
: GOTO 1008
1012 MAT REDIM T1$(1)3
: GOSUB '126(10,52,3,1,1,1,1,1,D1$(1),S0$,"X",1,T9,".....6",1)
: IF R1<=0 OR T9=0 THEN RETURN
: D1$(1)=T1$()
: IF VER(T1$(1),"HHH")<>3 THEN 1013
: A0$=D1$(1)
: GOSUB '52
: IF V<1 THEN 1014
: IF STR(F6$,,1)>HEX(00) THEN 1015
: E9$="Controller not attached"
: GOTO 1016
1013 E9$="Invalid characters in field"
: GOTO 1016
1014 IF V=-3 THEN E9$="Controller not attached through Attach utility"
: IF V=-1 THEN E9$="Illegal communications address"
: IF V=-10 THEN E9$="Controller not responding"
: IF V=-20 THEN E9$="Controller is being accessed by another partition"
: GOTO 1016
1015 IF STR(F6$,3,1)=HEX(FF) THEN RETURN
: E9$="2200SRV malfunction - Please detach and re-attach"
1016 GOSUB '128(E9$,99,0,20)
: T0$=HEX(18000150)
: GOTO 1012
1017 MAT REDIM T1$(1)8
: GOSUB '126(11,52,8,1,1,1,1,1,D1$(3),S0$,"X",1,T9," ",1)
: IF R1>0 THEN D1$(3)=T1$()
: RETURN
1022 DATA 1,8,0,"*****"
1023 DATA 1,16,0,"C H A N G E V D I S K C O N F I G U R A T I O N"
1024 DATA 1,68,0,"*****"
1025 DATA 2,34,0,"Revision 2.0 "
1026 DATA 10,22,0,"Enter communications address:"
1027 DATA 11,21,0,"Enter configuration file name:"
1028 DATA 21,50,0,"EXEC/RUN - Change configuration"
1029 DATA 22,47,0,"CANCEL/EDIT - Exit"
1030 DATA 0,0,0," "
1500 REM VSACESS0 12 JUNE 86 - NOTE--$CLOSE has been removed from line 1525 in
'199. This is necessary for the functioning of this utility!!!!
1503 DEFFN'101(V$,V1$,V2$)
1504 V7$=ALL(HEX(00))
: STR(V7$,,5)=HEX(FF)&"SMB"&HEX(FF)
: STR(V7$,7,1)=HEX(01)
: STR(V7$,23,2)=HEX(FFFF)
1505 V8$()=ALL(" ")
: STR(V8$(),1,3)=HEX(030202)
1506 V1=POS(" IRCBS"=V1$)
: IF V1<11OR V1>15THEN 1516
: V2=2^V1
: STR(V8$(),4,2)=BIN(V2,2)
1507 V1=POS(" SXER"=V2$)
: IF V1<12OR V1>15THEN 1516
: V2=2^V1
: STR(V8$(),6,2)=BIN(V2,2)
1508 STR(V8$(),8,2)=BIN(8+LEN(V$),2)
1509 STR(V8$(),10,1)=HEX(04)
: STR(V8$(),11,LEN(V$)+1)=V$&HEX(00)
1510 V1=12+LEN(V$)
: STR(V8$(),V1,7)=HEX(04)&"FILE"&HEX(0000)
1511 GOSUB '199
: IF V0$=HEX(5A)THEN 1516
1512 V7$=STR(V9$(),,32)
1513 V9$=STR(V9$(),34,2)
1514 V1=VAL(STR(V8$,3,2),2)-35
: STR(V9$(),,V1)=STR(V9$(),36,V1)
: STR(V9$(),V1+1)=ALL(" ")
1515 V0$=HEX(FF)
: RETURN
1516 V0$=HEX(00)
: RETURN
1517 DEFFN'199
1518 STR(V8$,7,1)=HEX(53)
1519 STR(V8$,6,1)=BIN(#PART-1)AND HEX(0F)OR HEX(50)
1520 $OPEN #3
: $GIO#3(466042708701,V8$)
: IF STR(V8$,1,1)<>HEX(80)THEN 1527
1521 V1=LEN(V8$())+34
: STR(V8$,6,2)=BIN(V1,2)
: $GIO#3(40E3426042701800A0001801A00040008701,V8$)V7$;STR(V8$(),,V1)
1522 IF STR(V8$,1,1)<>HEX(80)THEN 1527
1523 V9$()=ALL(" ")
: $GIO#3(870387041801C340,V8$)V8$;STR(V9$(),1,VAL(STR(V8$,3,2),2))
1524 $GIO#3(4000,V8$)
1526 V0$=HEX(FF)
: RETURN
1527 V0$=HEX(5A)
: RETURN
1528 DEFFN'102(V9$,V7$)
1529 STR(V7$,6,4)=HEX(00020000)
1530 V8$()=ALL(" ")
: STR(V8$(),1,5)=HEX(02)&V9$&HEX(0000)
1531 STR(V8$(),6,6)=HEX(000301000000)
1532 GOSUB '199
: IF V0$<>HEX(FF)THEN 1536
1533 V7$=STR(V9$(),,32)
1534 V1=VAL(STR(V8$,3,2),2)-32
: STR(V9$(),,V1)=STR(V9$(),33,V1)
: STR(V9$(),V1+1)=ALL(" ")
1535 V0$=HEX(FF)
1536 RETURN
2000 GOSUB '95
: IF V<>0 THEN 2003
: E9$="Change Configuration can only be run from terminal 1"
: E9=23
: C=2
: PRINT HEX(03)
: GOTO 3005
2003 C=0
: E9=99
: GOSUB '50
: IF V=1 THEN 2005
: IF E=82 THEN E9$="VDISKMAP file not found"
: ELSE GOSUB '90(E)
: GOTO 3005
2005 GOSUB '74("A")
: IF V<1 OR STR(F6$,,1)=HEX(00) THEN 2008
: D1$(1)=STR(F1$(V),1,3)
: D1$(3)=STR(F1$(V),4,8)
2008 PRINT HEX(03)
: P9$=HEX(F218000150)
2010 REM %REPEAT
: GOSUB '100(P9$," ")
: E9=99
2020 REM % IF cancel or no screen,exit
: IF R1>0 THEN 2060
: E9=23
: IF R1=-2 THEN E9$="Could not access screen"
: ELSE E9$="Change VDISK Configuration cancelled"
: C=1
: GOTO 3005
2060 REM %ELSE change
: IF D1$(3)<>" " THEN 2063
: E9$="Invalid configuration file"
: P9$=HEX(F218000150F6F902)
: GOTO 3005
2063 F$=D1$(3)
2080 GOSUB '128("Warning: Changing VDISK configuration may affect other VDISK
users.",23,00,20)
: GOSUB '128("Press EXEC/RUN to change configuration, CANCEL/EDIT to return
to screen",24,00,20)
2090 T$=" "
: KEYIN T$
: V=POS(HEX(50F082A1)=STR(T$,1,1))
: IF V=0 THEN 2090
: PRINT AT(22,0,160);
: P9$=HEX(F218000150)
: IF V>2 THEN 2105
: E9$="No change made to VDISK configuration"
: GOTO 3005
2105 REM % Activate config file
: PRINT AT(22,0,160);
: GOSUB '55(D1$(1))
: IF V>0 THEN 2107
: E9$="No status file for this controller"
: GOTO 3005
2107 GOSUB '60(D1$(3))
: IF V>=0 THEN 2108
: IF V=-1 THEN GOSUB '90(E)
: P9$=HEX(F218000150F6F902)
: GOTO 3005
2108 REM /update current config file in VDISKMAP
: STR(F1$(F1),4,8)=D1$(3)
: GOSUB '51
2110 MAT MOVE F2$() TO G2$()
: MAT MOVE F3$() TO G3$()
: MAT MOVE F4$() TO G4$()
: MAT MOVE F5$() TO G5$()
: MAT MOVE F7$() TO G7$()
: MAT MOVE F7() TO G7()
: G2=F2
2119 F2$(),F3$(),F4$(),F5$(),F7$()=" "
: F2=0
: G8=0
2120 REM %Close current VDISKs
: PRINT AT(22,0,160);
: $OPEN #2,#3,#4
: FOR E8=1 TO G2
: PRINT AT(23,0,80);
: GOSUB '128("Closing old configuration",24,0,20)
: E9$=" "
: G5$="///"&G3$(E8)&"/"&G4$(E8)&"/"&G5$(E8)
: GOSUB '75(G5$)
: IF S4$="/////" THEN 2132
: G5$=S4$
2124 HEXPACK E1$ FROM STR(G2$(E8),2,2)
: GOSUB '44(E1$)
: IF V0$>=HEX(80) THEN 2126
: IF V0$=HEX(02) THEN 2132
: IF V0$=HEX(01) THEN E9$="Invalid disk address"
: GOTO 2132
2126 GOSUB '102(V9$,V7$)
: IF V0$=HEX(FF) AND STR(V7$,6,1)=HEX(00) THEN 2128
: E9$="Could not close"
: GOTO 2132
2128 GOSUB '43(E1$)
: IF V0$<HEX(80)THEN E9$="Could not delete entry"
2132 REM %NEXT VDISK
: PRINT AT(22,0,160);
: IF E9$=" " THEN 2134
: S4$=E9$
: E9$="VDISK "&G5$&" - "&S4$
: GOSUB '128(E9$,23,0,20)
: GOSUB '128("Press any key to continue",99,0,20)
: KEYIN T$
: E9$=" "
2134 NEXT E8
2140 REM %Open new VDISKs
: FOR E8=1 TO E1
: PRINT AT(22,0,160);
: GOSUB '128("Activating new configuration",24,0,20)
: E9$=" "
: E5$="///"&E3$(E8)&"/"&E4$(E8)&"/"&E5$(E8)
: GOSUB '75(E5$)
: IF S4$="/////" THEN 2180
: ELSE E5$=S4$
2141 HEXPACK V1$ FROM STR(E2$(E8),2,2)
: V2$=STR(F6$,4,1) OR HEX(0F)
: IF V1$>=STR(F6$,4,1) AND V1$<=V2$ THEN 2142
: D1$=STR(F6$,4,1) OR HEX(40)
: V2$=OR HEX(40)
: IF V1$>=D1$ AND V1$<=V2$ THEN 2142
: E9$="Invalid disk address"
: GOTO 2180
2142 GOSUB '101(E5$,"C",E8$(E7(E8)))
: IF STR(V7$,6,1)<>HEX(00) THEN 2179
: IF V0$=HEX(FF) THEN 2166
: E9$="Could not open VDISK"
: GOTO 2180
2166 HEXPACK E1$FROM STR(E2$(E8),2,2)
: GOSUB '42(E1$)
: MAT SEARCH HEX(0001020580),=V0$ TO P$ STEP 1
: F=VAL(P$,2)
: IF F=0 THEN F=4
: IF F=5 THEN 2175
: RESTORE LINE 4520,F
: READ E9$
: S4$="Error - "&E9$
: E9$=S4$
2168 GOSUB '102(V9$,V7$)
: GOTO 2180
2175 F2=F2+1
: F7$(F2)=V9$
: F3$(F2)=E3$(E8)
: F4$(F2)=E4$(E8)
: REM add to status file
: F2$(F2)=E2$(E8)
: F5$(F2)=E5$(E8)
: F7(F2)=E7(E8)
: GOTO 2180
2179 GOSUB '91(STR(V7$,6,1),STR(V7$,8,2))
2180 REM %NEXT VDISK
: PRINT AT(22,0,160);
: IF E9$=" " THEN 2181
: S4$=E9$
: E9$="VDISK "&E5$&" - "&S4$
: GOSUB '128(E9$,23,0,20)
: GOSUB '128("Press any key to continue",99,0,20)
: KEYIN T$
: E9$=" "
: G8=1
2181 NEXT E8
2194 GOSUB '56(D1$(1))
: IF V=1 THEN 2200
: GOSUB '90
: E9$=E9$&" - Could not save status file."
: GOSUB '128(E9$,23,0,20)
: GOSUB '128("Press any key to try again",99,0,20)
: KEYIN T$
: PRINT AT(22,0,160);
: GOTO 2194
2200 $CLOSE#2,#3,#4
: E9$="VDISK configuration changed."
: IF G8>0 THEN E9$=E9$&" Some VDISKs could not be accessed."
3000 REM % Until Change VDISK exit
3005 PRINT AT(22,0,160);
: IF E9$<>" " THEN GOSUB '128(E9$,E9,0,20)
: E9$=" "
: ON C+1 GOTO 2010,3007,3006
3006 GOSUB '128("Press any key to continue",24,0,20)
: KEYIN T$
3007 PRINT AT(23,00,80);
: GOSUB '128("Loading VS Services Menu",24,0,20)
3010 LOAD T"@VSMENU"
3800 REM SE.SUBS, RELEASE 7.00, (08/23/82) SCREEN SUBROUTINES
3801 DIM T1(8),T2(2),S1$,S2$124,S3$1,S4$80,T1$1,T2$80,T3$1,T4$3,T$(10)1
3802 DEFFN'126(T1(1),T1(2),T1(3),T1(4),T1(5),T1(6),T1(7),T1(8),T1$(),S0$,S2$,T
2,T9,T$(),S9)
: S3$=S2$
: I=20
: GOSUB 3864
: T2,T5=MIN(MAX(1,T2),T1(6))
: $TRAN(T$(),HEX(202E))R
: T$(5)="5"
: R1=1
: IF S9>1THEN 3806
: IF T9<0THEN 3803
: T$(5)="5"
: T3$=S2$
: GOSUB 3831
: S2$=T3$
: IF T9=0THEN 3805
: T2=T5
3803 GOSUB 3835
: GOSUB '130(T0,T1,T1(3),S3$,T1$(T2),S0$," ",T$(),T0$)
: T1$(T2)=S4$
: IF T$(10)=" "THEN 3804
: GOSUB '125
: IF R1=-2THEN 3803
3804 IF R1<5OR R1=11OR R1=14THEN 3805
: IF R1=5THEN T2=T2+1
: IF R1=6THEN T2=T2-1
: IF T2>=1AND T2<=T1(6)THEN 3803
3805 RETURN
3806 S8$=S0$
: SELECT PRINT 205(80)
: PRINT HEX(0202020F);
: $TRAN(S2$,HEX(8520))R
: T2=T2-1
3808 T2=MAX(1,MOD(T2+1,T1(6)))
: IF STR(T1$(T2),,1)=HEX(00)THEN 3808
3810 IF T9<0THEN 3814
: T5=T2
: FOR T2=1TO T1(6)
: IF S9=2THEN 3811
: T4$=STR(S2$,T2,1)&HEX(0F09)
: GOTO 3812
3811 IF T2=T5THEN T4$=HEX(8B0E09)
: ELSE T4$=HEX(900F09)
3812 GOSUB 3835
: GOSUB 3824
: NEXT T2
: T2=T5
: IF T9=0THEN 3825
3814 IF S9=3THEN S8$=S8$&"DI"
: GOSUB 3835
: PRINT HEX(06);AT(T0-1,T1-1);
: T8=1
: GOSUB 3839
: IF S9=2AND R1>08AND R1<15THEN 3825
: IF R1<7THEN 3825
: IF S9=2THEN 3818
: IF POS(HEX(8B85)=STR(S2$,T2,1))=0THEN 3819
: ON R1-8GOTO 3815,3816
: GOTO 3819
3815 STR(S2$,T2,1)=HEX(85)
: GOTO 3817
3816 STR(S2$,T2,1)=HEX(8B)
3817 T4$=STR(S2$,T2,1)&HEX(0F09)
: GOSUB 3824
: I=1
: GOTO 3822
3818 T4$=HEX(900F09)
: GOSUB 3824
3819 ON POS(HEX(2008)=T1$)GOTO 3820,3821
: GOSUB 3826
: GOTO 3823
3820 I=1
: GOTO 3822
3821 I=-1
3822 T2=T2+I
: T2=MOD(T2,T1(6))
: IF T2=0THEN T2=T1(6)
: IF T1$(T2)=" "OR STR(T1$(T2),,1)=HEX(00)THEN 3822
3823 IF S9=3THEN T4$=STR(S2$,T2,1)&HEX(0F09)
: ELSE T4$=HEX(8B0E09)
: GOSUB 3835
: GOSUB 3824
: GOTO 3814
3824 PRINT HEX(06);AT(T0-1,T1-1);
: IF T1$(T2)>" "THEN PRINT HEX(0E);T4$;STR(T1$(T2));
: ELSE IF STR(T1$(T2),,1)>HEX(00)THEN PRINT TAB(T1-1+2);STR(T1$(T2));
: RETURN
3825 $TRAN(S2$,HEX(2085))R
: T0=T2
: PRINT HEX(0F0202000F);
: IF S2=2THEN RETURN
: MAT REDIM T1$(T1(6))1
: T1$()=S2$
: SELECT PRINT 005(80)
: RETURN
3826 T1$=OR HEX(20)
: S=-1
: IF T2=T1(6)THEN 3827
: FOR I=T2+1TO T1(6)
: T3$=STR(T1$(I),1,1)OR HEX(20)
: IF T3$<>T1$THEN NEXT I
: ELSE S=I
3827 IF T2=1OR S>0THEN 3828
: FOR I=1TO T2-1
: T3$=STR(T1$(I),1,1)OR HEX(20)
: IF T3$<>T1$THEN NEXT I
: ELSE S=I
3828 IF S>-1THEN T2=S
: RETURN
3830 DEFFN'127(T1(1),T1(2),T1(3),T1(4),T1(5),T1(6),T1(7),T1(8),T1$(),T$())
: $TRAN(T$(),HEX(202E))R
3831 SELECT PRINT 405(80)
: IF T$(7)=" "THEN PRINT HEX(020402000E06);
: ELSE PRINT HEX(0F06)
: FOR T2=1TO T1(6)
: GOSUB 3835
: S2$=T1$(T2)
: IF T$(3)=" "OR S2$=" "THEN 3832
: STR(S2$,,LEN(S2$))=ALL(8B)
3832 IF T$(5)>" "THEN $TRAN(S2$,HEX(8520))R
: PRINT AT(T0-1,T1-1);
: IF STR(S2$,,1)>HEX(00)THEN PRINT STR(S2$,,T1(3));
: NEXT T2
: SELECT PRINT 005(80)
: RETURN
3835 IF T$(4)>" "THEN T0=INT((T2-1)/T1(8))*T1(7)+T1(1)
: ELSE T0=MOD((T2-1),T1(4))*T1(7)+T1(1)
: IF T$(4)>" "THEN T1=MOD((T2-1),T1(8))*T1(5)+T1(2)
: ELSE T1=INT((T2-1)/T1(4))*T1(5)+T1(2)
: T0=T0+T2(1)
: T1=T1+T2(2)
: RETURN
3836 IF T0$<>" "THEN GOSUB 3860
: IF T>0THEN GOSUB 3862
: RETURN
3838 T=1
: PRINT HEX(06070E);AT(23,0,40);" Invalid key ignored";AT(T0-1,T1-2+T8);
3839 R1=99
: IF T$(9)=" "THEN PRINT HEX(02050F);
: KEYIN T1$,,3845
: GOSUB 3836
: IF T1$>HEX(82)THEN 3838
: IF T$(9)=" "THEN 3841
: IF POS(HEX(8182)=T1$)=0OR POS(S8$=T1$)=0THEN 3838
3841 IF T1$>HEX(82)THEN 3838
: ON POS(HEX(81820D)=T1$)GOTO 3847,3843,3849
: RETURN
3843 R1=1
: RETURN
3845 GOSUB 3836
: IF T1$>HEX(1F)THEN 3846
: IF POS(S8$=T1$)=0THEN 3846
: R1=4
: S0=VAL(T1$)
: RETURN
3846 ON POS(HEX(F01F50)=T1$)GOTO 3847,3847,3848
: IF T$(9)=" "THEN ON POS(HEX(7E7F)=T1$)GOTO 3849,3850
: GOTO 3851
3847 R1=0
: RETURN
3848 R1=-1
: RETURN
3849 R1=5
: RETURN
3850 R1=6
: RETURN
3851 T1$=AND HEX(0F)
: IF POS(HEX(0203050608090A0C0D)=T1$)>0THEN 3852
: GOTO 3838
3852 $TRAN(T1$,HEX(0B060E05))R
: R1=VAL(T1$)
: T2$="*PN****EDIuewd**"
: IF POS(S8$=STR(T2$,R1,1))>0THEN RETURN
: GOTO 3838
3853 ON POS(HEX(2008)=T1$)GOTO 3854,3855
: GOTO 3856
3854 IF T$(4)>" "THEN R1=12
: ELSE R1=14
: GOTO 3856
3855 IF T$(4)>" "THEN R1=13
: ELSE R1=11
3856 I=T1(6)
: IF T$(4)=" "THEN 3857
: IF R1=14THEN T2=MOD(T2+T1(8),I)
: IF R1=11THEN T2=MOD(T2-T1(8),I)
: GOTO 3858
3857 IF R1=14THEN T2=MOD(T2+1,I)
: IF R1=11THEN T2=MOD(T2-1,I)
3858 IF T2=0THEN T2=T1(6)
: IF T2>T1(6)THEN 3853
: RETURN
3860 FOR I=1TO VAL(STR(T0$,3))
: PRINT HEX(06);AT(VAL(STR(T0$,1))-2+I+T2(1),VAL(STR(T0$,2))+T2(2),VAL(STR(
T0$,4)));
: NEXT I
: T0$=" "
: GOSUB 3898
: RETURN
3862 PRINT HEX(06);AT(23,0,40);
: T=0
: GOSUB 3898
: RETURN
3864 S1$=HEX(0204)&BIN(I/10)&BIN(MOD(I,10))&HEX(0E)
: PRINT STR(S1$,,5);
: RETURN
3866 DEFFN'128(S2$,T0,T1,I)
: SELECT PRINT 005(80)
: IF T0=99THEN PRINT HEX(07);
: IF T1=99THEN T1=40-(LEN(S2$)/2)
: T0=MIN(24,T0)
: T1=MAX(1,T1)
: GOSUB 3864
: I=1
: STR(S2$,LEN(S2$)+1,1)=HEX(AF)
: S=POS(S2$=HEX(AF))
3867 PRINT HEX(06);AT(T0-1,T1-1);STR(S2$,I,S-1);
: I=I+S
: S=POS(STR(S2$,I)=HEX(AF))
: T0=T0+1
: IF S>0THEN 3867
: PRINT HEX(020402000F06);
: RETURN
3869 DEFFN'129
: SELECT PRINT 205(80)
3870 READ T0,T1,I,S4$
: ERRORR1=-2
: RETURN
3871 IF T0=0THEN RETURN
: T0=T0+T2(1)
: T1=T1+T2(2)
: IF I=99THEN 3872
: IF I=0THEN PRINT HEX(0F);
: ELSE GOSUB 3864
: PRINT HEX(06);AT(T0-1,T1-1);STR(S4$,,LEN(S4$));
: GOTO 3870
3872 PRINT HEX(06);AT(T0-1,T1-1);BOX(VAL(S4$),VAL(STR(S4$,2)))
: GOTO 3870
3874 DEFFN'130(T0,T1,T5,S2$,S4$,S8$,T2$,T$(),T0$)
: SELECT PRINT 405(80)
: PRINT HEX(0202000F020402000E);
: $TRAN(T$(),HEX(202E))R
: IF T2$>" "THEN PRINT HEX(060F);AT(T0-1,T1-2-LEN(T2$));T2$;HEX(0E);
: S2$=ALL(S2$)
: T6=POS("H#X"=S2$)
: PRINT HEX(0202020F);
: T8=1
: IF T$(9)>" "THEN 3876
: GOSUB 3897
: IF S8$<>" "THEN S8$=S8$&"IDEew"
: ELSE S8$="IDEew"
3876 GOSUB 3839
: IF T$(9)>" "THEN 3905
: IF R1<7THEN 3899
: IF R1=11OR R1=14THEN 3899
: ON R1-7GOTO 3880,3884,3882,3876,3886,3890,3876
: IF T1$=HEX(08)THEN 3890
: IF T8<=T5THEN 3878
: PRINT HEX(07);
: GOTO 3876
3878 STR(S4$,T8,1)=T1$
: $TRAN(T1$,HEX(8020))R
: IF T$(3)=" "THEN PRINT HEX(0E);T1$;
: ELSE PRINT HEX(0E8B);
: GOTO 3887
3880 IF T5<T8THEN 3876
: STR(S4$,T8)=" "
: GOSUB 3897
: GOTO 3876
3882 IF T5<T8THEN 3876
: MAT COPY -S4$<T8,T5-T8>TO -S4$<T8+1,T5-T8>
: STR(S4$,T8,1)=" "
: GOSUB 3897
: GOTO 3876
3884 IF T5<T8THEN 3876
: MAT COPY S4$<T8+1,T5-T8>TO S4$<T8,T5-T8>
: STR(S4$,T5,1)=" "
: GOSUB 3897
: GOTO 3876
3886 IF T8<T5+1THEN PRINT HEX(09);
3887 IF T8<>T5THEN 3888
: IF T$(1)=" "THEN 3888
: R1=5
: GOTO 3899
3888 T8=MIN(T5+1,T8+1)
: GOTO 3876
3890 IF T8>1THEN 3891
: IF T$(2)=" "THEN 3876
: R1=6
: GOTO 3899
3891 PRINT HEX(08);
: T8=T8-1
: IF T1$<>HEX(08)THEN 3876
: STR(S4$,T8,1)=" "
: PRINT HEX(8508);
: GOTO 3876
3892 PRINT HEX(06070E);AT(23,0,50);T2$;
: T=1
: GOSUB 3898
: GOTO 3876
3893 T2$=" Invalid key ignored"
: GOTO 3892
3894 T2$=" Information required, please enter"
: GOTO 3892
3895 T2$=" Invalid characters in field"
: GOTO 3892
3897 PRINT HEX(06);AT(T0-1,T1-1);
: T2$=S4$
: IF T$(3)>" "AND T2$>" "THEN STR(T2$,,LEN(T2$))=ALL(8B)
: $TRAN(T2$,HEX(8520))R
: PRINT STR(T2$,,T5);
3898 PRINT HEX(06);AT(T0-1,T1-2+T8);
: RETURN
3899 IF T$(7)=" "OR T$(3)>" "THEN 3900
: PRINT HEX(0F);
: GOSUB 3897
3900 $TRAN(S4$,HEX(20802085))R
: IF R1<1THEN 3902
: IF S4$=" "AND T$(6)>" "THEN 3894
3902 ON T6GOTO 3904,3903,3905
: GOTO 3904
3903 IF NUM(S4$)<T5THEN 3895
: GOTO 3905
3904 IF S4$>" "AND VER(STR(S4$,,T5),S2$)<T5THEN GOTO 3895
3905 SELECT PRINT 005(80)
: PRINT HEX(0F0202000F);
: RETURN
3906 % S$="SE.SUBS ": SCRATCH TS$: SAVE <S>T()S$3800,3999: PRINT HEX(0E);S$;H
EX(0F);" updated"
4020 DATA "D80 File not open"
4022 DATA "D81 File full"
4024 DATA "D82 File not in catalog"
4026 DATA "D83 File already cataloged"
4028 DATA "D84 File not scratched"
4030 DATA "D85 Index full"
4032 DATA "D86 Catalog end error"
4034 DATA "D87 No end-of-file"
4036 DATA "D88 Wrong record type"
4038 DATA "D89 Sector address beyond end-of-file"
4040 DATA "I90 Disk hardware error"
4042 DATA "I91 Disk hardware error"
4044 DATA "I92 Timeout error"
4046 DATA "I93 Format error"
4048 DATA "I94 Format key engaged"
4050 DATA "I95 Device error"
4052 DATA "I96 Data error"
4054 DATA "I97 Longitudinal redundancy check error"
4056 DATA "I98 Illegal sector address or platter not mounted"
4058 DATA "I99 Read-after-write error"
4510 REM /ADD errs
4520 DATA "VDISK/DMS not attached"
4530 DATA "Illegal disk address"
4540 DATA "VDISK already in table"
4550 DATA "Unsupported file attribute(s)"
9999 DEFFN '31 "SCRATCH T";HEX(22);"VCHANGE";HEX(22);": SAVE T()";HEX(22);"VC
HANGE";HEX(22)