image of READY prompt

Wang2200.org

Listing of file='@DSCFIG' on disk='vmedia/731-8028-A.wvd.zip'

# Sector 151, program filename = '@DSCFIG'
0010 REM ! @DSCFIG- 08/14/91  Setup DS CONFIGURATION
   : REM ! (c) Copyright, Wang Laboratories, Inc., 1990.  All rights reserved.
0020 REM %variables
   : DIM A,C$(16)4,D$(16)40,G$17,F$8,E$32,E$(32)32,P$32,G$(32)3,P(16),H$(32)1,
     P1$2,B$3,T$80,M1$50,M2$50,G1$1,D$3,K$1,Z4$4,P0$(32)1
0025 DIM R0$2,W$(32)3,W2$(4)6,W(4),W1$(32)3,W0(4),D1$3,D0$(6)3,D1$(4)6,D0$3
0026 REM %0 #0 Prog.platter, #1 D.S.Un/Protect, #2 D.S.cabinet
0027 REM %0 B$ $3.DS.addr,  D$ $3.addr,  D1$ $3.addr, R0$2 $2.Prom.Rev
   : REM %0 D9$ $3.DS.cabinet
0028 REM %0 D$( Drive description,  E$ Status item,  E$( Status table
0029 REM %0 H$( Drive.3rd.char, K$ $1.Kbd.char, P( #.surfaces, P$ Addr.convers
     ion
0030 REM %0 W Drive #,   W2  #.winchesters, W( Max.sectors/winch
   : REM %0 W$( Sectors/surface, W1$( Sectors.assigned,  W2$( Drive.data
   : REM %0 W4$( Start #+M/S,   W5$ Surface on drive
0035 DIM D9$3
   : D1$,D9$=SELECT #0
   : SELECT #1<D1$>
0040 H$()="0123456789ABCDEF0123456789ABCDEF"
   : P$=HEX(10000102030405060708090A0B0C0D0E10000102030405060708090A0B0C0D0E)
0042 RESTORE LINE7510
   : FOR I=1TO 16
   : READ D$(I)
   : READ P(I)
   : NEXT I
0070 REM %screen 1
   : SELECT PRINT 005(80)
   : PRINT HEX(0D030202000F020402000F06);
0080 T$="D S   C o n f i g u r a t i o n"
   : IF V=1THEN T$="P r o t e c t / U n p r o t e c t"
0090 IF V=1THEN PRINT AT(1,29);"D S   S u r f a c e s";
0100 PRINT AT(0,40-LEN(T$)/2);HEX(0F);T$
   : PRINT AT(23,55);"FN/TAB - Exit";AT(22,55);"RETURN - Proceed";
0110 GOSUB '50("(c) Copyright, Wang Laboratories, Inc., 1991","    All rights
     reserved.")
0115 K$,B$=D9$
   : IF K$<>"D"THEN B$="D10"
   : STR(B$,3,1)="0"
   : AND (STR(B$,2,1),33)
0120 REM %get DS address
   : PRINT AT(8,15);"Base address of DS unit (D10, D20, or D30): ";
   : LINPUT HEX(0E),-B$
   : IF B$="RUN"THEN 115
   : PRINT HEX(06);
   : GOSUB '50(" "," ")
   : $TRAN(B$,"DdBb")R
   : IF POS("DdBb"=STR(B$,1,1))<>0AND POS("123"=STR(B$,2,1))<>0AND STR(B$,3,1)
     ="0"THEN 130
   : GOSUB '50(HEX(0E),"Illegal address")
   : GOTO 120
0130 SELECT #2<B$>
   : ERRORGOSUB '50(HEX(0E),"Invalid address")
   : GOTO 120
0135 D$="D"&STR(B$,2,1)&"0"
   : D1,Z=0
0140 $IF ON #2,145
   : $BREAK
   : Z=Z+1
   : IF Z<999THEN 140
   : GOSUB '50(HEX(0E),"Drive unavailable")
   : GOTO 120
0145 IF V=0THEN PRINT AT(21,58);"RUN - Expand display";AT(22,64);"Restart Prog
     ram"
   : X9=1
   : D9$=D$
0150 REM %get DS status for each possible platter
0160 GOSUB 700
   : R0$=STR(E$(1),4,2)
0170 REM %DS software version
   : PRINT AT(8,15,60);
   : M2$="        Protocol level:  "&STR(E$(1),3,1)
   : M1$="DS PROM revision level:  "&R0$
   : GOSUB '50(M1$,M2$)
0180 IF V<1THEN PRINT AT(20,58);"'15 - Start Setup"
   : PRINT AT(1,0)
0190 INIT(00)W$()
   : W2$()=" "
   : MAT W=ZER
   : W2,W3=0
0200 IF R0$>"01"THEN V1=1
   : IF V=1THEN GOSUB 3010
0210 IF R0$<="32"THEN 250
   : GOSUB 1020
   : REM .DS PROM >3 lets you get drive switch status
0250 REM %display info. on each drive
   : FOR I=1TO 32
   : IF I=17THEN STR(D$,2,1)=OR HEX(04)
   : GOSUB '120(STR(E$(I),2,1))
   : IF I=1OR I=16OR I=31THEN PRINT
   : NEXT I
0260 REM %get user command
   : KEYIN K$,,270
   : IF K$=HEX(82)THEN GOSUB 3005
   : IF K$<>HEX(0D)THEN 260
   : GOTO 40
0270 IF K$=HEX(7F)OR K$=HEX(7E)THEN 410
   : IF K$=HEX(0F)THEN GOSUB 4000
   : GOTO 260
0280 REM %display info. on drive i
0290 DEFFN'120(G1$)
   : IF STR(G$(I),3,1)=HEX(04)THEN RETURN
   : MAT SEARCHH$(),=G1$TO P1$
   : IF P1$=HEX(0000)THEN RETURN
   : P1,P=VAL(P1$,2)
0300 P9=P(P)
   : ON IGOTO 310,,,,,,,,,,,,,,,,310,,,,,,,,,,,,,,,310
   : REM .Winchester drives fall thru       0  123456789ABCDEF 0  123456789ABC
     DE F
   : W2=W2+1
   : IF R0$>"32"THEN 305
   : IF P9>0THEN 310
   : I=I-1
   : RETURN
0305 P1=VAL(D1$(W2))-47
   : P9=MIN(14,VAL(STR(D1$(W2),6)))
   : IF P9>0THEN 310
   : IF STR(D1$(W2),2,1)<>HEX(96)THEN 310
   : I=I-1
   : RETURN
0310 IF I=32THEN PRINT BOX(2,79);
   : ELSE PRINT BOX(INT((P9-1)/5)+2,79);
0320 PRINT HEX(0E20);STR(D$(P1));HEX(0F);
   : IF STR(E$(I),17,1)=HEX(00)THEN 325
   : PRINT HEX(0E);"failed built-in test"
   : GOTO 330
0325 W1=VAL(STR(E$(I),6,3),3)
   : IF I>1THEN 326
   : IF W1=4160THEN PRINT "1.2 MB ";
   : IF W1=1280THEN PRINT "360 KB ";
   : PRINT "with";W1;"sectors"
   : GOTO 360
0326 IF I=32THEN 330
   : IF G1$="2"THEN 350
   : IF R0$>"32"THEN 330
   : W(W2)=W1*P9
   : W0(W2)=P
   : K$=STR(H$(),I)AND HEX(0F)
   : IF I>16THEN K$=K$OR HEX(40)
   : W2$(W2)=BIN(W1,3)&BIN(P9)&G1$&K$
0330 IF I<32THEN 350
0340 GOSUB 900
   : PRINT M9;"MB tape drive"
   : PRINT "  Address is ";STR(D$,1,2);H$(I);TAB(30);"Cassette is ";S$
   : RETURN
0350 IF P9=1THEN PRINT "  1  surface"
   : ELSE PRINTUSING " ## surfaces",P9
0352 IF G1$="2"THEN PRINT "  Must be on Drive 1",
0354 IF P9=0THEN 370
0360 PRINT " ";
   : FOR P1=1TO P9
   : D1$=STR(D$,1,2)&H$(I+P1-1)
   : PRINTUSING 385,VAL(STR(E$(I+P1-1),6),3);D1$;
   : IF P1=5OR P1=10THEN DO
   : PRINT
   : PRINT " ";
   : END DO
   : NEXT P1
   : PRINT
0370 I=I+P9-1
   : IF W2=4THEN I=31
0380 RETURN
0385 %######## on ###
0390 REM %exit
0400 DEFFN'127
0410 DEFFN'126
   : IF X9>0THEN 415
   : LOAD RUN "@MENU"
0415 X9=0
   : GOTO 10
0600 DEFFN'50(M1$,M2$)
   : REM %'50 - display message at lower left corner (lines 22,23)
   : PRINT AT(22,0);STR(M1$);AT(23,0);STR(M2$);HEX(0F);
   : RETURN
0690 REM %^.Get surface status to E$()
0700 GOSUB '50(HEX(0E),"Getting device status")
0760 FOR I=1TO 32
   : STR(G$,1,1)=STR(P$,I,1)OR HEX(20)
   : IF I<>17THEN 780
0770 STR(B$,2,1)=OR HEX(04)
   : SELECT #2<B$>
   : ERRORSTOP "SOMETHING'S GROSSLY WRONG HERE!"
0780 STR(G$,2,7)=ALL(00)
   : $GIOREADSURFACESTATUS#2(0E140F0012E20600070070A0400288D070406A10681640008
     7051A00C340,G$)G$;STR(E$,,VAL(STR(G$,5,1)))
   : ERRORGOTO 840
0790 IF STR(E$,2,1)=HEX(00)THEN STR(E$,18,1)=HEX(00)
   : G1$=STR(G$,8,1)AND HEX(10)
   : IF G1$>HEX(00)THEN 850
0800 IF STR(G$,8,1)<>HEX(00)THEN 810
   : IF STR(E$,1,1)=HEX(33)THEN 830
   : IF I=32AND STR(E$,1,2)=HEX(4533)THEN 820
0810 IF I>1THEN 840
   : GOSUB '50(HEX(0E),"Specified disk is not a DS")
   : RETURN CLEAR ALL
   : GOTO 120
0820 STR(E$,1,2)=HEX(3345)
0830 E$(I)=E$
   : G$(I)=STR(G$,6,3)
   : NEXT I
   : GOSUB '50(" "," ")
   : RETURN
0840 PRINT AT(21,0);"$GIO error return on drive ";I;HEXOF(G$)
0850 GOSUB '50(HEX(0E),"Disk unavailable")
   : RETURN CLEAR ALL
   : GOTO 120
0900 REM %^..Get tape status info
   : DIM X0$(6)1,X1$(6)1
0910 X0$(),X1$()=ALL(FF)
   : $GIOREADTAPESTATUSFIRST#2(0600070070A068D07040682E68378B674000870687051A0
     0C340,G$)G$;STR(X0$(),,VAL(STR(G$,5,1)))
   : ERRORGOTO 910
0920 $GIOREADTAPEXSTATUS#2(0600070070A068D07040682E683E8B674000870687051A00C34
     0,G$)G$;STR(X1$(),,VAL(STR(G$,5,1)))
   : ERRORSTOP #
0930 K$=X1$(1)AND HEX(7F)
   : M9=45
   : IF K$=HEX(17)THEN M9=150
   : S$=" "
   : K$=X0$(1)AND HEX(40)
   : IF K$=HEX(40)THEN S$="not in place"
   : ELSE DO
   : S$=" 45 mB"
   : K$=X1$(1)AND HEX(80)
   : IF K$=HEX(80)THEN S$="150 mB"
   : K$=X0$(1)AND HEX(10)
   : IF K$=HEX(10)THEN S$=S$&" protected"
   : END DO
0935 IF X0$()=HEX(000000000000)THEN S$="busy"
0940 RETURN
1000 REM %^.Prom 4 status read '30' of 18 bytes  6 drives x 3 bytes
   : REM . Bytes 01-03=floppy
   : REM . bytes 04-06=Drv.1  07-09=Drv.2  10-12=Drv.3  13-15=Drv.4
   : REM . bytes 16-18=Tape
   : REM .Byte A=Drive.select.type  Byte.B=Status   Byte C=M/S.&.#.platters
1010 REM .Byte.B=Status meaning
   : REM . 82=good drive configured  86=good.drv.not.configured  96=Bad.drv
1020 G$=STR(P$,1,1)OR HEX(20)
1030 E$,STR(G$,2,7)=ALL(00)
   : REM %.Prom 4 Read drive status
   : $GIOREADDRIVESTATUS#2(0E140F0012E20600070070A0400288D070406A1068294000870
     51A00C340,G$)G$;STR(E$,,VAL(STR(G$,5,1)))
1040 PRINT AT(1,0)
1050 D0$()=E$
   : FOR I=2TO 5
   : D1$(I-1)=D0$(I)&BIN(I-1)&HEX(0000)
   : NEXT I
1060 REM .Move Winchester drives into D1$()
1070 REM .Update D1$() item for Winchester drives
   : REM .Byte A=Drive.select.type  Byte.B=Status   Byte C=M/S.&.#.platters
   : REM .Byte 4=Drv#  Byte 5=start surface   Byte 6=#.platters
1080 REM .A.B.C.4 set above from E$ entry and I
   : REM .5.6 are set below
   : REM .10mb Rem is M side F ... others are M side 1-E   S side 1-E
1085 N1,N2=0
   : FOR I=1TO 4
   : D0$=D1$(I)
   : X,Z=VAL(STR(D0$,3))
   : IF Z=0THEN 1100
   : IF Z>64THEN Z=Z-64
   : IF STR(D0$,,1)<>"2"THEN 1090
   : X=15
   : GOTO 1100
1090 IF X>15THEN 1095
   : X=N1+1
   : N1=N1+Z
   : GOTO 1100
1095 X=N2+65
   : N2=N2+Z
1100 BIN(STR(D1$(I),5))=X
   : BIN(STR(D1$(I),6))=Z
   : NEXT I
1110 FOR I=1TO 4
   : D0$=D1$(I)
   : P=VAL(D0$)-47
   : X=VAL(STR(D1$(I),4))
1115 IF P<1THEN STOP "Cycle  Power on DS cabinet -- Key '4 to see bad status i
     nfo."#
1116 IF P>8THEN DO
   : PRINT BOX(1,79);HEX(0E20);"Illegal switch setting";TAB(40);"Drive ";I;TAB
     (70);HEXOF(D0$)
   : GOTO 1175
   : END DO
1120 IF STR(D0$,2,1)=HEX(86)THEN DO
   : PRINT BOX(1,79);HEX(0E20);D$(P);TAB(40);"Drive ";I;"-- unconfigured";TAB(
     70);HEXOF(D0$)
   : END DO
1130 IF STR(D0$,1,2)=HEX(3196)THEN DO
   : PRINT BOX(1,79);HEX(0E20);D$(P);TAB(40);"Drive ";I
   : GOTO 1175
   : END DO
1140 IF STR(D0$,2,1)=HEX(96)THEN DO
   : PRINT BOX(1,79);HEX(0E20);D$(P);TAB(40);"Drive ";I;"-- bad drive";TAB(70)
     ;HEXOF(D0$)
   : GOTO 1175
   : END DO
1145 IF N1>14OR N2>14THEN PRINT BOX(1,79);HEX(0E20);"Number of surfaces is gre
     ater than 14 on master or slave side"
1150 CONVERT STR(D$(P),,3)TO Z
   : ERRORZ=0
   : GOTO 1170
1160 IF Z/10=INT(Z/10)THEN Z=38912
   : ELSE Z=65024
1165 IF STR(D0$,1,1)=HEX(32)THEN DO
   : Z=0
   : IF I<>1THEN PRINT BOX(1,79);HEX(0E20);D$(P),TAB(40);"Drive ";I;" \CD\F5\F
     3\F4 be on drive 1"
   : END DO
1170 W(I)=Z*P(P)
   : W2$(I)=BIN(Z,3)&BIN(P(P))&STR(D1$(I),,1)&STR(D1$(I),5,1)
   : W0(I)=P
1175 NEXT I
1176 DIM C1$(4)1,C2$(4)6,C3$(4)2
   : FOR I=1TO 4
   : K$=STR(D1$(I),5,1)
   : IF K$=HEX(00)THEN K$="Z"
   : C1$(I)=K$
   : NEXT I
   : MAT SORTC1$()TO C2$(),C3$()
   : FOR I=1TO 4
   : C2$(I)=D1$(VAL(C3$(I),2))
   : NEXT I
   : D1$()=C2$()
1180 RETURN
3000 REM %^.Examine disk addresses
3005 STR(B$,2,1)=STR(B$,2,1)AND HEX(33)
   : SELECT #2<B$>
   : GOSUB 700
3010 SELECT PRINT 005(80)
   : IF V=0THEN PRINT HEX(03)
   : PRINT HEX(010E);TAB(22);"C u r r e n t   P l a t t e r  U s e"
   : IF V1=0THEN Z4$="n/a"
   : X9=1
3020 PRINT AT(2,40);BOX(2,0);AT(2,0);BOX(2,79)
3030 PRINT " Disk  Index    Current    Catalog Pro-  Disk  Index    Current
      Catalog Pro-"
3040 PRINT " Addr. Size         End    Maximum tect  Addr. Size         End
      Maximum tect"
3060 DIM X$(32)4,Z8$80,A$(16)16,Z1$1,D$3,Z2$2,Z7$70
3070 DIM X$40,X4$40
3080 D$=B$
   : $TRAN(D$,"152637")R
3090 X$()=D$
   : GOSUB 3140
   : PRINT
3100 PRINT AT(23,55);"FN/TAB - Exit";AT(22,55);"RETURN - Restart Program";
3110 IF V=0THEN PRINT AT(21,58);"RUN - Repeat Screen"
3120 B=0
   : ON VGOSUB 7010
3130 RETURN
3140 R1,J=0
3150 J=J+1
   : IF J=17THEN R1=0
   : D$=X$(J)
   : IF D$=" "THEN RETURN
3160 R1=R1+1
   : R=0
   : IF STR(D$,2)>"4"THEN R=R+40
   : PRINT AT(R1+3,R);
3170 Z8$=" "
   : GOSUB '200(D$,X$())
   : ON X4GOSUB 3290,3300,3310,3330
3180 IF E=48THEN 3220
   : IF E=91THEN 3220
3185 PRINTUSING " ### ",D$;
   : K$=STR(E$(J),18)
   : IF J=1AND E=98THEN Z8$="Door open or no diskette"
3190 K$=K$AND HEX(83)
   : $TRAN(K$,HEX(23005301530253034880488148824883))R
   : STR(X$(J),4)=K$
   : IF V1=1THEN GOSUB 7135
   : IF H0$="?"THEN 3192
   : IF A>0AND A<4096THEN 3200
3192 C$=" None"
   : B=0
   : C=VAL(STR(E$(J),6),3)-1
   : GOTO 3205
3200 CONVERT ATO C$,(####)
   : STR(C$,5,1)=H0$
   : IF STR(C$,,1)="0"THEN STR(C$,,POS(C$>"0")-1)=" "
3205 CONVERT CTO C1$,(##########)
   : IF C>0AND STR(C1$,,1)="0"THEN STR(C1$,,POS(C1$>"0")-1)=" "
   : IF C>VAL(STR(E$(J),6),3)THEN STR(C1$,11)="x"
   : IF B>CTHEN STR(C1$,11)="?"
3210 IF Z8$="Yes"THEN PRINTUSING 3250,C$,B,C1$,Z4$;
   : ELSE PRINTUSING 3240,Z8$,Z4$
   : GOTO 3150
3220 IF R1>1THEN R1=R1-1
   : IF J<32THEN 3150
   : Z8$=Z8$&" None"
   : STR(X$(J),1)=" "
   : RETURN
3240 %############################# ####
3250 % ##### ########## ########### ####
3285 REM %.Get Rcv Disk address
3290 Z8$=Z8$&" disk not in table"
   : RETURN
3300 Z8$="Hogged or not configured"
   : PRINT Z8$
   : X$()=" "
   : RETURN CLEAR
   : RETURN
3310 Z8$="Is unavailable"
   : RETURN CLEAR
3320 PRINT HEX(0D);Z8$
   : PRINT
   : X$()=" "
   : RETURN
3330 Z8$="disk not in list"
   : RETURN
3339 REM %^.'200 Read Index info
3340 DEFFN'200(D$,X$())
3350 X4=0
   : MAT SEARCHX$(),=STR(D$,,3)TO X7$STEP 4
   : IF VAL(X7$,2)=0THEN 3460
   : SELECT #2<D$>
   : ERRORX=ERR
   : RETURN
3360 $OPEN 3450,#2
   : ERRORX4=2
   : RETURN
3370 $CLOSE#2
   : Z$=" "
   : HEXPACKZ$FROMSTR(D$,2,1)
   : IF J=1THEN GOSUB 3470
3380 $GIO(731002000301122270A040008600,Z$)
   : ERRORX=ERR
   : X4=3
   : Z8$="FROM $GIO AT 360"
   : RETURN
3390 IF STR(Z$,8,1)=HEX(00)THEN 3400
   : X4=3
   : RETURN
3400 LIMITS T#2,"START",A,B,C,E
   : ERRORE=ERR
   : Z7$=ERR$(E)
   : Z8$="Error "
   : CONVERT ETO STR(Z8$,7,2),(##)
   : Z8$=Z7$
   : IF E<>85THEN RETURN
3410 Z8$="Yes"
   : E=0
3420 DATA LOAD BA T#2,(0)A$()
3422 C$=" '&?"
   : H0$=A$()
   : A=VAL(H0$)+1
   : IF A>3THEN A=4
   : H0$=STR(C$,A,1)
3430 A=VAL(STR(A$(1),2))
   : B=VAL(STR(A$(1),3),2)-1
   : C=VAL(STR(A$(1),5),2)-1
3435 IF H0$="&"THEN DO
   : A=VAL(STR(A$(),2),2)
   : B=VAL(STR(A$(),4),3)-1
   : C=VAL(STR(A$(),7),3)-1
   : END DO
3440 RETURN
3450 X4=2
   : RETURN
3460 X4=4
   : RETURN
3470 REM Z8$="DS cabinet"
   : X$()=" "
   : Z2$="D"&STR(D$,2,1)
   : X4$="0123456789ABCDEF"
   : FOR A=1TO 16
   : X$(A)=Z2$&STR(X4$,A,1)
   : NEXT A
   : ADD(STR(Z2$,2,1),04)
   : FOR A=1TO 16
   : X$(A+16)=Z2$&STR(X4$,A,1)
   : NEXT A
   : RETURN
4000 REM %^.Setup DS Surface assigments
4010 REM %0 W Drive #,   W2  #.winchesters, W( Max.sectors/winch
   : REM %0 W$( Sectors/surface, W4$( Start #+M/S,   W5$ Surface on drive
4012 REM .W4$ MMSSssss####  Master/Slave--start point--#.items
4020 DIM X$(32)4,Z8$80,A$(16)16,Z1$1,D$3,Z2$2,Z7$70,A$10,X$40,X4$40,W4$(4)12,W
     5$32,W3$3,R$(16)16
4030 SELECT PRINT 005(80)
   : IF V=0THEN PRINT HEX(03)
   : PRINT HEX(010E);TAB(12);"S e t u p  D. S.  S u r f a c e   A s s i g n m
     e n t s"
4040 PRINT AT(23,55);"FN/TAB - Exit";AT(22,55);"                        ";
4045 W,W2=0
   : X9=1
   : REM .Change FN/TAB Exit to top
   : FOR I=1TO 4
   : IF W(I)>0THEN W2=W2+1
   : NEXT I
4050 PRINT AT(1,0);W2;"Winchesters with sectors available"
   : FOR I=1TO 4
   : IF W(I)>0THEN PRINTUSING "No. # = ##,###,###  ",I,W(I);
   : NEXT I
4060 PRINT AT(3,40);BOX(2,0);AT(3,0);BOX(2,79)
4070 PRINT " Master disk             Catalog         Slave disk              C
     atalog       "
4080 PRINT " Address                 Maximum         Address                 M
     aximum"
4090 %   ###               ###,###,###           ###               ###,###,###

4110 X$="123456789ABCDE"
   : INIT(00)W4$(),W5$
4115 IF W2<1THEN 4220
4120 REM %.Show surfaces and assignments
4130 FOR I=1TO 14
   : D$,D1$=STR(B$,,2)&STR(X$,I,1)
   : STR(D$,2,1)=STR(D$,2,1)AND HEX(FB)
   : PRINTUSING 4090,D$,VAL(W$(I),3),D1$,VAL(W$(I+14),3)
   : W1$(I)=D$
   : W1$(I+14)=D1$
   : NEXT I
4132 K$="Y"
   : PRINT AT(20,1);
   : LINPUT "Use D.S. Defaults "-K$
   : IF K$="Y"THEN 4384
4134 FOR I=1TO 4
   : IF W(I)>0THEN W2=I
   : NEXT I
4135 REM . IF R0$<="30"THEN 4222
4140 REM %.Determine Master/Slave
4150 W=W+1
   : IF W<1OR W>W2THEN W=1
   : IF W(W)=0THEN 4150
4151 PRINT AT(20,0,80);"Winchester ";W
   : BIN(K$)=W+48
   : REM  LINPUT -K$
   : X=VAL(K$)-48
   : IF X>W2THEN 4151
   : W=X
4155 PRINT AT(22,55);"   RUN - Accept Screen? ";
4156 K$="M"
   : I0=0
   : FOR I=1TO 14
   : IF W$(I)>HEX(000000)THEN I0=I0+1
   : NEXT I
   : IF I0=14THEN K$="S"
4158 IF K$="M"THEN 4160
   : I0=0
   : FOR I=15TO 28
   : IF W$(I)>HEX(000000)THEN I0=I0+1
   : NEXT I
   : IF I0=14THEN 4215
4160 PRINT AT(22,0,40);AT(20,0,80);"Winchester";W;TAB(30);"Master or Slave ";
   : LINPUT -K$
4165 A$=" "
   : IF K$="M"THEN A$="Master"
   : IF K$="S"THEN A$="Slave"
   : IF A$=" "THEN 4160
   : PRINT AT(20,13);A$;
4170 PRINT AT(21,0,80);" B=1.2 (4160)  C=10MB (38912)  D=16MB (65024) R=Remain
     ing  or  value"
   : PRINT AT(22,55,25);
4180 X0=W(W)
   : CONVERT X0TO A$,(########)
4190 I0=VAL(W4$(W))
   : IF I0>0THEN 4210
   : IF K$="M"THEN I0=1
   : IF K$="S"THEN I0=15
   : I9=I0+13
4200 IF W$(I0)=HEX(000000)THEN 4210
   : I0=I0+1
   : GOTO 4200
4210 IF I0>I9THEN 4156
   : W4$(W)=BIN(I0,1)&K$
   : GOSUB 4230
   : IF W<W2THEN 4150
4215 PRINT AT(21,0,160)
   : PRINT
   : K$="."
   : LINPUT "All entries made and acceptable  Y/N",-K$
   : PRINT AT(22,0,60);
   : IF K$="Y"OR K$="y"THEN 4430
   : IF K$="N"OR K$="n"THEN 10
   : GOTO 4215
4220 PRINT "No Winchester drives in system"
   : GOTO 4225
4221 GOSUB '50(HEX(0E),"ILLEGAL DEFAULT")
   : GOTO 4225
4222 GOSUB '50(HEX(0E),"This capability needs DS PROM 4.0 or greater")
4225 PRINT AT(22,0);
   : KEYIN K$
   : RETURN CLEAR
   : GOTO 10
4228 REM %.Ask surface details
4230 FOR I=I0TO I9
4240 IF K$="M"AND I>14THEN 4370
   : IF K$="S"AND I<15THEN 4370
4260 X1,X=VAL(W$(I),3)
   : IF X=0THEN 4270
   : CONVERT XTO A$,(########)
4270 PRINT AT(20,21);
   : PRINTUSING "###########  Sectors remaining",X0
   : IF X0>0THEN 4290
   : X=0
   : I=I9
   : GOTO 4370
4280 PRINT HEX(07)
4290 PRINT AT(22,0);"Amount for surface ";W1$(I);"=";
   : LINPUT -A$
4300 IF VER(A$,"AA")=1THEN STR(A$,2)=" "
   : IF LEN(A$)>1THEN 4310
   : IF A$="A"THEN A$="1280"
   : IF A$="B"THEN A$="4160"
   : IF A$="C"THEN A$="38912"
   : IF A$="D"THEN A$="65024"
   : IF A$=" "THEN A$="0"
   : IF A$="0"THEN 4310
   : IF A$<>"R"THEN 4290
   : X=X1+X0
   : GOTO 4320
4310 CONVERT A$TO X
   : ERRORGOTO 4280
4320 IF MOD(X,32)>0THEN X=(INT(X/32)+1)*32
   : IF X=X1THEN 4330
   : IF X<0OR X>X0+X1THEN 4280
   : X0=X0+X1
   : X0=X0-X
4330 IF X=0THEN 4350
   : W$(I)=BIN(X,3)
   : STR(W5$,I,1)=BIN(W)
   : IF X>0THEN DO
   : IF I<15THEN PRINT AT(4+I,8);
   : ELSE PRINT AT(I-10,48);
   : PRINTUSING "# ########## ###########",W," ",X
   : END DO
4350 REM
4360 IF X=0THEN I=I9
4370 NEXT I
4380 IF X<>0THEN 4230
   : RETURN
4384 REM %.Set in DS defaults
   : REM .1st set D1$() in drive order
   : FOR I=1TO 4
   : C1$(I)=STR(D1$(I),4,1)
   : NEXT I
   : MAT SORTC1$()TO C2$(),C3$()
   : FOR I=1TO 4
   : C2$(I)=D1$(VAL(C3$(I),2))
   : NEXT I
   : D1$()=C2$()
4385 FOR I=1 TO 4
   : C1$(I)=D1$(I)
   : NEXT I
   : DIM B2$2
   : B2$=C1$()
   : IF POS(B2$="7")=0 THEN 4386
   : IF B2$="27" OR B2$="17" OR B2$="71" THEN 4386
   : GOTO 4221
4386 B2$=STR(C1$(),3)
   : IF POS(B2$="17")=0 THEN 4387
   : IF B2$="27" OR B2$="17" THEN 4387
   : GOTO 4221
4387 K$=HEX(01)
   : FOR I=1TO 4
   : IF STR(D1$(I),2,1)<>HEX(82)OR STR(D1$(I),,1)="2"THEN 4388
   : IF I=3THEN K$=HEX(41)
   : STR(W2$(I),6,1)=K$
   : K$=K$ADDSTR(D1$(I),6,1)
4388 NEXT I
4390 REM .then set W$(32)3 with sizes
   : INIT(00)W$(),W5$
   : MAT W0=ZER
   : FOR I=1TO 4
   : IF W2$(I)=" "THEN 4394
   : K$=STR(W2$(I),6)
   : IF K$>" "THEN K$=K$ADDHEX(CE)
   : X=MAX(VAL(K$),1)
   : REM .X=Start drive
4392 FOR Z=1TO VAL(STR(W2$(I),4))
   : W$(X+Z-1)=STR(W2$(I),,3)
   : IF STR(D1$(I),1,1)<>"2"THEN STR(W5$,X+Z-1,1)=BIN(I)
   : NEXT Z
   : W0(I)=VAL(STR(W2$(I),5))-47
4394 NEXT I
4400 REM %^.Create Drive configuration sector
   : REM .Bytes.001-032 Drive constants
   : REM .011-013 "TBO"
   : REM .014 binary count of platters in drive
   : REM .015 start platter eg 01, 05, 41
4410 REM .Bytes 033-256 One 16 byte item per surface on drive sss + nnn
   : REM .where $(N),3,3)=nnn=number of sectors
4420 REM . W5$32 By surface drive 1,2,3, or 4
   : REM .  W$(32) 3 By surface number of sectors
4430 SELECT PRINT 005(80)
   : PRINT HEX(010E);TAB(12);"* N E W * "
   : PRINT AT(20,0,160)
4440 F$="@DEFAULT"
   : PRINT AT(22,0,40);
   : LINPUT "Configuration file name "-F$
4450 LIMITS T#0,F$,A,B,C,E
   : ERRORE=ERR
   : M2$=HEX(070E)&ERR$(E)
   : PRINT AT(23,0);M2$;AT(0,0)
   : GOTO 4430
4455 IF E=1THEN 4440
   : IF E=0THEN DATA SAVE DC OPEN T#0,(6)F$
4460 LIMITS T#0,F$,A,B,C,E
   : DATA LOAD DC OPEN T#0,F$
   : W1=A
4470 FOR W=1TO 4
   : K$=BIN(W)
   : INIT(00)R$()
   : X=0
   : FOR I=1TO 31
   : IF STR(W5$,I,1)=K$THEN DO
   : X=X+1
   : STR(R$(X+2),4,3)=W$(I)
   : END DO
   : NEXT I
4472 IF X=0THEN 4500
4480 X$=HEX(0102030405060708090A0B0C0D0E4142434445464748494A4B4B4D4E)
   : I=POS(W5$=K$)
   : K$=STR(X$,I)
4490 STR(R$(),11,9)="TBO"&BIN(X)&K$&BIN(W0(W))
4500 DATA SAVE BA T#0,(A,A)R$()
4510 NEXT W
4520 DSKIP #0,4S
   : DATA SAVE DC #0,END
4525 GOSUB 8400
4530 M1$="Configuration created in file "&F$
   : M2$=" "
   : IF #TERM=1THEN M2$="Key Reset and sf '10 to apply"
   : GOSUB '50(M1$,M2$)
   : PRINT AT(22,0);
   : KEYIN K$
   : GOTO 10
6999 REM %^.Protect/Unprotect logic
7010 DIM V0$(32)1,V$(32)1
   : REM %0 V0$( Protect at entry,  V$(  Protect at RUN
7015 PRINT AT(21,58);"RUN - Accept Screen?"
7018 IF STR(X$(),4,1)=" "THEN STR(X$(),4,1)="#"
7019 PRINT AT(22,64,15);"Restart Program"
7020 A=0
   : FOR I=1TO 32
   : K$=STR(X$(I),4)
   : IF K$<>" "THEN DO
   : A=A+1
   : X$(A)=X$(I)
   : V0$(A),V$(A)=K$
   : K$=STR(X$(I),3)
   : IF K$="0"THEN I1=0
   : IF K$="1"THEN I1=1
   : P0$(A)=BIN(I1)
   : I1=I1+1
   : END DO
   : NEXT I
   : IF A=32THEN 7030
   : FOR I=A+1TO 32
   : X$(I)=" "
   : NEXT I
7030 REM .Set up prompting
   : R=4
   : FOR I=1TO A
   : GOSUB 7120
   : NEXT I
   : GOSUB 7145
7040 I=1
7050 PRINT HEX(0E);
   : GOSUB 7120
   : PRINT HEX(0808080806);
   : KEYIN K$
7060 IF K$=HEX(7F)OR K$=HEX(7E)THEN 410
   : REM /.TAB
   : IF K$=HEX(82)THEN 7150
   : REM /.RUN
   : IF K$=HEX(0D)THEN 10
   : REM /.CR
7070 IF K$=HEX(08)THEN 7140
7080 $TRAN(K$,"HhNnSs")R
   : IF K$="H"OR K$="N"OR K$="S"THEN V$(I)=K$
   : IF V0$(I)="H"THEN K$,V$(I)="H"
7110 GOSUB 7125
   : I=I+1
   : IF I=A+1THEN 7040
   : GOTO 7050
7120 K$=STR(X$(I),3)
   : I1=VAL(P0$(I))
7125 K$=V$(I)
   : GOSUB 7135
7130 J=35
   : IF STR(X$(I),2,1)>"3"THEN J=J+40
   : PRINT AT(R+I1,J);Z4$;HEX(0F);
   : RETURN
7135 IF K$="H"THEN Z4$="Hard"
   : IF K$="S"THEN Z4$="Soft"
   : IF K$="#"OR K$="N"THEN Z4$="No"&HEX(8080)
   : IF V1=0THEN Z4$="n/a"
   : RETURN
7140 GOSUB 7120
   : I=I-1
   : IF I>0THEN 7050
   : I=A
   : GOTO 7050
7145 PRINT AT(21,0);"Valid keys to alter Protect"
   : IF V1=0THEN 7148
   : PRINT AT(23,0,50);"S to Soft Protect;  H to Hard Protect";AT(22,0,50);"N
     to set 'No' to disable Soft Protect"
   : RETURN
7148 PRINT AT(23,0,50);HEX(0E);"Rev. 01 does not allow Protect alteration";HEX
     (0F01);
   : RETURN
7150 PRINT AT(23,0,50);AT(21,0,80);
   : IF V$()=V0$()THEN PRINT "No changes were made"
   : ELSE PRINT "Highlighted fields denote changes made"
7160 FOR I=1TO A
   : PRINT HEX(0E);
   : IF V$(I)=V0$(I)THEN PRINT HEX(0F);
   : GOSUB 7120
   : NEXT I
7165 IF V1=0THEN 10
7170 PRINT AT(22,64,15);"Proceed";AT(22,0,50);"Do you wish to set new defaults
       (Y or N)";
   : K$="N"
   : LINPUT HEX(0E),-K$
   : $TRAN(K$,"YYNN")R
   : I=POS("YN"=K$)
   : IF I<1THEN 7170
7180 IF V$()=V0$()THEN ON IGOTO 7010,10
   : ON IGOTO 7200,7010
   : STOP #
7190 REM %^.Apply Protection desired
   : REM .D$() = surfaces  V$() = Protection
7200 PRINT AT(22,64,15);"Proceed"
   : FOR I=1TO A
   : K$=V$(I)
   : D$=X$(I)
   : IF K$<>V0$(I)THEN IF POS("HSN"=K$)>0THEN GOSUB 7210
   : NEXT I
   : GOSUB '50(HEX(0E06),"Desired Protection Applied")
   : PRINT AT(22,60);
   : GOTO 260
7205 REM %.Enable/disable Protection
   : REM .K$="N or H or S"  D$=disk surface
7210 REM .K$ denotes protection wanted..N=No., H=Hard, S=Soft
7220 SELECT #1<D$>
   : ERRORSTOP #
7225 REM .Convert hex platter to DS internal format (except for tape)
7230 HEXPACKG1$FROMSTR(D$,2,2)
   : G1$=AND HEX(0F)ADDHEX(0F)AND HEX(0F)OR HEX(20)
   : $TRAN(G1$,HEX(302F))R
7235 REM .Set $GIO argument  byte 1=platter  byte 2=Protect mechanism
7240 G$=G1$
   : IF K$="N"THEN STR(G$,2,1)=HEX(00)
   : ELSE STR(G$,2,1)=HEX(01)
7245 REM .Byte 2 = Protect mechanism byte
   : REM .Bit 0, '01' bit   0=OFF disabled,     1=ON enabled
   : REM .Bit 1, '02' bit   0=OFF one platter,  1=ON All platters
   : REM .Bit 7, '80' bit   0=OFF Soft Protect, 1=ON Hard protect
7250 IF K$="H"THEN STR(G$,2,1)=OR HEX(80)
7260 $GIOPROTECTORENABLEPLATTER#1(0600070070A068D070406A10681C42204000,G$)
7270 RETURN
7500 REM %.Data for DS drives
7510 DATA "RAM Disk",1
7520 DATA "No drive present",1
7530 DATA "10 MB Removable Hard Disk",1
7540 DATA "10 MB Fixed Hard Disk",1
7550 DATA "20 MB Fixed Hard Disk",2
7560 DATA "32 MB Fixed Hard Disk",2
7570 DATA "64 MB Fixed Hard Disk",4
7580 DATA "140 MB Fixed Hard Disk",14
7590 DATA "32 MB Fixed Hard Disk",2
7600 DATA "112 MB Fixed Hard Disk",7
7610 DATA "Unknown",1
   : DATA "Unknown",1
   : DATA "Unknown",1
   : DATA "Unknown",1
7620 DATA "Streaming Cassette Tape Drive",1
7630 DATA "Diskette Drive",1
8000 REM %^.Apply Changes to DS cabinet
   : REM %.Code @ 8000-8990 will be a separate module saved scrambled as @DSCF
     IG8
8010 DEFFN'10
   : IF #TERM<>1THEN 10
   : D$=SELECT #2
   : STR(D$,2,1)=STR(D$,2,1)AND HEX(FB)
   : STR(D$,3,1)="0"
   : D1$=SELECT #1
   : PRINT HEX(03);AT(23,55);"FN/TAB - Exit";AT(0,0);"Apply changes to cabinet
      ";D$;" from file on ";D1$
8015 X=4
   : IF STR(E$(),4,2)>"3D"THEN 8020
   : GOSUB '50(HEX(0E),"You need DS prom level 4 to apply changes")
   : KEYIN K$
   : GOTO 10
8020 PRINT AT(1,0);HEX(0E);"Enter PASSWORD to apply changes"
   : Z$=" "
   : PRINT AT(1,40);
   : LINPUT -Z$
   : V3$=DATE
   : DATE=V3$PASSWORDZ$
   : ERRORPRINT HEX(07)
   : X=X-1
   : IF X>0THEN 8020
   : GOTO 10
8025 F$="@DEFAULT"
8030 PRINT HEX(07)
   : PRINT AT(1,0,80);
   : LINPUT "Configuration file name "-F$
8040 LIMITS T#1,F$,W1,B,C,E
   : IF E<>2THEN 8030
   : IF C<>6THEN 8030
8045 PRINT AT(1,0,80);HEX(0E);"A P P L Y I N G    U P D A T E   T O   D S   P
     R O M"
   : D1=1
8050 REM %.Drive configuration sector
   : REM .Bytes.001-032 Drive constants
   : REM .001-007 Reserved for alternate sectoring
   : REM .008-010 reserved for future use
8055 REM .011-013 "TBO"
   : REM .014 binary count of platters in drive
   : REM .015 start platter eg 01, 05, 41
8060 REM .016.# heads/drive
   : REM .017 cylinder to start RWC
   : REM .018 # cylinders for alternate sectors
   : REM .019 drive switch setting
   : REM .020-032 reserved for future use
8065 REM .Bytes 033-256 One 16 byte item per surface on drive sss + nnn
   : REM .where sss= start point       nnn=number of sectors
8075 GOSUB 8400
   : REM /.Do display
8080 K$="."
   : PRINT AT(21,0,80);
   : LINPUT "Apply Y or N"-K$
   : IF K$<>"Y"THEN RETURN
8160 GOTO 9000
8240 REM %.Read Configuration file item
   : REM .RETURN X=0 is not an update item
8250 INIT(00)R$()
   : DATA LOAD BA T#1,(A,A)R$()
   : REM /.Read config data
8252 X=0
   : IF STR(R$(),11,3)<>"TBO"THEN X=1
   : IF R$(3)=HEX(00000000000000000000000000000000)THEN X=1
   : RETURN
8260 DATA SAVE DC CLOSE#1
   : RETURN
8270 REM %.Data for DS drives
8280 REM .016.# heads/drive
   : REM .017 cylinder to start RWC
   : REM .018 # cylinders for alternate sectors
   : REM .019 drive switch setting
   : REM .020-032 reserved for future use
8290 DATA HEX(04200202),"10 MB Fixed Hard Disk"
8300 DATA HEX(044D0203),"20 MB Fixed Hard Disk"
8310 DATA HEX(08400404),"32 MB Fixed Hard Disk"
8320 DATA HEX(08FF0805),"64 MB Fixed Hard Disk"
8330 DATA HEX(0EFF0806),"140 MB Fixed Hard Disk"
8340 DATA HEX(04FF0807),"32 MB Fixed Hard Disk"
8350 DATA HEX(0EFF0808),"112 MB Fixed Hard Disk"
8390 REM %^.Display data from '10
8400 RESTORE LINE8290
   : FOR I=4TO 10
   : READ C$(I),D$(I)
   : NEXT I
8410 A=W1
   : INIT(00)W$(),P0$()
   : MAT W=ZER
   : W2=0
   : FOR W=1TO 4
   : INIT(00)W3$
   : GOSUB 8250
   : IF X=0THEN GOSUB 8420
   : NEXT W
   : IF W2>0THEN GOSUB 8510
   : ELSE PRINT "No data"
   : RETURN
8420 W2=W2+1
   : Z=VAL(STR(R$(),16))
   : CONVERT STR(D$(Z),,3)TO X
   : ERRORX=0
8422 IF X=10THEN W(W2)=38912
   : IF X=20THEN W(W2)=38912*2
   : IF X=32THEN W(W2)=65024*2
   : IF X=64THEN W(W2)=65024*4
   : IF X=112OR X=140THEN W(W2)=14*38912
8430 Z=VAL(STR(R$(),14))
   : K$=STR(R$(),15)
8432 IF K$=HEX(01)THEN J=1
   : IF K$=HEX(41)THEN J=15
   : FOR I=1TO Z
   : W$(J)=STR(R$(2+I),4)
   : P0$(J)=BIN(W)
   : J=J+1
   : NEXT I
8435 RETURN
8510 SELECT PRINT 005(80)
   : PRINT HEX(03);AT(23,55);"FN/TAB - Exit";AT(1,8);HEX(0E);
   : H3$=" "
   : GOSUB 8515
   : IF D1=0THEN RETURN
8512 H3$="005"
   : LINPUT "Hard copy to printer"-H3$
   : M$=DATE
   : LINPUT "Remark for hard copy "-M$
   : SELECT PRINT <H3$>
   : PRINT HEX(0D0C);M$
   : GOSUB 8515
   : SELECT PRINT 005
   : RETURN
8515 PRINT "P r o p o s e d   D. S.  S u r f a c e   A s s i g n m e n t s"
8520 X$="123456789ABCDE"
   : INIT(00)W4$(),W5$
8530 IF W2>0THEN 8540
   : PRINT "No Winchester drives in system"
   : STOP #
8540 PRINT W2;"Winchesters with sectors available"
8555 PRINT
   : IF H3$=" "THEN PRINT BOX(2,72)
8560 PRINT " Master disk             Catalog         Slave disk              C
     atalog       "
8570 PRINT " Address                 Maximum         Address                 M
     aximum"
8580 %   ###   #           ###########           ###   #           ###########

8590 FOR I=1TO 14
   : D$,D1$=STR(B$,,2)&STR(X$,I,1)
   : STR(D$,2,1)=STR(D$,2,1)AND HEX(FB)
   : PRINTUSING 8580,D$,VAL(P0$(I)),VAL(W$(I),3),D1$,VAL(P0$(I+14)),VAL(W$(I+1
     4),3)
   : W1$(I)=D$
   : W1$(I+14)=D1$
   : NEXT I
8595 PRINT
8600 RETURN
8800 REM %^.Debugging aids
8810 REM %.Drive status in hex
   : HEXPRINT R$(1)
   : PRINT W(W2);Z;HEXOF(K$)
   : FOR I=1TO Z
   : HEXPRINT W$(I)
   : NEXT I
   : FOR Z=3TO 16
   : IF STR(R$(Z),4,3)>HEX(000000)THEN HEXPRINT R$(Z)
   : NEXT Z
   : INPUT Z
   : RETURN
8820 DEFFN'4
   : PRINT HEX(03)
8823 PRINT "DEBUG AID--NEW STATUS READ = ";HEXOF(G$)
   : PRINT HEXOF(E$)
8824 FOR I=1TO 6
   : PRINT HEXOF(D0$(I));" ";
   : NEXT I
8825 PRINT "Winchester items in Drive sequence "
   : FOR I=1TO 4
   : PRINT HEXOF(STR(D1$(I),,3));".";HEXOF(STR(D1$(I),4)),
   : NEXT I
   : PRINT
8830 PRINT "Interpret status bytes after pickup"
8840 PRINT "xx Surface.Max .1 .2 .3.4.5 .6.7.8 .9.0.1.2.3.4.5.6.7.8"
   : FOR I=1TO 16
   : E$=E$(I)
   : PRINTUSING 8860,I,VAL(STR(E$,6,3),3);
   : PRINT " ";HEXOF(STR(E$,1,1));".";HEXOF(STR(E$,2,1));".";HEXOF(STR(E$,3,3)
     );".";HEXOF(STR(E$,6,3));".";HEXOF(STR(E$,9,10))
   : NEXT I
   : INPUT "Key return for more"I
8850 PRINT "xx Surface.Max .1 .2 .3.4.5 .6.7.8 .9.0.1.2.3.4.5.6.7.8"
   : FOR I=17TO 32
   : E$=E$(I)
   : PRINTUSING 8860,I,VAL(STR(E$,6,3),3);
   : PRINT " ";HEXOF(STR(E$,1,1));".";HEXOF(STR(E$,2,1));".";HEXOF(STR(E$,3,3)
     );".";HEXOF(STR(E$,6,3));".";HEXOF(STR(E$,9,10))
   : NEXT I
   : RETURN
8860 %## ###########
9000 A=W1
   : COM CLEAR F$
   : LOAD T#0,"@DSAPPLY"9020,9999BEG 9005
9005 FOR W=1TO 4
   : INIT(00)W3$
   : GOSUB 8250
   : IF X=0THEN GOSUB 9020
   : NEXT W
9010 GOSUB 8260
   : PRINT AT(23,0,40);"'10 Procedure completed";
   : KEYIN K$
   : GOTO 10
9020 STOP "Covered by @DSAPPLY "#
   : RETURN