image of READY prompt

Wang2200.org

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

# Sector 403, program filename = 'KFAM3204'
4000 REM KFAM3204,VER.03/02/76
4310 DIM S$8,R2$(8)2,R7$30,R4$3
   : DIM R8$2,K$30,R$2,R5$2,R9$2
4380 LOAD DA T#4,(R6$,R6$)4400,4459
4400 DIM A0$(4)64,E0$(4)64,I0$(4)64
4460 PRINT HEX(030A0A0A0A)
   : PRINT "REORGANIZE KFAM FILE (KFAM3204)"
4530 GOSUB '235(1,0)
   : IF Q$<>" "THEN 7130
   : GOSUB 5790
   : R$=HEX(0000)
   : R1=1
4600 GOSUB 5700
   : IF R2$>"C"THEN 5410
4650 R9$=R4$
   : ADDC(R9$,R1$)
4720 Z=1
4770 Z=2
4810 R9$=R4$
   : ADDC(R9$,R1$)
4890 GOSUB '66
   : IF STR(K$,1,1)=HEX(FF)THEN 5100
   : GOSUB '232(1,0,K$)
   : IF Q$="N"THEN 5100
   : IF Q$<>" "THEN 7130
   : IF STR(T4$,1,2)<>R$THEN 5100
   : IF Q<>R1THEN 5100
   : STR(T3$(1),T4+1,3)=STR(R4$,1,3)
   : MAT COPY T3$()<1,T5>TO T0$()<T,T5>
   : GOSUB 7970
5100 R5$=R4$
   : GOSUB 5890
   : GOSUB '237(1,0)
   : IF Q$="E"THEN 5350
   : IF Q$<>" "THEN 7130
   : GOSUB 5790
   : IF R2$>"C"THEN 5300
   : R1=R1+1
   : IF R1>R0THEN 5270
   : IF R5$=R$THEN 4600
   : GOTO 4650
5270 GOSUB 5620
   : R1=1
5300 ADDC(R$,V6$)
   : GOTO 4600
5350 GOSUB 5620
   : GOTO 6740
5410 IF R$=STR(R4$,1,2)THEN 5100
   : R8$=R$
   : ADDC(R8$,R1$)
   : R9$=R4$
   : ADDC(R9$,R1$)
   : FOR X=1TO S9
   : DATA LOAD BA T#2,(R9$,R9$)E0$()
   : DATA SAVE BA T$#2,(R8$,R8$)E0$()
   : NEXT X
   : R9$=R4$
   : ADDC(R9$,R1$)
5590 GOTO 4890
5620 R9$=R$
   : ADDC(R9$,R1$)
5670 RETURN
5700 R9$=R$
   : ADDC(R9$,R1$)
5760 RETURN
5790 S$=T$
   : MAT COPY T2$()TO R2$()
   : R4$=T4$
   : R7$=T7$
   : R2=Q
   : RETURN
5890 T$=S$
   : MAT COPY R2$()TO T2$()
   : T4$=R4$
   : T7$=R7$
   : RETURN
6200 DEFFN'65
   : S8=3+(R1-1)*R
   : S2=3+(R2-1)*R
   : IF Z=2THEN 6430
   : MAT COPY E0$()<S2,R>TO I0$()<S8,R>
   : RETURN
6430 MAT COPY A0$()<S8,R>TO E0$()<S2,R>
   : RETURN
6520 DEFFN'66
   : IF R2$="A"THEN 6670
   : S8=R3+(R1-1)*R
6580 MAT COPY A0$()<S8,R5>TO T3$()
6590 K$=STR(T3$(1),1,R5)
   : RETURN
6670 K$=STR(A0$(R1),R3,R5)
6680 RETURN
6740 Q2$=HEX(0000)
   : BIN(STR(Q2$,2))=S9-1
   : XOR (Q2$,FF)
   : FOR X=1TO 4
   : V5$(X)=V8$
   : NEXT X
   : V2$=HEX(0001)
   : T2$=HEX(0001)
   : T0=1
   : T=1
   : T$=HEX(01)
   : INIT(5A)T8$()
   : INIT(00)T7$
   : INIT(FF)T0$()
   : INIT(00)STR(T0$(1),1,R5)
   : T2$(1),T9$=T2$
   : GOSUB 7970
   : R1=R0
6910 R$=Q2$
   : C1=0
6960 C1=C1+1
   : R1=R1+1
   : IF R1<=R0THEN 7090
   : ADDC(R$,V6$)
   : IF R$<=Q3$THEN 7060
   : GOSUB '70("LAST KEY NOT FOUND")
7060 GOSUB 5700
   : R1=1
7090 GOSUB '66
   : IF K$>T7$THEN 7150
7130 GOSUB '70("SEQUENCE ERROR")
7150 T7$=K$
   : T6$=K$
   : IF T6$<HEX(FF)THEN 7200
   : GOSUB '70("INVALID KEY")
7200 IF VAL(STR(T$,1))+T5<193THEN 7380
   : Q2=1
   : FOR T3=T0TO 1STEP -1
   : IF VAL(STR(T$,T3))+T5<193THEN 7270
   : Q2=Q2+1
   : GOTO 7280
7270 Q2=0
7280 NEXT T3
   : IF Q2<9THEN 7330
7310 GOSUB '70("KEY FILE SPACE EXCEEDED")
7330 V9$=V2$
   : BIN(T6$)=Q2
   : ADDC(V9$,T6$)
   : IF V3$<V9$THEN 7310
7380 V9$=T2$(1)
   : IF V9$=T9$THEN 7450
   : GOSUB 545
7450 T3$=R$
   : BIN(STR(T3$,3))=R1
   : T4$=T3$
   : T3=1
7500 T=VAL(STR(T$,T3))+T5
   : IF T<193THEN 7800
   : INIT(FF)T0$()
   : STR(T0$(1),1,T4)=K$
   : STR(T0$(1),T4+1,3)=T3$
   : ADDC(V2$,01)
   : T9$,T2$(T3),T3$=V2$
   : STR(T$,T3,1)=HEX(01)
   : GOSUB 7970
   : T3=T3+1
   : IF T3>T0THEN 7690
   : V9$=T2$(T3)
   : GOSUB 545
   : GOTO 7500
7690 T0=T0+1
   : INIT(FF)T0$()
   : INIT(00)STR(T0$(1),1,T5)
   : STR(T0$(1),T4+1,2)=T2$
   : ADDC(V2$,01)
   : T9$,T2$,T2$(T3)=V2$
   : STR(T$,T3,1)=HEX(01)
   : GOTO 7500
7800 T3$(1)=K$
   : STR(T3$(1),T4+1,3)=T3$
   : BIN(STR(T$,T3))=T
   : MAT COPY T3$()TO T0$()<T,T5>
   : GOSUB 7970
   : IF K$<>R7$THEN 6960
   : Q2$,V2$(V0)=R$
   : BIN(V5$(V0))=R1
   : GOSUB '239(1)
   : V9$=HEX(A0FD)
   : T1$=HEX(A002A002A001A001A008A001A002)
7888 $PACK(F=T1$)T0$()FROMV9$,Q2$,V5$(),V8$,V1$,V6$,V2$()
   : DATA SAVE BA T$#2,(S7,X)T0$()
   : PRINT "RECORD COUNT ";C1
   : PRINT HEX(0A)
   : PRINT "END OF PROGRAM"
   : GOTO 8820
7970 V9$=T9$
   : ADDC(V9$,V0$)
   : DATA SAVE DA T$#T1,(V9$,V9$)T9$,T0$()
   : RETURN
8050 DEFFN'210(T6)
8060 IF M$="X"THEN 8260
   : ON D1GOTO 8080,8100,8120,8140,8160,8180,8200
8080 SELECT #1390
   : RETURN
8100 SELECT #13A0
   : RETURN
8120 SELECT #13B0
   : RETURN
8140 SELECT #13D0
   : RETURN
8160 SELECT #1B90
   : RETURN
8180 SELECT #1BA0
   : RETURN
8200 SELECT #1BB0
   : RETURN
8240 DEFFN'211(T6)
   : GOTO 8060
8260 ON D1GOTO 8270,8290,8310,8330,8350,8370,8390
8270 SELECT #1310
   : RETURN
8290 SELECT #1320
   : RETURN
8310 SELECT #1330
   : RETURN
8330 SELECT #1350
   : RETURN
8350 SELECT #1B10
   : RETURN
8370 SELECT #1B20
   : RETURN
8390 SELECT #1B30
   : RETURN
8430 ON D2GOTO 8440,8460,8480,8500,8520,8540,8560
8440 SELECT #2310
   : RETURN
8460 SELECT #2320
   : RETURN
8480 SELECT #2330
   : RETURN
8500 SELECT #2350
   : RETURN
8520 SELECT #2B10
   : RETURN
8540 SELECT #2B20
   : RETURN
8560 SELECT #2B30
   : RETURN
8600 ON D4GOTO 8610,8630,8650,8670,8690,8710,8730
8610 SELECT #4310
   : RETURN
8630 SELECT #4320
   : RETURN
8650 SELECT #4330
   : RETURN
8670 SELECT #4350
   : RETURN
8690 SELECT #4B10
   : RETURN
8710 SELECT #4B20
   : RETURN
8730 SELECT #4B30
   : RETURN
8770 DEFFN'70(Q6$)
   : PRINT "RESTORE BOTH USER FILE AND KEY FILE FROM BACKUP"
   : PRINT "COPIES BEFORE ATTEMPTING TO RE-RUN THIS PROGRAM"
   : PRINT HEX(0A)
   : PRINT Q6$
8820 GOSUB 8260
   : $IF ON #1,8840
8840 GOSUB 8430
   : $IF ON #2,8860
8860 GOSUB 8600
   : $IF ON #4,8880
8880 STOP
   : COM CLEAR D1
   : LOAD DC T#0,"START065"