home *** CD-ROM | disk | FTP | other *** search
/ Ahoy 1988 November / Ahoy_Magazine_88-11_1988_Double_L.d64 / Mini-Comp (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  11KB  |  334 lines
  1. 1 rem==================================
  2. 2 rem           mini-comp
  3. 3 rem        rupert report #59
  4. 4 rem  a minimal compiler for the c-64
  5. 5 rem======= run 2000 to compile ======
  6. 8 rem these are all allowed types of statements
  7. 9 rem a and a% both represent the same integer
  8. 10 a=50
  9. 20 b=-10
  10. 30 c=a
  11. 40 d=a+b
  12. 50 if a=b then 60
  13. 60 goto 70
  14. 70 print
  15. 80 print a
  16. 90 print b;
  17. 100 print chr$(c)
  18. 110 print chr$(d);
  19. 120 a$=chr$(c)
  20. 130 b$="hello"
  21. 140 c$=a$
  22. 150 b$=b$+a$
  23. 160 print a$
  24. 170 print b$;
  25. 999 end
  26. 1000 rem --- common routines ---
  27. 1100 c=peek(m): m=m+1: print c,: if c=32 then 1100: rem ignore spaces
  28. 1110 if c=0 then print
  29. 1120 return
  30. 1300 vt=0: rem vt=0, not a variable; vt=1, integer; vt=2, string
  31. 1310 if c<65 or c>90 then return :rem not a variable
  32. 1320 vn=c: c1=peek(m): m=m+1: rem vn=var name
  33. 1330 if c1=36 then vt=2: print c1,: return: rem '$ string var
  34. 1340 if c1=37 then vt=1: goto 1360: print c1,: rem '% integer var
  35. 1350 vt=1: m=m-1: goto 1360:  rem default=integer
  36. 1355 m=m-1: return: rem not a variable
  37. 1360 ad=(vn-65)*2+vm
  38. 1370 nx=ad: gosub 1400: a0=nl: a1=nh
  39. 1380 nx=ad+1: gosub 1400: a2=nl: a3=nh
  40. 1390 return
  41. 1400 nh=int(nx/256)
  42. 1410 nl=nx-256*nh
  43. 1420 return
  44. 1500 for kk=1 to n
  45. 1510 if cm>em then print"out of memory - compiled prgm too large": end
  46. 1520 poke cm,c(kk)
  47. 1530 print cm;":";c(kk)
  48. 1540 cm=cm+1: next
  49. 1550 return
  50. 1600 rem get addr of string var with name in vn
  51. 1620 sv=vn-65  :rem string variable #
  52. 1630 if sv<0 or sv>25 then ec=65: gosub 10000: stop
  53. 1640 if sb(sv)=0 then goto 1660    :rem new string
  54. 1650 mem=em-sb(sv)*256+1: goto 1690
  55. 1660 nb=nb+1: if nb>26 then print"too many string variables": stop
  56. 1670 sb(sv)=nb  :rem block #
  57. 1680 mem=em-nb*256+1: if (mem-cm)<256 then print"out of string space": stop
  58. 1690 nx=mem: gosub 1400: return   :rem addr in nl/nh
  59. 2000 rem === initialization ======
  60. 2010 dim ll(50,2)      :rem ll(n,1)=line # of nth line
  61. 2015 :rem  ll(n,2)=compiled mem location of this line
  62. 2020 dim c(100)   :rem stores object code bytes
  63. 2030 false=0: true=not false
  64. 2040 def fnptr(m)=peek(m)+256*peek(m+1)
  65. 2050 vm=49152  :rem $c000 start of variable mem
  66. 2060 pm=49408  :rem $c100 start of object memory
  67. 2070 em=53247  :rem $cfff end of object memory
  68. 2075 dim sb(25), s(255): sm=52992: nb=0 :rem string variables
  69. 2080 bt=2049   :rem $0800 start of basic text
  70. 2085 gosub 11000   :rem put print rtn in mem
  71. 2090 m=bt        :rem next source memory to peek
  72. 2100 sn=1      :rem current source statement number
  73. 2110 cm=pm       :rem next object memory to poke
  74. 2120 for n=vm to vm+51: poke n,0: next : rem clr var's
  75. 2125 rem ============= main ============
  76. 2130 ptr=fnptr(m): m=m+2   :rem next line ptr
  77. 2140 ln=fnptr(m): m=m+2     :rem current line #
  78. 2150 if ln>999 then print "=== end of pass 1 ===": goto 2400
  79. 2160 print "     current line # ="; ln
  80. 2170 ll(sn,1)=ln     :rem current line #
  81. 2180 ll(sn,2)=cm          :rem start obj mem loc
  82. 2190 sn=sn+1    :rem # source statements
  83. 2200 rem --- get byte ---
  84. 2210 gosub 1100    :rem fetch next byte
  85. 2220 gosub 1300: if vt=1 then gosub 3000 : goto 2290: rem 'variable
  86. 2225 if vt=2 then gosub 9000: goto 2290 :rem string variable
  87. 2230 if c=139 then gosub 4000: goto 2290: rem 'if
  88. 2240 if c=137 then gosub 5000: goto 2290: rem 'goto
  89. 2250 if c=153 then gosub 6000: goto 2290: rem 'print
  90. 2260 if c=128 then gosub 7000: goto 2290: rem 'end
  91. 2270 if c=143 then gosub 8000: goto 2290: rem 'rem
  92. 2280 print "unknown command code";c;"in line";ll(sn,1):stop
  93. 2290 if c>0 then ec=0: gosub 10000: stop :rem 'eol
  94. 2300 get k$:if k$="" then 2130 :rem back for more
  95. 2310 get k$:if k$="" then 2310
  96. 2320 goto 2130
  97. 2400 rem  - pass 2 - fix jump addresses
  98. 2410 if ji=0 then 2570 :rem no jumps
  99. 2420 for n=1 to ji   :rem check items in jump table
  100. 2430 :mm=jt(n,1) :rem referenced line #
  101. 2440 :for j=1 to sn    :rem check actual line #s
  102. 2445 :rem   - get obj mem target address and jmp address:
  103. 2450 :if mm=ll(j,1) then taddr=jt(n,2):  jaddr=ll(j,2): goto 2490
  104. 2460 :next j
  105. 2470 :rem no match found
  106. 2480 :ec=1: ln=jt(n,0): gosub 10000:stop
  107. 2490 :nx=jaddr :rem addr of line # mm
  108. 2530 :gosub 1400 :rem convert line #
  109. 2540 :poke taddr,nl     :rem use addr in jump table
  110. 2550 :poke taddr+1,nh
  111. 2560 next n    :rem next jump table item
  112. 2570 print"=== end of pass 2 ==="
  113. 2580 print"to execute the compiled program, enter"
  114. 2590 print" sys"; pm
  115. 2595 print"object code resides from";pm;"to";cm-1
  116. 2600 end
  117. 3000 rem <<<  a=(-)nn, a=b, a=b+c >>>
  118. 3010 d0=a0: d1=a1 :rem addr of a's lsb
  119. 3020 d2=a2: d3=a3 :rem a's msb
  120. 3030 gosub 1100: if c<>178 then 9000 :rem not '=
  121. 3040 gosub 1100   :rem '-, nn, or b
  122. 3050 gosub 1300: if vt=1 then 3400
  123. 3055 rem <<< a=(-)nn >>>
  124. 3060 if c=171 then c$="-" :rem '-
  125. 3065 if c<>171 then c$=" "+chr$(c) :rem '0-9
  126. 3070 gosub 1100  :rem get digits of nn
  127. 3080 if c=0 then 3120
  128. 3085 if chr$(c)<"0" or chr$(c)>"9" then ec=48: gosub 10000: stop
  129. 3090 c$=c$+chr$(c)
  130. 3100 goto 3070
  131. 3120 nn=val(c$)
  132. 3130 nn%=nn   :rem error check
  133. 3140 if nn<0 then nn=nn+65536       :rem convert (-32768,32767) to (0,65535)
  134. 3150 nx=nn: gosub 1400
  135. 3170 msb=nh: lsb=nl
  136. 3175 :rem lda #nn(lsb), sta a(lsb), lda  #nn(msb), sta a(msb)
  137. 3180 n=10: c(1)=169: c(2)=lsb: c(3)=141: c(4)=d0: c(5)=d1
  138. 3190 c(6)=169: c(7)=msb: c(8)=141: c(9)=d2: c(10)=d3
  139. 3200 gosub 1500    :rem poke values into object memory
  140. 3210 return
  141. 3400 rem <<< a=b or a=b+c >>>
  142. 3410 s0=a0: s1=a1   :rem b's lsb addr
  143. 3420 s2=a2: s3=a3   :rem b's msb
  144. 3430 gosub 1100
  145. 3440 if c=0 then 3600   :rem a=b
  146. 3450 rem <<< a=b+c >>>
  147. 3460 if c<>170 then ec=170:  ec$=" + ": gosub 10000: stop :rem test '+
  148. 3470 gosub 1100: gosub 1300: if vt<>1 then ec=65: gosub 10000: stop: rem 'c
  149. 3480 gosub 1100: if c>0 then ec=0: gosub 10000: stop :rem 'eol
  150. 3490 s4=a0: s5=a1   :rem addr c's lsb
  151. 3500 s6=a2: s7=a3   :rem c's msb
  152. 3530 rem clc, lda b(lsb), adc c(lsb),sta a(lsb)
  153. 3535 rem lda b(msb), adc c(msb), sta a(msb)
  154. 3540 n=19: c(1)=24: c(2)=173: c(3)=s0: c(4)=s1
  155. 3550 c(5)=109: c(6)=s4: c(7)=s5: c(8)=141: c(9)=d0: c(10)=d1
  156. 3560 c(11)=173: c(12)=s2: c(13)=s3: c(14)=109: c(15)=s6: c(16)=s7
  157. 3570 c(17)=141: c(18)=d2: c(19)=d3
  158. 3580 gosub 1500
  159. 3590 return
  160. 3600 rem <<< a=b >>>
  161. 3610 rem lda b(lsb), sta a(lsb), lda b(msb), sta a(msb)
  162. 3620 n=12: c(1)=173: c(2)=s0: c(3)=s1: c(4)=141: c(5)=d0: c(6)=d1
  163. 3630 c(7)=173: c(8)=s2: c(9)=s3: c(10)=141: c(11)=d2: c(12)=d3
  164. 3640 gosub 1500
  165. 3650 return
  166. 4000 rem <<<  if a=b then mm  >>>
  167. 4010 gosub 1100  :rem 'a
  168. 4020 gosub 1300: if vt<>1 then ec=65:   gosub 10000: stop
  169. 4030 s0=a0: s1=a1: s2=a2: s3=a3
  170. 4040 gosub 1100: if c<>178 then ec=178:  gosub 10000: stop   :rem '=
  171. 4050 gosub 1100      :rem 'b
  172. 4060 gosub 1300: if vt<>1 then ec=65:   gosub 10000: stop
  173. 4070 gosub 1100      :rem 'then
  174. 4080 if c<>167 then ec=167: gosub 10000: stop
  175. 4090 c$=""
  176. 4100 gosub 1100: if c=0 then 4120   :rem get mm
  177. 4110 c$=c$+chr$(c): goto 4100
  178. 4120 mm=val(c$)
  179. 4130 if mm<0 or mm>999 then ec=1:  gosub 10000: stop
  180. 4140 ji=ji+1       :rem jump table index
  181. 4150 jt(ji,0)=ln   :rem current line #
  182. 4160 jt(ji,1)=mm   :rem target line #
  183. 4170 jt(ji,2)=cm+17   :rem mem loc after 'jmp
  184. 4180 rem  lda a(msb), cmp b(msb), bne exit,
  185. 4185 rem  lda a(lsb), cmp b(lsb), bne exit, jmp mm
  186. 4190 n=19: c(1)=173: c(2)=s2: c(3)=s3
  187. 4200 c(4)=205: c(5)=a2: c(6)=a3
  188. 4210 c(7)=208: c(8)=11: c(9)=173: c(10)=s0: c(11)=s1
  189. 4220 c(12)=205: c(13)=a0: c(14)=a1
  190. 4230 c(15)=208: c(16)=3: c(17)=76: c(18)=0: c(19)=0
  191. 4240 gosub 1500
  192. 4250 return
  193. 5000 rem <<< goto mm >>>
  194. 5010 c$=""
  195. 5020 gosub 1100: rem get digits of mm
  196. 5030 if c=0 then 5060
  197. 5040 c$=c$+chr$(c)
  198. 5050 goto 5020
  199. 5060 mm=val(c$)
  200. 5070 if mm<0 or mm>999 then ec=1:  gosub 10000: stop
  201. 5080 ji=ji+1      :rem jump table index
  202. 5085 jt(ji,0)=ln  :rem source line#
  203. 5090 jt(ji,1)=mm  :rem target line#
  204. 5100 jt(ji,2)=cm+1 :rem obj mem location after 'jmp'
  205. 5110 rem  jmp mm
  206. 5120 n=3: c(1)=76: c(2)=0: c(3)=0
  207. 5130 gosub 1500
  208. 5140 return
  209. 6000 rem <<< print, print a[;], or print chr$(a)[;] >>>
  210. 6010 gosub 1100: if c=199 then 6300 :rem 'chr$
  211. 6020 if c=0 then pc=13: gosub 6200: return:  rem 'print
  212. 6030 gosub 1300: if vt=2 then 9700
  213. 6035 if vt<>1 then ec=65: gosub 10000: stop
  214. 6040 rem <<< print a >>>
  215. 6050 rem   ldx $a(msb), ldy $a(lsb), jsr $c0e0
  216. 6060 print: n=9: c(1)=174: c(2)=a0: c(3)=a1
  217. 6070 c(4)=172: c(5)=a2: c(6)=a3
  218. 6080 c(7)=32: c(8)=224: c(9)=192
  219. 6090 gosub 1500
  220. 6095 pc=32: gosub 6200    :rem add space after  digits
  221. 6100 gosub 1100: if c=0 then pc=13: gosub 6200: return   :rem print cr
  222. 6110 if c<>59 then ec=59: gosub 10000:   stop  :rem  ' ;
  223. 6120 gosub 1100: if c>0 then ec=0: gosub 10000: stop
  224. 6130 return
  225. 6200 rem --- print character pc ---
  226. 6210 rem lda #pc, jsr $ffd2
  227. 6220 print:n=5: c(1)=169: c(2)=pc: c(3)=32
  228. 6230 c(4)=210: c(5)=255: gosub 1500
  229. 6240 return
  230. 6300 rem <<< print chr$(a) [;] >>>
  231. 6310 gosub 1100: if c<>40 then ec=40: gosub 10000: stop :rem  '(
  232. 6320 gosub 1100: gosub 1300: if vt<>1 then ec=65: gosub 10000: stop
  233. 6330 rem    lda a(lsb), jsr $ffd2
  234. 6340 print: n=6: c(1)=173: c(2)=a0: c(3)=a1
  235. 6350 c(4)=32: c(5)=210: c(6)=255
  236. 6360 gosub 1500
  237. 6370 gosub 1100: if c<>41 then ec=41: gosub 10000: stop  : rem ')
  238. 6380 gosub 1100: if c>0 then 6400
  239. 6390 print: pc=13: gosub 6200: return
  240. 6400 if c<>59 then ec=59: gosub 10000:   stop  :rem ';
  241. 6410 gosub 1100: if c<>0 then ec=0:gosub 10000: stop
  242. 6420 return
  243. 7000 rem <<< end >>>
  244. 7005 rem    rts
  245. 7010 n=1: c(1)=96: gosub 1500
  246. 7020 gosub 1100: if c<>0 then ec=0:gosub 10000: stop
  247. 7030 return
  248. 8000 rem <<< rem >>>
  249. 8010 gosub 1100: if c>0 then 8010
  250. 8020 return
  251. 8999 rem << strings >>
  252. 9000 rem <<  string variables  >>
  253. 9010 gosub 1600 :d0=nl: d1=nh: rem get dest var addr
  254. 9020 gosub 1100: if c<>178 then ec=178: ec$=" = ": gosub 10000: stop
  255. 9030 gosub 1100
  256. 9040 gosub 1300: if vt=2 then 9400 :rem a$=b$...
  257. 9050 if c=34 then 9200  :rem '"literal"
  258. 9060 if c<>199 then ec=199: ec$="chr$": gosub 10000: stop
  259. 9100 rem << a$=chr$(n) >>
  260. 9110 gosub 1100: if c<>40 then ec=40: ec$="(": gosub 10000: stop
  261. 9120 gosub 1100: gosub 1300: if vt<>1 then ec=65: gosub 10000: stop
  262. 9130 gosub 1100: if c<>41 then ec=41: ec$=")": gosub 10000: stop
  263. 9140 gosub 1100: if c>0 then ec=0: gosub 10000: stop
  264. 9150 rem  lda #1; sta a$; lda n.lsb; ldy #1; sta a$,y
  265. 9160 n=13: c(1)=169: c(2)=1: c(3)=141: c(4)=d0: c(5)=d1: c(6)=173
  266. 9170 c(7)=a0: c(8)=a1: c(9)=160: c(10)=1: c(11)=153: c(12)=d0
  267. 9180 c(13)=d1: gosub 1500: return
  268. 9200 rem << a$=" literal " >>
  269. 9205 nc=0  :rem store # of chars
  270. 9210 gosub 1100: if c=34 then 9250
  271. 9220 nc=nc+1: if nc=256 then print"string too long": stop
  272. 9230 s(nc)=c
  273. 9240 goto 9210
  274. 9250 gosub 1100: if c<>0 then ec=0: gosub 10000: stop
  275. 9260 rem lda # nc: sta a$: ldy #1
  276. 9265 rem ..for k=1 to nc: lda # s(k): sta a$,y: iny: next k..
  277. 9270 n=7: c(1)=169: c(2)=nc: c(3)=141: c(4)=d0: c(5)=d1: c(6)=160: c(7)=1
  278. 9280 gosub 1500
  279. 9290 n=6: for k=1 to nc: c(1)=169: c(2)=s(k): c(3)=153: c(4)=d0: c(5)=d1
  280. 9295 c(6)=200: gosub 1500: next k : return
  281. 9400 rem <<  a$=b$ ... >>
  282. 9410 gosub 1600: s0=nl: s1=nh  :rem b$ addr
  283. 9420 gosub 1100: if c=170 then 9500  :rem '+
  284. 9430 if c>0 then ec=0: gosub 10000: stop
  285. 9440 rem  ldx b$: ldy #0; loop: lda b$,y; sta a$,y; iny; bpl loop
  286. 9450 n=15: c(1)=174: c(2)=s0: c(3)=s1: c(4)=160: c(5)=0: c(6)=185: c(7)=s0
  287. 9460 c(8)=s1: c(9)=153: c(10)=d0: c(11)=d1: c(12)=200: c(13)=202
  288. 9470 c(14)=16: c(15)=246: gosub 1500: return
  289. 9500 rem <<  a$=b$ + c$ >>
  290. 9510 gosub 1100: gosub 1300: if vt<>2 then ec=65: gosub 10000: stop
  291. 9520 gosub 1600: s2=nl: s3=nh :rem c$ addr
  292. 9530 gosub 1100: if c>0 then ec=0: gosub 10000: stop
  293. 9535 gosub 9450: rem a$=b$
  294. 9540 n=53: c(1)=169: c(2)=d0: c(3)=133: c(4)=253: c(5)=169: c(6)=d1
  295. 9545 c(7)=133: c(8)=254: c(9)=173: c(10)=s0: c(11)=s1: c(12)=24: c(13)=101
  296. 9550 c(14)=253: c(15)=133: c(16)=253: c(17)=169: c(18)=0: c(19)=101
  297. 9555 c(20)=254: c(21)=133: c(22)=254: c(23)=174: c(24)=s2: c(25)=s3
  298. 9560 c(26)=160: c(27)=1: c(28)=185: c(29)=s2: c(30)=s3: c(31)=145
  299. 9565 c(32)=253: c(33)=200: c(34)=170: c(35)=208: c(36)=247: c(37)=173
  300. 9570 c(38)=s0: c(39)=s1: c(40)=24: c(41)=109: c(42)=s2: c(43)=s3
  301. 9575 c(44)=144: c(45)=5: c(46)=162: c(47)=23: c(48)=108: c(49)=0
  302. 9580 c(50)=3: c(51)=141: c(52)=d0: c(53)=d1
  303. 9590 gosub 1500: return
  304. 9700 rem << print a$ >>
  305. 9710 gosub 1600: s0=nl: s1=nh
  306. 9720 rem  ldx len(a$); ldy #1; loop:  lda a$,y; jsr $ffd2; iny; dex; bne loop
  307. 9730 n=15: c(1)=174: c(2)=s0: c(3)=s1: c(4)=160: c(5)=1: c(6)=185
  308. 9740 c(7)=s0: c(8)=s1: c(9)=32: c(10)=210: c(11)=255: c(12)=200
  309. 9750 c(13)=202: c(14)=208: c(15)=246: gosub 1500
  310. 9760 gosub 1100: if c=0 then pc=13: gosub 6200: return
  311. 9770 if c<>59 then ec=59: ec$=";": gosub 10000: stop
  312. 9780 gosub 1100: if c>0 then ec=0: gosub 10000: stop
  313. 9790 return
  314. 10000 print:print"syntax error in line[146]";ln
  315. 10010 if ec=0 then print"expected end-of-line not found":return
  316. 10020 if ec=1 then print"invalid line number":return
  317. 10030 if ec=48 then print"numeric value 0-9 expected": return
  318. 10040 if ec=65 then print"variable a-z expected": return
  319. 10050 if ec>127 then print"expected basic keyword ";ec$: return
  320. 10060 print"expected character   ";chr$(ec);"   with ascii value"ec :return
  321. 11000 rem -- put m.l. print routine into memory --
  322. 11010 m=49376  :rem $c0e0
  323. 11020 cs=3319 :rem checksum
  324. 11030 read b: if b<0 then 11060
  325. 11040 poke m,b: m=m+1: ck=ck+b
  326. 11050 goto 11030
  327. 11060 if ck<>cs then print"error in data statements starting at 11120":stop
  328. 11070 return
  329. 11080 data 169, 32, 200, 136, 16, 2
  330. 11090 data 169, 45, 32, 210, 255, 152, 16, 12
  331. 11100 data 138, 73, 255, 24, 105, 1, 170, 152
  332. 11110 data 73, 255, 105, 0, 32, 205, 189, 96
  333. 11120 data -1
  334.