Listing of file='@MOVEFIL' on disk='vmedia/turbo-1.30.01.wvd.zip'
# Sector 351, program filename = '@MOVEFIL'
0005 REM %Added test for 3 Byte Address. Not supported. Lines 150,152,155,44
0,445.MEB 4/7/93
0050 DIM A1$3,A2$3,T$1,C1,C2
: DIM C1$8,C2$8,C3$8,C0$8,A4$5,A3$3,A5$3,P9$8
: DIM S$(24,2)8,S$3,N$8,N3$8,P0$1,P1$1,Q1$1,Q$1,Q6$2,L$2,E$49,S1$3,S2$3,N1$
8,N2$8,N4$8,N5$8,N6$8,H7$(30)8,A$(1)
: PRINT HEX(020D0C030F020402000F);
0090 PRINT HEX(060E03);AT(0,5);"***** Move File Utility - (c) Copr. Wang Labor
atories, Inc. 1990 *****"
: S$(),C1$,C2$,C3$,N3$,P9$=ALL(00)
: T$="W"
: A5$,A3$=" "
: P=1
: PRINT AT(2,0);"Press 'FN' or 'TAB' to return to menu"
0120 A1$="D11"
0130 PRINT AT(4,0);
: LINPUT "Input address: "-A1$
: IF A1$="RUN"THEN 120
: $TRAN(A1$,"BbDd")R
: GOSUB '100(A1$)
: IF Q$<>" "THEN 130
: IF A1$=A3$AND Q$=" "THEN 160
: A3$=A1$
: PRINT HEX(06);AT(6,0);"W = WANG 2200 type";AT(7,0);"I = IBM 3741 type"
0150 PRINT AT(5,0,30);
: LINPUT "Input platter type: "-T$
: IF T$="W"OR T$="w"THEN PRINT AT(5,22);"WANG"
: IF T$="I"OR T$="i"THEN PRINT AT(5,22);"3741"
: C1=POS("IWiw"=T$)
: IF C1=0THEN 150
: PRINT HEX(06);AT(6,0,);
: C1,C2=MOD(C1,2)*2^14
: GOSUB '105(1,A1$,C1)
: A$(1)=STR(S$(),1,1)
: IF A$(1)=HEX(02)THEN 155
0152 IF Q$=" "THEN 160
: A3$=" "
: GOTO 130
0155 IF A$(1)<>HEX(02)THEN 160
: PRINT AT(14,10,);HEX(0E);"Address ";A1$;" is a 3 Byte Address. Three Byt
e Addresses not supported."
: A3$=" "
: GOTO 130
0160 GOSUB 400
: H$="N"
: PRINT AT(7,20,);
: LINPUT "Do you wish to move all active files ?",H$
: IF STR(H$,1,1)="N"OR STR(H$,1,1)="n"THEN 190
: REM CHECK FOR SAME DISK
: IF A1$<>A2$THEN 162
: PRINT HEX(07);AT(11,0,80);"Input and output disks may not be the same."
: PRINT AT(6,0,240)
: GOTO 130
0162 PRINT AT(7,20,);" ** MOVING ALL ACTIVE FILES **"
: Z=1
: H$="Y"
: PRINT AT(8,20,50);
: LINPUT "Do you wish to overwrite files ?",H$
: $TRAN(H$,"YyNn")R
: GOTO 200
0190 PRINT AT(7,20,);" ** MOVING SPECIFIED FILES **"
0200 GOSUB '115(1,0,A1$,C1)
: IF Q$<>" "THEN 130
: I1=VAL(STR(S$(),2))
0210 IF Z9=1THEN 240
: IF C1$<>P9$THEN 230
0220 GOSUB '130(0,1,C3$,A9,I1-1,A1$,C1)
: IF N3$="@SPAN001"THEN C9$="Y"
: IF Q$="N"AND C9$="Y"THEN 250
: IF Q$="N"AND Z=1AND H$="Y"THEN 550
: IF Q$="N"AND Z=1THEN 570
: IF Z=1AND R3<0THEN 225
: IF Q$="N"THEN N3$=" "
: GOTO 240
0225 C3$=N3$
: GOTO 200
0230 Z9=1
0240 IF Z9=1THEN 241
: C1$,C2$,C3$=N3$
: GOTO 242
0241 C2$,C3$=N3$
0242 A9=S9
: IF R3<0OR STR(N3$,,5)="@SPAN"THEN 220
: GOTO 270
0250 C9$=" "
: A9=0
: C3$=ALL(00)
: GOSUB '130(1,1,"@SPAN001",0,I1-1,A1$,C1)
: C1$,C2$=" "
: IF R3<0THEN 210
: IF Q$<>" "THEN 270
: C1$,C2$=N3$
: GOSUB '115(1,R4,A1$,C1)
: C2$=STR(S$(),9,8)
: PRINT HEX(0E);AT(11,0,80);"File @SPAN001";" contains a portion of file ";
C2$;
0270 P9$=C1$
: IF Z=1THEN 280
: PRINT HEX(06);AT(9,0,320);
: LINPUT "Input file name: "-C1$
: GOTO 290
0280 PRINT AT(10,0,320);"MOVING FILE ";C2$
0290 IF C1$=" "THEN 220
: IF STR(C1$,,5)="@SPAN"AND STR(C1$,6)<>"001"THEN 270
: C0$=C1$
: $OPEN #1,#2
: PRINT HEX(06);AT(11,0,80);"GETTING FILE PARAMETERS";
: IF C1$<>N3$OR Q$<>" "OR P9$=C1$THEN GOSUB '130(1,1,C1$,0,I1-1,A1$,C1)
0300 IF Q$=" "AND C1$="@SPAN001"THEN 320
: ELSE IF Q$=" "THEN 350
: IF C1$="@SPAN001"THEN 340
: C1$="@SPAN001"
: A9=0
0310 GOSUB '130(1,1,C1$,A9,I1-1,A1$,C1)
: IF Q$="N"THEN 340
0320 GOSUB '115(1,R4,A1$,C1)
: Q$="N"
: C2$=STR(S$(),9,8)
: IF C2$<>C0$AND C0$<>"@SPAN001"THEN 340
: Q$=" "
: C1$=N3$
: A3=VAL(STR(S$(),5),2)
: A5=VAL(STR(S$(),3),2)-A3
: GOTO 360
0340 $CLOSE
: PRINT HEX(07);AT(11,0);
: LINPUT "File does not exist in source platter. Key RETURN to try again",P
1$
: PRINT AT(11,0,160);
: C1$=" "
: GOTO 270
0350 C2$=N3$
: A3=R6
: A5=R5-R4-R6+1
0360 PRINT HEX(0E);AT(11,0,);
: IF STR(C0$,,5)<>"@SPAN"THEN 370
: PRINT "File ";C0$;" contains a portion of file ";C2$;
0370 IF Z=1THEN 455
: PRINT AT(12,0);"Currently,";A3;"sectors are used in file ";C2$;" and";A5;
" are free.";
0380 PRINT HEX(0F);AT(10,0,80);
: CONVERT A5TO A4$,(#####)
: LINPUT "Extra Sectors: "-A4$
: CONVERT A4$TO A4
: ERRORGOTO 370
0390 IF A4<0OR A4+A3>2^16-1THEN 380
: PRINT HEX(06);AT(13,0,)
: GOTO 460
0400 IF A5$<>" "THEN 500
0405 A2$="D10"
0410 PRINT AT(4,40,40);
: LINPUT "Output address: "-A2$
: IF A2$="RUN"THEN 405
: $TRAN(A2$,"BbDd")R
: GOSUB '100(A2$)
: IF Q$<>" "THEN 410
: IF A2$=A5$AND Q$=" "OR A2$=A1$THEN 440
: A5$=A2$
0420 PRINT HEX(06);AT(6,40,40);"W = WANG 2200 type";AT(7,40,);"I = IBM 3741 ty
pe"
: T$="W"
0430 PRINT AT(5,40,40);
: LINPUT "Output platter type: "-T$
: IF T$="W"OR T$="w"THEN PRINT AT(5,62);"WANG"
: IF T$="I"OR T$="i"THEN PRINT AT(5,62);"3741"
: C2=POS("IWiw"=T$)
: IF C2=0THEN 430
: PRINT HEX(06);AT(6,40,);
: C2=MOD(C2,2)*2^14
0440 GOSUB '105(2,A2$,C2)
: A$(1)=STR(S$(),1,1)
: IF A$(1)=HEX(02)THEN 445
: IF Q$=" "THEN 450
: A5$=" "
: GOTO 410
0445 IF A$(1)<>HEX(02)THEN 450
: PRINT AT(14,10,);HEX(0E);"Address ";A2$;" is a 3 Byte Address. Three Byt
e Addresses not supported."
: GOTO 410
0450 RETURN
0455 A4=A5
0460 GOSUB '115(2,0,A2$,C2)
: IF Q$<>" "THEN 410
: I4=VAL(STR(S$(),2))
0470 IF C2=0OR K9=1THEN 500
: PRINT AT(15,0);
: Q1$="N"
: F=1
0475 IF STR(S$(),,2)<>HEX(000D)AND STR(S$(),5,2)<>HEX(03E9)THEN PRINT HEX(0E);
"Your platter needs to be initialized";HEX(0F);
: ELSE F=0
: IF F=1THEN Q1$="Y"
: PRINT AT(16,0);
: LINPUT "Do you want to initialize the platter?"-Q1$
: K9=1
: ON POS("YyNn"=Q1$)GOTO 490,490,480,480
: ELSE GOTO 470
0480 ON F+1GOTO 500
: PRINT AT(8,40);
: LINPUT "Mount a new platter and key RETURN",P1$
: GOTO 420
0490 PRINT HEX(06);AT(17,0);"Initializing output platter"
: GOSUB '240(A2$)
0500 IF Z=1THEN 510
: PRINT HEX(06);AT(9,40,);
0505 LINPUT "Output file name: "-C2$
: REM CHECK FOR SAME DISK, SAME NAME
: IF C1$<>C2$OR A1$<>A2$THEN 510
: PRINT HEX(07);AT(14,10,70);"File names must be different if input and out
put disks are the same.";AT(9,40);
: GOTO 505
0510 PRINT HEX(06);AT(14,10,);"Scanning output index";AT(15,0,);
: GOSUB '130(1,2,C2$,0,I4-1,A2$,C2)
: IF Q$="N"THEN 540
0520 Q1$="N"
: IF STR(H$,1,1)="Y"AND Z=1THEN 540
: IF STR(H$,1,1)="N"AND Z=1THEN 530
: PRINT AT(14,10);"File ";C2$;" already exists. OK to overwrite?";
: LINPUT Q1$
: PRINT AT(14,10,50);HEX(06);
: ON POS("YyNn"=Q1$)GOTO 540,540,500,500
: ELSE GOTO 520
0530 H7$(P)=C2$
: P=P+1
: IF P>30THEN P=30
: GOTO 210
0540 PRINT AT(6,30,50);
: GOSUB '255(C1$,A1$,C1,A4,C2$,A2$,C2)
0541 IF C2<>0THEN 544
: REM - DON'T TRY TO FIX THE PROGRAM HEADER IF NOT A WANG DISKETTE (SPM 05/
28/86 for OS 2.7)
0542 REM IF FILE WAS A PROGRAM FILE, CHANGE FILE NAME IN FIRST SECTOR TO MATCH
THE FILE NAME IN THE CATALOG INDEX
: GOSUB '105(2,A2$,C2)
: LIMITS T#2,C2$,D1,D2,D3,D4
: IF D4<>1THEN GOTO 544
0543 GOSUB '115(2,D1,S$,0)
: STR(S$(1,1),2,7)=STR(C2$,1,7)
: STR(S$(1,2),1,1)=STR(C2$,8,1)
: GOSUB '110(2,D1,S$,0)
: IF STR(S$(),,1)>=HEX(60)THEN GOSUB 560
0544 $CLOSE
: GOTO 210
0545 DEFFN'127
0550 DEFFN'126
: LOAD RUN "START"
0560 GOSUB '115(2,R1,S$,0)
: IF STR(S$(R2,2),,8)=C2$AND STR(S$(R2,1),,2)=HEX(1080)THEN STR(S$(R2,1),2,
1)=HEX(40)
: GOSUB '110(N,R1,S$,0)
: RETURN
0570 PRINT AT(7,24,);"OVERWRITE EXCEPTIONS"
: FOR I=1TO 10
: PRINT AT(I+8,10);I;") ";H7$(I);AT(I+8,30);I+10;") ";H7$(I+10);AT(I+8,50);
I+20;") ";H7$(I+20)
: NEXT I
0580 KEYIN K$,550,550
: GOTO 580
5000 REM !@MOVE1 02/02/90 PLS mod.by TBO Rel 3.3.0
: REM ! Copyright Wang Laboratories 1985, 1989
: REM ! All rights reserved
5020 REM %.VALIDATE ADDR
5025 DEFFN'100(S$)
: IF S$="340"THEN 5035
: $TRAN(S$,"AaBbCcDdEeFf")R
: IF POS("DB3"=S$)>0AND POS("123567"=STR(S$,2))>0AND VER(STR(S$,3),"H")>0TH
EN 5030
: Q$="I"
: RETURN
5030 IF POS("3B"=S$)=0OR POS("123"=STR(S$,2))=0OR STR(S$,3)<>"0"THEN 5035
: IF STR(S$,,1)="3"THEN STR(S$,3)="1"
: STR(S$,,1)="D"
5035 Q$=" "
: RETURN
5040 REM %SELECT DISK
5050 DEFFN'105(N,S$,T)
: Q$=" "
: IF T=0OR T=2^14THEN 5060
: Q$="S"
: RETURN
5060 SELECT #N<S$>
: GOSUB '115(N,0,S$,T)
: RETURN
5090 REM %SAVE
5100 DEFFN'110(N,S,S$,T)
: IF T<>0THEN 5105
: DATA SAVE BA T#N,(S)S$()
: ERRORGOSUB '200(S$)
5102 RETURN
5105 S=S*2
: DATA SAVE BA T#N,(S+T)S$()
: ERRORGOSUB '200(S$)
: RETURN
5110 DATA SAVE BA T#N,(S+T+1)STR(S$(),129)
: ERRORGOSUB '200(S$)
5120 RETURN
5130 REM %LOAD
5140 DEFFN'115(N,S,S$,T)
: IF T<>0THEN 5145
: DATA LOAD BA T#N,(S)S$()
: ERRORGOSUB '200(S$)
5142 RETURN
5145 S=S*2
: DATA LOAD BA T#N,(S+T)S$()
: ERRORGOSUB '200(S$)
: RETURN
5150 DATA LOAD BA T#N,(S+T+1)STR(S$(),129)
: ERRORGOSUB '200(S$)
5160 RETURN
5170 REM %SCAN INDEX
5180 DEFFN'130(O,N,N$,T8,T9,S$,T)
: N3$=ALL(00)
: Q$="N"
: R3=0
: FOR I=T8TO T9
: GOSUB '115(N,I,S$,T)
: FOR J=1TO 16
: REM UNWANTED NAME
: IF POS(S$(J,1)<>HEX(00))=0THEN 5220
: IF I=0AND J=1OR STR(S$(J,1),,1)=HEX(21)THEN 5230
: IF S$(J,2)<>N$AND N$>HEX(00)THEN 5230
5190 REM RIGHT NAME
: N3$=S$(J,2)
: IF POS(N$<>HEX(00))=0OR O<>0THEN 5200
: REM DESIRED FILE NEXT
: N$=ALL(00)
: GOTO 5230
5200 REM FILE FOUND
: REM STATUS/TYPE
: R3=-SGN(VAL(STR(S$(J,1),2,1))/128)+2
: IF STR(S$(J,1),,1)=HEX(11)THEN R3=-R3
: REM START
: R4=VAL(STR(S$(J,1),3),2)
: REM END
: R5=VAL(STR(S$(J,1),5),2)
: REM USED
: R1=S
: R2=J
5205 GOSUB '115(N,R5,S$,T)
: R6=VAL(STR(S$(),2),2)
5210 REM RETURN CODE
: Q$=" "
: REM SECTOR AND SLOT #
: S8=J
: S9=I
: I=T9
5220 J=16
5230 NEXT J,I
: RETURN
5240 REM %ERR
5250 DEFFN'200(STR(E$,,3))
: E=ERR
: RESTORE LINE9010,MAX(E-88,1)
: READ STR(E$,4)
5260 PRINT HEX(0706);AT(14,10,230);"Error ";STR(E$,4,1);E;"at address ";STR(E$
,,3);AT(15,10);STR(E$,5);AT(16,10);
: LINPUT "KEY RETURN",P1$
: Q$="I"
: PRINT HEX(06);AT(14,0,);
: RETURN
5280 DEFFN'255(N1$,S1$,T1,S3,N2$,S2$,T2)
: Q$=" "
: REM %INIT
: N5,N6=1
: N6$="@SPAN"
: U7,T3,T5=0
5290 REM %CHECK
: Q$="F"
: IF STR(N1$,,5)="@SPAN"AND STR(N1$,6)<>"001"OR STR(N2$,,5)="@SPAN"THEN RET
URN
: GOSUB '100(S1$)
: IF Q$<>" "THEN RETURN
: GOSUB '105(1,S1$,T1)
: IF Q$<>" "THEN RETURN
: GOSUB '100(S2$)
: IF Q$<>" "THEN RETURN
: GOSUB '105(2,S2$,T2)
: IF Q$<>" "THEN RETURN
: PRINT HEX(06);AT(14,10,70);"Calculating output parameters";
5300 REM DOES FILE EXIST?
: GOSUB '115(1,0,S1$,T1)
: GOSUB '220
: GOSUB '130(1,1,N1$,0,VAL(STR(S$(),2))-1,S1$,T1)
: IF Q$="N"THEN RETURN
: S1=R4
: S2=R5
5310 REM %START,END,USED,NAME,TYPE
5320 IF STR(N1$,,5)="@SPAN"THEN 5330
: REM NON-SPANNING INPUT FILE
: S4,S7=S1
: N5$=N1$
: GOSUB '115(1,S2,S1$,T1)
: GOSUB '220
: S6=VAL(STR(S$(),2),2)
: T4=S6+MIN(S3,S2-S1-S6+1)
: T0=R3
: GOTO 5350
5330 REM SPANNING INPUT FILE
: S4,S7=S1+1
: GOSUB '115(1,S1,S1$,T1)
: GOSUB '220
: S6=VAL(STR(S$(),5),2)
: T4=S6+MIN(S3,VAL(STR(S$(),3),2)-S6)
: N5$=STR(S$(),9)
: T0=-SGN(VAL(STR(S$(),2))/128)+2
5350 REM OUTPUT DISK
: GOSUB '115(2,0,S2$,T2)
: GOSUB '220
: R0=VAL(STR(S$(),2))
: R7=VAL(STR(S$(),3),2)
: R8=VAL(STR(S$(),5),2)
: REM SCAN OUTPUT INDEX
: GOSUB '130(1,2,N2$,0,R0-1,S2$,T2)
: IF Q$<>" "THEN GOTO 5430
: GOSUB '115(2,S9,S2$,T2)
: IF R5-R4+1<S6+S3-T5THEN 5390
5360 REM %FILE EXISTS
: N6$=N2$
: IF T2=0THEN 5370
: REM CHANGE STATUS/TYPE (3741)
: STR(S$(S8,1),,2)=HEX(10)&BIN(-SGN(T0-2)*128)
: GOSUB '110(2,S9,S2$,T2)
: GOSUB '220
: GOTO 5380
5370 REM SCRATCH/REOPEN (2200)
: SCRATCH T#2,N2$
: IF ABS(T0)=1THEN SAVE T#2,(N2$)N2$0,0
: ELSE DATA SAVE DC OPEN T#2,N2$,N2$
5380 REM COPY
: GOSUB '140(S4,MAX(1,T4-1))
: REM SET END OF FILE
: GOSUB '130(1,2,N2$,0,R0-1,S2$,T2)
5385 IF STR(N1$,,5)<>"@SPAN"THEN GOTO 5386
: GOSUB '205(R5,S5)
: GOTO 5387
5386 GOSUB '205(R5,S2)
5387 REM VERIFY
: GOSUB '230
: Q$=" "
: RETURN
5390 REM %OLD FILE TOO SMALL
: IF T2=0THEN 5400
: STR(S$(S8,1),,2)=HEX(11)
: S$(S8,2)="@JUNKAAA"
: GOSUB '110(2,S9,S2$,T2)
: GOSUB '220
: GOTO 5430
5400 REM GET UNIQUE NAME
: N4$="@JUNKAAA"
5410 LIMITS T#2,N4$,R4,R5,R3,R3
: IF R3=0THEN 5420
: I=POS(-N4$<>"Z")
: STR(N4$,I,1)=ADDHEX(01)
: IF I<8THEN STR(N4$,I+1)=ALL("A")
: GOTO 5410
5420 REM SCRATCH/RENAME (2200)
: SCRATCH T#2,N2$
: IF T0=1THEN SAVE T#2,(N2$)N4$0,0
: ELSE DATA SAVE DC OPEN T#2,N2$,N4$
: SCRATCH T#2,N4$
5430 REM %FILE DOESN'T EXIST
: Q$=" "
5440 IF N6=1AND R8-R7-1>=S6+S3-T5THEN N6$=N2$
: ELSE CONVERT N6TO STR(N6$,6),(###)
: IF STR(N6$,,5)<>"@SPAN"THEN 5490
: IF R8-R7<=2THEN 5525
5450 PRINT AT(11,0,);"File ";N1$;" will not fit on disk ";S$
: IF P0$="Y"THEN 5460
: P0$="N"
: LINPUT "Would you like an @SPANxxx file? Y/N ",P0$
: IF P0$="y"THEN P0$="Y"
: IF P0$<>"Y"THEN 5525
5460 REM SECTORS ALLOCATED
: REM OPEN FILE
: GOSUB '210(MIN(S6+S3-U7+2,R8-R7),2)
: IF Q$="I"THEN 5350
: U7=U7+MIN(S6+S3-U7,R8-R7-2)
5470 REM SAVE ORIGINAL PARMS
: S$()=HEX(10)&BIN(-SGN(ABS(T0)-2)*128)&BIN(S6+S3,2)&BIN(S6,2)&BIN(N6,2)&ST
R(N2$)&ALL(00)
: GOSUB '110(2,R7,S2$,T2)
: GOSUB '220
: IF T5>=T4THEN 5505
: GOTO 5500
5490 REM SECTORS ALLOCATED
: U7=S6+S3
: REM OPEN FILE
: GOSUB '210(S6+S3,T0)
: IF Q$="I"THEN 5350
: GOTO 5380
5500 REM MOVE FILE
: R9=MIN(R8-R7-2,T4-T5)
: GOSUB '140(S7,R9)
: REM SECTORS COPIED
: T5=T5+R9
5505 REM WRITE TRAILER
: GOSUB '130(1,2,N6$,0,R0-1,S2$,T2)
: IF STR(N3$,,5)<>"@SPAN"THEN GOTO 5506
: GOSUB '115(1,T4+T6-1,S1$,T1)
: STR(S$(),2,2)=BIN(R5-R4+1,2)
: GOSUB '110(2,R5,S2$,T2)
: GOSUB '220
: GOTO 5507
5506 GOSUB '205(R5,R5-R4+1)
5507 REM VERIFY
: GOSUB '230
: REM DONE?
: IF T5<T4OR U7<S6+S3THEN 5520
5508 REM ALL DONE
: IF STR(N3$,,5)<>"@SPAN"THEN 5510
: LIMITS T#1,N1$,D1,D2,D3,D4
: GOSUB '115(1,D2,S1$,T2)
: STR(S$(),2,2)=BIN(D3,2)
: GOSUB '110(2,R5-1,S1$,T2)
5510 REM DONE
: Q$=" "
: RETURN
5520 N6=N6+1
: REM UPDATE STARTING SECTOR
: S7=S4+T5
: REM MORE TO COPY
5525 PRINT AT(14,10);"Output platter full. Mount a new one to continue copying
.";AT(15,10);
: P1$=" "
: LINPUT "Key RETURN",P1$
5530 PRINT HEX(06);AT(14,10,)
: IF T2=0THEN 5350
: PRINT AT(14,10);"Initializing output platter";
: GOSUB '240(S2$)
: PRINT AT(14,10,70);
: GOTO 5350
5540 DEFFN'140(T6,T7)
: GOSUB '130(1,2,N6$,0,R0-1,S2$,T2)
: REM FIRST OUTPUT SECTOR
: IF STR(N6$,,5)="@SPAN"THEN S0=R4+1
: ELSE S0=R4
: IF STR(N1$,,5)="@SPAN"THEN 5550
: REM COPY
: PRINT AT(14,10);"Copying file ";N5$;" (Output name =";N6$;")"
: GOSUB '150(T6,T6+T7-1,S0)
: RETURN
5550 REM %SPANNING INPUT FILE
: GOSUB '115(1,0,S1$,T1)
: GOSUB '220
: GOSUB '130(1,1,N1$,0,VAL(STR(S$(),2))-1,S1$,T1)
: IF Q$=" "THEN 5570
5560 PRINT AT(14,10,80);"Mount platter containing file ";N1$;AT(15,10,80);
: LINPUT "Key RETURN",P1$
: PRINT AT(14,10,);
: GOTO 5550
5570 REM FIRST INPUT SECTOR
: S4=R4+1
: REM LAST INPUT SECTOR
: S5=R5-1
: GOSUB '115(1,S4-1,S1$,T1)
: GOSUB '220
: IF STR(S$(),9,8)=N5$THEN 5580
: PRINT AT(14,10,80);N1$;" does not contain file ";N5$;AT(15,10,80);
: LINPUT "Mount the correct platter and key RETURN",P1$
: PRINT AT(14,10,)
: GOTO 5550
5580 REM OK. TO COPY
: PRINT AT(14,10);"Copying file ";N1$;" containing file ";N5$;" (Output nam
e =";N6$;")"
: GOSUB '150(S4,MIN(S5,S4+T7-T3-1),S0)
: REM # OF SECTORS COPIED SO FAR
: T3=T3+U2-U1+1
: IF T3>=T7THEN RETURN
: S0=S0+U2-U1+1
: N5=N5+1
: CONVERT N5TO STR(N1$,6),(###)
: GOTO 5550
5590 REM %COPY
5600 DEFFN'150(U1,U2,U3)
: REM 2200
: IF T1+T2<>0THEN 5610
: COPY T#1,(U1,U2)TO T#2,(U3)
: RETURN
5610 REM COPY FROM OR TO 3741
: FOR I=U1TO U2
: GOSUB '115(1,I,S1$,T1)
: GOSUB '220
: GOSUB '110(2,U3+I-U1,S2$,T2)
: GOSUB '220
: NEXT I
: RETURN
5630 REM %WRITE TRAILER
5640 DEFFN'205(U4,U5)
: GOSUB '115(1,U5,S1$,T1)
: GOSUB '110(2,U4,S2$,T2)
: GOSUB '220
: RETURN
5650 REM % OPEN A FILE
: REM 2200
5660 DEFFN'210(U6,U)
: REM ALLOCATE FILE SPACE
: IF T2<>0THEN 5690
: IF ABS(U)=2THEN 5670
: SAVE T#2,(U6-3)N6$0,0
: ERRORIF ERR=85THEN 5740
: ELSE GOSUB '200(S2$)
5665 RETURN
5670 DATA SAVE DC OPEN T#2,(U6)N6$
: ERRORIF ERR=85THEN 5740
: ELSE GOSUB '200(S2$)
5680 RETURN
5690 REM %3741
: N4$=ALL(00)
: REM SCAN INDEX
: FOR I=0TO 12
: GOSUB '115(2,I,S2$,T2)
: GOSUB '220
: MAT SEARCHSTR(S$(),,256),=STR(N4$)TO L$STEP 16
: REM BRANCH IF CURRENT SECTOR FULL
: IF L$=HEX(0000)THEN 5730
: REM STORE SECTOR #
: S8=I
5700 REM UPDATE SECTOR 0
: GOSUB '115(2,0,S2$,T2)
: GOSUB '220
: N4=VAL(STR(S$(),3),2)
: IF N4+U6>VAL(STR(S$(),5),2)THEN 5720
: STR(S$(),3,2)=BIN(N4+U6,2)
: GOSUB '110(2,0,S2$,T2)
: GOSUB '220
5710 REM CREATE ENTRY
: GOSUB '115(2,S8,S2$,T2)
: GOSUB '220
: STR(S$(),VAL(L$,2))=HEX(10)&BIN(MOD(ABS(U),2)*128)&BIN(N4,2)&BIN(N4+U6-1,
2)&HEX(0000)&STR(N6$)&ALL(00)
: GOSUB '110(2,S8,S2$,T2)
: RETURN
5720 PRINT AT(14,10,);HEX(0E);"Insufficient room to create file in output plat
ter";AT(15,10);
: LINPUT "Mount a new platter and key RETURN",P1$
: PRINT HEX(06);AT(14,10,);
: GOTO 5690
5730 NEXT I
5740 REM NO FREE ENTRIES
: PRINT AT(14,10,70);HEX(0E);"Ouput index full";AT(15,10);
: LINPUT "Mount a new platter and key RETURN",P1$
: PRINT HEX(06);AT(14,10,);
: GOTO 5660
5750 REM %VERIFY
5760 DEFFN'230
: PRINT AT(14,10,70);"Verifying file ";N6$;
: VERIFY T#2,(R4*(SGN(T2)+1)+T2,R5*(SGN(T2)+1)+T2)E
: IF E<>0THEN 5770
: PRINT AT(14,10,70)
: RETURN
5770 REM ERROR (QUIT)
: PRINT AT(15,10,70);"Error in sector";(E-T2)/(SGN(T2)+1)-R4;"of file ";N6$
: END
5780 REM SOMETHING'S WRONG; QUIT
5790 DEFFN'220
: IF Q$<>"I"THEN RETURN
: END
5800 REM %SCRATCH 3741
5810 DEFFN'240(S$)
: REM UPDATE INDEX
: S$()=HEX(000D000D03E9)&ALL(00)
: GOSUB '110(2,0,S$,2^14)
: S$()=ALL(00)
: FOR I=1TO 12
: GOSUB '110(2,I,S$,2^14)
: NEXT I
: RETURN
9010 DATA "PIllegal Device Address","IDisk Hardware Error","IDisk Hardware Err
or","ITimeout Error","IDisk Format Error","IFormat Key Engaged","IDevice
Error (May Be a Protected Platter","ICyclic Read Error"
9020 DATA "ILRC Error","IIllegal sector address or platter not mounted","IRead
After Write Error"