Listing of file='@DSCFIG' on disk='vmedia/CS_D_cassette_diags.wvd.zip'
# Sector 99, program filename = '@DSCFIG'
0010 REM ! @DSCFIG - 09/13/88 DISPLAY DS CONFIGURATION
: REM written by Roger M. Kirk Jr. 02/24/87 TBO mods
: REM ! (c) Copyright, Wang Laboratories, Inc., 1987. All rights reserved.
0020 REM %variables
: DIM E$32,E$(32)32,P$32,G$(32)3,D$(16)40,P(16),H$(32)1,P1$2,B$3,T$80,M1$50
,M2$50,G1$1,D$3,K$1,Z4$4,G$17,P0$(32)1
0030 P$=HEX(10000102030405060708090A0B0C0D0E10000102030405060708090A0B0C0D0E)
0040 H$()="0123456789ABCDEF0123456789ABCDEF"
0050 RESTORE
0060 FOR I = 1 TO 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=1 THEN 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., 1987"," All rights
reserved.")
0115 B$="D10"
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))<>0 AND POS("123"=STR(B$,2,1))<>0 AND 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
0140 D$="D"&STR(B$,2,1)&"0"
0145 IF V=0THEN PRINT AT(21,58);"RUN - Expand display";AT(22,64);"Restart Prog
ram"
0150 REM %get DS status for each possible platter
0160 GOSUB '50(HEX(0E),"Getting device status")
: GOSUB 760
0240 REM %DS software version
: PRINT AT(8,15,60);
: M2$=" Protocol level: "&STR(E$(1),3,1)
: M1$="DS PROM revision level: "&STR(E$(1),4,2)
: GOSUB '50(M1$,M2$)
: PRINT AT(1,0);
0245 IF STR(E$(),4,2)>"01"THEN V1=1
: IF V=1 THEN GOSUB 3010
0250 REM %display info. on each drive
: FOR I=1 TO 32
: IF I=17 THEN STR(D$,2,1)=OR HEX(04)
: GOSUB '120 (STR(E$(I),2,1))
: NEXT I
0260 REM %get user command
: KEYIN K$,,270
: IF K$=HEX(82)THEN GOSUB 3005
: IF K$<>HEX(0D)THEN 260
: GOTO 10
0270 IF K$=HEX(7F) OR K$=HEX(7E) THEN 410
: GOTO 260
0280 REM %display info. on drive i
0290 DEFFN'120 (G1$)
: IF STR(G$(I),3,1)=HEX(04)THEN 380
0300 MAT SEARCH H$(),=G1$ TO P1$
: IF P1$=HEX(0000)THEN GOTO 380
: P=VAL(P1$,2)
0310 PRINT BOX(2,75);
0320 PRINT HEX(0E20);STR(D$(P));HEX(0F);
: IF STR(E$(I),17,1)=HEX(00)THEN 325
0321 PRINT HEX(0E);"failed built-in test"
: GOTO 330
0325 PRINT "with"; VAL(STR(E$(I),6,3),3);"sectors";
: IF P(P)>1 THEN PRINT "/platter"
: ELSE PRINT
0330 IF I<32 THEN 350
0340 PRINT " Address: ";
: GOTO 360
0350 IF P(P)=1THEN PRINT " 1 platter: ";
: ELSE PRINTUSING 420;P(P);
0360 FOR P1=1TO P(P)
: PRINT " ";STR(D$,1,2);H$(I+P1-1);
: NEXT P1
: PRINT
: PRINT
0370 I=I+P(P)-1
0380 RETURN
0390 REM %exit
0400 DEFFN'127
0410 DEFFN'126
: LOAD RUN "@MENU"
0420 % ## platters:
0430 REM %data
0440 DATA "RAM Disk",1
0450 DATA "Unknown",1
0460 DATA "10 MB Removable Hard Disk",1
0470 DATA "10 MB Fixed Hard Disk",1
0480 DATA "20 MB Fixed Hard Disk",2
0490 DATA "32 MB Fixed Hard Disk",2
0500 DATA "64 MB Fixed Hard Disk",4
0510 DATA "140 MB Fixed Hard Disk",14
0520 DATA "32 MB Fixed Hard Disk",2
0530 DATA "112 MB Fixed Hard Disk",7
0540 DATA "Unknown",1
0550 DATA "Unknown",1
0560 DATA "Unknown",1
0570 DATA "Unknown",1
0580 DATA "Streaming Cassette Tape Drive",1
0590 DATA "Diskette Drive",1
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
0700 GOSUB '50(HEX(0E),"Getting device status")
: STR(B$,2,1)=STR(B$,2,1)AND HEX(33)
: SELECT #2<B$>
0760 FOR I = 1 TO 32
: STR(G$,1,1)=STR(P$,I,1)OR HEX(20)
: IF I<>17 THEN 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)
: $GIO STATUS REQUEST #2 (0E14 0F00 12E2 0600 0700 70A0 4002 88D0 7040 6A10
6816 4000 8705 1A00 C340, G$)G$;STR(E$,,VAL(STR(G$,5,1)))
: IF STR(E$,2,1)=HEX(00)THEN STR(E$,18,1)=HEX(00)
0790 G1$=STR(G$,8,1) AND HEX(10)
: IF G1$=HEX(00) THEN 800
: GOSUB '50(HEX(0E),"Disk unavailable")
: RETURN CLEAR ALL
: GOTO 120
0800 IF STR(G$,8,1)<>HEX(00) THEN 810
: IF STR(E$,1,1)=HEX(33)THEN 830
: IF I=32 AND STR(E$,1,2)=HEX(4533) THEN 820
0810 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
3000 REM %^.Examine disk addresses
3005 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"
3020 PRINT AT(2,40);BOX(2,0);AT(2,0);BOX(2,79)
3030 PRINT " Disk Index Current Catalog Pro- Disk Index Current C
atalog Pro- "
3040 PRINT " Address Size End Maximum tect Address Size End M
aximum 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 V GOSUB 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=00
: IF STR(D$,2)>"4"THEN R=R+40
: PRINT AT(R1+3,R);
3170 Z8$=" "
: GOSUB '200(D$,X$())
: ON X4 GOSUB 3290,3300,3310,3330
3180 IF E=48THEN 3220
: IF E=91THEN 3220
3190 PRINTUSING " ### ",D$;
3195 K$=STR(E$(J),18)
3200 IF J=1AND E=98THEN Z8$="Door open or no diskette"
3210 K$=K$AND HEX(83)
: $TRAN(K$,HEX(23005301530253034880488148824883))R
: STR(X$(J),4)=K$
3212 IF V1=1THEN GOSUB 7135
: IF A>0THEN 3213
: C$=" No"
: B,C=0
: GOTO 3215
3213 C$=" "
: CONVERT ATO C$,(###)
: IF STR(A$(),,1)>HEX(00)THEN STR(C$,4)="'"
3214 IF STR(C$,,1)="0"THEN STR(C$,,POS(C$>"0")-1 )=" "
3215 IF Z8$="Yes"THEN PRINTUSING 3250,C$,B,C,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 % ##### ####### ####### ####
3280 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
3340 DEFFN '200 (D$,X$())
3350 X4=0
: MAT SEARCH X$(),=STR(D$,,3)TO X7$ STEP 4
: IF VAL(X7$,2)=0 THEN 3460
: SELECT #2 <D$>
: ERRORX=ERR
: RETURN
3360 $OPEN 3450,#2
: ERRORX4=2
: RETURN
3370 $CLOSE#2
: Z$=" "
: HEXPACK Z$ FROM STR(D$,2,1)
: IF J=1THEN GOSUB 3470
3380 $GIO (7310 0200 0301 1222 70A0 4000 8600,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 E TO STR(Z8$,7,2),(##)
: Z8$=Z7$
: IF E<>85THEN RETURN
3410 Z8$="Yes"
: E=0
3420 DATA LOAD BA T#2,(0)A$()
3430 A=VAL(STR(A$(1),2))
: B=VAL(STR(A$(1),3),2)-1
: C=VAL(STR(A$(1),5),2)-1
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=1 TO 16
: X$(A+16)=Z2$&STR(X4$,A,1)
: NEXT A
: RETURN
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=34
: 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=1 TO 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 I GOTO 7010,10
: ON I GOTO 7200,7010
: STOP #
7190 REM %^.Apply Protection desired
: REM .D$() = surfaces V$() = Protection
7200 PRINT AT(22,64,15);"Proceed"
: FOR I=1 TO 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$FROM STR(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 $GIO PROTECT OR ENABLE PLATTER #1(0600 0700 70A0 68D0 7040 6A10 681C 4220
4000,G$)
7270 RETURN