Listing of file='KFAM8004' on disk='vmedia/701-2086B.wvd.zip'
# Sector 483, program filename = 'KFAM8004'
0010 REM KFAM8004,VER.03/02/76
0200 DIM I$(32)8,X1$2,Z$8,H$2,X$64
: DIM M1$(13)20,Q6$64,N1$8,A$46,A1$(13)46,A2$(46)3
: DIM G$(4)64,G$2,L$2,F$1,Y$1,A2$2,P$(4)64,J$(1)2,C2$(1)1
: PRINT HEX(030A0A0A0A)
: PRINT "BUILD SUBROUTINE MODULE"
0585 LIMITS T#0,"KFAM0004",U,X,Y
: C2$(1)=HEX(FD)
: M1$(1)="230 OPEN"
: M1$(2)="OPEN FOR FINDNEW"
: M1$(3)="231 DELETE"
: M1$(4)="232 FINDOLD"
: M1$(5)="233 FINDNEW"
: M1$(6)="234 FINDNEW(HERE)"
0670 M1$(7)="235 FINDFIRST"
: M1$(8)="236 FINDLAST"
: M1$(9)="237 FINDNEXT"
: M1$(10)="238 RELEASE"
: M1$(11)="239 CLOSE"
: M1$(12)="MULTIPLE FILES"
: M1$(13)="RECOVERY OPTION"
0740 A1$(1)="1121000010010101110000000000000001210000000010"
: A1$(2)="0040000000000000000000000000000000000000000000"
: A1$(3)="1000110101011001111100000000100010000000011010"
0770 A1$(4)="1000010101011001111110000000000000000000011010"
: A1$(5)="1000111101011001111000000001110100000001101010"
: A1$(6)="1000111101011001111100000001111100000001101010"
0800 A1$(7)="1000010101011001111101111000000000000000011110"
: A1$(8)="1000010101011001111100010100000000000000010010"
: A1$(9)="1000010101011001111100111000000000000000011110"
0830 A1$(10)="1000000001011001110000000010000000000000000010"
: A1$(11)="1000000001011001110000000000000000001210000010"
: A1$(12)="0000000010111110010000000000000000000000000000"
0865 A1$(13)="0040000000000000000000000000000000400400000000"
: A2$(1)=HEX(020001)
: A2$(2)=HEX(020502)
: A2$(3)=HEX(020803)
: A2$(4)=HEX(021220)
: A2$(5)=HEX(051003)
: A2$(6)=HEX(054503)
: A2$(7)=HEX(057003)
0940 A2$(8)=HEX(064515)
: A2$(9)=HEX(083003)
: A2$(10)=HEX(087002)
: A2$(11)=HEX(087607)
: A2$(12)=HEX(091402)
: A2$(13)=HEX(092203)
: A2$(14)=HEX(094405)
: A2$(15)=HEX(096005)
: A2$(16)=HEX(098202)
: A2$(17)=HEX(101505)
1040 A2$(18)=HEX(104505)
: A2$(19)=HEX(107007)
: A2$(20)=HEX(109805)
: A2$(21)=HEX(112005)
: A2$(22)=HEX(117502)
: A2$(23)=HEX(121510)
: A2$(24)=HEX(132505)
: A2$(25)=HEX(136512)
: A2$(26)=HEX(148002)
: A2$(27)=HEX(152602)
1140 A2$(28)=HEX(154506)
: A2$(29)=HEX(159803)
: A2$(30)=HEX(164009)
: A2$(31)=HEX(177004)
: A2$(32)=HEX(183055)
: A2$(33)=HEX(242015)
: A2$(34)=HEX(262005)
: A2$(35)=HEX(271502)
: A2$(36)=HEX(271825)
: A2$(37)=HEX(287505)
1225 A2$(38)=HEX(290605)
: A2$(39)=HEX(291801)
: A2$(40)=HEX(296002)
: A2$(41)=HEX(298001)
: A2$(42)=HEX(300002)
: A2$(43)=HEX(303502)
: A2$(44)=HEX(306002)
: A2$(45)=HEX(307201)
: A2$(46)=HEX(999900)
1400 GOSUB '243("ENTER NAME OF PROGRAM TO BE GENERATED",8)
: N1$=Q6$
: GOSUB '125("ENTER THE NO. OF THE OUTPUT PROGRAM DEVICE")
: D2=X
1440 GOSUB '248(5,0,10)
: PRINT "MODULES INCLUDED --"
: INIT(30)A$
: C=5
: D=0
: FOR N=1TO 13
1500 Q6$=M1$(N)
: E=LEN(Q6$)+2
: STR(Q6$,E)="? (Y OR N)"
: GOSUB '243(Q6$,1)
: IF Q6$="Y"THEN 1600
: IF Q6$="N"THEN 1680
: PRINT HEX(010A0A0A)
: PRINT "RE-ENTER"
: GOTO 1500
1600 C=C+1
: IF C<15THEN 1640
: C=6
: D=30
1640 GOSUB '248(C,D,0)
: PRINT M1$(N)
: OR (A$,A1$(N))
1680 NEXT N
: FOR N=1TO 46
: IF STR(A$,N,1)<"6"THEN 1688
: STR(A$,N,1)="1"
1688 NEXT N
1690 GOSUB '243("OK TO PROCEED? (Y OR N)",1)
: IF Q6$="Y"THEN 1770
: IF Q6$="N"THEN 1440
: PRINT HEX(010A0A0A)
: PRINT "RE-ENTER"
: GOTO 1690
1770 GOSUB '248(0,0,5)
: PRINT HEX(0A0A0A0A)
: PRINT "PHASE 2 -- BUILDING PROGRAM ";N1$
: B=0
: FOR N=1TO 46
: IF STR(A$,N,1)<>"1"THEN 1840
: UNPACK(##)STR(A2$(N),3,1)TO X
: B=B+X
1840 NEXT N
: B=INT(B/10)+4
: GOSUB 5630
: GOSUB '39(N1$,2,B)
: G$(1)=HEX(40)
: STR(G$(1),2,8)=N1$
: STR(G$(1),10,1)=HEX(FD)
: DATA SAVE BA T$#2,(G$,G$)G$()
: G$(1)=HEX(00FF0010A2)
: STR(G$(1),6)=N1$
: G=LEN(G$(1))+1
: STR(G$(1),G)=HEX(0D0000)
: G=G+3
2020 U=U+1
: N=1
: F$="0"
: A2$=HEX(0200)
: Y$=HEX(0D)
2080 DATA LOAD BA T#0,(U,U)P$()
: P=2
2100 Q=256-P
: MAT COPY P$()<P+1,2>TO J$()
2130 IF J$(1)<A2$THEN 2210
: F$=STR(A$,N,1)
: N=N+1
: A2$=A2$(N)
: GOTO 2130
2210 MAT SEARCHP$()<P+1,Q>,=Y$TO J$()
: Y=VAL(STR(J$(1),2))+3
: IF F$<>"1"THEN 2360
: IF G+Y<256THEN 2330
: MAT COPY C2$()TO G$()<G,1>
: IF G$>=L$THEN 2590
: DATA SAVE BA T$#2,(G$,G$)G$()
: G=2
2330 MAT COPY P$()<P,Y>TO G$()<G,Y>
: G=G+Y
2360 P=P+Y
: MAT COPY P$()<P,1>TO J$()
: IF J$(1)=HEX(FF)THEN 2100
: IF J$(1)=HEX(FD)THEN 2080
: STR(G$(1),1,1)=HEX(20)
: IF J$(1)=HEX(FE)THEN 2430
: GOSUB '101("INVALID DELIMITER")
2430 MAT COPY J$()TO G$()<G,1>
: IF G$>=L$THEN 2590
: DATA SAVE BA T$#2,(G$,G$)G$()
: LIMITS T#2,N1$,A,E,X
: X1$=G$
: GOSUB '41
: Z=X-A+1
: GOSUB '43(Z)
: G$(1)=HEX(202020FD)
: STR(G$(1),2,2)=X1$
: GOSUB 5820
: DATA SAVE BA T$#2,(E,X)G$()
2476 LOAD DC T#0,"START065"
2500 DEFFN'101(X$)
: GOSUB '248(0,0,4)
: PRINT X$
: GOSUB 5820
: $IF ON #2,2560
2560 RETURN CLEAR
2570 STOP
: GOTO 2476
2590 GOSUB '101("OUTPUT PROGRAM SPACE EXCEEDED")
5060 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"
5120 GOSUB '245(X$,1,0)
: X=Q9
: IF X<1THEN 5180
: IF X>7THEN 5180
: GOSUB '248(5,0,5)
: RETURN
5180 PRINT HEX(010A0A0A)
: PRINT "INVALID DEVICE ADDRESS"
: GOTO 5120
5630 IF M$="X"THEN 5820
: ON D2GOTO 5650,5670,5690,5710,5730,5750,5770
5650 SELECT #2390
: RETURN
5670 SELECT #23A0
: RETURN
5690 SELECT #23B0
: RETURN
5710 SELECT #23D0
: RETURN
5730 SELECT #2B90
: RETURN
5750 SELECT #2BA0
: RETURN
5770 SELECT #2BB0
: RETURN
5820 ON D2GOTO 5830,5850,5870,5890,5910,5930,5950
5830 SELECT #2310
: RETURN
5850 SELECT #2320
: RETURN
5870 SELECT #2330
: RETURN
5890 SELECT #2350
: RETURN
5910 SELECT #2B10
: RETURN
5930 SELECT #2B20
: RETURN
5950 SELECT #2B30
: RETURN
6040 DEFFN'40(N1$,Z)
: DATA LOAD BA T#Z,(0,X)I$()
: X1$=STR(I$(1),1,2)
: GOSUB '41
: S9=X
: X1$=STR(I$(1),3,2)
: GOSUB '41
: Y=X
: X1$=STR(I$(1),5,2)
: GOSUB '41
: A=X-Y
: Z$=N1$
: XOR (STR(Z$,2),Z$)
: Y$=STR(Z$,8,1)
: H$=HEX(0000)
: ADDC(H$,Y$)
: ADDC(H$,Y$)
6230 ADDC(H$,Y$)
: ADD(STR(H$,1,1),STR(H$,2,1))
: H=VAL(H$)
: H=H-INT(H/S9)*S9
: DATA LOAD BA T#Z,(H,X)I$()
: GOSUB '42
: IF X>0THEN 6390
: IF Y=0THEN 6390
: H=0
6330 DATA LOAD BA T#Z,(H,X)I$()
: GOSUB '42
: IF X>0THEN 6390
: H=H+1
: IF H<S9THEN 6330
6390 RETURN
6420 DEFFN'41
: AND (STR(X1$,1,1),7F)
: X=VAL(X1$)*256+VAL(STR(X1$,2))
: RETURN
6480 DEFFN'42
: Y=0
: X=2
: IF H>0THEN 6530
: X=4
6530 IF STR(I$(X-1),1,1)=HEX(10)THEN 6570
: IF STR(I$(X-1),1,1)=HEX(11)THEN 6570
: IF STR(I$(X-1),1,1)=HEX(00)THEN 6620
: GOTO 6580
6570 IF I$(X)=N1$THEN 6640
6580 X=X+2
: IF X<34THEN 6530
: Y=1
6620 X=0
6640 RETURN
6720 DEFFN'39(N1$,Z,B)
: GOSUB '40(N1$,Z)
: IF X=0THEN 6900
6760 STR(I$(X-1),2,1)=HEX(80)
: DATA SAVE BA T$#Z,(H,X)I$()
: LIMITS T#Z,N1$,A,E,G
: GOSUB '43(A)
: G$=X1$
: GOSUB '43(E)
: L$=X1$
: RETURN
6900 IF B>ATHEN 7000
: DATA SAVE DC OPEN T$#Z,B,N1$
: GOSUB '40(N1$,Z)
: IF X>0THEN 6760
: RETURN CLEAR
6970 GOSUB '101("SYSTEM ERROR")
7000 RETURN CLEAR
7010 GOSUB '101("NO ROOM ON DISK FOR OUTPUT PROGRAM")
7070 DEFFN'43(X)
: Y=INT(X/256)
: X=X-256*Y
: BIN(X1$)=Y
: BIN(STR(X1$,2))=X
: 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 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