image of READY prompt

Wang2200.org

Listing of file='@DSTAPEB' on disk='vmedia/CS_D_cassette_diags.wvd.zip'

# Sector 26, program filename = '@DSTAPEB'
0010 REM ! @DSTAPEB -09/20/89 - Backup Disk Platters to Cassette Utility
0020 REM !          - Release 2.+
0030 REM ! (C) Copyright, Wang Laboratories, Inc., 1987.  All rights reserved.
0040 REM % IF DISK ACCESS CONCURRENT WITH BACKUP IS DESIRED, COMMENT OUT OR
   : REM % REMOVE THE '$OPEN' IN THE LINE \D2\C5\C6\C5\D2\C5\CE\C3\C5\C4 IN TH
     E NEXT INSTRUCTION
   : ON 0 GOTO 800
0050 REM % AND IF MAXIMUM INTERLEAVE IS DESIRED - ALSO REMOVE 'ON 999' FROM TH
     E LINE
   : REM % WHICH IS \D2\C5\C6\C5\D2\C5\CE\C3\C5\C4 IN THE NEXT INSTRUCTION
   : ON 0 GOTO 1080
0060 REM % VARIABLE DEFINITIONS
0070 DIM S$(32)64
   : REM PLATTER LIST TO BACK UP (64-byte directory entries)
   : REM   str(s$(i),1,49) = name/description
   : REM   str(s$(i),50,3) = ascii disk address
   : REM   str(s$(i),53,2) = starting sector (binary)
   : REM   str(s$(i),55,2) = ending sector (binary)
0080 REM   str(s$(i),57,4) = starting block on tape (binary)
   : REM   str(s$(i),61,4) = ending block on tape (binary)
0090 DIM S1$2
   : REM - MATSEARCH RECEIVER FOR S$()
0110 DIM S$31
   : REM - TAPE DRIVE STATUS BUFFER
0120 DIM K
   : REM - FOR...NEXT LOOP INDEX VARIABLES
0130 DIM D$3
   : REM - TAPE DRIVE ADDRESS
0140 DIM K$1
   : REM - KEYIN BYTE
0150 DIM G$15
   : REM - $GIO STATUS REGISTERS
0155 DIM D9$9
   : G$=DATE
   : D9$=STR(G$,3,2)&"/"&STR(G$,5,2)&"/"&STR(G$,,2)
0160 DIM B$(8)64
   : REM - 512-BYTE BLOCK BUFFER
0170 DIM D1$3,D3$3
   : REM - SOURCE DISK ADDRESS
0180 DIM B0,E0
   : REM - LIMITS OF PLATTER
0190 REM WORK VARIABLES
   : DIM W$5
0200 REM ERASE / APPEND FLAG
   : DIM E$1
0210 REM TEMPORARY
   : DIM T1$80,T$1
   : T$=" "
0220 REM messages
   : DIM M$50,M2$50,M1$50
0230 REM BLOCK# OF LAST DATA BLOCK +1
   : DIM C$3
0240 REM platter name
   : DIM N$49
0250 REM starting sector
   : DIM S9$5
0260 REM % MAINLINE
0270 SELECT PRINT 005(80)
   : PRINT HEX(020D0C030F06020402000F);
   : D3$=" "
0280 T1$="B a c k u p   D i s k   P l a t t e r s   T o   C a s s e t t e"
   : PRINT AT(0,40-LEN(T1$)/2);HEX(0F);T1$;
0290 GOSUB '50("(c) Copyright, Wang Laboratories, Inc., 1988","    All rights
     reserved.")
0300 PRINT AT(23,61);"FN/TAB - Exit";AT(22,61);"RETURN - Proceed";
0305 D$="D5F"
0310 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 305
   : PRINT HEX(06);
   : GOSUB '50(" "," ")
   : $TRAN(D$,"BbDdFf")R
   : IF POS("DB"=STR(D$,1,1))<>0 AND POS("567"=STR(D$,2,1))<>0 AND STR(D$,3,1)
     ="F" THEN 320
   : GOSUB '50(HEX(0E),"Illegal address")
   : GOTO 310
0320 SELECT #1 <D$>
   : ERRORGOSUB '50(HEX(0E),"Invalid address")
   : GOTO 310
0330 REM %get tape address status
   : GOSUB '201("Getting tape status")
   : S$=" "
   : $GIO STATUS REQUEST #1(0E14 0F00 12E2 0600 0700 70A0 68D0 7040 682E 6816
     4000 8705 1A00 C340, G$) G$; STR(S$,,VAL(STR(G$,5,1)))
   : ERRORGOTO 370
0340 REM check for timeout
   : T1$=STR(G$,8,1) AND HEX(10)
   : IF STR(T1$,1,1)=HEX(00) THEN 350
   : GOSUB '50(HEX(0E),"Tape cassette drive unavailable")
   : GOTO 310
0350 REM check for tape drive
   : IF STR(S$,2,1)<>"E" THEN 370
0360 REM check for errors
   : IF STR(G$,6,3)=HEX(000000)THEN 380
0370 GOSUB '50(HEX(0E),"Not a DS tape cassette drive")
   : GOTO 310
0380 GOSUB '50(" "," ")
0390 REM % APPEND / ERASE FLAG
0400 E$="E"
   : PRINT AT(3,22);"Append onto tape or Erase tape (A or E): ";HEX(0E);
   : LINPUT -E$
   : PRINT HEX(06);
   : $TRAN(E$,"AaEe")R
   : IF E$<>"E" AND E$<>"A" THEN 400
0410 REM % PLATTER DATA
   : PRINT AT(7,2);"\A0\A0\A0\A0\A0\A0\A0\A0\CE\E1\ED\E5\A0\F4\EF\A0\E2\E5\A0\
     F0\F5\F4\A0\E9\EE\A0\D4\E1\F0\E5\A0\C4\E9\F2\E5\E3\F4\EF\F2\F9\A0\A0\A0\A
     0\A0\A0\A0\A0\A0 \D0\EC\E1\F4\F4\E5\F2 \D3\F4\E1\F2\F4 \A0\C5\EE\E4\A0 \A
     0\A0\CD\E2\A0\A0"
   : R=7
   : K=0
   : S$(),N$=" "
0420 REM %get platter address
   : PRINT AT(5,0,80);"Address of disk platter to backup (blank, if no more):
     ";
   : LINPUT HEX(0E),-D1$
   : PRINT HEX(06);
   : GOSUB '50(" "," ")
0430 IF D1$<>" "THEN 460
0440 IF K>0THEN 790
0450 GOSUB '50(HEX(0E),"A minimum of 1 platter is needed for backup")
   : GOTO 420
0460 $TRAN(D1$,"AaBbCcDdEeFf")R
   : IF D1$="340" THEN 470
   : IF POS("DB3"=STR(D1$,1,1))<>0 AND POS("123567"=STR(D1$,2,1))<>0 AND VER(S
     TR(D1$,3,1),"H")<>0 AND D1$<>"D5F" AND D1$<>"D6F" AND D1$<>"D7F" THEN 470
   : GOSUB '50(HEX(0E),"Illegal disk platter address")
   : GOTO 420
0470 IF POS("3B"=STR(D1$,1,1))=0 OR POS("123"=STR(D1$,2,1))=0 OR STR(D1$,3,1)<
     >"0" THEN 480
   : IF STR(D1$,1,1)="3" THEN STR(D1$,3,1)="1"
   : STR(D1$,1,1)="D"
0480 SELECT #2 <D1$>
   : ERRORGOSUB '50(HEX(0E),"Invalid address")
   : GOTO 420
0490 IF K<32 THEN 500
   : GOSUB '50("Exceeded number of platters allowed","Complete backup; then,
     append additional platters")
   : D1$=" "
   : GOTO 420
0500 MAT SEARCH STR(S$(),50),=D1$TO S1$STEP 64
   : IF S1$=HEX(0000)THEN 520
0510 PRINT AT(5,0,80);"Platter /";D1$;" already in list.  Do you wish it again
     ? ";
   : K$="N"
   : LINPUT HEX(0E)-K$
   : IF K$="Y" OR K$="y" THEN 520
   : GOTO 420
0520 REM UPDATE DISPLAY
   : R=R+1
   : IF R<=19 THEN 550
0530 R=8
   : PRINT AT(R,0,1120);AT(R+12,72);BOX(0,-5);AT(R,53);"/";STR(S$(K),50,3);AT(
     R,2);STR(S$(K),,49);AT(R,60);
   : PRINTUSING "#####",VAL(STR(S$(K),53,2),2);
   : PRINT AT(R,66);
   : PRINTUSING "#####",VAL(STR(S$(K),55,2),2);
   : PRINT AT(R,72);
   : PRINTUSING "###.#",ROUND(((VAL(STR(S$(K),55,2),2)-VAL(STR(S$(K),53,2),2)+
     1)/4096,1);
0540 M=0
   : FOR Z=1TO K
   : M=M+1+VAL(STR(S$(Z),55,2),2)-VAL(STR(S$(Z),53,2),2)
   : NEXT Z
   : PRINT AT(R+1,72);BOX(0,5);
   : PRINTUSING "###.#";ROUND( (M/4096,1);
   : R=R+1
0550 PRINT AT(R,53);"/";D1$
   : K=K+1
0560 STR(S$(K),50,3)=D1$
0565 N$=D9$
0570 REM % GET PLATTER NAME/DESCRIPTION
   : PRINT AT(5,0,80);"Platter name: ";
   : LINPUT HEX(0E),-N$
   : STR(S$(K),,49)=N$
   : PRINT HEX(06);AT(R,2,49);N$;
0580 REM % GET START SECTOR ADDRESS
   : S9$="00000"
0590 PRINT AT(5,0,80);"Starting sector (default = beginning of platter): ";
   : LINPUT HEX(0E),-S9$
   : PRINT HEX(06);
   : GOSUB '50(" "," ")
0600 CONVERT S9$ TO W
   : ERRORGOSUB '50(HEX(0E),"Illegal sector address")
   : GOTO 590
0610 IF W>=0 AND W<65536 AND INT(W)=W THEN 620
   : GOSUB '50(HEX(0E),"Illegal sector address")
   : GOTO 590
0620 DATA LOAD BA T#2,(W) STR(B$(),,256)
   : ERRORM2$="Error xx reading starting sector"
   : CONVERT ERR TO STR(M2$,7,2),(##)
   : GOSUB '50(HEX(0E),M2$)
   : K=K-1
   : R=R-1
   : GOTO 420
0630 STR(S$(K),53,2)=BIN(W,2)
   : PRINT AT(R,60);
   : PRINTUSING "#####",W;
   : B0=W
0640 REM % GET END SECTOR ADDRESS
   : DATA LOAD BA T#2,(0) STR(B$(),,256)
   : ERRORM2$="Error xx reading sector 0"
   : CONVERT ERR TO STR(M2$,7,2),(##)
   : GOSUB '50(HEX(0E),M2$)
   : GOTO 590
0650 W=VAL(STR(B$(),3,2),2)
   : CONVERT W-1 TO W$,(#####)
0660 PRINT AT(5,0,80);"Ending sector (default = current end of catalogued data
     ): ";
   : LINPUT HEX(0E),-W$
   : PRINT HEX(06);
   : GOSUB '50(" "," ")
0670 CONVERT W$ TO W
   : ERRORGOSUB '50(HEX(0E),"Illegal sector address")
   : GOTO 660
0680 IF W>=0 AND W<65536 AND INT(W)=W THEN 690
   : GOSUB '50(HEX(0E),"Illegal sector address")
   : GOTO 660
0690 DATA LOAD BA T#2,(W) STR(B$(),,256)
   : ERRORM2$="Error xx reading ending sector"
   : CONVERT ERR TO STR(M2$,7,2),(##)
   : GOSUB '50(HEX(0E),M2$)
   : GOTO 660
0700 STR(S$(K),55,2)=BIN(W,2)
   : PRINT AT(R,66);
   : PRINTUSING "#####",W;
0710 PRINT AT(R,72);BOX(0,-5);
0720 PRINT AT(R+1,72);BOX(0,5);AT(R,72);
   : PRINTUSING "###.#",ROUND(((1+W-VAL(STR(S$(K),53,2),2))/4096,1);
0730 M=0
   : FOR Z=1TO K
   : M=M+1+VAL(STR(S$(Z),55,2),2)-VAL(STR(S$(Z),53,2),2)
   : NEXT Z
   : PRINT AT(R+1,72);
   : PRINTUSING "###.#";ROUND( (M/4096,1);
0740 IF B0<W THEN 750
   : GOSUB '50(HEX(0E),"Start sector >= end sector")
   : GOTO 590
0750 PRINT AT(5,0,80);"Accept this entry ?";
   : K$="Y"
   : LINPUT HEX(0E)-K$
   : IF K$="Y" OR K$="y" THEN 420
0760 PRINT AT(R,0,80);AT(R+1,72,6);BOX(0,-5);
   : S$(K)=" "
   : R=R-1
   : K=K-1
   : IF K=0THEN 420
0770 M=0
   : FOR Z=1TO K
   : M=M+1+VAL(STR(S$(Z),55,2),2)-VAL(STR(S$(Z),53,2),2)
   : NEXT Z
   : PRINT AT(R+1,72);BOX(0,5);
   : PRINTUSING "###.#";ROUND( (M/4096,1);
0780 GOTO 420
0790 REM %---------- TAPE OPERATIONS -----------------------------------------
     ---
   : PRINT AT(22,61,19);AT(23,61,19);
   : D3$=" "
0800 REM %HOG TAPE DS
   : GOSUB '50(HEX(0E),"Waiting for DS")
   : $OPEN 800,#1
   : REM %COMMENT OUT OR REMOVE THE '$OPEN' IF CONCURRENT ACCESS DESIRED!
0810 REM %REWIND TAPE
   : GOSUB '201("Rewinding tape")
   : $GIO REWIND TAPE #1 (0600 0700 70A0 68D0 7040 682E 6830 8B67 4000 8706, G
     $)
   : IF STR(G$,6,3)<>HEX(000000) THEN 1430
0820 REM %erase or retension?
   : IF E$="A" THEN 910
0830 REM %NEW TAPE
   : REM erase and initialize directory
0840 REM %erase tape
   : GOSUB '201("Erasing tape")
   : $GIO ERASE TAPE #1 (0600 070070A0 68D0 7040 682E 6831 8B67 4000 8706, G$)
   : IF STR(G$,6,3)<>HEX(000000) THEN 1430
0850 REM %position to beginning of tape directory
   : GOSUB '201 ("Positioning to tape directory")
   : STR(G$,3,3)=HEX(000000)
   : $GIO SEEK DIRECTORY BLOCK #1 (0600 0700 70A0 68D0 7040 682E 683F 8B67 680
     1 6A30 6A40 6A50 4000 8706, G$)
   : IF STR(G$,6,3)<>HEX(000000) THEN 1430
0860 REM %write tape directory label
   : B$()="TAPE DIRECTORY LABEL"
   : STR(B$(),33,32)="TYPE 1.1:  PLATTER BACKUP"
   : STR(B$(),65,32)="WRITTEN BY:  WANG DS"
   : STR(B$(),97,32)="UTILITY DATE:  03/20/87"
   : GOSUB '201 ("Writing tape directory label")
0870 REM write block to tape buffer
   : GOSUB '203
   : IF STR(G$,6,3)<>HEX(000000) THEN 1430
0880 REM write file mark
   : $GIO WRITE FILE MARK #1 (0600 0700 70A0 68D0 7040 682E 6834 8B67 4000 870
     6, G$)
   : IF STR(G$,6,3)<>HEX(000000) THEN 1430
0890 REM block# of next block to be written
   : C$=HEX(000000)
   : GOTO 1010
0900 REM %OLD TAPE
0910 REM %already retensioned?
   : IF T$="T" THEN 930
0920 REM %retension tape
   : GOSUB '50(HEX(0E),"Retensioning tape")
   : $GIO RETENSION TAPE #1 (0600 0700 70A0 68D0 7040 682E 6832 8B67 4000 8706
     , G$)
   : IF STR(G$,6,3)<>HEX(000000) THEN 1430
   : T$="T"
0930 REM %appending onto a tape
   : REM read tape directory to determine last data block written
0940 REM %position to beginning of tape directory
   : GOSUB '201 ("Positioning to tape directory")
   : STR(G$,3,3)=HEX(000000)
   : $GIO SEEK DIRECTORY BLOCK #1 (0600 0700 70A0 68D0 7040 682E 683F 8B67 680
     1 6A30 6A40 6A50 4000 8706, G$)
   : IF STR(G$,6,3)<>HEX(000000) THEN 1430
0950 REM %READ TAPE DIRECTORY
   : GOSUB '201 ("Reading tape directory")
   : C$=HEX(000000)
0960 REM read tape directory label (1st block)
   : GOSUB '202
   : IF STR(G$,6,3)<>HEX(000000) THEN 1430
0970 IF STR(B$(),1,32)="TAPE DIRECTORY LABEL" AND STR(B$(),33,32)="TYPE 1.1:
     PLATTER BACKUP" THEN 980
   : M$="Data on tape is not from backup"
   : GOTO 1700
0980 REM read directory block
   : GOSUB '202
   : IF STR(G$,6,3)<>HEX(000000) THEN 990
   : C$=STR(B$(),62,3) ADDC HEX(000001)
   : GOTO 980
0990 REM skip any file marks
   : IF STR(G$,6,3)=HEX(1A0000) THEN 980
1000 REM check for end of data
   : IF STR(G$,6,3)<>HEX(170000) THEN 1430
1010 REM %FOR EACH PLATTER TO BE BACKED UP, DO THE FOLLOWING
   : IF K=0 THEN 1330
   : FOR R=1 TO K
   : D3$=STR(S$(R),50,3)
   : CONVERT VAL(C$,3)TO C5$,(######)
1020 M$="Positioning to last block"
   : GOSUB '201(M$)
   : STR(G$,3,3)=C$
   : IF C$>HEX(000000) THEN STR(G$,3,3)=SUBC HEX(000001)
   : $GIO SEEK BLOCK #1 (0600 0700 70A0 68D0 7040 682E 683F 8B67 6800 6A30 6A4
     0 6A50 4000 8706, G$)
   : IF STR(G$,6,3)<>HEX(000000) THEN 1430
1030 M$="Position to end of data"
   : GOSUB '201(M$)
   : $GIO SEEK END OF DATA #1 (0600 0700 70A0 68D0 7040 682E 683A 8B67 4000 87
     06, G$)
   : IF STR(G$,6,3)<>HEX(000000) THEN 1430
1040 REM %begin copy
   : D1$=STR(S$(R),50,3)
   : SELECT #2 <D1$>
   : M$="Copying disk platter /"&D1$&" to tape"
   : GOSUB '201(M$)
1050 REM %start/end sectors
   : B0=VAL(STR(S$(R),53,2),2)
   : E0=VAL(STR(S$(R),55,2),2)
1060 REM # tape blocks to write
   : C2=INT((E0-B0)/2)+1
1070 REM %DS DISK OR EXTERNAL DISK?
   : D2$=D1$ OR HEX(000400)
   : IF STR(D1$,1,1)<>"D" OR STR(D2$,2,1)<>STR(D$,2,1) THEN 1150
1080 ON 999 GOTO 1150
   : REM %REMOVE THE 'ON 999' IF MAXIMUM INTERLEAVE DESIRED ALONG W/CONCURRENT
      ACCESS
1090 REM %DS disk
   : REM disk address
   : D1$=STR(S$(R),50,3)
   : HEXPACK STR(G$,4,1) FROM STR(D1$,2,2)
   : STR(G$,4,1)=AND HEX(0F)
   : IF STR(D1$,2,1)>"4"THEN STR(G$,4,1)=STR(G$,4,1)OR HEX(10)
1100 FOR J=B0 TO E0 STEP 256
1110 REM starting sector
   : STR(G$,2,2)=BIN(J,2)
1120 REM number of sectors
   : STR(G$,11,2)=BIN(MIN(E0-J+1,256),2)
1130 $GIO BACKUP SECTORS #1 (0600 0700 70A0 68D0 7040 682E 6833 6A40 6800 6A20
      6230 8B67 6AB0 6AC0 8B67 4000 8706, G$)
   : IF STR(G$,6,3)<>HEX(000000) THEN 1430
1140 NEXT J
   : GOTO 1250
1150 REM %external disk
1160 REM if one sector
   : IF E0=B0THEN 1230
1170 REM do sectors in groups of 2 first
   : FOR J=B0TO E0-MOD(1+E0-B0,2) STEP 2
1180 REM get data for tape block
   : DATA LOAD BA T#2,(J)STR(B$(),,256)
   : ERRORGOTO 1690
1190 DATA LOAD BA T#2,(J+1)STR(B$(),257,256)
   : ERRORGOTO 1690
1200 REM write block to tape buffer
   : GOSUB '203
   : IF STR(G$,6,3)<>HEX(000000) THEN 1430
1210 NEXT J
1220 IF MOD(1+E0-B0,2)=0THEN 1250
1230 REM for odd sector in last block
   : STR(B$(),257,256)=ALL(00)
   : DATA LOAD BA T#2,(E0)STR(B$(),,256)
   : ERRORGOTO 1690
1240 REM write block to tape buffer
   : GOSUB '203
   : IF STR(G$,6,3)<>HEX(000000) THEN 1430
1250 REM %write file mark
   : $GIO WRITE FILE MARK #1 (0600 0700 70A0 68D0 7040 682E 6834 8B67 4000 870
     6, G$)
   : IF STR(G$,6,3)<>HEX(000000) THEN 1430
1260 REM %update directory variable
   : STR(S$(R),57,4)=HEX(00) & STR(C$)
   : C$=ADDC BIN(C2,2)
   : STR(S$(R),61,4)=HEX(00) & STR(C$)
   : C$=ADDC HEX(000001)
1270 REM %position to beginning of tape directory
   : GOSUB '201 ("Positioning to tape directory")
   : STR(G$,3,3)=HEX(000000)
   : $GIO SEEK DIRECTORY BLOCK #1 (0600 0700 70A0 68D0 7040 682E 683F 8B67 680
     1 6A30 6A40 6A50 4000 8706, G$)
   : IF STR(G$,6,3)<>HEX(000000) THEN 1430
1280 REM %position to end of directory
   : GOSUB '201("Positioning to end of directory")
   : $GIO SEEK END OF DATA #1 (0600 0700 70A0 68D0 7040 682E 683A 8B67 4000 87
     06, G$)
   : IF STR(G$,6,3)<>HEX(000000) THEN 1430
1290 REM %write directory entry
   : B$()=S$(R)
   : GOSUB '201 ("Updating tape directory")
1300 REM write block to tape buffer
   : GOSUB '203
   : IF STR(G$,6,3)<>HEX(000000) THEN 1430
1310 REM write file mark
   : $GIO WRITE FILE MARK #1 (0600 0700 70A0 68D0 7040 682E 6834 8B67 4000 870
     6, G$)
   : IF STR(G$,6,3)<>HEX(000000) THEN 1430
1320 REM %more platters?
   : PRINT AT(7+R,58);HEX(0202020F960202000F)
   : NEXT R
1330 REM %REWIND TAPE
   : GOSUB '201("Rewinding tape")
   : $GIO REWIND TAPE #1 (0600 0700 70A0 68D0 7040 682E 6830 8B67 4000 8706, G
     $)
   : IF STR(G$,6,3)<>HEX(000000) THEN 1430
1340 REM %BACKUP DONE
   : GOSUB '201 ("Backup completed")
   : PRINT HEX(07);
   : GOTO 1710
1350 REM %READ BLOCK SUBROUTINE
   : REM Return-  B$()=data block
   : REM   STR(G$,6,1)=error code
   : REM   STR(G$,7,2)=command error
1360 DEFFN'202
   : $GIO READ BLOCK #1(0600 0700 70A0 68D0 7040 682E 684A 8B67 4000 8B76 D00F
      C341 8B52 E00F 0626 0800, G$) B$()
   : IF STR(G$,6,3)<>HEX(260000) THEN RETURN
1370 REM retry if LRC error
   : FOR I=1 TO 16
   : $GIO REREAD BLOCK #1(0600 0700 70A0 68D0 7040 682E 684C 8B67 4000 8B76 D0
     0F C341 8B52 E00F 0626 0800, G$) B$()
   : IF STR(G$,6,3)<>HEX(260000) THEN I=16
   : NEXT I
   : RETURN
1380 REM %WRITE BLOCK SUBROUTINE
   : REM Entry-   B$()=data block
   : REM Return-  STR(G$,6,1)=error code
   : REM          STR(G$,7,2)=command error
1390 DEFFN'203
   : FOR I=1 TO 16
   : $GIO WRITE BLOCK #1(1300 0600 0700 70A0 68D0 7040 682E 6848 8B67 A002 870
     6, G$) B$()
   : IF STR(G$,6,3)<>HEX(260000) THEN I=16
   : NEXT I
   : RETURN
1400 REM % TAPE CASSETTE ERROR HANDLING
   : REM STR(G$,6,1) = ERROR CODE
   : REM STR(G$,7,2) = COMMAND ERROR
1410 REM if nonrecoverable error,
   : GOTO 1700
1420 REM if recoverable error,
   : GOTO 1780
1430 RETURN  CLEAR  ALL
   : IF STR(G$,7,2)=HEX(0000) THEN 1440
   : M$="Tape Command Error"
   : GOTO 1700
1440 K$=STR(G$,6,1)
   : ON POS(HEX(919395969899)=K$) GOTO 1450,1470,1460,1480,1500,1490
   : GOTO 1510
1450 M$="ERROR I91:  Disk Drive Not Ready"
   : GOTO 1700
1460 M$="ERROR I95:  Device Error"
   : GOTO 1700
1470 M$="ERROR I93:  Format Error"
   : GOTO 1700
1480 M$="ERROR I96:  Data Error"
   : GOTO 1700
1490 M$="ERROR I99:  Read After Write Error"
   : GOTO 1700
1500 M$="ERROR I98:  Illegal Sector Address or No Platter"
   : GOTO 1700
1510 ON VAL(K$)-15 GOTO 1530,1540,1550,1560,1570,1580,1590,1600,,,1610,1620,16
     30,,,,1640,,,1650,1660,,1670,1680
1520 M$="ERROR:  Device Error"
   : GOTO 1700
1530 GOSUB '50("ERROR T10:  No Tape Cassette","Mount tape cassette and press
     RETURN")
   : GOTO 1780
1540 M$="ERROR T11:  No Tape Cassette Drive"
   : GOTO 1700
1550 GOSUB '50("ERROR T12:  Write Protect","Unprotect tape cassette and press
      RETURN")
   : GOTO 1780
1560 M$="ERROR T13:  End Of Tape"
   : GOTO 1700
1570 M$="ERROR T14:  Unrecoverable Data Error"
   : GOTO 1700
1580 M$="ERROR T15:  Bad Data Block"
   : GOTO 1700
1590 M$="ERROR T16:  Bad Block"
   : GOTO 1700
1600 M$="ERROR T17:  No Data"
   : GOTO 1700
1610 M$="ERROR T1A:  Unexpected File Mark Read"
   : GOTO 1700
1620 M$="ERROR T1B:  Illegal Command"
   : GOTO 1700
1630 M$="ERROR T1C:  Power On/Reset"
   : GOTO 1700
1640 M$="ERROR T20:  Invalid Number of File Marks"
   : GOTO 1700
1650 M$="ERROR T23:  Insufficient Buffer Space"
   : GOTO 1700
1660 M$="ERROR T24:  Tape Drive Error"
   : GOTO 1700
1670 M$="ERROR T26:  LRC Error"
   : GOTO 1700
1680 M$="ERROR T27:  Device Error"
   : GOTO 1700
1690 REM %Disk error
   : M$="ERROR I##:  Disk Error"
   : CONVERT ERR TO STR(M$,8,2),(##)
   : GOTO 1700
1700 REM %Nonrecoverable error
   : M1$="Tape backup aborted"
   : IF D3$<>" " THEN M1$=M1$ & " copying /" & D3$
   : GOSUB '50(M1$,M$)
   : PRINT HEX(07);
1710 REM %RESTART OR EXIT?
   : PRINT AT(23,61);"FN/TAB - Exit";AT(22,61);"RETURN - Proceed";
1720 REM unhog tape DS
   : $CLOSE#1
1730 KEYIN K$,,1740
   : IF K$=HEX(0D) THEN 270
   : GOTO 1730
1740 IF K$<>HEX(7E) AND K$<>HEX(7F) THEN 1730
1750 REM %EXIT
1760 DEFFN'127
1770 DEFFN'126
   : LOAD RUN  "@MENU"
1780 REM %recoverable tape error
   : PRINT AT(23,61);"FN/TAB - Exit";AT(22,61);"RETURN - Proceed";
1790 KEYIN K$,,1800
   : IF K$=HEX(0D) THEN 790
   : GOTO 1790
1800 IF K$<>HEX(7E) AND K$<>HEX(7F) THEN 1790
   : GOTO 1770
1810 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
1820 REM %'201 - display message at lower left corner (line 23)
1830 DEFFN'201(M$)
   : PRINT AT(23,0);HEX(0E);STR(M$);HEX(0F);
   : RETURN