Listing of file='VATTACH' on disk='vmedia/731-8011A.wvd.zip'
# Sector 123, program filename = 'VATTACH'
0004 REM % (c) Copyright Wang Laboratories, Inc. 1986
0005 REM % ATTACH VDISK UTILITY-"VATTACH" ** Nori Odoi ** Rev. 1.00 * 12/10/86
**
0006 REM /comm addr
: COM A0$3,A3$1
0010 REM % screen subs
: DIM T1$(416)1, R1, S0, T1(8),S4$80,T1$1
0020 REM % VDISKMAP
: DIM F1$(50)12,F1,F$,F,F6$40
0023 REM /Status file name,#VDISKS in file,Disk addr, packing format,VS filena
me, file handle, Exc/Sh
: DIM F2$8,F2,F2$(33)3,F3$,F3$(33)8,F4$(33)8,F5$29,F5$(33)8,F7$(33)8,F7(33)
,F9$(8)30
: $FORMAT F3$=A3,A8,A8,A8,A2,P1
0027 REM Config file
: $FORMAT E7$=A3,A8,A8,A8,P1
0030 REM % Storage-E2$=2200 addr;E3$()=vol name,E4$()=lib name;E5$()=file name
;E7()=mode;E1$=alternate config file name;E1=last Vdisk, File mode table
0035 DIM E2$(33)3, E3$(33)8, E4$(33)8, E5$(33)8,E7(33),E1,E7$(3)
: E7$(1)="X"
: E7$(2)="R"
: E7$(3)="S"
0040 DIM D1$(4)8
0050 REM %C=EXIT,P$=Search var,P9$='100 options,P8$=1st field,E9$=Err msg,E=er
r,temps
: DIM C,P$16,P9$,P8$1,E9$80,E,I,J,D
0080 REM $GIO regs, partition #
: DIM A$16,P5$1,P5
0083 REM /DMS
: DIM V$32, V0$1,V1$1, V2$1, V3$1, V4$2, V5$2, V6$6,V7$32, V8$, V8$(16), V9
$2, V9$(16,16)
0100 GOTO 2000
0110 REM %** DEFFN'40 - ASSIGN\A0DMS - V0$=HEX(00) if WSE not active,=HEX(0t)
if already assigned,=HEX(8t) if ok,t=DMS task#
0114 DEFFN'40
: STR(A$,7,1)=HEX(50)
: STR(A$,6,1) = BIN(#PART-1) AND HEX(0F) OR HEX(50)
: $GIO #3 (4660 4270 8701, A$)
0116 V0$=A$
: RETURN
0120 REM %** DEFFN'41-DEASSIGN\A0DMS-err-V0$=0h,ok=nonzero
0122 DEFFN'41
: STR(A$,7,1)=HEX(51)
: STR(A$,6,1)=BIN(#PART-1)AND HEX(0F)OR HEX(50)
: $OPEN #4
: $GIO #3 (4660 4270 8701, A$)
: $CLOSE#4
0124 V0$=A$
: RETURN
0130 REM %** DEFFN'42-ADD\A0VDISK\A0TO\A02258(disk address) (no $OPENs) - Resp
onse in V0$=0-no DMS,=1-illegal disk address,=2-VDISK already added,=5-er
r sending data,=80h-ok
0135 DEFFN'42(D1$)
: REM construct command
: 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$)
0137 V0$=A$
: IF V0$<>HEX(00) THEN 139
: RETURN
: REM % Send platter address
0139 $GIO #2(A000 8701,A$)D1$
: V0$=A$
: V0$=ADD HEX(01)
: IF V0$>=HEX(80) THEN 141
: RETURN
: REM % Send SMB hdr, file handle, open mode, data block (from OPEN)
0141 $GIO #2 (1800 A000 1801 A000 1802 A000 1803 A000 8701,A$)V7$;V9$;V2$;STR(
V9$(),,V1)
: IF STR(A$,,1)>=HEX(80) THEN V0$=HEX(80)
: ELSE V0$=HEX(05)
: RETURN
0150 REM % ** DEFFN'45 - DMS\A0STATUS -V<0=err, response-F6$,len V1 **
0152 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 158,#2,#3
: ERRORV=-1
: GOTO 159
0153 $GIO#2(4500)
: ERRORV=-1
: GOTO 159
0154 $BREAK
: FOR D=1 TO 1200
: $IF ON #2,155
: NEXT D
: V=-10
: GOTO 159
0155 $IF ON #3,157
: ERRORV=-1
: GOTO 159
0156 $GIO#3(4550 405F)
: $BREAK
: FOR D=1 TO 1200
: $IF ON #3,157
: NEXT D
: V=-10
: GOTO 159
0157 $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 159
0158 V=-20
0159 $CLOSE#2,#3
: RETURN
0160 REM %** DEFFN'46-DMS\A0VERSION-ok-V0$=FFh,err=0h,response=STR(V9$(),34,V1
)
0162 DEFFN'46
: V=1
: V7$=ALL(00)
: STR(V7$,,5)=HEX(FF)&"SMB"&HEX(FF)
: STR(V7$,7,1)=HEX(2B)
: STR(V7$,23,2)=ALL(FF)
: V8$()=ALL(" ")
: STR(V8$(),,3)=ALL(00)
: GOSUB '199
: IF V0$=HEX(5A)THEN 164
: V0$=HEX(FF)
: V1=VAL(STR(V9$(),33,1))*2
: RETURN
0164 V0$=HEX(00)
: RETURN
0170 REM %** DEFFN'48 - SET\A0DEVICE\A0TABLE(comm addr) V<0 if err
0172 DEFFN'48(A9$)
: V=1
: IF STR(A9$,1,1)<>"0" OR STR(A9$,2,1)="0" THEN 176
: HEXPACK T1$ FROM STR(A9$,2,2)
: IF MOD(VAL(T1$),4)>0 THEN 176
0173 REM /sts addr
: T1$=ADD HEX(01)
: HEXUNPACK T1$ TO STR(A9$,2,2)
: SELECT #1 <A9$>
: ERRORGOTO 176
0174 REM /comm addr
: T1$=ADD HEX(01)
: HEXUNPACK T1$ TO STR(A9$,2,2)
: SELECT #2 <A9$>
: ERRORGOTO 176
0175 REM /data addr
: T1$ =ADD HEX(01)
: HEXUNPACK T1$ TO STR(A9$,2,2)
: SELECT #3 <A9$>
: GOSUB '45
: T$="D"
: HEXUNPACK STR(F6$,4,1) TO STR(T$,2,2)
: SELECT #4<T$>
: RETURN
0176 V=-1
: RETURN
0180 REM %** DEFFN'50 - READ\A0VDISKMAP
0184 DEFFN'50
: V=1
: DATA LOAD DC OPEN T"VDISKMAP"
: ERRORE=ERR
: V=0
: RETURN
0186 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-OK-V=1,no addr=-1,no platter=-2,not in VDIS
KMAP=-3.If found,F1=entry else=trailer record
0235 DEFFN '52
: V=1
: D1$(1)=A0$
: GOSUB '48(A0$)
: D1$(2)=T$
0236 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 F1=F/12+1
: IF F1=50 THEN 239
: D1$(3)=STR(F1$(F1),4,8)
: RETURN
0238 REM /not found
: V=-3
: MAT SEARCH F1$(),="ZZZ" TO P$ STEP 12
: RETURN
0239 F1=1
: F1$(),D1$(3)=" "
: F1$(2)="ZZZ 0"
: RETURN
0250 REM %** DEFFN'56 - WRITE\A0VSTATUS - Inp=cntlr addr,Out=ok-V=1,open faile
d=-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 /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 /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 - Inp=config file, Out=succ-V=1, open fa
iled-V=-1 - wrong file type=-2
0275 DEFFN'60(F$)
: V=1
: DATA LOAD DC OPEN T F$
: ERRORE=ERR
: V=-1
: RETURN
0277 E2$(),E3$(),E4$(),E5$()=" "
: MAT E7=ZER
: E1=0
: MAT REDIM F9$(8)28
: 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 records
: 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
: I=5
: RETURN
0285 REM /err
: GOSUB '128("Could not prefill - not a configuration file",99,0,20)
: V=-2
: 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$,,F)=" ")
: 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 routine
0515 DEFFN'90(D)
: RESTORE LINE 4010,D-79
: READ E9$
: GOSUB '128(E9$,99,1,20)
: RETURN
0520 REM %** DEFFN'91 - OPEN\A0ERR(errclass,errcode)
0525 DEFFN'91(P8$,V4$)
: P$,V6$=" "
: CONVERT VAL(STR(P8$,,1)) TO P$,(##)
: CONVERT VAL(STR(V4$,,2),2) TO V6$,(####)
: E9$="2200SRV err class- "&STR(P$,POS(P$<>"0"),LEN(P$))& " Err code- "&STR
(V6$,POS(V6$<>"0"))
: RETURN
0600 REM %** DEFFN'95 - CHECK\A0IF\A0TERMINAL\A01-if true, V=1, else V=0, if f
alse, print err
0615 DEFFN'95
: V=1
: IF #TERM=1 THEN RETURN
: ELSE V=0
: RETURN
1000 DEFFN'100(S9$,S0$)
: REM Display and Accept ATTACHV (VER 7.00)
1001 RESTORE LINE 1021
: GOSUB '129
1002 T9=0
: FOR T4=1TO 03
1003 ON T4GOSUB 1006,1011,1016
1004 NEXT T4
1005 IF POS(S9$=F8)>0 THEN GOSUB '130(24,80,1," "," ",S0$," "," 3 9",T0$)
: RETURN
1006 MAT REDIM T1$(1)3
: GOSUB '127(10,57,3,1,1,1,1,1,D1$(1)," ")
: RETURN
1011 MAT REDIM T1$(1)3
: GOSUB '127(11,57,3,1,1,1,1,1,D1$(2)," ")
: RETURN
1016 MAT REDIM T1$(1)8
: GOSUB '127(12,57,8,1,1,1,1,1,D1$(3)," ")
: RETURN
1021 DATA 1,18,0,"*****"
1022 DATA 1,26,0,"A T T A C H D M S / V D I S K"
1023 DATA 1,59,0,"*****"
1024 DATA 2,34,0,"Revision 1.00"
1025 DATA 10,33,0,"Communications address:"
1026 DATA 11,26,0,"Primary VDISK platter address:"
1027 DATA 12,31,0,"VDISK configuration file:"
1028 DATA 20,49,0,"SF9 - Replace configuration file"
1029 DATA 21,44,0,"EXEC/RUN - Attach to VS"
1030 DATA 22,41,0,"CANCEL/EDIT - Exit"
1031 DATA 0,0,0," "
1400 DEFFN'99 (S9$,S0$)
: REM Display and Accept ATTACHV2 (VER 7.00)
1401 S4=1
: S3=01
: S2=0
: S1=0
: T0$=" "
1402 RESTORE LINE 1416
: GOSUB '129
1403 T9=0
: FOR T4=1TO 01
1404 ON T4GOSUB 1411
1405 NEXT T4
1406 T9=-1
: T3=S4
1407 ON T3GOSUB 1411
1408 ON R1GOTO ,,,,1409,1410
: RETURN
1409 T3=MOD(T3+1,S3+1)
: IF T3=0 THEN T3=S4
: GOTO 1407
1410 T3=MOD(T3-1,S3+1)
: IF T3<S4 THEN GOTO 1410
: GOTO 1407
1411 MAT REDIM T1$(002)019
: RESTORE LINE 1411
: FOR I=1TO 002
: READ T1$(I)
: NEXT I
: GOSUB '126(17,46,1,2,1,002,1,1,T1$(),S0$," ",D6,T9," ",2)
: IF R1>0 THEN D6=T0
: RETURN
1412 DATA "Suspend Emulation","Terminate Emulation"
1416 DATA 17,26,00,"Select exit option:"
1417 DATA 21,58,00,"EXEC/RUN - Proceed"
1418 DATA 0,0,0," "
1500 REM VSACESS0 12 JUNE 86
1621 DEFFN'101(V$,V1$,V2$)
1623 V7$=ALL(HEX(00))
: STR(V7$,,5)=HEX(FF)&"SMB"&HEX(FF)
: STR(V7$,7,1)=HEX(01)
: STR(V7$,23,2)=HEX(FFFF)
1624 V8$()=ALL(" ")
: STR(V8$(),1,3)=HEX(030202)
1625 V1=POS(" IRCBS"=V1$)
: IF V1<11OR V1>15THEN 1635
: V2=2^V1
: STR(V8$(),4,2)=BIN(V2,2)
1626 V1=POS(" SXER"=V2$)
: IF V1<12OR V1>15THEN 1635
: V2=2^V1
: STR(V8$(),6,2)=BIN(V2,2)
1627 STR(V8$(),8,2)=BIN(8+LEN(V$),2)
1628 STR(V8$(),10,1)=HEX(04)
: STR(V8$(),11,LEN(V$)+1)=V$&HEX(00)
1629 V1=12+LEN(V$)
: STR(V8$(),V1,7)=HEX(04)&"FILE"&HEX(0000)
1630 GOSUB '199
: IF V0$=HEX(5A)THEN 1635
1631 V7$=STR(V9$(),,32)
1632 V9$=STR(V9$(),34,2)
1633 V1=VAL(STR(V8$,3,2),2)-35
: STR(V9$(),,V1)=STR(V9$(),36,V1)
: STR(V9$(),V1+1)=ALL(" ")
1634 V0$=HEX(FF)
: RETURN
1635 V0$=HEX(00)
: RETURN
1649 DEFFN'199
1650 STR(V8$,7,1)=HEX(53)
1651 STR(V8$,6,1)=BIN(#PART-1)AND HEX(0F)OR HEX(50)
1653 $OPEN #3
: $GIO#3(466042708701,V8$)
: IF STR(V8$,1,1)<>HEX(80)THEN 1664
1655 V1=LEN(V8$())+34
: STR(V8$,6,2)=BIN(V1,2)
: $GIO#3(40E3426042701800A0001801A00040008701,V8$)V7$;STR(V8$(),,V1)
1656 IF STR(V8$,1,1)<>HEX(80)THEN 1664
1657 V9$()=ALL(" ")
: $GIO#3(870387041801C340,V8$)V8$;STR(V9$(),1,VAL(STR(V8$,3,2),2))
1658 $GIO#3(4000,V8$)
1660 $CLOSE#3
1662 V0$=HEX(FF)
: RETURN
1664 V0$=HEX(5A)
: RETURN
1688 DEFFN'102(V9$,V7$)
1690 STR(V7$,6,4)=HEX(00020000)
1691 V8$()=ALL(" ")
: STR(V8$(),1,5)=HEX(02)&V9$&HEX(0000)
1692 STR(V8$(),6,6)=HEX(000301000000)
1693 GOSUB '199
: IF V0$<>HEX(FF)THEN 1697
1694 V7$=STR(V9$(),,32)
1695 V1=VAL(STR(V8$,3,2),2)-32
: STR(V9$(),,V1)=STR(V9$(),33,V1)
: STR(V9$(),V1+1)=ALL(" ")
1696 V0$=HEX(FF)
1697 RETURN
1999 REM % *********************** Start of Main Program *********************
2000 GOSUB '95
: IF A0$=" " THEN 2002
: IF V<>0 THEN 2003
: E9$="Attach can only be run from terminal 1"
: PRINT HEX(03)
: GOTO 3025
2002 E9$="Attach must be run from menu"
: PRINT HEX(03)
: C=2
: GOTO 3025
2003 GOSUB '50
: C=1
: E9=23
: IF V=1 THEN 2005
: IF E=82 THEN 2005
: GOSUB '90(E)
: A3$="S"
: GOTO 3025
2005 GOSUB '52
: PRINT HEX(03)
: C=0
: P9$=HEX(F218000140F8)
2010 REM /Input
: GOSUB '100(P9$,HEX(8209))
2020 IF R1=4 AND S0=9 THEN 2030
: IF R1=1 THEN 2060
: IF R1<1 THEN 2025
: E9$="Could not access screen"
: C=1
: A3$="S"
: GOTO 3025
2025 REM % CASE cancel
: E9$="Attach DMS/VDISK utility cancelled"
: C=1
: E9=24
: A3$="S"
: GOTO 3025
2030 REM % CASE replace
: PRINT AT(19,0,160),AT(23,0,80);
: GOSUB '128("EXEC/RUN - Replace configuration file",21,44,0)
: S4$=D1$(3)
2035 GOSUB '130(23,36,8,"X",S4$," ","Enter new configuration file name: "," ",
" ")
: IF R1=1 THEN 2040
: IF R1>1 THEN 2035
: REM / CASE - cancel
: PRINT AT(22,0,80);
: E9$="Replace configuration file cancelled"
: E9=24
: GOTO 2050
2040 D1$(3)=S4$
: PRINT AT(22,0,80);
: F1$(F1)=STR(D1$(1),1,3)&D1$(3)
: GOSUB '51
2045 E9=24
: E9$="Configuration file replaced"
2050 PRINT AT(20,0,240);
: GOSUB '128(E9$,E9,0,20)
: E9$=" "
: GOTO 2010
2060 REM % CASE attach
: PRINT AT(19,0,400);AT(23,0);HEX(0204040E);"Testing 2200SRV - Please be pa
tient";HEX(0F06);
: FOR I=1 TO 4000
: NEXT I
2070 GOSUB '40
: IF V0$=HEX(00) THEN 2072
: IF V0$=HEX(20)THEN 2082
: GOTO 2080
2072 E9$="Error - Workstation Emulation not in effect for this partition"
: C=2
: GOTO 3025
2080 GOSUB '46
: IF V0$=HEX(FF) THEN 2085
: GOSUB '41
2082 E9$="Cannot access DMS - Please terminate and re-run 2200SRV"
: A3$="A"
: GOTO 3025
2085 REM /add to VDISKMAP
: PRINT AT(23,0,80);
: GOSUB '128("Attaching DMS",24,0,20)
: IF VER(STR(F1$(F1),1,3),"HHH")=3 THEN 2087
: F1$(F1)=D1$(1)&" 1"
: F1$(F1+1)="ZZZ 0"
: GOTO 2089
2087 REM /mark attached
: STR(F1$(F1),12,1)="1"
2089 REM /save to VDISKMAP
: GOSUB '51
: IF V=1 THEN 2090
: ELSE GOSUB '90(E)
: GOSUB '128("Press any key to retry",21,99,00)
: KEYIN T$
: PRINT AT(23,0,80);
: GOTO 2085
2090 REM /if config file, then read
: S4$=D1$(3)
2092 IF S4$=" " THEN 2097
: PRINT AT(23,0,80);
: GOSUB '60(S4$)
: IF V=1 THEN 2100
2095 REM /config file err
: GOSUB '90(E)
: GOSUB '128("Press CANCEL/EDIT to exit",21,99,00)
: GOSUB '130(20,56,8,"X",S4$," ","Enter configuration file name to retry: "
," "," ")
: IF R1>0 THEN 2092
: C=1
2097 REM /No config file
: F2=0
: GOSUB '56(D1$(1))
: E9$="Controller successfully attached. No VDISK configuration file activa
ted."
: GOTO 3000
2100 REM % Activate config file
: F2=0
: FOR F7=1 TO E1
: REM /open VDISK F5$(F7) at platter E2$(F7) in mode E7(F7) (E=1,S=2)
: F5$="///"&E3$(F7)&"/"&E4$(F7)&"/"&E5$(F7)
: GOSUB '75(F5$)
: IF S4$="/////" THEN 2125
: ELSE F5$=S4$
: E9$= "Opening VDISK "&F5$
: PRINT AT(22,0,160);
: GOSUB '128(E9$,24,0,20)
2103 F$=E2$(F7)
: IF STR(F$,1,1)="D" THEN 2104
: IF STR(F$,1,1)="B" THEN STR(F$,3,1)="1"
: ELSE STR(F$,3,1)="0"
2104 F$=STR(F$,2,2)
: HEXPACK P5$ FROM F$
2105 $OPEN #2,#3,#4
: GOSUB '101(F5$,"C",E7$(E7(F7)))
: IF STR(V7$,6,1)=HEX(00) THEN 2106
: $CLOSE#2,#3,#4
: GOSUB '91(STR(V7$,6,1),STR(V7$,8,2))
: S4$=E9$
: C=1
: GOTO 2118
2106 IF V0$=HEX(FF) THEN 2110
: $CLOSE#2,#3,#4
: S4$="Open error"
: GOTO 2118
2110 $OPEN #3
: GOSUB '42(P5$)
: $CLOSE#2,#3,#4
: F=POS(HEX(0001020580)=V0$)
: IF F=0 THEN F=4
: IF F=5 THEN 2120
: RESTORE LINE 4520,F
: READ E9$
: A3$="S"
: IF F=1 THEN 3025
: S4$=E9$
: GOSUB '102(V9$,V7$)
2118 PRINT AT(22,0,160);
: E9$="VDISK "&F5$&" at "&E2$(F7)&" - "&S4$
: GOSUB '128(E9$,23,0,20)
: GOSUB '128("Press any key to continue",99,00,20)
: KEYIN T$
: E9$=" "
: GOTO 2125
2120 REM /for status file
: F2=F2+1
: F2$(F2)=E2$(F7)
: F3$(F2)=E3$(F7)
: F4$(F2)=E4$(F7)
: F5$(F2)=E5$(F7)
: F7(F2)=E7(F7)
: F7$(F2)=V9$
2125 NEXT F7
: REM /Next VDISK
2130 REM /Save status file
: GOSUB '56(D1$(1))
: IF V=1 THEN 2135
: GOSUB '90(E)
: GOSUB '128("Please correct disk problem",22,0,20)
: GOSUB '128("Press any key to continue",23,0,20)
: KEYIN T$
: PRINT AT(21,00,160);
: GOTO 2130
2135 E9$="Controller attached. "&D1$(3)&" activated."
: IF C=1 THEN E9$=E9$&" Some VDISKs could not be opened."
: C=1
3000 REM % Success
: PRINT AT(19,0,160);AT(21,0,240);
: GOSUB '128(E9$,E9,0,20)
3004 GOSUB '99(" "," ")
: IF R1<>1 THEN 3004
: PRINT AT(23,00,80);
: IF D6=2 THEN 3010
: GOSUB '128("Suspending Workstation Emulation",24,0,20)
: LOAD T"SUSPEWSE"
3010 GOSUB '128("Terminating Workstation Emulation",24,0,20)
: LOAD T"TERMWSE"
3020 REM % Failed attach exit
3025 PRINT AT(22,0,160);
: GOSUB '128(E9$,23,0,20)
: IF C=2 THEN 3035
3027 GOSUB '128("Press any key to return to Workstation Emulation",99,00,20)
: KEYIN T$
3030 PRINT AT(23,00,80);
: GOSUB '128("Returning to Workstation Emulation",24,00,20)
: LOAD T"DMSRES"
3035 GOSUB '128("Press any key to return to VS Services",99,00,20)
: KEYIN T$
3040 PRINT AT(23,00,80);
: GOSUB '128("Returning to VS Services",24,00,20)
: 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"
4000 REM % *********************** Text Messages *********************
4010 REM / Disk error messages
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"
4500 REM % *********************** Error Messages *********************
4510 REM / ADD routine error messages
4520 DATA "VDISK/DMS not attached"
4530 DATA "Illegal disk address"
4540 DATA "VDISK already in table"
4550 DATA "Unsupported file attribute(s)"
9996 DEFFN '18 "LIST SD 2060, "
9999 DEFFN '31 "SCRATCH T";HEX(22);"VATTACH";HEX(22);": SAVE T()";HEX(22);"VA
TTACH";HEX(22)