Listing of file='VDETACH' on disk='vmedia/731-8011A.wvd.zip'
# Sector 215, program filename = 'VDETACH'
0004 REM % (c) Copyright Wang Laboratories, Inc. 1986
0005 REM % DETACH VDISK UTILITY-"VDETACH" ** Nori Odoi ** Rev. 1.002 * 12/10/8
6 **
0010 COM A0$3,A3$1
: A3$="D"
0015 REM %Screen subs
: DIM T1$(416)1, R1, S0, T1(8),S4$80,T1$1
0020 REM % Disk variables- VDISKMAP record, desired VDISK rec,temps,DMS status
,VDISK addr
: DIM F1$(50)12,F1,F$,F,F6$40,E1$1
0023 REM /Status file-file name,#VDISKs in file,Disk addr, packing format,VS f
ilename, file handle, Exc/Sh
0024 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
0025 $FORMAT F3$=A3,A8,A8,A8,A2,P1
0027 REM / VDISK config file format
0029 $FORMAT E7$=A3,A8,A8,A8,P1
0040 REM % Input
: DIM D1$(4)8
0050 REM % Control variables-C=EXIT,P$=Search variable, P9=Screen #,P9$='100 o
ptions,P8$=1st field,E9$=Error msg,E=error
0055 DIM C,P$16,P9,P9$,P8$1,E,E8$1,E9$80,E8
0070 REM % Scratch variables- I&J are loop variables, D1$=temp packed disk add
ress
0075 DIM I,J,D,D1$1
0080 DIM A$16
: REM $GIO registers
0081 DIM P5$1,P5
: REM partition number
0083 DIM V2$1, V3$1, V4$2, V5$2, V6$6,V7$32, V8$, V8$(16), V9$2, V9$(16,16)
: REM / Needed for DMS routines
0099 REM % Goto beginning of program
0100 GOTO 2000
0120 REM % **** DEFFN'41 - DEASSIGN\A0DMS
0122 REM / **** Response =HEX(00) if error, =nonzero if done ***
0123 DEFFN'41
: REM construct command & hog VDISK
: 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
0125 $OPEN #3,#4
: $GIO #3 (4660 4270 8701, A$)
: $CLOSE#3,#4
0128 V0$=STR(A$,1,1)
: RETURN
0130 REM % **** DEFFN'43 - DELETE\A0VDISK (disk address-bottom 2 digits)(no $o
pens)
0131 REM / *** Deletes a VDISK entry from 2258 table (VDISK must be closed) *
***
0132 REM / **** Response in V0$-=0-no DMS, =1h-illegal disk address *****
0133 REM /** =2h-VDISK not in table, =80h-ok ***
0134 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$)
0136 V0$=STR(A$,1,1)
: IF STR(V0$,1,1)<>HEX(00) THEN 138
: RETURN
: REM % Send platter address
0138 $GIO #2(A000 8701,A$)D1$
: V0$=STR(A$,1,1)
: IF STR(V0$,1,1)>=HEX(80) THEN RETURN
: STR(V0$,1,1)=ADD HEX(01)
: RETURN
0140 REM % **** DEFFN'44 - VDISK\A0STATUS (disk address-bottom 2 digits) (no $
opens) ***
0141 REM / ** Response in V0$-=0-no DMS, =1-illegal disk address, =2-not in **
0142 REM / ** VDISK table, =80h-ok--V2$=mode, V7$=SMB hdr, V9$=file handle ***
0143 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$)
0145 V0$=STR(A$,1,1)
: IF STR(V0$,1,1)<>HEX(00) THEN 147
: RETURN
: REM % Send platter address
0147 $GIO #2(A000 8701,A$)D1$
: V0$=STR(A$,1,1)
: STR(V0$,1,1)=ADD HEX(01)
: IF STR(V0$,1,1)>=HEX(80) THEN 149
: RETURN
: REM % Get SMB hdr, file handle, open mode, data block
0149 REM Get status from 2258
: V9$()=ALL(" ")
: $GIO #2 (1800 C340 1801 C340 1802 C340 8703 8704 1803 C340, A$) V7$;V9$;V
2$;STR(V9$(),1,VAL(STR(A$,3,2),2))
: V1=VAL(STR(A$,3,2),2)
: RETURN
0150 REM % **** DEFFN'45 - DMS\A0STATUS -- V<0=err
0151 REM /* Response-F6$,len V1-assignment,2200SRV status,disk addr,VDISK stat
us *
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'48 - SET\A0DEVICE\A0TABLE(comm addr) V<0 if err
0162 DEFFN'48(A9$)
: V=1
: IF STR(A9$,1,1)<>"0" OR STR(A9$,2,1)="0" THEN 166
: HEXPACK T1$ FROM STR(A9$,2,2)
: IF MOD(VAL(T1$),4)>0 THEN 166
0163 REM /status addr
: T1$=ADD HEX(01)
: HEXUNPACK T1$ TO STR(A9$,2,2)
: SELECT #1 <A9$>
: ERRORGOTO 166
0164 REM /command addr
: T1$=ADD HEX(01)
: HEXUNPACK T1$ TO STR(A9$,2,2)
: SELECT #2 <A9$>
: ERRORGOTO 166
0165 REM /data addr
: T1$ =ADD HEX(01)
: HEXUNPACK T1$ TO STR(A9$,2,2)
: SELECT #3 <A9$>
: GOSUB '45
: IF STR(F6$,1,1)=HEX(00) THEN RETURN
: T$="D"
: HEXUNPACK STR(F6$,4,1) TO STR(T$,2,2)
: SELECT #4<T$>
: RETURN
0166 V=-1
: RETURN
0180 REM % **** DEFFN'50 - READ\A0MAP routine
0182 REM / **** Reads VDISKMAP & stores in F1$() - array of entries ***
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
0240 REM % **** DEFFN'55 - READ\A0VSTATUS
0242 REM / **** Inp=cntlr addr, Out=succ-V=0, open failed-V=-1, read ***
0243 REM / **** failed-V=-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
0400 REM % **** DEFFN'70 - ADDR\A0VAL
0405 REM / **** Validate hex address. V=1 if valid, =0 if not ***
0415 DEFFN'70(F$)
: IF VER(F$,"HHH")=3 AND LEN(F$)=3 THEN 416
: ELSE V=0
: RETURN
0416 HEXPACK V2$ FROM STR(F$,2,2)
: IF V2$<HEX(10)THEN V=0
: ELSE V=1
: RETURN
0460 REM % **** DEFFN'74 - FIND\A0ATTACHED/DETACHED
0461 REM / **** If T="A" then find 1st attached, else 1st detached ***
0462 REM / **** V=index if fnd, else V<0 ***
0465 DEFFN'74(F$)
: FOR I=1 TO 50
: IF STR(F1$(I),1,3)="ZZZ" THEN 466
: GOSUB '48(STR(F1$(I),1,3))
: IF V=-1 THEN 467
: V=-2
: IF STR(F6$,,1)>HEX(00) AND F$="A" THEN V=I
: IF STR(F6$,,1)=HEX(00) AND F$="D" THEN V=I
: IF V>0 THEN RETURN
: GOTO 467
0466 I=50
0467 NEXT I
: RETURN
0500 REM % **** DEFFN'90 - DISK\A0ERR routine ***
0505 REM / **** Process disk errors ***
0515 DEFFN'90(D)
: RESTORE LINE 4010,D-79
: READ E9$
: GOSUB '128(E9$,99,1,20)
: RETURN
0600 REM % **** DEFFN'95 - CHECK\A0TERMINAL routine ***
0605 REM / **** Check if is terminal 1 or not ***
0606 REM / **** Return V=1 if true, V=0 if false, 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 DETACHV (VER 7.00)
1001 S4=1
: S3=01
: S2=0
: S1=0
: T0$=" "
1002 IF POS(S9$=F2)>0 THEN T0$=STR(S9$,POS(S9$=F2)+1,4)
1003 RESTORE LINE 1017
: GOSUB '129
1004 T9=0
: FOR T4=1TO 01
1005 ON T4GOSUB 1012
1006 NEXT T4
1007 T9=-1
: T3=S4
1008 ON T3GOSUB 1012
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$(001)003
: GOSUB '126(10,52,3,1,1,001,1,1,D1$(1),S0$,"X",1,T9,".....6",1)
: IF R1<=0 OR T9=0 THEN RETURN
: D1$(1)=T1$()
: IF VER(T1$(),"HHH")<>3 THEN 1013
: RETURN
1013 GOSUB '128("Invalid characters in field",99,0,20)
: T0$=HEX(18000150)
: GOTO 1012
1017 DATA 01,18,00,"*****"
1018 DATA 01,26,00,"D E T A C H D M S / V D I S K"
1019 DATA 01,59,00,"*****"
1020 DATA 02,34,00,"Revision 2.0 "
1021 DATA 10,21,00,"Enter communications address:"
1022 DATA 22,50,00,"EXEC/RUN - Detach from VS"
1023 DATA 23,47,00,"CANCEL/EDIT - Exit"
1024 DATA 0,0,0," "
1500 REM VSACESS0 12 JUNE 86
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 REM % Quit if not terminal 1
: GOSUB '95
: IF V<>0 THEN 2003
: E9$="Detach must be run from terminal 1"
: E8$="K"
: C=1
: E9=23
: PRINT HEX(03)
: GOTO 3005
2003 C=0
: E9=99
: GOSUB '50
: IF V=1 THEN 2005
: IF E=82 THEN 2005
: GOSUB '90(E)
: GOTO 3005
2005 GOSUB '74("A")
: IF V>0 THEN D1$(1)=STR(F1$(V),1,3)
: ELSE D1$(1)=" "
: PRINT HEX(03)
: P9$=HEX(F218000150)
2010 REM % REPEAT loop
: REM /Display input screen
: GOSUB '100(P9$," ")
2020 REM % IF cancel or shift cancel or screen not found then exit
: IF R1>0 THEN 2060
: E9=23
: IF R1=-2 THEN E9$="Could not access screen"
: ELSE E9$="Detach DMS/VDISK cancelled"
: E8$=" "
: C=1
: GOTO 3005
2060 REM %ELSE detach
: GOSUB '128("Validating",24,00,20)
2070 REM /Check if attached
: GOSUB '48(D1$(1))
: IF STR(F6$,,1)>HEX(00) AND V>0 THEN 2072
: IF STR(F6$,,1)=HEX(00) THEN E9$="Controller not attached"
2071 IF V=-20 THEN E9$="Controller is being accessed by another partition"
: IF V=-10 THEN E9$="Controller not responding"
: IF V=-1 THEN E9$="Illegal communications address"
: GOTO 3005
2072 T1$=STR(F6$,2,1)AND HEX(20)
: IF T1$<>HEX(00) THEN 2074
: A3$="T"
: GOTO 2078
2074 T1$=STR(F6$,2,1)AND HEX(0F)
: T=#PART-1
: IF T<>VAL(T1$) THEN 2076
: A3$="S"
: GOTO 2078
2076 CONVERT VAL(T1$)+1 TO P$,(##)
: P$=STR(P$,POS(P$<>"0"))
: E9$="DMS assigned to partition "&P$&". You can only detach from that part
ition."
: GOTO 3005
2078 GOTO 2079
: REM !!!
: IF STR(F6$,3,1)=HEX(FF) THEN 2079
: E9$="2200SRV is not responding"
: GOTO 3005
2079 PRINT AT(19,0,400);
: GOSUB '128("WARNING: Please check that all DMS users on your system are r
eady for detach",23,0,20)
: GOSUB '128("Press EXEC/RUN to detach, CANCEL/EDIT to exit",24,0,20)
2080 T$=" "
: KEYIN T$
: V=POS(HEX(50F082A1)=STR(T$,1,1))
: IF V=0 THEN 2080
: PRINT AT(22,0,160);
: IF V>2 THEN 2082
: E9$=" "
: C=0
: GOTO 3005
2082 REM % Close all open VDISKs & delete entries
: REM /if err, ignore
: A0$=D1$(1)
: E1$=STR(F6$,4,1)
: F6$=STR(F6$,5)
: K8=0
: FOR E8=1 TO 32
: IF STR(F6$,E8,1)=HEX(00) THEN 2090
: K8=K8+1
: IF K8=1 OR MOD(K8,2)=0 THEN PRINT AT(23,0,80)
: GOSUB '128("Closing VDISKs",24,00,20)
: IF K8<>1 THEN 2083
: FOR I=1 TO 3000
: NEXT I
2083 $OPEN #2,#3,#4
: GOSUB '44(E1$)
: IF V0$>=HEX(80) THEN 2084
: $CLOSE#2,#3,#4
: IF V0$=HEX(02) THEN 2090
2084 GOSUB '102(V9$,V7$)
: IF V0$=HEX(FF) THEN 2086
: REM $CLOSE #2,#3,#4
2086 $OPEN #3
: GOSUB '43(E1$)
: $CLOSE#2,#3,#4
: IF V0$>=HEX(80) THEN 2090
2090 REM /increment VDISK address
: D1$=E1$ AND HEX(0F)
: IF D1$=HEX(0F) THEN E1$=ADD HEX(30)
: E1$=ADD HEX(01)
: NEXT E8
2092 PRINT AT(19,0,400);
: GOSUB '128("Please logoff VS",23,0,20)
: GOSUB '128("Press any key to continue",24,0,20)
: KEYIN T$
: T$="V"&D1$(1)
: SCRATCH T T$
: ERRORE=ERR
2094 C=2
3000 REM % UNTIL detach exit
3005 PRINT AT(22,0,160);
: IF E9$<>" " THEN GOSUB '128(E9$,E9,0,20)
: E9$=" "
: ON C+1 GOTO 2010, 3007,3020
3007 IF E8$<>"K" THEN 3010
: PRINT AT(23,0,80);
: GOSUB '128("Press any key to continue",99,0,20)
: KEYIN T$
3010 PRINT AT(23,0,80);
: GOSUB '128("Loading VS Services Menu",24,0,20)
: LOAD RUN "@VSMENU"
3020 PRINT AT(23,00,80);
: GOSUB '128("Returning to 2200SRV",24,0,20)
3030 LOAD T"DMSRES"
3799 REM % *********************** SCREEN SUBS - APEERS *********************
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"
9989 REM % *********************** Useful Text Constants *********************
9992 DEFFN '16 "LIST S"
9994 DEFFN '17 "LIST SD"
9996 DEFFN '18 "LIST SD 120, "
9997 DEFFN '19 "PRINT E8, MOD(E8,4)"
9999 DEFFN '31 "SCRATCH T";HEX(22);"VDETACH";HEX(22);": SAVE T()";HEX(22);"VD
ETACH";HEX(22)