Listing of file='DSTSCMDS' on disk='vmedia/CS_D_cassette_diags.wvd.zip'
# Sector 156, program filename = 'DSTSCMDS'
0010 REM % DSTSCMDS 05/11/89 TBO
: REM WRITTEN BY DAVID M. BARRETT 07/29/86
: REM MODIFIED BY ROGER M. KIRK 01/09/87
: REM MODIFIED BY BP (new GIOs) 4/17/87
: REM
0015 DIM W$1,W2$2
0020 DIM A$1,R$3,R1$1,S$3,S1$5,S2$2,S$(1)64,B$2,B1$,B$(512)1,C$(512)1,T$80
0022 DIM K$1,K1$1,T$(3)2,T0$(3)2,T1$(3)2,T2$2,Z$80
0035 DIM G$16
: DIM R$(16)16,M$1,F$3,C0$1,C2$2
0040 SELECT PRINT 005(80),LIST 005(80)
0070 REM ********************
: REM % GET TAPE DRIVE ADDRESS
: T$="T A P E C O M M A N D S"
: PRINT HEX(0D030202000F020402000F06);AT(0,40-LEN(T$)/2);T$;
0080 R$="D5F"
: PRINT AT(3,0);"Tape cassette drive address:";
: LINPUT -R$
: $TRAN(R$,"DdFf")R
: SELECT #2<R$>
: ERRORGOTO 80
0085 S$()=ALL(FF)
: $GIO DXF STATUS #2 (0600 0700 70A0 68D0 7040 682E 6816 4000 8705 1A00 C34
0, G$)G$;STR(S$(),,VAL(STR(G$,5,1)))
: R0$=STR(S$(),5,1)&"."& STR(S$(),4,1)
: PRINT "PROM Rev= ";R0$
: IF R0$>="2.3"THEN R0=1
0090 STR(G$,1,1) = HEX(0E) OR HEX(20)
0110 DIM C$100
: C$="SF commands"
: GOTO 120
0112 REM %^.Next command
0115 IF C$<>"SF commands" THEN 130
: PRINT AT(17,20);"Press any key to continue";
: KEYIN A$
0120 RETURN CLEAR ALL
: PRINT HEX(030D);
: GOSUB 820
0125 PRINT AT(22,68);"SF - Command";AT(23,64);"FN/TAB - Exit";
0130 IF C$<>"SF commands" THEN 205
: KEYIN A$,,140
: GOTO 130
0140 ON VAL(A$)+1GOTO 240,260,280,770,560,580,500,370,660,740,420,520,460,440,
540,819,,,,790,600,620,1200,300,640,1300,350,,3000,720,,160
0142 REM .Enhancements for single commands, view status, and peek
0145 IF R0=1THEN ON POS(HEX(1011121B1E)=A$)GOSUB 2000,2100,2400,2600,2200
: GOTO 130
0159 REM %Command String
0160 C$=HEX(130003040808080508080883)
: REM drive status, rewind, Wang mode, rewind,read block 3 times , goto l
ast rewind
0170 C$=HEX(0D00030105181A04060D18181A05060D181A0508)
0180 C=0
: C1=11
0185 K$=HEX(00)
: FOR A=0TO 15
: PRINT AT(A,35);HEXOF(K$);
: ADD(K$,01)
: NEXT A
: FOR A=0TO 15
: PRINT AT(A,77);HEXOF(K$);
: ADD(K$,01)
: NEXT A
0190 PRINT AT(16,0,80);"Commands: ";
: FOR C=1 TO LEN(C$)
: PRINT " ";HEXOF(STR(C$,C,1));
: NEXT C
: C=0
0200 PRINT AT(20,20);"Press any key to execute command";
: KEYIN A$
0205 C=C+1
: A$=STR(C$,C,1)
: IF A$>=HEX(80) THEN 210
: IF A$<>" " THEN 140
: C1=0
: C$="SF commands"
: GOTO 130
0210 REM branch (command >= hex(80))
: REM branch is to command - hex(80) in command string
: C=VAL(A$)-128
: GOTO 205
0215 DEFFN'100
: REM .Show after
: T1$()=TIME
: PRINT AT(21,0);" Error code: ";HEXOF(STR(G$,6,1));AT(22,0);"Command err
or: ";HEXOF(STR(G$,7,1));AT(23,3);"GIO status: ";HEXOF(STR(G$,8,1));
0216 H,M,S=0
: IF STR(T0$(),,6)=STR(T1$(),,6)THEN 221
0217 IF T0$(1)=T1$(1)THEN 218
: CONVERT T0$(1)TO T0
: CONVERT T1$(1)TO T1
: H=T1-T0
0218 IF T0$(2)=T1$(2)THEN 219
: CONVERT T0$(2)TO T0
: CONVERT T1$(2)TO T1
: M=T1-T0
0219 IF T0$(3)=T1$(3)THEN 220
: CONVERT T0$(3)TO T0
: CONVERT T1$(3)TO T1
: S=T1-T0
0220 IF S<0THEN DO
: S=S+60
: M=M-1
: END DO
: IF M<0THEN DO
: M=M+60
: H=H-1
: END DO
: IF H=-24THEN H=0
0221 PRINT AT(20,3);
: PRINTUSING " TIME = ## : ## : ##",H,M,S
0222 K$=STR(G$,6)
: HEXUNPACKK$TO T2$
: RESTORE LINE995
0223 Z$="ERROR -- Note after a terminal RESET you must '0 Rewind"
: E=1
: IF T2$="1A"THEN E=2
: IF STR(G$,8,1)=HEX(04)THEN 225
0224 READ Z$
: IF Z$=" "THEN 226
: IF STR(Z$,2,2)<>T2$THEN 224
: E=0
0225 PRINT AT(21,20);Z$
0226 IF E>0THEN PRINT HEX(07);
: PRINT AT(22,65);HEX(05);
: RETURN
0230 DEFFN'101(T$)
: REM .Show before
: T1$()=TIME
0232 $BREAK
: T0$()=TIME
: IF T0$()=T1$()THEN 232
: IF C1=0THEN 234
: PRINT AT(16,C1-1);HEX(89);
: C1=C1+3
0234 PRINT AT(17,0,4*80);AT(19,0);HEX(0E);T$;HEX(0F);AT(21,0,79);" Error cod
e: ";AT(22,0,68);"Command error: ";AT(23,3,50);"GIO status: ";
: RETURN
0239 REM %^- TAPE OPERATIONS -
0240 DEFFN'0
: REM **********************
: REM % Rewind tape
: GOSUB '101("Rewind Tape")
0250 $GIO REWIND TAPE #2 (0600 0700 70A0 68D0 7040 682E 6830 8B67 4000 8706, G
$)
: GOSUB '100
: GOTO 130
0260 DEFFN'1
: REM **********************
: REM % ERASE TAPE
: GOSUB '101("Erase Tape")
0270 $GIO ERASE TAPE #2 (0600 0700 70A0 68D0 7040 682E 6831 8B67 4000 8706, G$
)
: GOSUB '100
: GOTO 130
0280 DEFFN'2
: REM **********************
: REM % RETENSION TAPE
: GOSUB '101("Retension Tape")
0290 $GIO RETENSION TAPE #2 (0600 0700 70A0 68D0 7040 682E 6832 8B67 4000 8706
, G$)
: GOSUB '100
: GOTO 130
0300 REM **********************
: REM % BACKUP SECTORS
: GOSUB '101("Backup Sectors")
: PRINT AT(17,20);"Source platter address?";
: LINPUT -S$
: STR(G$,4,1)=BIN(VAL(STR(S$,3,1))-48)
: IF STR(S$,2,1)>"4"THEN STR(G$,4,1)=STR(G$,4,1)OR HEX(10)
0310 PRINT AT(18,20);"Starting sector address";
: INPUT S1
: IF S1 <0THEN 310
: IF S1>65535THEN 310
: STR(G$,2,2) = BIN(S1,2)
0320 PRINT AT(19,20);"Number of sectors to backup";
: INPUT S2
: STR(G$,11,2) =BIN(S2,2)
0340 $GIO BACKUP SECTORS #2 (0600 0700 70A0 68D0 7040 682E 6833 6A40 6800 6A20
6230 8B67 6AB0 6AC0 8B67 4000 8706, G$)
: GOSUB '100
: GOTO 130
0350 REM **********************
: REM % WRITE FILE MARK
: GOSUB '101("Write File Mark")
0360 $GIO WRITE FILE MARK #2 (0600 0700 70A0 68D0 7040 682E 6834 8B67 4000 870
6, G$)
: GOSUB '100
: GOTO 130
0370 REM **********************
: REM % RESTORE SECTORS
: GOSUB '101("Restore Sectors")
: PRINT AT(17,20);"Destination platter address?";
: LINPUT -S$
: STR(G$,4,1)=BIN(VAL(STR(S$,3,1))-48)
: IF STR(S$,2,1)>"4"THEN STR(G$,4,1)=STR(G$,4,1)OR HEX(10)
0380 PRINT AT(18,20);"Starting sector address";
: INPUT S1
: IF S1 <0THEN 310
: IF S1>65535THEN 310
: STR(G$,2,2) = BIN(S1,2)
0390 PRINT AT(19,20);"Number of sectors to restore";
: INPUT S2
: STR(G$,11,2)=BIN(S2,2)
0410 $GIO RESTORE SECTORS #2 (0600 0700 70A0 68D0 7040 682E 6835 6A40 6800 6A2
0 6230 8B67 6AB0 6AC0 8B67 4000 870B 870C 8706, G$)
: PRINT AT(19,20,50);"Number of sectors restored ";VAL(STR(G$,11,2))
: GOSUB '100
: GOTO 130
0420 REM **********************
: REM % READ FILE MARK
: GOSUB '101("Read File Mark")
0430 $GIO READ FILE MARK #2 (0600 0700 70A0 68D0 7040 682E 6836 8B67 4000 8706
, G$)
: GOSUB '100
: GOTO 130
0440 REM **********************
: REM % READ TAPE STATUS
: GOSUB '101("Get Tape Drive Status")
0441 S$()=ALL(FF)
: $GIO READ STATUS #2 (0600 0700 70A0 68D0 7040 682E 6837 8B67 4000 8706 87
05 1A00 C340 , G$)G$;STR(S$(),,VAL(STR(G$,5,1)))
0442 IF STR(G$,8,1)=HEX(04)THEN 559
0443 PRINT AT(18,39);".0 .1 .2 .3 .4 .5"
: PRINT AT(19,30);"Status: ";
: FOR A=1TO 6
: PRINT HEXOF(STR(S$(),A,1));" ";
: NEXT A
: PRINT AT(20,39);"S0 S1 DErr# UErr#";AT(21,39);
0444 K$=STR(S$(),,1)
0445 K1$=K$AND HEX(40)
: IF K1$>HEX(00)THEN PRINT "CNI ";
0446 K1$=K$AND HEX(20)
: IF K1$>HEX(00)THEN PRINT "USL ";
0447 K1$=K$AND HEX(10)
: IF K1$>HEX(00)THEN PRINT "WRP ";
0448 K1$=K$AND HEX(08)
: IF K1$>HEX(00)THEN PRINT "EOM ";
0449 K1$=K$AND HEX(04)
: IF K1$>HEX(00)THEN PRINT "UDA ";
0450 K1$=K$AND HEX(02)
: IF K1$>HEX(00)THEN PRINT "BNL ";
0451 K1$=K$AND HEX(01)
: IF K1$>HEX(00)THEN PRINT "FIL ";
0452 K$=STR(S$(),2,1)
: PRINT AT(22,39);
0453 K1$=K$AND HEX(40)
: IF K1$>HEX(00)THEN PRINT "ILL ";
0454 K1$=K$AND HEX(20)
: IF K1$>HEX(00)THEN PRINT "NDT ";
0455 K1$=K$AND HEX(10)
: IF K1$>HEX(00)THEN PRINT "MBD ";
0456 K1$=K$AND HEX(08)
: IF K1$>HEX(00)THEN PRINT "BOM ";
0457 K1$=K$AND HEX(04)
: IF K1$>HEX(00)THEN PRINT "BPE ";
0458 K1$=K$AND HEX(01)
: IF K1$>HEX(00)THEN PRINT "POR ";
0459 GOSUB '100
: GOTO 130
0460 REM **********************
: REM %get /DxF STATUS
: GOSUB '101("Get /DxF Status")
0465 PRINT AT(18,39);".1.2.3.4.5.6.7.8.9.!.1.2.3.4.5.6.7"
0470 S$()=ALL(FF)
: $GIO DXF STATUS #2 (0600 0700 70A0 68D0 7040 682E 6816 4000 8705 1A00 C34
0, G$)G$;STR(S$(),,VAL(STR(G$,5,1)))
: PRINT AT(19,30);"Status: ";HEXOF(STR(S$(),1,VAL(STR(G$,5,1))))
0475 PRINT AT(20,40);
: FOR A=1 TO 5
: PRINT STR(S$(),A,1);" ";
: NEXT A
: GOSUB '100
: GOTO 130
0480 REM **********************
: REM % WRITE W/O UNDERRUNS
: GOSUB '101("Write Without Underruns")
0490 $GIO WRITE WITHOUT UNDERRUN #2 (0600 0700 70A0 68D0 7040 682E 6838 8B67
4000 8706, G$)
: GOSUB '100
: GOTO 130
0500 REM **********************
: REM % SEEK END OF DATA
: GOSUB '101("Seek End of Data")
0510 $GIO SEEK END OF DATA #2 (0600 0700 70A0 68D0 7040 682E 683A 8B67 4000
8706, G$)
: GOSUB '100
: GOTO 130
0520 REM **********************
: REM % READ n FILE MARKS
: GOSUB '101("Read N File Marks")
: PRINT AT(17,20);"Number of file marks to read";
: INPUT S1
: STR(G$,2,1)=BIN(S1)
0530 $GIO READ N FILE MARKS #2 (0600 0700 70A0 68D0 7040 682E 683B 8B67 6A20 4
000 8706, G$)
: GOSUB '100
: GOTO 130
0540 REM **********************
: REM % READ EXTENDED STATUS
: GOSUB '101("Get Extended Status")
: S$()=ALL(FF)
0545 $GIO READ EXTENDED STATUS #2 (0600 0700 70A0 68D0 7040 682E 683E 8B67 400
0 8706 8705 1A00 C340, G$)G$;STR(S$(),,VAL(STR(G$,5,1)))
0550 IF STR(G$,8,1)=HEX(04)THEN 559
0551 PRINT AT(18,39);".0 .1 .2 .3 .4 .5"
: PRINT AT(19,30);"Status: ";
: FOR A=1TO 6
: PRINT HEXOF(STR(S$(),A,1));" ";
: NEXT A
: PRINT AT(20,39);"ID FS Mo Taddress";AT(21,39);
0552 K$=STR(S$(),2,1)
0553 K1$=K$AND HEX(40)
: IF K1$>HEX(00)THEN PRINT "ROM ";
0554 K1$=K$AND HEX(20)
: IF K1$>HEX(00)THEN PRINT "RAM ";
0555 K1$=K$AND HEX(10)
: IF K1$>HEX(00)THEN PRINT "BUF ";
0556 K1$=K$AND HEX(08)
: IF K1$>HEX(00)THEN PRINT "STL ";
0557 K1$=K$AND HEX(04)
: IF K1$>HEX(00)THEN PRINT "BOT ";
0558 K1$=K$AND HEX(02)
: IF K1$>HEX(00)THEN PRINT "DRV ";
0559 GOSUB '100
: GOTO 130
0560 REM **********************
: REM % SEEK BLOCK
: GOSUB '101("Seek Block")
: PRINT AT(17,20);"Data block to find";
: S1=0
: IF C$="SF commands" THEN INPUT S1
: IF S1>4294967295 THEN 560
: IF S1<0THEN 560
: STR(G$,4,2)=BIN(MOD(S1,65536),2)
: STR(G$,2,2)=BIN(INT(S1/65536),2)
0570 $GIO SEEK BLOCK #2 (0600 0700 70A0 68D0 7040 682E 683F 8B67 6800 6A30 6A4
0 6A50 4000 8706, G$)
: GOSUB '100
: GOTO 130
0580 REM **********************
: REM % SEEK DIRECTORY BLOCK
: GOSUB '101("Seek Directory Block")
: PRINT AT(17,20);"Directory block to find";
: S1=0
: IF C$="SF commands" THEN INPUT S1
: IF S1>4294967295 THEN 580
: IF S1<0THEN 580
: STR(G$,4,2)=BIN(MOD(S1,65536),2)
: STR(G$,2,2)=BIN(INT(S1/65536),2)
0590 $GIO SEEK DIRECTORY BLOCK #2 (0600 0700 70A0 68D0 7040 682E 683F 8B67 680
1 6A30 6A40 6A50 4000 8706, G$)
: GOSUB '100
: GOTO 130
0600 REM **********************
: REM % SELECT DRIVE
: GOSUB '101("Select Drive")
: PRINT AT(17,20);"Number of drive to select";
: INPUT S1
: IF S1>4 THEN 600
: IF S1<1THEN 600
: STR(G$,2,1)=BIN(S1)
0610 $GIO SELECT DRIVE #2 (0600 0700 70A0 68D0 7040 682E 6845 8B67 6A20 8B67 4
000 8706, G$)
: GOSUB '100
: GOTO 130
0620 REM **********************
: REM % SELECT DRIVE/LOCK CARTRIDGE
: GOSUB '101("Select Drive with Lock")
: PRINT AT(17,20);"Number of drive to select";
: INPUT S1
: IF S1>4 THEN 620
: IF S1<1THEN 620
: STR(G$,2,1)=BIN(S1)
0630 $GIO SELECT DRIVE LOCK CARTRIDGE #2 (0600 0700 70A0 68D0 7040 682E 6846 8
B67 6A20 8B67 4000 8706, G$)
: GOSUB '100
: GOTO 130
0640 REM **********************
: REM % WRITE BLOCK
: GOSUB '101("Write Block")
: PRINT AT(17,20);"Byte to fill block with";
: LINPUT -STR(B$,1,2)
: HEXPACKB1$FROMB$
: C$()=ALL(B1$)
0650 $GIO WRITE BLOCK #2 (0600 0700 70A0 68D0 7040 682E 6848 8B67 A002 8706, G
$)STR(C$(),1,512)
: GOSUB '100
: GOTO 130
0660 REM **********************
: REM % READ BLOCK
: GOSUB '101("Read Block")
: B$()=ALL(00)
0670 $GIO READ BLOCK #2 (0600 0700 70A0 68D0 7040 682E 684A 8B67 4000 8B76 D00
F C341 8B52 E00F 0626 0800, G$)STR(B$(),1,512)
0680 GOSUB '100
0690 IF E<>0THEN 698
: PRINT AT(0,0,1360);
: FOR X=1 TO 512 STEP 32
: PRINT HEXOF(STR(B$(),X,16));" ";HEXOF(STR(B$(),X+16,16));" Byte =";X-1
: NEXT X
0698 GOTO 115
0720 REM **********************
: REM % RELEASE TAPE BUFFER
: GOSUB '101("Release Tape Buffer")
0730 $GIO RELEASE TAPE BUFFER #2 (0600 0700 70A0 68D0 7040 682E 684B 8B67 4000
8706, G$)
: GOSUB '100
: GOTO 130
0740 REM **********************
: REM % REREAD BLOCK
: GOSUB '101("Reread Block")
0750 $GIO REREAD BLOCK #2 (0600 0700 70A0 68D0 7040 682E 684C 8B67 4000 8B76 D
00F C341 8B52 E00F 0626 0800, G$)STR(B$(),1,512)
0760 GOTO 680
0770 REM **********************
: REM % SELECT WANG FORMAT
: GOSUB '101("Select Wang Mode")
0780 $GIO SELECT WANG MODE #2 (0600 0700 70A0 68D0 7040 682E 6838 8B67 4000 87
06, G$)
: GOSUB '100
: GOTO 130
0790 REM **********************
: REM % SELECT INDUSTRY FORMAT
: GOSUB '101("Select Industry Mode")
0800 $GIO SELECT INDUSTRY MODE #2 (0600 0700 70A0 68D0 7040 682E 6839 8B67 400
0 8706, G$)
: GOSUB '100
: GOTO 130
0819 DEFFN'15
: GOSUB 820
: GOTO 125
0820 REM %^.Display commands
: PRINT HEX(06);AT(0,0,80*16);
: RESTORE LINE 870
: DIM N$40
0830 FOR I=0 TO 31
: READ N$
: PRINT AT(MOD(I,16),40*INT(I/16));
: PRINTUSING "'## - ",I;
: PRINT N$;
: NEXT I
0840 FOR I=0 TO 16 STEP 4
: PRINT AT(I,0);BOX(0,80);
: NEXT I
0845 T$=ALL(HEX(C3))
: PRINT HEX(0202020F);T$;HEX(0202000F);
0850 RETURN
0860 REM %Command names (in SF key order)
0870 DATA "Rewind","Erase","Retension","Wang Mode"
0880 DATA "Seek Block","Seek Directory Block","Seek End of Data","Restore Sect
ors"
0890 DATA "Read Block","Reread Block","Read File Mark","Read N File Marks"
0900 DATA "/DxF Status","Tape Drive Status","Extended Status","MENU"
0910 REM " "," "," ","Industry Mode"
0911 DATA "1 BYTE COMMAND - NO RETURN","1 BYTE COMMAND - STATUS RETURN","VIEW
LAST STATUS","Industry Mode"
0920 DATA "Select Drive","Select Drive with Lock","Read N blocks","Backup"
0930 DATA "Write Block","Write N blocks","Write File Mark","READ DS MEMORY"
0940 REM " ","Release Tape Buffer"," ","Command String"
0941 DATA "VIEW STATUS MEANINGS","Release Tape Buffer","VIEW BUS","Command Str
ing"
0990 REM %.Status returns
0995 DATA "T00 O.K."
1000 DATA "T10 No Tape Cassette","T11 No Tape Cassette Drive","T12 Write Prote
ct","T13 End of Tape","T14 Unrecoverable data error","T15 Bad Data Block"
,"T16 ??","T17 No Data","T1A File Mark Read","T1B Illegal Command","T1C P
ower on/RESET"
1010 DATA "T20 Invalid Number of File Marks","T23 Insufficient Buffer Space","
T24 Tape Drive Error","T26 LRC Error","T27 Device Error"
1020 DATA "T32 No BOT, EOT or clear leader"
1100 DATA " "
1190 REM %^.Read N blocks
1200 GOSUB '101("Read N blocks")
: PRINT AT(17,20);
: S1=0
: INPUT "Number of blocks to read",S1
1210 FOR A=1TO S1
: PRINT AT(18,30);A
: $GIO READ BLOCK #2 (0600 0700 70A0 68D0 7040 682E 684A 8B67 4000 8B76 D00
F C341 8B52 E00F 0626 0800, G$)STR(B$(),1,512)
: GOSUB '100
: IF T2$<>"00"THEN A=S1
: NEXT A
: GOTO 130
1300 GOSUB '101("Write N blocks")
: PRINT AT(17,20);
: S1=0
: INPUT "Number of blocks to write",S1
1310 C0$=HEX(00)
: FOR A=1TO 512
: STR(C$(),A,1)=C0$
: ADD(C0$,01)
: NEXT A
1320 FOR A=1TO S1
: PRINT AT(19,30);A
: $GIO WRITE BLOCK #2 (0600 0700 70A0 68D0 7040 682E 6848 8B67 A002 8706, G
$)STR(C$(),1,512)
: GOSUB '100
: NEXT A
: GOTO 130
1890 STOP #
1900 REM %^.Cassette commands put into DS Prom R2.3
2000 REM %.Send a single op code -- get no return
2008 GOSUB '200("Send single op code -- get no return",HEX(011121222460A0A362D
0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF))
2010 REM NO ACTION TAKEN AFTERWARD. FOR STATUS
2020 REM COMMANDS - USE STATUS-ISSUING COMMAND.
2030 REM
2060 STR(G$,1,1)=HEX(2E)
2070 STR(G$,2,1)=C0$
: REM TEAC COMMAND BYTE
2080 $GIO DIAGNOSTIC COMMAND #2(0600 0700 70A0 68D0 7040 6A10 681D 6A20 8703 4
000 8704,G$)
2085 GOTO 2155
2090 GOTO 2230
2100 REM %.Send a single op code (STATUS) -- Return data to DS memory
2128 GOSUB '200("Send single op code (STATUS) -- return of data to DS memory",
HEX(C0C8C9CBCCCDF3CF))
2130 STR(G$,1,1)=HEX(2E)
2140 STR(G$,2,1)=C0$
: REM STATUS COMMAND
2150 $GIO DIAGNOSTIC COMMAND #2(0600 0700 70A0 68D0 7040 6A10 681E 6A20 8703 4
000 8704 ,G$)
2155 PRINT AT(18,0,440);"Command ";HEXOF(C0$);" issued -- View BUS status = ";
: GOTO 2230
2160 REM
2200 REM %.Receive BUS status direct from TEAC
2220 PRINT AT(18,0,440);"View BUS status = ";
2230 STR(G$,1,1)=HEX(2E)
2240 $GIO DIAGNOSTIC COMMAND #2(0600 0700 70A0 68D0 7040 6A10 681B 4000 8702 ,
G$)
2250 HEXPRINT STR(G$,2,1)
2360 PRINT " PER XFR REQ ONL DIR EXC RDY ACK"
: M$=HEX(80)
2370 FOR I = 1 TO 8
: W$=STR(G$,2,1)AND M$
: IF W$>HEX(00)THEN PRINT " * ";
: ELSE PRINT " ";
: ROTATE(M$,-1)
: NEXT I
: RETURN
2390 REM %^
2400 REM %.Fetch STATUS from DS memory as left by others
2410 DIM S9$20
: REM %0 S9$ PEEK ARG
2420 PRINT AT(18,0,460);"Retrieve status left by others"
2430 STR(G$,1,1)=HEX(2E)
2440 $GIO DIAGNOSTIC COMMAND #2(0600 0700 70A0 68D0 7040 6A10 681F 4000 8702 1
A00 C640 ,G$)G$;STR(S9$,,VAL(STR(G$,2,1)))
2450 REM HEXPRINT STR(G$,2,1)
: REM TOTAL NUMBER OF BYTES TO RECEIVE
2460 REM HEXPRINT STR(S9$,,-1+VAL(STR(G$,2,1)))
: REM ALL OF THE BYTES EXCEPT LAST I.E. STATUS
2470 REM HEXPRINT STR(S9$,VAL(STR(G$,2,1)),1)
: REM LAST BYTE IF=0 THEN STATUS IS OLD IF=1 THEN STATUS IS NEW!
2500 PRINT ".0 .1 .2 .3 .4 .5 IE if 00=Old Status if 01=New status"
: FOR X=1 TO VAL(STR(G$,2))
: PRINT HEXOF(STR(S9$,X,1));" ";
: NEXT X
: RETURN
2600 REM %.DSTEST01 - READS DS MEMORY - FOR DIAGNOSTIC USE ONLY
2610 REM
2640 STR(G$,1,1)=HEX(20)
2650 STR(G$,2,2)=HEX(0000)
: REM ADDRESS (HH LL)
2660 STR(G$,4,1)=HEX(00)
: REM BANK
2665 PRINT HEX(01);AT(18,0,460);"Read DS memory "
: PRINT "Enter hex address";
: LINPUT -A6$
: IF A6$=" "THEN 2830
: HEXPACK W2$ FROM A6$
2670 STR(G$,2,2)=W2$
2680 $GIO PEEK #2(0600 0700 70A0 68D0 7040 6A10 6827 6A40 6A20 6230 8705 1704
1156 1576 4000 8367 C640 870B ,G$)R$()
2690 FOR I = 1 TO 256 STEP 16
: PRINT HEXOF(W2$);" ";
: W1$=STR(R$(),I,16)
: FOR X=1TO 16
: PRINT HEXOF(STR(W1$,X,1));" ";
: ADDC(W2$,01)
: IF X=8THEN PRINT " ";
: NEXT X
: PRINT " ";
: FOR X=1 TO 16
: W$=STR(W1$,X,1)
: IF W$>HEX(0F)AND W$<HEX(80) THEN PRINT W$;
: ELSE PRINT ".";
: NEXT X
: PRINT
: NEXT I
2700 PRINT "Pause"
: ADD(STR(G2$,2,1),01)
: KEYIN W$
: IF W$=HEX(0D)THEN 2670
: PRINT HEX(03);
: RETURN CLEAR
: GOTO 819
2790 RETURN
2800 DEFFN'200(Z$,G$)
: PRINT HEX(01);AT(18,0,460);Z$
: PRINT "Legal values are ";
: FOR X=1 TO LEN(G$)
: PRINT HEXOF(STR(G$,X,1));" ";
: NEXT X
: PRINT
: C2$=" "
2805 LINPUT "Enter command "-C2$
2808 IF C2$=" "THEN 2830
: IF VER(C2$,"HH")<>2 THEN 2805
2810 HEXPACK C0$ FROM C2$
2820 IF POS(G$=C0$)=0THEN 2805
: RETURN
2830 RETURN CLEAR
: GOTO 125
3000 DEFFN'28
: PRINT AT(0,0,16*80);" 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
"
3200 KEYIN K$
3900 GOTO 819