image of READY prompt

Wang2200.org

Listing of file='KFAM4103' on disk='vmedia/701-2049C.wvd.zip'

# Sector 282, program filename = 'KFAM4103'
0010 REM KFAM4103,VER.02/18/76
0012 COM Q6$64
   : DIM X$64,D8$21,E$60,I1$3,O1$3,T$1,Z$8,H$2,L$1
   : DIM X1$2,N$8,I$(32)8,D$(4)64
   : D8$="310320330350B10B20B30"
   : C=0
   : PRINT HEX(030A0A0A0A)
   : PRINT "DISK COPY AND REORGANIZE"
0640 GOSUB '125("ENTER THE NO. OF THE INPUT PLATTER DEVICE ADDRESS")
   : D1=X
   : I1$=STR(D8$,X*3-2,3)
   : ON D1-1GOTO 703,706,709,712,715,718
   : SELECT #1310
   : GOTO 770
0703 SELECT #1320
   : GOTO 770
0706 SELECT #1330
   : GOTO 770
0709 SELECT #1350
   : GOTO 770
0712 SELECT #1B10
   : GOTO 770
0715 SELECT #1B20
   : GOTO 770
0718 SELECT #1B30
0770 GOSUB '125("ENTER THE NO. OF THE OUTPUT PLATTER DEVICE ADDRESS")
   : D2=X
   : O1$=STR(D8$,X*3-2,3)
   : ON D2-1GOTO 833,836,839,842,845,848
   : SELECT #2310
   : GOTO 900
0833 SELECT #2320
   : GOTO 900
0836 SELECT #2330
   : GOTO 900
0839 SELECT #2350
   : GOTO 900
0842 SELECT #2B10
   : GOTO 900
0845 SELECT #2B20
   : GOTO 900
0848 SELECT #2B30
0900 IF I1$<>O1$THEN 960
   : GOSUB '40("INPUT AND OUTPUT PLATTERS MUST BE DIFFERENT")
   : GOTO 640
0960 GOSUB '243("ENTER FILE NAME",8)
   : N$=Q6$
   : IF N$=" "THEN 1870
   : GOSUB '50(N$,1)
   : IF X>0THEN 990
   : GOSUB '40("FILE NOT FOUND")
   : GOTO 960
0990 LIMITS T#1,N$,F0,F9,F1
   : L=F9-F0+1
0995 DATA LOAD BA T#1,(F0,X)D$()
   : AND (STR(D$(1),1,1),10)
   : IF STR(D$(1),1,1)=HEX(00)THEN 1020
   : GOSUB '40("PROTECTED PROGRAM")
   : GOTO 960
1020 DATA LOAD BA T#2,(0,X)D$()
   : X1$=STR(D$(1),1,2)
   : GOSUB '41
   : S7=X
   : X1$=STR(D$(1),3,2)
   : GOSUB '41
   : S0=X
   : X1$=STR(D$(1),5,2)
   : GOSUB '41
   : S9=X
   : S2=S9-S0
   : GOSUB '248(5,0,1)
   : PRINT "INPUT ";I1$,"OUTPUT ";O1$,"AVAILABLE SPACE ";TAB(48);S2
1160 IF C>0THEN 1200
1170 C=7
   : GOSUB '248(7,0,8)
   : PRINT "FILE NAME    LENGTH    SECTORS USED    NEW LENGTH"
1200 C=C+1
   : IF C>14THEN 1170
   : GOSUB '248(C,0,0)
   : PRINTUSING 1240,N$,L,F1
1240 %########     #####           #####
1245 IF F1>S2THEN 1845
1260 GOSUB '245("ENTER NUMBER OF SECTORS TO BE COPIED",5,0)
   : N1=Q9
   : IF N1<F1THEN 1810
   : IF N1>S2THEN 1830
   : GOSUB '248(C,44,0)
   : PRINTUSING 1320,N1
1320 %#####
1340 DATA SAVE DC OPEN T$#2,N1,N$
1360 DATA LOAD BA T#1,(F9,X)D$()
   : T$=STR(D$(1),1,1)
   : AND (T$,F0)
1420 DATA SAVE BA T$#2,(S0+N1-1,X)D$()
   : Z=L-2
   : IF N1>LTHEN 1480
   : Z=N1-2
1480 FOR Y=0TO Z
1490 DATA LOAD BA T#1,(F0+Y,X)D$()
1500 DATA SAVE BA T$#2,(S0+Y,X)D$()
   : NEXT Y
   : IF T$=HEX(A0)THEN 1785
   : Z$=N$
   : XOR (STR(Z$,2),Z$)
   : L$=STR(Z$,8,1)
   : H$=HEX(0000)
   : ADDC(H$,L$)
   : ADDC(H$,L$)
   : ADDC(H$,L$)
   : ADD(STR(H$,1,1),STR(H$,2,1))
   : H=VAL(H$)
   : H=H-INT(H/S7)*S7
1670 DATA LOAD BA T#2,(H,X)I$()
   : GOSUB '42
   : IF X>0THEN 1770
   : H=0
1710 DATA LOAD BA T#2,(H,X)I$()
   : GOSUB '42
   : IF X>0THEN 1770
   : H=H+1
   : IF H<S7THEN 1710
   : STOP "DISASTER"
1770 STR(I$(X-1),2,1)=HEX(80)
1780 DATA SAVE BA T$#2,(H,X)I$()
1785 GOSUB '248(5,48,1)
   : PRINT S2-N1
   : GOTO 960
1810 GOSUB '40("LESS THAN SECTORS USED")
   : GOTO 1260
1830 GOSUB '40("GREATER THAN AVAILABLE SPACE")
   : GOTO 1260
1845 STOP "NO ROOM TO COPY"
1870 GOSUB '248(0,0,4)
   : GOSUB '50("START050",0)
   : IF X>0THEN 1890
   : PRINT "MOUNT SYSTEM DISK"
   : GOSUB '243("KEY RETURN(EXEC) TO RESUME",0)
   : GOTO 1870
1890 COM CLEAR Q6$
   : LOAD DC T#0,"START050"
1920 DEFFN'40(E$)
   : GOSUB '248(3,0,0)
   : PRINT E$
   : RETURN
3410 DEFFN'50(N$,Z)
3430 DATA LOAD BA T#Z,(0,X)I$()
   : X1$=STR(I$(1),1,2)
   : GOSUB '41
   : S7=X
   : Z$=N$
   : XOR (STR(Z$,2),Z$)
   : L$=STR(Z$,8,1)
   : H$=HEX(0000)
   : ADDC(H$,L$)
   : ADDC(H$,L$)
   : ADDC(H$,L$)
   : ADD(STR(H$,1,1),STR(H$,2,1))
   : H=VAL(H$)
   : H=H-INT(H/S7)*S7
3640 DATA LOAD BA T#Z,(H,X)I$()
   : GOSUB '42
   : IF X>0THEN 3770
   : IF Y=0THEN 3770
   : H=0
3710 DATA LOAD BA T#Z,(H,X)I$()
   : GOSUB '42
   : IF X>0THEN 3770
   : H=H+1
   : IF H<S7THEN 3710
3770 RETURN
3800 DEFFN'41
   : AND (STR(X1$,1,1),7F)
   : X=VAL(X1$)*256+VAL(STR(X1$,2))
   : RETURN
3860 DEFFN'42
   : Y=0
   : X=2
   : IF H>0THEN 3910
   : X=4
3910 IF STR(I$(X-1),1,1)=HEX(10)THEN 3940
   : IF STR(I$(X-1),1,1)=HEX(00)THEN 3990
   : GOTO 3950
3940 IF I$(X)=N$THEN 4010
3950 X=X+2
   : IF X<34THEN 3910
   : Y=1
3990 X=0
4010 RETURN
4060 DEFFN'125(X$)
   : GOSUB '248(5,0,5)
   : PRINT ,"1.  310     5.  B10"
   : PRINT ,"2.  320     6.  B20"
   : PRINT ,"3.  330     7.  B30"
   : PRINT ,"4.  350"
4120 GOSUB '245(X$,1,0)
   : X=Q9
   : IF X<1THEN 4180
   : IF X>7THEN 4180
   : GOSUB '248(5,0,5)
   : RETURN
4180 PRINT HEX(010A0A0A)
   : PRINT "INVALID DEVICE ADDRESS"
   : GOTO 4120
8710 Q6=3
   : GOTO 9289
8975 DEFFN'242(W0,Q6$)
   : IF W0<=0THEN 9405
   : IF W0=1THEN 8990
   : STR(Q6$,2)=STR(Q6$,1,W0-1)
8990 PRINT Q6$;
   : RETURN
9010 DEFFN'243(Q6$,Q0)
   : GOSUB 9200
9022 SELECT CO 205
   : Q6$=" "
   : INPUT Q6$
   : IF Q0=0THEN 9231
   : IF LEN(Q6$)<=Q0THEN 9231
   : GOSUB 9150
9032 DEFFN'244(Q0)
   : GOSUB 9220
   : GOSUB 9210
   : GOTO 9022
9038 DEFFN'245(Q6$,Q2,Q3)
   : Q0=ABS(Q2)+Q3+1
   : GOSUB 9200
9044 GOSUB '242(ABS(Q2)+2,HEX(09))
   : PRINT "/"
   : GOSUB 9220
   : SELECT CO 205
   : Q9,W0=-1E-99
   : INPUT Q9
   : IF W0=Q9THEN 9058
   : IF Q9>=0THEN 9070
   : IF Q2<=0THEN 9070
9058 GOSUB 9150
9060 DEFFN'246(Q2,Q3)
   : Q0=ABS(Q2)+Q3+1
   : GOSUB 9220
   : GOSUB 9210
   : GOTO 9044
9070 IF ABS(Q9)>=10^ABS(Q2)THEN 9058
   : W0=ABS(Q9*10^Q3)
   : IF INT(W0)<>W0THEN 9058
   : GOTO 8710
9150 GOSUB 8710
   : PRINT "RE-ENTER"
   : RETURN
9200 GOSUB 9405
   : PRINT HEX(010A);STR(Q6$,1);
9210 GOSUB 9405
   : GOSUB '242(Q0+2,"-")
   : PRINT TAB(64)
9220 PRINT HEX(010A0A)
   : RETURN
9231 PRINT HEX(0A);TAB(64)
   : GOTO 9405
   : Q6=0
9289 Q7=0
   : Q8=1
9290 DEFFN'248(Q6,Q7,Q8)
   : GOSUB 9405
   : IF Q8<1THEN 9350
   : GOSUB 9350
   : SELECT PRINT 205
   : Q6$=" "
   : PRINT STR(Q6$,Q7+1)
   : IF Q8<2THEN 9350
   : FOR W0=2TO Q8
   : PRINT HEX(0A);STR(Q6$,1)
   : NEXT W0
9350 PRINT HEX(01)
   : GOSUB '242(Q7,HEX(09))
   : GOSUB '242(Q6,HEX(0A))
9405 SELECT PRINT 005(64),CO 005
   : RETURN