image of READY prompt

Wang2200.org

Listing of file='KFAM3004' on disk='vmedia/701-2086B.wvd.zip'

# Sector 529, program filename = 'KFAM3004'
0001 REM KFAM3004,VER.11/08/76
0004 COM D1,D2,D4,S7
   : COM R,R0,R3,R5,R7,R1$2,R2$1,R6$2,S9,C$40,N,R0$3
   : COM Q6$64
   : GOTO 3072
3072 LOAD DC T#0,"KFAM0104"3072,3072
4800 DIM C$40,Y$1,U1$8,U0$3,K1$8,K0$3,R3$8,F0$3,X1$2
   : DIM X$64,D$(4)64
4900 PRINT HEX(03)
   : GOSUB '243("ARE THERE BACKUP COPIES OF USER FILE AND KEY FILE? (Y OR N)",
     1)
   : IF Q6$="Y"THEN 5010
   : PRINT "ANY ERROR DURING THE RUNNING OF KFAM3204 WILL"
   : PRINT "DESTROY BOTH FILES."
   : PRINT HEX(0A)
4960 PRINT "MAKE COPIES OF THE DISK PLATTER(S) CONTAINING"
   : PRINT "THE USER FILE AND THE KEY FILE BEFORE RUNNING"
   : PRINT "THIS PROGRAM."
   : STOP
   : GOTO 4900
5010 GOSUB '243("ENTER USER FILE NAME (SSSSFJNN)",8)
   : U1$=Q6$
   : IF STR(U1$,5,1)<>"F"THEN 5060
   : IF STR(U1$,6,1)<"0"THEN 5060
   : IF STR(U1$,6,1)<="9"THEN 5090
5060 GOSUB '50("NOT KFAM FILE NAME")
   : GOTO 5010
5090 GOSUB '125("ENTER THE NO. OF THE USER FILE DEVICE ADDRESS")
   : D2=Q9
   : GOSUB 7740
5190 GOSUB '245("ENTER KEY FILE NUMBER (NORMAL=1)",1,0)
   : K9=Q9
   : IF K9>0THEN 5240
   : GOSUB '50("INVALID")
   : GOTO 5190
5240 K1$=U1$
   : STR(K1$,5,1)="K"
   : CONVERT K9TO STR(K1$,6,1),(#)
   : GOSUB '125("ENTER THE NO. OF THE KEY FILE DEVICE ADDRESS")
   : D1=Q9
5510 GOSUB '243("ENTER WORK FILE NAME",8)
   : R3$=Q6$
   : GOSUB '125("ENTER THE NO. OF THE WORK FILE DEVICE ADDRESS")
   : D4=Q9
   : GOSUB 8090
   : IF R3$<>" "THEN 5730
   : DATA LOAD BA T#4,(0,X)D$()
   : R6$=STR(D$(1),5,2)
   : AND (STR(R6$,1,1),7F)
5690 X1$=R6$
   : ADDC(X1$,0E)
   : DATA SAVE BA T$#4,(X1$,X1$)D$()
   : GOTO 5870
5730 GOSUB '243("IS WORK FILE CATALOGUED? (Y OR N)",1)
   : PRINT HEX(03)
   : IF Q6$="Y"THEN 5780
   : DATA SAVE DC OPEN T$#4,15,R3$
5780 LIMITS T#4,R3$,X,Y,Z
   : Z=INT(X/256)
   : BIN(R6$)=Z
   : BIN(STR(R6$,2))=X-256*Z
   : IF Y-X>13THEN 5870
   : GOSUB '50("WORK FILE TOO SMALL")
   : GOTO 5510
5870 GOSUB '230(1,1,2,K9,U1$,"X")
   : IF Q$=" "THEN 5910
   : IF Q$<>"C"THEN 5890
   : GOSUB '51("ACCESS NOT EXCLUSIVE")
5890 GOSUB '51("ERROR OPENING FILES")
5910 LIMITS T#2,U1$,X,Y,Z
   : Z=INT(X/256)
   : BIN(R1$)=Z
   : BIN(STR(R1$,2))=X-256*Z
   : S7=Y-1
   : R=VAL(STR(V1$,2))
   : R0=VAL(V8$)
   : R5=VAL(STR(V1$,5))
   : R3=VAL(STR(V1$,3))*256+VAL(STR(V1$,4))+1
   : R2$=V1$
   : S9=VAL(V6$)
   : IF S9>40THEN 6170
   : IF R2$="A"THEN 6410
   : INIT(C0)C$
6060 N=S9
   : R7=1
   : IF R2$<>"M"THEN 6120
   : R7=INT((R3-1)/256)+1
   : R3=R3-256*(R7-1)
6120 GOSUB 7550
   : GOSUB 7910
   : LOAD DC T#0,"KFAM3104"4000,9990
6170 GOSUB '51("MORE THAN 40 SECTORS PER RECORD")
6290 DEFFN'50(Q6$)
   : PRINT HEX(010A0A0A)
   : PRINT Q6$
   : RETURN
6350 DEFFN'51(Q6$)
   : PRINT HEX(01)
   : PRINT Q6$
   : GOSUB 7370
   : $IF ON #1,6380
6380 STOP
6410 GOSUB '235(1,0)
   : X1$=T4$
   : ADDC(X1$,R1$)
   : DATA LOAD BA T#2,(X1$,X1$)D$()
   : IF STR(D$(1),1,2)=HEX(8101)THEN 6440
6430 GOSUB '51("INVALID RECORD FORMAT")
6440 N=0
   : P=3
   : C=0
6470 X=INT((P-1)/64)
   : Y=P-64*X
   : X=X+1
   : Y$=STR(D$(X),Y,1)
   : IF Y$=HEX(FD)THEN 6680
   : IF Y$=HEX(08)THEN 6550
   : IF Y$<HEX(81)THEN 6430
   : IF Y$>HEX(C0)THEN 6430
6550 IF C=0THEN 6580
   : IF Y$=STR(C$,N,1)THEN 6610
6570 GOSUB '51("NOT BLOCKED AS SPECIFIED")
6580 N=N+1
   : IF N>38THEN 6430
   : STR(C$,N,1)=Y$
6610 C=C+1
   : AND (Y$,7F)
   : P=P+1+VAL(Y$)
   : IF C<R0THEN 6470
   : C=0
   : GOTO 6470
6680 IF C>0THEN 6570
   : X=(P-3)/R0
   : IF X=RTHEN 6720
   : GOSUB '51("RECORD LENGTH NOT SPECIFIED CORRECTLY")
6720 IF N=0THEN 6430
   : P=3
   : N1=0
6770 N1=N1+1
   : IF N1>NTHEN 6870
   : Y$=STR(C$,N1,1)
   : AND (Y$,7F)
   : Y=VAL(Y$)+1
   : IF P+Y>=R3THEN 6860
   : P=P+Y
   : GOTO 6770
6860 IF R3+R5<=P+YTHEN 6880
6870 GOSUB '51("KEY FIELD OUT OF BOUNDS")
6880 IF STR(C$,N1,1)>HEX(80)THEN 6910
   : GOSUB '51("NUMERIC KEY INVALID")
6910 R3=R3-P
   : R7=N1
   : GOTO 6120
6980 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"
7040 GOSUB '245(X$,1,0)
   : X=Q9
   : IF X<1THEN 7100
   : IF X>7THEN 7100
   : GOSUB '248(5,0,5)
   : RETURN
7100 PRINT HEX(010A0A0A)
   : PRINT "INVALID DEVICE ADDRESS"
   : GOTO 7040
7170 DEFFN'210(T6)
7180 IF M$="X"THEN 7370
   : ON D1GOTO 7200,7220,7240,7260,7280,7300,7320
7200 SELECT #1390
   : RETURN
7220 SELECT #13A0
   : RETURN
7240 SELECT #13B0
   : RETURN
7260 SELECT #13D0
   : RETURN
7280 SELECT #1B90
   : RETURN
7300 SELECT #1BA0
   : RETURN
7320 SELECT #1BB0
   : RETURN
7360 DEFFN'211(T6)
   : GOTO 7180
7370 ON D1GOTO 7380,7400,7420,7440,7460,7480,7500
7380 SELECT #1310
   : RETURN
7400 SELECT #1320
   : RETURN
7420 SELECT #1330
   : RETURN
7440 SELECT #1350
   : RETURN
7460 SELECT #1B10
   : RETURN
7480 SELECT #1B20
   : RETURN
7500 SELECT #1B30
   : RETURN
7550 IF M$="X"THEN 7740
   : ON D2GOTO 7570,7590,7610,7630,7650,7670,7690
7570 SELECT #2390
   : RETURN
7590 SELECT #23A0
   : RETURN
7610 SELECT #23B0
   : RETURN
7630 SELECT #23D0
   : RETURN
7650 SELECT #2B90
   : RETURN
7670 SELECT #2BA0
   : RETURN
7690 SELECT #2BB0
   : RETURN
7740 ON D2GOTO 7750,7770,7790,7810,7830,7850,7870
7750 SELECT #2310
   : RETURN
7770 SELECT #2320
   : RETURN
7790 SELECT #2330
   : RETURN
7810 SELECT #2350
   : RETURN
7830 SELECT #2B10
   : RETURN
7850 SELECT #2B20
   : RETURN
7870 SELECT #2B30
   : RETURN
7910 IF M$="X"THEN 8090
   : ON D4GOTO 7930,7950,7970,7990,8010,8030,8050
7930 SELECT #4390
   : RETURN
7950 SELECT #43A0
   : RETURN
7970 SELECT #43B0
   : RETURN
7990 SELECT #43D0
   : RETURN
8010 SELECT #4B90
   : RETURN
8030 SELECT #4BA0
   : RETURN
8050 SELECT #4BB0
   : RETURN
8090 ON D4GOTO 8100,8120,8140,8160,8180,8200,8220
8100 SELECT #4310
   : RETURN
8120 SELECT #4320
   : RETURN
8140 SELECT #4330
   : RETURN
8160 SELECT #4350
   : RETURN
8180 SELECT #4B10
   : RETURN
8200 SELECT #4B20
   : RETURN
8220 SELECT #4B30
   : RETURN
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 Q0>1THEN 9025
   : IF Q6$="Y"THEN 9025
   : IF Q6$<>"N"THEN 9027
9025 IF LEN(Q6$)<=Q0THEN 9231
9027 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