image of READY prompt

Wang2200.org

Listing of file='DSTS.010' on disk='vmedia/CS_D_cassette_diags.wvd.zip'

# Sector 334, program filename = 'DSTS.010'
0010 REM ! DSTS.010 -09/20/89 - CS/2200 Cassette test
0020 REM ! Pkg. No. 195-xxxx    Rev.No. 1.0
0030 REM ! Pkg.Name  725-4893  3.5 in.Teac streaming cassette drive diagnostic
0040 REM ! (C) Copyright, Wang Laboratories, Inc., 1989.  All rights reserved.
0050 DIM P$3,P9$16,P8$8,T1$80,T$1,E9$1,F8$1,M9$80
   : F8$=HEX(8B)
   : E9$="N"
   : P$=" "
0060 M9$="Pkg. Name   DS/CSD Teac Streaming cassette drive diagnostic   725-48
     93"
   : GOSUB 700
   : PRINT AT(1,0);"Pkg. No.  195-xxxx  Rev.No. 1.0"
0080 KEYIN T$
0090 REM %.Program control of operation
0100 DIM S3$20
0110 M1=99999999999
   : REM /.Write passes
0120 M2=99999999999
   : REM /.Read verify passes
0130 B9=999999999
0160 IF M1>0THEN 170
   : IF B9>1THEN 170
   : INPUT "Blocks to read",B9
0170 IF M1<0OR M2<0THEN STOP "Put in good values "#
0180 REM %.S.F. Logic
0190 REM %0  '15 SR-Get stati,      '48  Display Phase =
0200 REM %0  '50 Display ln22-23,   '201 Display ln 23
0210 REM %0 '126 FN/TAB,            '127 FN/TAB
0220 REM %0 '202 SR.Read.block,     '203 SR.Write.block
0230 REM %0 '204 Display status
0240 REM %0 '205 SR.Rewind,         '206 SR.Read/verify
0250 REM %0  #1  Tape drive,         #2  Disk surface
0260 REM %.Variable assignments
0270 REM %0 C0$  C0$1,    D0$ YYMMDD,   D1$  Disk.Platter,  D9$  MM/DD/YY
0280 REM %0 B    Cur.block.#,       B9   Max.block.#,   B8  x.512.bytes
0290 REM %0 E1   # DErrs,           E2   #errs.Bad.LRC
0300 REM %0 E3   # Rd.Retries,      E4   # Rd.failures
0310 REM %0 T0$( hh/mm/ss.pre,      T1$( hh-mm-ss.post
0320 DIM T$(100)56,P0
   : IF P0=0THEN INIT(FF)T$()
   : REM %0 T$(  Status collection
   : REM .6 status bytes + IE byte for each of 8 status commands
   : REM T$(P0) status is stored as T$(P0+1) = status
0330 DIM C0$1,T0$(4)2,T1$(4)2
   : REM .HH-mm-ss and Error counters
0340 DIM R$(16)16,S4$(6)8
   : REM %0 R$(  256.byte.w/a,  S4$( status.results
0350 REM % VARIABLE DEFINITIONS
0360 DIM S0$(6)1,S1$(6)1
   : REM %0 S0( Status.0,       S1$(  Status.1
0370 DIM S1$2
   : REM %0 S1$  $2 Match ptr
0380 DIM S$31
   : REM %0 S$   TAPE DRIVE STATUS BUFFER
0390 DIM K
   : REM %0 K  For-Next ctr
0400 DIM D$3
   : REM %0 D$  $3 Tape Address
0410 DIM D4$3
   : REM %0 D4$  $3 DPU RAM disk
0420 DIM K$1
   : REM %0 K$  $1 KEYIN Char
0430 DIM G1$15,G$15
   : REM - $GIO STATUS REGISTERS
0440 DIM D9$9
   : D0$=DATE
   : D9$=STR(D0$,3,2)&"/"&STR(D0$,5,2)&"/"&STR(D0$,,2)
0450 DIM B1$(16,32)16,B$(16,32)16
   : B8=16
   : MAT REDIM B1$(1,32)16,B$(1,32)16
0460 REM %0 B$( 512.byte.block, B1$( 512.byte.block
0470 DIM D1$3
   : REM - SOURCE DISK ADDRESS
0480 DIM B0,E0
   : REM %0 B0 Lo.platter.addr,   E0 Hi.platter.addr
0490 REM WORK VARIABLES
   : DIM W$5
0500 DIM E$1
   : REM %0 E$ Erase/Append
0510 REM messages
   : DIM M$50,M2$50,M1$50
   : REM %0 M$ M$50,  M2$ M2$50,  M1$  M1$50
0520 REM BLOCK# OF LAST DATA BLOCK +1
   : DIM C$3
   : REM %0 C$  Last.data.blk+1
0530 DIM N$49
   : REM %0 N$ Platter.name
0540 DIM S9$5
   : REM %0 S9$ Start.sector
0550 P1=4
   : REM /.Line for phase display
0560 REM %^.Job flow
0570 GOSUB 730
   : REM /.Setup with initial prompts
0580 D9=6
   : IF F9<3THEN PRINT AT(D9,5);"Initial Rewind and Erase"
   : IF F9<3THEN PRINT AT(D9+1,5);"Write ";M8;"Mb tape of canned pattern to ta
     pe"
   : PRINT AT(D9+2,5);"Rewind"
   : IF F9<>2THEN PRINT AT(D9+3,5);"Read/verify"
   : PRINT AT(D9+4,5);"Complete"
0590 R1=12
   : PRINT AT(R1-1,55,160+24);"Data"
   : PRINT AT(R1,25);"Stream  Sector        DErr.#  Compare  #.Read  #.Write"
   : PRINT "                Mb        I / O  Equivalency   Errors  Errors   Re
     trys  Retrys"
   : PRINT AT(D9+5,0);BOX(1,12);" ^ Phases ^"
0600 IF F9>=3THEN 650
   : PRINT AT(D9,0);F8$
   : GOSUB '48("Initial Rewind and Erase")
   : PRINT AT(22,61,19);AT(23,61,19);
   : GOSUB 960
0610 IF M1=0THEN 660
   : REM %Write Phase
   : GOSUB '201("Writing canned pattern to tape")
   : PRINT AT(D9+1,0);F8$
0620 REM .Set start/end counters
   : B,M0,B0=0
   : E0=M8*4096
   : REM /.E0 End = mb*4096 blocks
0630 PRINT AT(15,0);BOX(-1,-79);AT(14,0);BOX(1,79);AT(14,1);"Write Phase"
   : P9=1
0640 GOSUB 1050
   : REM /.Write
   : B9=B
0650 PRINT AT(D9+2,0);F8$
   : GOSUB '205
   : REM /.Rewind
0660 B,M0,B0=0
   : E0=M8*4096
   : REM /.E0 End = mb*4096 blocks
0670 IF F9=2THEN 680
   : PRINT AT(D9+3,0);F8$
   : GOSUB '206
   : REM /.Read/Verify Phase
0680 M$="Stop end of job"
   : GOSUB '48(M$)
   : GOSUB '201(M$)
   : PRINT AT(D9+4,0);F8$;
   : GOSUB 710
   : KEYIN T$
   : GOTO 10
0690 REM %^.Setup with initial prompts
0700 SELECT PRINT 005(80)
   : PRINT HEX(020D0C030F06020402000F);
   : PRINT AT(0,40-LEN(M9$)/2);HEX(0F);M9$;
   : GOSUB '50("(c) Copyright, Wang Laboratories, Inc., 1989","    All rights
     reserved.")
0710 PRINT AT(21,55);"Reset '15 - Status notes";AT(23,61);"FN/TAB - Exit";AT(2
     2,61);"RETURN - Proceed";
   : RETURN
0730 GOSUB 700
0740 D$="D5F"
0750 REM %get tape address
   : PRINT AT(2,12);"Address of tape cassette drive (D5F, D6F, or D7F): ";
   : LINPUT HEX(0E),-D$
   : IF D$="RUN"THEN 740
   : PRINT HEX(06);
   : GOSUB '50(" "," ")
   : $TRAN(D$,"BbDdFf")R
   : IF POS("DB"=STR(D$,1,1))<>0AND POS("567"=STR(D$,2,1))<>0AND STR(D$,3,1)="
     F"THEN 760
   : GOSUB '50(HEX(0E),"Illegal address")
   : GOTO 750
0760 SELECT #1<D$>
   : ERRORGOSUB '50(HEX(0E),"Invalid address")
   : GOTO 750
0770 REM %get tape address status
   : GOSUB '201("Getting tape status")
   : S$=" "
   : $GIOSTATUSREQUEST#1(0E140F0012E20600070070A068D07040682E6816400087051A00C
     340,G$)G$;STR(S$,,VAL(STR(G$,5,1)))
   : ERRORGOTO 810
0780 REM check for timeout
   : T1$=STR(G$,8,1)AND HEX(10)
   : IF STR(T1$,1,1)=HEX(00)THEN 790
   : GOSUB '50(HEX(0E),"Tape cassette drive unavailable")
   : GOTO 750
0790 REM check for tape drive
   : IF STR(S$,2,1)<>"E"THEN 810
0800 REM check for errors
   : IF STR(G$,6,3)=HEX(000000)THEN 830
0810 GOSUB '50(HEX(0E),"Not a DS tape cassette drive")
   : GOTO 750
0820 REM %.Get tape status, rewind if necessary, check cassette type.
0830 GOSUB 1820
   : IF S1$(1)<HEX(FF)THEN 840
   : GOSUB '205
   : GOTO 830
0840 S1$()=S4$(2)
   : IF S1$(1)=HEX(97)THEN T9=2
   : ELSE T9=1
   : IF T9=1THEN M9=45
   : ELSE M9=150
   : PRINT AT(1,30);M9;"Mb type cassette"
0850 PRINT AT(4,0,10*80)
   : IF S1$(1)=HEX(02)OR S1$(1)=HEX(97)THEN 865
   : IF S1$(1)=HEX(17)THEN PRINT AT(3,30);"150 Mb Drive"
   : GOSUB '201("ERROR see reason above")
0860 PRINT AT(6,0);BOX(3,79);AT(7,3);"Tape drive selected will not write to th
     is tape  Mb <> Mb  "
   : PRINT
   : PRINT
   : KEYIN K$
   : F8=1
   : PRINT AT(6,0);BOX(-3,-79)
0862 DATA "ERASE tape, then WRITE worst case pattern, then READ/verify","ERASE
      tape, then WRITE worst case pattern","READ worst case pattern","Read cus
     tomer tape"," "
0865 PRINT AT(1,0);"Drive address = ";D$
   : PRINT AT(2,0,10*80)
   : GOSUB '201("OPERATOR - see prompt above")
0866 PRINT AT(3,0,20*80-20);"Options : "
   : RESTORE LINE862
   : FOR J=1TO 4
   : READ T1$
   : IF F8=1AND J<3THEN T1$="not an option"
   : PRINT J;T1$
   : NEXT J
   : RESTORE LINE862
0867 T$=" "
   : KEYIN T$
   : $TRAN(T$,HEX(0131023203330434))R
   : F9=VAL(T$)
   : IF F9>JTHEN 867
   : IF F8=1AND F9<3THEN 867
   : RESTORE LINE862,F9
   : READ T1$
   : PRINT AT(2,0,10*80);T1$
   : M8=M9
   : ON F9GOTO 870,870,870,940
   : GOTO 867
0870 GOSUB '201("OPERATOR - see prompt above")
   : P9$="29FC29FC29FC29FC"
0880 PRINT AT(4,0);
   : LINPUT "Pattern in hex"-P9$
   : J=LEN(P9$)
   : IF VER(P9$,"HHHHHHHHHHHHHHHH")<16THEN 880
0890 HEXPACKP8$FROMP9$
   : IF F9>2THEN 915
0910 PRINT AT(5,0);"Number of mb to write max=";M9
   : M8=M9
   : INPUT M8
   : IF M8<1OR M8>M9THEN 910
   : M8=INT(M8)
0915 B$()=P8$&".Mb.=.000.Block.=.00000."
   : FOR J=33TO 512STEP 8
   : STR(B$(),J)=P8$
   : NEXT J
   : CONVERT M8TO STR(B$(),15,3),(###)
   : B1$()=B$()
0930 IF M1=0THEN 940
   : IF F9>2THEN 940
   : E9$="Y"
   : %GOSUB '201("OPERATOR - see prompt above"): PRINT AT(8,0);: LINPUT "Erase
      tape ",-E9$
0940 PRINT AT(4,0,10*80)
   : RETURN
0950 REM %^ -------- TAPE OPERATIONS -------
   : PRINT AT(22,61,19);AT(23,61,19);
0960 REM %HOG TAPE DS
   : GOSUB '50(HEX(0E),"Waiting for DS")
   : $OPEN 960,#1
0970 GOSUB '201("Release Tape Buffer")
   : $GIORELEASETAPEBUFFER#1(0600070070A068D07040682E684B8B6740008706,G$)
0980 REM %REWIND TAPE
   : GOSUB '205
0990 REM %.............Bypass Erase...........
1000 IF M1=0THEN 1020
   : IF E9$="N"THEN 1020
1010 REM %erase tape
   : GOSUB '201("Erasing tape")
   : $GIOERASETAPE#1(0600070070A068D07040682E68318B6740008706,G$)
   : IF STR(G$,6,3)<>HEX(000000)THEN 1250
1020 GOSUB '204
   : T1$(),T0$()=TIME
1030 RETURN
1040 REM %^.Write phase BOM-EOM using block writes
1050 REM %NORMALLY external disk
1060 M1$="Move pattern in 512 byte blocks to ... Mb tape"
   : CONVERT M8TO STR(M1$,36,3),(###)
   : GOSUB '48(M1$)
1070 REM 150mb writes to tape after 128*512 byte blocks
   : FOR J=B0TO E0STEP 2
1075 CONVERT M0TO STR(B$(),25,7),(#######)
1080 M0=M0+2
   : IF M0/256=INT(M0/256)THEN DO
   : GOSUB '204
   : B=B+1
   : END DO
1085 PRINT AT(14,15);
   : PRINTUSING "###          ###  #,###,###    ###,###                   ###,
     ###",INT(M0/4096),B,J,E1,E1;
1100 REM write block to tape buffer
   : GOSUB '203
   : IF STR(G$,6,3)<>HEX(000000)THEN 1250
1120 NEXT J
   : GOSUB '204
   : RETURN
1130 REM %^.Block Read or Write
1140 REM %READ BLOCK SUBROUTINE
   : REM Return-  B$()=data block
   : REM   STR(G$,6,1)=error code
   : REM   STR(G$,7,2)=command error
1150 DEFFN'202
   : $GIOREADBLOCK#1(0600070070A068D07040682E684A8B6740008B76D00FC3418B52E00F0
     6260800,G$)B$()
   : IF STR(G$,6,3)<>HEX(260000)THEN RETURN
1160 GOSUB '204
   : REM /.Get status on read retries
1170 REM retry if LRC error
   : FOR I=1TO 16
   : E3=E3+1
   : $GIOREREADBLOCK#1(0600070070A068D07040682E684C8B6740008B76D00FC3418B52E00
     F06260800,G$)B$()
   : IF STR(G$,6,3)<>HEX(260000)THEN 1180
   : GOSUB '204
   : NEXT I
   : E4=E4+1
   : RETURN
1180 I=16
   : NEXT I
   : GOSUB '204
   : RETURN
1190 REM %WRITE BLOCK SUBROUTINE
   : REM Entry-   B$()=data block
   : REM Return-  STR(G$,6,1)=error code
   : REM          STR(G$,7,2)=command error
1200 DEFFN'203
   : $GIOWRITEBLOCK#1(13000600070070A068D07040682E68488B67A0028706,G$)B$()
   : IF STR(G$,6,3)<>HEX(260000)THEN RETURN
   : GOSUB '204
   : I=0
1210 $GIOWRITEBLOCK#1(13000600070070A068D07040682E68488B67A0028706,G$)B$()
   : GOSUB '204
   : IF STR(G$,6,3)<>HEX(260000)THEN RETURN
   : I=I+1
   : IF I<16THEN 1210
   : RETURN
1220 REM %^.Tape Cassette error handling
   : REM STR(G$,6,1) = ERROR CODE
   : REM STR(G$,7,2) = COMMAND ERROR
1230 REM if nonrecoverable error,
   : GOTO 1520
1240 REM if recoverable error,
   : GOTO 1700
1250 RETURN CLEAR ALL
   : IF STR(G$,7,2)=HEX(0000)THEN 1260
   : M$="Tape Command Error"
   : GOTO 1520
1260 K$=STR(G$,6,1)
   : ON POS(HEX(919395969899)=K$)GOTO 1270,1290,1280,1300,1320,1310
   : GOTO 1330
1270 M$="ERROR I91:  Disk Drive Not Ready"
   : GOTO 1520
1280 M$="ERROR I95:  Device Error"
   : GOTO 1520
1290 M$="ERROR I93:  Format Error"
   : GOTO 1520
1300 M$="ERROR I96:  Data Error"
   : GOTO 1520
1310 M$="ERROR I99:  Read After Write Error"
   : GOTO 1520
1320 M$="ERROR I98:  Illegal Sector Address or No Platter"
   : GOTO 1520
1330 ON VAL(K$)-15GOTO 1350,1360,1370,1380,1390,1400,1410,1420,,,1430,1440,145
     0,,,,1460,,,1470,1480,,1490,1500
1340 M$="ERROR:  Device Error"
   : GOTO 1520
1350 GOSUB '50("ERROR T10:  No Tape Cassette","Mount tape cassette and press
     RETURN")
   : GOTO 1700
1360 M$="ERROR T11:  No Tape Cassette Drive"
   : GOTO 1520
1370 GOSUB '50("ERROR T12:  Write Protect","Unprotect tape cassette and press
      RETURN")
   : GOTO 1700
1380 M1$=" "
   : M$="GOOD PASS:  End Of Tape"
   : GOTO 1520
   : REM %.Loop to next pass
1390 M$="ERROR T14:  Unrecoverable Data Error"
   : GOTO 1520
1400 M$="ERROR T15:  Bad Data Block"
   : GOTO 1520
1410 M$="ERROR T16:  Bad Block"
   : GOTO 1520
1420 M$="ERROR T17:  No Data"
   : GOTO 1520
1430 M$="ERROR T1A:  Unexpected File Mark Read"
   : GOTO 1520
1440 M$="ERROR T1B:  Illegal Command"
   : GOTO 1520
1450 M$="ERROR T1C:  Power On/Reset"
   : GOTO 1520
1460 M$="ERROR T20:  Invalid Number of File Marks"
   : GOTO 1520
1470 M$="ERROR T23:  Insufficient Buffer Space"
   : GOTO 1520
1480 M$="ERROR T24:  Tape Drive Error"
   : GOTO 1520
1490 M$="ERROR T26:  LRC Error"
   : GOTO 1520
1500 M$="ERROR T27:  Device Error"
   : GOTO 1520
1510 REM %Disk error
   : M$="ERROR I##:  Disk Error"
   : CONVERT ERRTO STR(M$,8,2),(##)
   : GOTO 1520
1520 REM %Nonrecoverable error
   : M1$="Tape backup aborted copying"
   : GOSUB '50(M1$,M$)
   : PRINT HEX(07);
1530 %STOP #
1540 REM %RESTART OR EXIT?
   : GOSUB 710
1550 REM %.Enter verify phase
1560 T1$()=TIME
   : GOSUB '204
   : PRINT "Pass completion on: ";M$
   : IF P$<>" "THEN GOSUB 2270
1570 H1,H2,H3=0
1580 IF T0$(1)=T1$(1)THEN 1590
   : CONVERT T0$(1)TO T0
   : CONVERT T1$(1)TO T1
   : H1=T1-T0
1590 IF T0$(2)=T1$(2)THEN 1600
   : CONVERT T0$(2)TO T0
   : CONVERT T1$(2)TO T1
   : H2=T1-T0
1600 IF T0$(3)=T1$(3)THEN 1610
   : CONVERT T0$(3)TO T0
   : CONVERT T1$(3)TO T1
   : H3=T1-T0
1610 IF H3<0THEN DO
   : H3=H3+60
   : H2=H2-1
   : END DO
   : IF H2<0THEN DO
   : H2=H2+60
   : H1=H1-1
   : END DO
   : IF H1<=-24THEN H1=0
1620 IF P9=2THEN 1630
   : P9=2
1630 E1=0
   : IF M2=0THEN 1640
   : M2=M2-1
   : GOSUB '206
   : REM /.Read/Verify
1640 B9=B
   : M0,B=0
   : E1,E2,E3,E4=0
   : $CLOSE#1
   : RETURN
1650 KEYIN K$,,1660
   : IF K$=HEX(0D)THEN 730
   : GOTO 1650
1660 IF K$<>HEX(7E)AND K$<>HEX(7F)THEN 1650
1670 REM %.FN/TAB exit
1680 DEFFN'127
1690 DEFFN'126
   : LOAD RUN "@MENU"
1700 REM %recoverable tape error
   : GOSUB 710
1710 KEYIN K$,,1720
   : IF K$=HEX(0D)THEN 10
   : GOTO 1710
1720 IF K$<>HEX(7E)AND K$<>HEX(7F)THEN 1710
   : GOTO 1690
1730 REM %^.48 Display Phase =
1740 DEFFN'48(M1$)
   : PRINT AT(P1,0,80);TAB(36-LEN(M1$)/2);HEX(0E);"Phase = ";M1$;HEX(0F)
   : RETURN
1750 DEFFN'49(M1$)
   : PRINT AT(D9,0,80);"   ";M1$
   : D9=D9+1
   : RETURN
1760 REM %'50 - display message at lower left corner (lines 22,23)
1770 DEFFN'50(M1$,M2$)
   : PRINT AT(22,0);STR(M1$);AT(23,0);STR(M2$);HEX(0F);
   : RETURN
1780 REM %'201 - display message at lower left corner (line 23)
1790 DEFFN'201(M$)
   : PRINT AT(23,0);HEX(0E);STR(M$);HEX(0F);
   : RETURN
1800 REM %^.'204 -- Display status on lines 19-21
1810 DEFFN'204
1820 $IF OFF /001,1830
   : KEYIN T$
   : ON POS(HEX(F0507E7F0D)=T$)GOTO 1822,1822,1680,1680,1820
   : GOTO 1820
1822 REM .CANCEL
   : RETURN CLEAR
   : GOTO 10
1830 $BREAK
   : S0$(),S1$()=ALL(FF)
   : $GIOREADSTATUS#1(0600070070A068D07040682E68378B674000870687051A00C340,G1$
     )G1$;STR(S0$(),,VAL(STR(G1$,5,1)))
   : ERRORGOTO 1820
1840 $GIOREADEXTENDEDSTATUS#1(0600070070A068D07040682E683E8B674000870687051A00
     C340,G1$)G1$;STR(S1$(),,VAL(STR(G1$,5,1)))
1850 IF S0$()=S1$()AND S1$()=HEX(FFFFFFFFFFFF)THEN RETURN
   : S4$(1)=S0$()
   : S4$(2)=S1$()
1860 X=VAL(STR(S4$(1),3),2)
   : IF T9=1THEN E1=E1+X
   : ELSE E1=X
   : REM .DErr#
1870 %X=VAL(STR(S4$(1),5),2): IF X>0THEN E(2)=X: REM .UErr#
1880 T0$=TIME
1890 PRINT AT(17,0,460);"Tape Drive status after ";M$,"At ";STR(T0$,,2);":";ST
     R(T0$,3,2);":";STR(T0$,5,2)
   : P=0
   : PRINT AT(18,P);".0 .1 .2 .3 .4 .5"
1900 PRINT AT(19,P);
   : FOR A=1TO 6
   : PRINT HEXOF(S0$(A));" ";
   : NEXT A
   : PRINT AT(20,P);"S0 S1 DErr# UErr#";AT(21,P);
1910 IF STR(S0$(),,2)=HEX(0000)THEN 2060
   : K$=STR(S0$(1))
1920 K1$=K$AND HEX(40)
   : IF K1$>HEX(00)THEN PRINT "CNI ";
1930 K1$=K$AND HEX(20)
   : IF K1$>HEX(00)THEN PRINT "USL ";
1940 K1$=K$AND HEX(10)
   : IF K1$>HEX(00)THEN PRINT "WRP ";
1950 K1$=K$AND HEX(08)
   : IF K1$>HEX(00)THEN PRINT "EOM ";
1960 K1$=K$AND HEX(04)
   : IF K1$>HEX(00)THEN PRINT "UDA ";
1970 K1$=K$AND HEX(02)
   : IF K1$>HEX(00)THEN PRINT "BNL ";
1980 K1$=K$AND HEX(01)
   : IF K1$>HEX(00)THEN PRINT "FIL ";
1990 K$=STR(S0$(2))
   : PRINT AT(22,P);
2000 K1$=K$AND HEX(40)
   : IF K1$>HEX(00)THEN PRINT "ILL ";
2010 K1$=K$AND HEX(20)
   : IF K1$>HEX(00)THEN PRINT "NDT ";
2020 K1$=K$AND HEX(10)
   : IF K1$>HEX(00)THEN PRINT "MBD ";
2030 K1$=K$AND HEX(08)
   : IF K1$>HEX(00)THEN PRINT "BOM ";
2040 K1$=K$AND HEX(04)
   : IF K1$>HEX(00)THEN PRINT "BPE ";
2050 K1$=K$AND HEX(01)
   : IF K1$>HEX(00)THEN PRINT "POR ";
2060 REM %."Get Extended Status"
   : P=19
2070 PRINT AT(18,P);".0 .1 .2 .3 .4 .5"
2080 PRINT AT(19,P);
   : FOR A=1TO 6
   : PRINT HEXOF(S1$(A));" ";
   : NEXT A
   : PRINT AT(20,P);"ID FS Mo Taddress";AT(21,P);
2090 K$=S1$(2)
   : IF K$=HEX(00)THEN 2160
2100 K1$=K$AND HEX(40)
   : IF K1$>HEX(00)THEN PRINT "ROM ";
2110 K1$=K$AND HEX(20)
   : IF K1$>HEX(00)THEN PRINT "RAM ";
2120 K1$=K$AND HEX(10)
   : IF K1$>HEX(00)THEN PRINT "BUF ";
2130 K1$=K$AND HEX(08)
   : IF K1$>HEX(00)THEN PRINT "STL ";
2140 K1$=K$AND HEX(04)
   : IF K1$>HEX(00)THEN PRINT "BOT ";
2150 K1$=K$AND HEX(02)
   : IF K1$>HEX(00)THEN PRINT "DRV ";
2160 IF T9=1THEN RETURN
   : IF S1$(1)=HEX(02)THEN RETURN
2170 P=40
   : C0$=HEX(C9)
   : GOSUB 2220
   : S4$(3),S0$()=S3$
   : C0$=HEX(CB)
   : GOSUB 2220
   : S4$(4),S1$()=S3$
   : GOSUB 2260
2180 PRINT AT(19,P-3);"C9=";HEX(0808080A);"CB="
2190 P=62
   : C0$=HEX(CC)
   : GOSUB 2220
   : S4$(5),S0$()=S3$
   : C0$=HEX(CD)
   : GOSUB 2220
   : S4$(6),S1$()=S3$
   : GOSUB 2260
2200 PRINT AT(19,P-3);"CC=";HEX(0808080A);"CD="
2210 RETURN
2220 STR(G2$,,2)=HEX(2E)&C0$
2230 $GIODIAGNOSTICCOMMAND#1(0600070070A068D070406A10681E6A20870340008704,G2$)
2240 $GIODIAGNOSTICCOMMAND#1(0600070070A068D070406A10681F400087021A00C640,G2$)
     G2$;STR(S3$,,VAL(STR(G2$,2,1)))
2250 RETURN
2260 PRINT AT(18,P);".0 .1 .2 .3 .4 .5"
   : PRINT AT(19,P);
   : FOR A=1TO 6
   : PRINT HEXOF(S0$(A));" ";
   : NEXT A
   : PRINT AT(20,P);
   : FOR A=1TO 6
   : PRINT HEXOF(S1$(A));" ";
   : NEXT A
   : RETURN
2270 SELECT PRINT <P$>
   : PRINT "Program at ";M$;M1$
   : PRINT "------.0 .1 .2 .3 .4 .5  .0 .1 .2 .3 .4 .5 Status results"
   : PRINT "C0,C8=";
   : Z=1
   : GOSUB 2280
   : PRINT "C9,CB=";
   : Z=3
   : GOSUB 2280
   : PRINT "CC,CD=";
   : Z=5
   : GOSUB 2280
   : SELECT PRINT 005
   : RETURN
2280 S0$()=S4$(Z)
   : S1$()=S4$(Z+1)
   : FOR A=1TO 6
   : PRINT HEXOF(S0$(A));" ";
   : NEXT A
   : FOR A=1TO 6
   : PRINT " ";HEXOF(S1$(A));
   : NEXT A
   : PRINT
   : RETURN
2290 REM %^.'205 Rewind
2300 DEFFN'205
2310 GOSUB '201("Rewinding tape")
   : $GIOREWINDTAPE#1(0600070070A068D07040682E68308B6740008706,G$)
   : IF STR(G$,6,3)<>HEX(000000)THEN 1250
2320 GOSUB '204
2330 GOSUB '201("Set Industry Mode/for 17 tracks")
   : $GIOSETINDUSTRYMODE#1(0600070070A068D07040682E68398B6740008706,G$)
   : GOSUB '204
2340 RETURN
2350 REM %^.'206 Read / Verify
2360 DEFFN'206
   : M1$="READ verify pass -- ... Mb"
   : CONVERT M8TO STR(M1$,21,3),(###)
   : GOSUB '48(M1$)
2370 GOSUB '201("READ/verify")
   : PRINT AT(14,0);BOX(-1,-79);AT(15,0);BOX(1,79);AT(15,1);M$
2375 IF F9<>3THEN 2390
   : INIT(00)B$()
   : GOSUB '202
   : STR(B1$(),15,3)=STR(B$(),15,3)
   : CONVERT STR(B$(),15,3)TO J
   : IF M8>JTHEN M8=J
   : E0=M8*4096
   : PRINT AT(D9+3,25);M8;"Mb"
2380 REM %.Read/verify block by block -- 5 seconds per block
2390 FOR J=B0TO E0-2STEP 2
   : IF F9=3AND J=B0THEN 2420
   : INIT(00)B$()
2400 GOSUB '202
   : REM .Read a block from tape
2410 IF F9=4THEN 2440
2420 CONVERT M0TO STR(B1$(),25,7),(#######)
2430 IF B$()<>B1$()THEN E2=E2+1
2440 M0=M0+2
   : IF M0/256=INT(M0/256)THEN DO
   : GOSUB '204
   : B=B+1
   : IF B>=B9THEN J=E0
   : END DO
2450 PRINT AT(15,15);
   : PRINTUSING "###          ###  #,###,###    ###,###  ###,###  ###,###  ###
     ,###",INT(M0/4096),B,J,E1,E2,E1," "
2460 NEXT J
   : GOSUB '204
   : RETURN
3000 DEFFN'15
   : PRINT HEX(03);BOX(2,40);
3001 IF S0$(1)=HEX(FF)THEN GOSUB '204
3002 P=2
   : PRINT AT(0 ,P);
   : FOR A=1TO 6
   : PRINT HEXOF(S0$(A));" ";
   : NEXT A
   : PRINT AT(1,P);"S0 S1 DErr# UErr#"
   : P=22
   : PRINT AT(0,P);
   : FOR A=1TO 6
   : PRINT HEXOF(S1$(A));" ";
   : NEXT A
   : PRINT AT(1,P);"ID FS Mo Taddress"
3005 PRINT AT(3,0);" S0 Status byte 0"," S1 Status byte 1"
3010 PRINT "'40' CNI Cassette not in place","'40' ILL Illegal command"
3020 PRINT "'20' USL Unselected device    ","'20' NDT No data detected"
3030 PRINT "'10' WRP Write Protected      ","'10' MMD Marginal block detected"
3040 PRINT "'08' EOM End of Media         ","'08' BOM Beginning of media     "
3050 PRINT "'04' UDA Unrecover.Data Error ","'04' BPE Buss Parity Error      "
3060 PRINT "'02' BNL Bad Block not Located","'02'     Always zero            "
3070 PRINT "'01' FIL File Mark Detected   ","'01' POR Power On (RESET) occured
     "
3075 PRINT "DErr# is a retry counter","UErr# is underrun counter"
3080 PRINT
3110 PRINT "FS  is Fault Status","ID  is drive & cassette information"
3111 PRINT "'40' ROM fault after reset","    shown on menu after selection."
3112 PRINT "'20' RAM fault after reset"
3113 PRINT "'10' BUFfer fault after reset"
3114 PRINT "'08' STL STALL tape did not move after motion command"
3115 PRINT "'04' BOT Drive failed to detect EOT, BOT, or clear leader"
3116 PRINT "'02' DRV Drive fault"
3120 PRINT "Mo  is Mode  0=Industry  1=Wang"
3130 PRINT "Taddress is tape track number"
3140 KEYIN K$
3150 GOTO 10