Listing of file='@DSTAPEB' on disk='vmedia/734-8446-A.wvd.zip'
# Sector 1496, program filename = '@DSTAPEB'
0010 REM ! TDSTAPEB -01/03/92 - Backup Disk Platters to Cassette Utility
0020 REM ! - Release 2.h
0030 REM ! (C) Copyright, Wang Laboratories, Inc., 1987. All rights reserved.
0032 REM %.Logic variations are described in the following REM statements
0040 REM %.Variation 1
: 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 the
next instruction
: ON 0GOTO 800
0050 REM .AND if maximum interleave is desired - ALSO remove 'ON 999' from
: REM .the line which is \D2\C5\C6\C5\D2\C5\CE\C3\C5\C4 in the next instruc
tion
: ON 0GOTO 1080
0055 REM %.Variation 2
: REM .To invoke a prompt to start the backup procedure at a DATE and TIME
: REM .remove 'ON 999' at referenced line of next instruction
: ON 0GOTO 440
0056 REM %.Variation 3 (M1 is Update mode flag)
: REM .M1=1 Update.directory.after.each.surface.write
: REM .M1=2 Update.directory.after.all.surfaces.are.written
: M1=1
0060 REM % VARIABLE DEFINITIONS
0070 DIM S$(32)70,S0$70
: S9=70
: REM Surface list to back-up (70-byte directory entries)
0075 REM 01,49 = name/description
: REM 50,3 = disk address
: REM 53,2 = starting sector (binary)
: REM 55,2 = ending sector (binary)
: REM Binary values from 53-56 are moved to 65-70 and processed as 3 bytes.
0080 REM 57,4 = starting block on tape (binary)
: REM 61,4 = ending block on tape (binary)
0085 REM 65,3 = starting sector (binary)
: REM 68,3 = ending sector (binary)
0090 DIM S1$2
: REM - MATSEARCH RECEIVER FOR S$()
0100 S1=65
: S2=68
: REM .3 byte addr start @65 end @68
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,B0$(128)64
: REM %0 B$( 512.byte.block, B0$( 32.sector.buffer
0170 DIM D1$3,D3$3
: REM - SOURCE DISK ADDRESS
0180 DIM B0,E0,B1
: 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 K$,D$=SELECT #0
: IF K$<>"D"THEN D$="D10"
: K$=STR(D$,2)
: OR (K$,04)
: STR(D$,2)=K$&"F"
: D3$=D$
0310 REM %get tape address
: PRINT AT(2,12);"Address of tape cassette drive (D5F, D6F, or D7F): ";
0312 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))<>0AND POS("567"=STR(D$,2,1))<>0AND 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
0325 PRINT AT(1,0,80)
0330 REM %get tape address status
: GOSUB '201("Getting tape status")
: Z=0
0332 $IF ON #1,335
: $BREAK
: Z=Z+1
: IF Z<999THEN 332
: GOSUB '50(HEX(0E),"Drive unavailable")
: GOTO 310
0335 S$=" "
: $GIOSTATUSREQUEST#1(0E140F0012E20600070070A068D07040682E6816400087051A00C
340,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
0372 DIM X0$(6)1,X1$(6)1
: X0$()=ALL(FF)
: $GIOSTATUSREAD#1(0600070070A068D07040682E68378B674000870687051A00C340,G$)
G$;STR(X0$(),,VAL(STR(G$,5,1)))
: ERRORGOTO 320
0374 X1$()=ALL(FF)
: $GIOXSTATUSREAD#1(0600070070A068D07040682E683E8B674000870687051A00C340,G$
)G$;STR(X1$(),,VAL(STR(G$,5,1)))
: ERRORSTOP #
0376 RETURN
0380 PRINT AT(1,72);"Prom=";STR(S$,4,2)
: REM .Get tape status info
: GOSUB 372
0386 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
0388 PRINT AT(1,5);
: PRINTUSING " ### MB Tape Drive -- Cassette is #########################
##",M9,S$
: S9$=S$
: IF LEN(S$)<9THEN 392
: C=C+1
: IF C<2THEN 330
0390 GOSUB '50(HEX(0E),"Adjust cassette")
: GOTO 310
0392 IF M9=45AND X1$(1)<>HEX(02)THEN 390
: IF M9=150AND X1$(1)<>HEX(97)THEN 390
0394 REM
0396 GOSUB '50(" "," ")
0398 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
: IF K<1THEN 450
0440 REM %.Ask when to start -- then to backup
: ON 999GOSUB 1900
: GOTO 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))<>0AND POS("123567"=STR(D1$,2,1))<>0AND VER(STR
(D1$,3,1),"H")<>0AND 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))=0OR POS("123"=STR(D1$,2,1))=0OR 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<32THEN 500
: GOSUB '50("Exceeded number of platters allowed","Complete backup; then,
append additional platters")
: D1$=" "
: GOTO 420
0500 MAT SEARCHSTR(S$(),50),=D1$TO S1$STEP S9
: 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
: S0$=S$(K+1)
: IF STR(S0$,65,6)=" "THEN STR(S0$,65,6)=HEX(00)&STR(S0$,53,2)&HEX(00)
&STR(S0$,55,2)
: R=R+1
: IF R<=19THEN 550
0530 PRINT AT(R,72);BOX(0,-5)
: R=7
: PRINT AT(R+1,0,1120);
0540 M=0
: GOSUB 780
: PRINT AT(R+1,72);BOX(0,5);
: PRINTUSING "###.#";ROUND((M/4096,1);
: R=R+1
0550 PRINT AT(R,53);"/";D1$
0565 N$=D9$
0570 REM % GET PLATTER NAME/DESCRIPTION
: PRINT AT(5,0,80);"Platter name: ";
: LINPUT HEX(0E),-N$
: PRINT HEX(06);AT(R,2,49);N$;
0575 STR(S0$,,49)=N$
: STR(S0$,50,3)=D1$
: K=K+1
: S$(K)=S0$
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
: ERRORGOTO 615
0610 IF W>=0AND INT(W)=WTHEN 620
0615 GOSUB '50(HEX(0E),"Illegal sector address")
: GOTO 590
0620 VERIFY T#2,(W,W)E
: ERRORGOTO 615
0625 DATA LOAD BA T#2,(W)STR(B$(),,256)
: ERRORM2$="Error xx reading starting sector"
: CONVERT ERRTO STR(M2$,7,2),(##)
: GOSUB '50(HEX(0E),M2$)
: K=K-1
: R=R-1
: GOTO 420
0630 STR(S0$,S1,3)=BIN(W,3)
: PRINT AT(R,60);
: PRINTUSING "#####",W;
: B1=W
0640 REM % GET END SECTOR ADDRESS
: DATA LOAD BA T#2,(0)STR(B$(),,256)
: ERRORM2$="Error xx reading sector 0"
: CONVERT ERRTO STR(M2$,7,2),(##)
: GOSUB '50(HEX(0E),M2$)
: GOTO 590
0650 IF STR(B$(),,1)=HEX(02)THEN W=VAL(STR(B$(),4),3)
: ELSE W=VAL(STR(B$(),3),2)
: CONVERT W-1TO 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
: ERRORGOTO 685
0680 IF W>=0AND INT(W)=WTHEN 690
0685 GOSUB '50(HEX(0E),"Illegal sector address")
: GOTO 660
0690 VERIFY T#2,(W,W)E
: ERRORGOTO 685
0695 DATA LOAD BA T#2,(W)STR(B$(),,256)
: ERRORM2$="Error xx reading ending sector"
: CONVERT ERRTO STR(M2$,7,2),(##)
: GOSUB '50(HEX(0E),M2$)
: GOTO 590
0700 STR(S0$,S2,3)=BIN(W,3)
: 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(S0$,S1),3))/4096,1);
0725 S$(K)=S0$
0730 M=0
: GOSUB 780
: PRINT AT(R+1,72);
: PRINTUSING "###.#";ROUND((M/4096,1);
0740 IF B1<WTHEN 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
: GOSUB 780
: PRINT AT(R+1,72);BOX(0,5);
: PRINTUSING "###.#";ROUND((M/4096,1);
: GOTO 420
0780 FOR Z=1TO K
: M=M+1+VAL(STR(S$(Z),S2),3)-VAL(STR(S$(Z),S1),3)
: NEXT Z
: RETURN
0790 REM %^--------- TAPE OPERATIONS ----------------
0795 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!
0805 IF M1=2THEN PRINT AT(21,0);"Delayed directory mode"
0810 REM %REWIND TAPE
: GOSUB '201("Rewinding tape")
: $GIOREWINDTAPE#1(0600070070A068D07040682E68308B6740008706,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")
: $GIOERASETAPE#1(0600070070A068D07040682E68318B6740008706,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)
: $GIOSEEKDIRECTORYBLOCK#1(0600070070A068D07040682E683F8B6768016A306A406A50
40008706,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
: $GIOWRITEFILEMARK#1(0600070070A068D07040682E68348B6740008706,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")
: $GIORETENSIONTAPE#1(0600070070A068D07040682E68328B6740008706,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)
: $GIOSEEKDIRECTORYBLOCK#1(0600070070A068D07040682E683F8B6768016A306A406A50
40008706,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: P
LATTER 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)ADDCHEX(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=0THEN 1330
: FOR R=1TO K
: D3$=STR(S$(R),50,3)
1015 IF M1=2AND R>1THEN 1035
1020 M$="Positioning to last block"
: GOSUB '201(M$)
: STR(G$,3,3)=C$
: IF C$>HEX(000000)THEN STR(G$,3,3)=SUBCHEX(000001)
: IF C$<HEX(003C00)THEN STR(G$,3,3)=HEX(000000)
: $GIOSEEKBLOCK#1(0600070070A068D07040682E683F8B6768006A306A406A5040008706,
G$)
: IF STR(G$,6,3)<>HEX(000000)THEN 1430
1030 M$="Position to end of data"
: GOSUB '201(M$)
: $GIOSEEKENDOFDATA#1(0600070070A068D07040682E683A8B6740008706,G$)
: IF STR(G$,6,3)<>HEX(000000)THEN 1430
1035 GOSUB 372
: C$=STR(X1$(),4)
: IF M9=45THEN C$=C$AND HEX(0FFFFF)
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),S1),3)
: E0=VAL(STR(S$(R),S2),3)
1055 PRINT AT(22,10);"of";E0
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 999GOTO 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)
: HEXPACKSTR(G$,4,1)FROMSTR(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=B0TO E0STEP 256
1110 REM starting sector
: STR(G$,1,3)=BIN(J,3)
1115 PRINT AT(22,0);J
1120 REM number of sectors
: STR(G$,11,2)=BIN(MIN(E0-J+1,256),2)
1130 $GIOBACKUPSECTORS#1(0600070070A068D07040682E68336A406A106A2062308B676AB06
AC08B6740008706,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
: S0=MOD(1+E0-B0,2)
: B9=B0
: IF E0-B0<33THEN 1170
1162 REM do sectors in groups of 32 first
: FOR J=B0TO E0-33STEP 32
1163 PRINT AT(22,0);J
1164 REM get data for tape block
: DATA LOAD BMT#2,(J)B0$()
: ERRORGOTO 1690
1165 FOR Z=1TO 32*256STEP 512
: B$()=STR(B0$(),Z,512)
1166 REM write block to tape buffer
: GOSUB '203
: IF STR(G$,6,3)<>HEX(000000)THEN 1430
: NEXT Z
1168 NEXT J
: B9=J+32
1170 REM do sectors in groups of 2
: FOR J=B9TO E0-S0STEP 2
1175 PRINT AT(22,0);J
1180 REM get data for tape block
: DATA LOAD BMT#2,(J)B$()
: 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 S0=0THEN 1250
1230 REM do 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
: $GIOWRITEFILEMARK#1(0600070070A068D07040682E68348B6740008706,G$)
: IF STR(G$,6,3)<>HEX(000000)THEN 1430
1255 PRINT AT(22,0,40)
1260 REM %update directory variable
: STR(S$(R),57,4)=HEX(00)&STR(C$)
: C$=ADDCBIN(C2,3)
: STR(S$(R),61,4)=HEX(00)&STR(C$)
: C$=ADDCHEX(000001)
1265 INIT(00)STR(S$(R),53,4)
: IF E0>65535THEN 1270
: STR(S$(R),53,2)=BIN(B0,2)
: STR(S$(R),55,2)=BIN(E0,2)
1270 IF M1=2THEN 1280
: REM %.Write directory item as surface is written
: GOSUB 1840
: REM .Position to directory
: GOSUB 1860
: REM .Update item
: REM write block to tape buffer
1280 NEXT R
1290 DEFFN'11
: IF K=0OR M1<>2THEN 1330
: REM %.Update.directory.after.all.surfaces.are.written
: GOSUB 1840
: FOR R=1TO K
: GOSUB 1860
: NEXT R
: PRINT AT(21,0,30)
1330 REM %REWIND TAPE
: GOSUB '201("Rewinding tape")
: $GIOREWINDTAPE#1(0600070070A068D07040682E68308B6740008706,G$)
: IF STR(G$,6,3)<>HEX(000000)THEN 1430
1340 REM %BACKUP DONE
: GOSUB '201("Backup completed")
: PRINT HEX(07);
: GOTO 1710
1342 IF K=0THEN RETURN
: FOR R=1TO K
: IF STR(S$(R),53,6)=" "THEN K=R-1
: NEXT R
: REM %.Update.directory.after.all.surfaces.are.written
: GOSUB 1840
: FOR R=1TO K
: GOSUB 1860
: NEXT R
: PRINT AT(21,0,30)
: RETURN
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
: $GIOREADBLOCK#1(0600070070A068D07040682E684A8B6740008B76D00FC3418B52E00F0
6260800,G$)B$()
: IF STR(G$,6,3)<>HEX(260000)THEN RETURN
1370 REM retry if LRC error
: FOR I=1TO 16
: $GIOREREADBLOCK#1(0600070070A068D07040682E684C8B6740008B76D00FC3418B52E00
F06260800,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=1TO 16
: $GIOWRITEBLOCK#1(13000600070070A068D07040682E68488B67A0028706,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
1425 RETURN CLEAR
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)
: IF M1=2THEN GOSUB 1342
: 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$)-15GOTO 1530,1540,1550,1560,1570,1580,1590,1600,,,1610,1620,163
0,,,,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 ERRTO 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 795
: 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
1840 REM %position to beginning of tape directory
: GOSUB '201("Positioning to tape directory")
: STR(G$,3,3)=HEX(000000)
: $GIOSEEKDIRECTORYBLOCK#1(0600070070A068D07040682E683F8B6768016A306A406A50
40008706,G$)
: IF STR(G$,6,3)<>HEX(000000)THEN 1425
1850 REM %position to end of directory
: GOSUB '201("Positioning to end of directory")
: $GIOSEEKENDOFDATA#1(0600070070A068D07040682E683A8B6740008706,G$)
: IF STR(G$,6,3)<>HEX(000000)THEN 1425
1855 RETURN
1860 REM %write directory entry
: B$()=S$(R)
: GOSUB '201("Updating tape directory")
1870 REM write block to tape buffer
: GOSUB '203
: IF STR(G$,6,3)<>HEX(000000)THEN 1425
1880 REM write file mark
: $GIOWRITEFILEMARK#1(0600070070A068D07040682E68348B6740008706,G$)
: IF STR(G$,6,3)<>HEX(000000)THEN 1425
1885 PRINT AT(7+R,0);HEX(0202020F960202000F)
1890 RETURN
1900 REM %.Ask when to start
: DIM T0$6,T9$6
: PRINT AT(4,0,2*80);"The current date time is"
: GOSUB 1940
: M$="mm/dd/yy hh:mm"
: PRINT AT(5,0);
: LINPUT "Start backup NOW, or at ",-STR(M$,,14)
: IF M$="NOW"OR M$=" "THEN 1930
1910 T0$=STR(M$,7,2)&STR(M$,,2)&STR(M$,4,2)
: T9$=STR(M$,10,2)&STR(M$,13,2)
: REM .T0$=yymmdd T9$=hhmm
: PRINT AT(5,12,8);HEX(06);
1920 $IF ON /001,1900
: $BREAK200
: M$=TIME
: IF STR(M$,,6)<>STR(T0$,,6)THEN GOSUB 1940
: M$=DATE
: IF STR(M$,,6)<>STR(T0$,,6)THEN 1920
: REM .Day to do backup
: M$=TIME
: IF STR(M$,,4)<STR(T9$,,4)THEN 1900
: REM .backup time is here
1930 PRINT AT(4,0,160)
: RETURN
1940 M1$=DATE
: M2$=TIME
: M$=STR(M1$,3,2)&"/"&STR(M1$,5,2)&"/"&STR(M1$,,2)&" "&STR(M2$,,2)&":"&STR(
M2$,3,2)
: PRINT AT(4,25);M$
: RETURN
9999 HEXPRINT STR(B$(),,1)
: HEXPRINT STR(B$(),,30)
: PRINT ".1.2.3.4.5.6.7"
: PRINT VAL(STR(B$(),4),3)
: PRINT VAL(STR(B$(),3),2)
: LIST SD650,655
: PRINT W
: LIST DC T/D61