image of READY prompt

Wang2200.org

Listing of file='@MOVEFIL' on disk='vmedia/731-8015D.wvd.zip'

# Sector 578, 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"