image of READY prompt

Wang2200.org

Listing of file='@MOVE1' on disk='vmedia/701-2294O.wvd.zip'

# Sector 743, program filename = '@MOVE1'
5000 REM % Prog = @MOVE1      By PLS     Date = 05/12/81    Time = 00.00.00 PM
         Rel 2.4
5020 REM %VALIDATE ADDR
5030 DEFFN'100(S$)
   : MAT SEARCH"310320330350360370B10B20B30B50B60B70D10D11D12D13D14D15D20D21D2
     2D23D24D25D30D31D32D33D34D35D50D51D52D53D54D55D60D61D62D63D64D65D70D71D72
     D73D74D75",=STR(S$)TO Q6$STEP 3
   : IF Q6$=HEX(0000)THEN Q$="I"
   : ELSE 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
   : 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 LINE 9010,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)
   : GOSUB '205(R5,S6)
   : 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
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)
   : GOSUB '205(R5,R5-R4+1)
   : REM VERIFY
   : GOSUB '230
   : REM DONE?
   : IF T5<T4OR U7<S6+S3THEN 5520
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);
   : LINPUT "Key RETURN",P1$
   : 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,S2,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 SEARCH STR(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"