home *** CD-ROM | disk | FTP | other *** search
/ C64'er / C64'er.iso / 85xx / 8508.d64 / compiler (.txt) < prev    next >
Commodore BASIC  |  1995-03-30  |  11KB  |  480 lines
  1. 100 REM ****************************
  2. 110 REM *                          *
  3. 120 REM *       FORTH-COMPILER     *
  4. 130 REM *                          *
  5. 140 REM *           FUER           *
  6. 150 REM *                          *
  7. 160 REM *        COMMODORE-64      *
  8. 170 REM *                          *
  9. 180 REM ****************************
  10. 190 REM *                          *
  11. 200 REM *  ALEXANDER SCHINDOWSKI   *
  12. 210 REM *                          *
  13. 220 REM *  6000 FRANKFURT/MAIN 50  *
  14. 230 REM *                          *
  15. 240 REM * RUDOLF-HILFERDING-STR.49 *
  16. 250 REM *                          *
  17. 260 REM ****************************
  18. 270 REM *                          *
  19. 280 REM *  TELEPHON:(069)/570520   *
  20. 290 REM *                          *
  21. 300 REM ****************************
  22. 310 :
  23. 320 :
  24. 330 :
  25. 340 IF A=0 THENA=1:LOAD"VOCABULARY",8,1
  26. 350 DEF FNH(X)=(INT(X/256))
  27. 360 DEF FNL(X)=(X-256*FNH(X))
  28. 370 POKE 53272,23:PRINT"[147][154]";CHR$(8);
  29. 380 VOC=6*4096:BE=VOC:SP=0:Z1=0
  30. 390 POKE 55,FN L(BE):POKE 56,FN H(BE)
  31. 395 DIM ST(20),SC$(24),WO$(100),AD(100)
  32. 400 PRINT TAB(14);"[198]ORTH-[195]OMPILER"
  33. 410 PRINT TAB(17);"FUER DEN"
  34. 420 PRINT TAB(15);"[195]OMMODORE-64"
  35. 430 PRINT"----------------------------------------";
  36. 440 PRINT"     [214]ON [193]LEXANDER [211]CHINDOWSKI 1985"
  37. 450 DATA 38
  38. 460 DATA "+",49563
  39. 470 DATA "CLS",49158,"DEPTH",49968
  40. 480 DATA "@",50012,"DROP",49236
  41. 490 DATA "EMIT",49855,"EXPECT",49936
  42. 500 DATA "=",49410,"I",49766
  43. 510 DATA "KEY",49880
  44. 520 DATA "+LOOP",49821,"MOD",49733
  45. 530 DATA "NOT",49458,"OVER",49284
  46. 540 DATA ".",49163,"-",49578
  47. 550 DATA "SWAP",49248,">R",49751
  48. 560 DATA "AND",49497,"CR",49384
  49. 570 DATA "/",49721,"DO",49757,"!",49977
  50. 580 DATA "DUP",49239,"XOR",49541
  51. 590 DATA "GET",49862,">",49434
  52. 600 DATA "<",49452,"LOOP",49811
  53. 610 DATA "*",49596,"OR",49519
  54. 620 DATA "C@",50030,"C!",49996
  55. 630 DATA "R>",49745,"TYPE",49915
  56. 640 DATA "PICK",50062,"CALL",50047,"ROT",50085
  57. 650 READ AN
  58. 660 FOR I=1 TO AN
  59. 670 READ WO$(I),AD(I)
  60. 680 NEXT I:POKE 2,0:POKE 252,0
  61. 690 GOSUB 3830
  62. 693 :
  63. 695 REM **************************
  64. 700 REM *** BEFEHLS-AUSWERTUNG ***
  65. 705 REM **************************
  66. 708 :
  67. 710 GOSUB 2630
  68. 715 :
  69. 720 IF BE$=":" THEN 1540
  70. 725 :
  71. 730 FOR I=AN TO 1 STEP -1
  72. 740 IF BE$=WO$(I) THEN 760
  73. 750 NEXT I:GOTO 770
  74. 760 SYS AD(I):GOTO 700
  75. 765 :
  76. 770 GOSUB 3030
  77. 780 IF OK=0 THEN 830
  78. 790 POKE 781,FN L(XX)
  79. 800 POKE 780,FN H(XX)
  80. 810 SYS 49194
  81. 820 GOTO 700
  82. 825 :
  83. 830 IF BE$="RESET" THEN RUN
  84. 835 :
  85. 840 IF BE$="BASIC" THEN END
  86. 845 :
  87. 850 IF BE$<>"VLIST" THEN 900
  88. 860 PRINT:FOR I=AN TO 1 STEP-1
  89. 870 PRINT WO$(I)"  ";
  90. 880 NEXT:PRINT
  91. 890 GOTO 700
  92. 895 :
  93. 900 IF BE$<>"FORGET" THEN 950
  94. 910 GOSUB 2630:FOR I=AN TO 1 STEP-1
  95. 920 IF BE$<>WO$(I) THEN NEXT I
  96. 930 IF I>AN THEN PRINT BE$" [201] CAN'T FIND":GOTO 700
  97. 935 :
  98. 940 VOC=AD(I):AN=I-1:GOTO 700
  99. 950 IF BE$<>"(" THEN 980
  100. 960 IF BE$<>")" THEN GOSUB2630:GOTO960
  101. 970 GOTO 700
  102. 975 :
  103. 980 IF BE$<>"EDIT" THEN 1020
  104. 990 GOSUB 2630 :SC=VAL(BE$)
  105. 1000 PRINT"[211]CREEN:";SC:GOSUB 3280
  106. 1010 IF BE$="-->"THEN ZE$="":SC=SC+1:GOTO1000
  107. 1012 GOTO 700
  108. 1015 :
  109. 1020 IF BE$<>"LOAD" THEN 1050
  110. 1030 GOSUB 2630:SC=VAL(BE$)
  111. 1040 BLOCK=1:Z1=0:GOSUB 3110:GOTO 700
  112. 1050 IF BE$<>"-->" THEN 1070
  113. 1060 SC=SC+1:GOSUB3110:COMP=1:BLOCK=1:Z1=0:GOTO 700
  114. 1070 :
  115. 1080 IF BE$<>"VARIABLE" THEN 1145
  116. 1085 GOSUB 2630:AN=AN+1:WO$(AN)=BE$
  117. 1090 AD(AN)=VOC:XX=VOC+8
  118. 1095 GOSUB 3470:POKE VOC,169
  119. 1100 POKE VOC+1,FN H(XX)
  120. 1105 POKE VOC+2,162
  121. 1110 POKE VOC+3,FN L(XX)
  122. 1115 POKE VOC+4,32:POKE VOC+5,42
  123. 1120 POKE VOC+6,192:POKE VOC+7,96
  124. 1125 POKE VOC+8,FN L(X)
  125. 1130 POKE VOC+9,FN H(X)
  126. 1135 VOC=VOC+10
  127. 1140 GOTO 700
  128. 1145 :
  129. 1150 IF BE$<>"MEMORY" THEN 1220
  130. 1155 GOSUB 2630:AN=AN+1:WO$(AN)=BE$
  131. 1160 AD(AN)=VOC
  132. 1165 GOSUB 3470:POKE VOC,169
  133. 1170 POKE VOC+1,FN H(VOC+12)
  134. 1175 POKE VOC+2,162
  135. 1180 POKE VOC+3,FN L(VOC+12)
  136. 1185 POKE VOC+4,32:POKE VOC+5,42
  137. 1190 POKE VOC+6,192:AD=VOC+12+XX
  138. 1195 POKE VOC+7,96
  139. 1200 POKE VOC+8,FN L(AD):POKE VOC+9,FN H(AD)
  140. 1205 POKE VOC+10,FN L(XX):POKE VOC+11,FN H(XX)
  141. 1210 VOC=AD:GOTO 700
  142. 1220 :
  143. 1230 IF BE$<>"CONSTANT" THEN 1280
  144. 1240 GOSUB 2630:A$=": "+BE$+" "
  145. 1250 GOSUB 3470
  146. 1260 ZE$=A$+STR$(X)+" ;"+ZE$
  147. 1270 GOTO 700
  148. 1280 :
  149. 1290 IF BE$<>"CLEAR" THEN 1350
  150. 1300 GOSUB 2630:SC=VAL(BE$)
  151. 1310 FOR ZE=0 TO 24
  152. 1320 SC$(ZE)=""
  153. 1330 NEXT ZE:GOSUB3220
  154. 1340 GOTO700
  155. 1350 :
  156. 1360 IFBE$="SAVE-SYSTEM"THEN3510
  157. 1365 :
  158. 1370 IFBE$="LOAD-SYSTEM"THEN3720
  159. 1380 :
  160. 1390 IF BE$<>"FLOPPY" THEN 1420
  161. 1400 GOSUB2630
  162. 1410 OPEN1,8,15,BE$:CLOSE1:GOTO 700
  163. 1420 :
  164. 1430 IFBE$<>"LIST" THEN 1520
  165. 1440 GOSUB2630:SC=VAL(BE$):GOSUB3110
  166. 1450 INPUT"[193]UF [196]RUCKER (Y/N)";A$:A=3:IFA$="Y"THENA=4
  167. 1460 OPEN4,A,-7*(A=4)
  168. 1470 FOR Z=0 TO 23
  169. 1480 PRINT#4,RIGHT$(STR$(Z),2)":"SC$(Z)
  170. 1490 NEXT Z:CLOSE4
  171. 1500 IFA=3THENPOKE198,0:WAIT198,1
  172. 1510 COMP=0:GOTO700
  173. 1520 :
  174. 1530 PRINTBE$" [201] CAN'T FIND":GOTO 700
  175. 1533 :
  176. 1535 REM *************************
  177. 1540 REM ***     COMPILER      ***
  178. 1545 REM *************************
  179. 1548 :
  180. 1550 GOSUB2630:AN=AN+1:WO$(AN)=BE$
  181. 1560 AD(AN)=VOC:COMP=1
  182. 1570 :
  183. 1580 GOSUB 2630
  184. 1590 FOR I=1 TO ANZ
  185. 1600 IF BE$<>WO$(I) THEN NEXT I
  186. 1610 AD=AD(I)
  187. 1615 :
  188. 1620 IF BE$<>"BEGIN" THEN 1640
  189. 1630 ST(SP)=VOC:SP=SP+1:GOTO 1570
  190. 1635 :
  191. 1640 IF BE$<>"UNTIL" THEN 1730
  192. 1650 POKE VOC,32
  193. 1660 POKE VOC+1,180:POKE VOC+2,194
  194. 1670 POKE VOC+3,176:POKE VOC+4,3
  195. 1680 POKE VOC+5,76
  196. 1690 SP=SP-1:AD=ST(SP):IF SP<0 THEN65535
  197. 1700 POKE VOC+6,FN L(AD)
  198. 1710 POKE VOC+7,FN H(AD)
  199. 1720 VOC=VOC+8:GOTO 1570
  200. 1725 :
  201. 1730 IF BE$=";" THEN POKE VOC,96:VOC=VOC+1:COMP=0:GOTO 700
  202. 1735 :
  203. 1740 GOSUB 3030
  204. 1750 IF OK=0 THEN 1800
  205. 1760 POKE VOC,169:POKE VOC+1,FN H(XX)
  206. 1770 POKEVOC+2,162:POKEVOC+3,FN L(XX)
  207. 1780 POKE VOC+4,32:POKE VOC+5,42
  208. 1790 POKE VOC+6,192:VOC=VOC+7:GOTO 1570
  209. 1800 :
  210. 1810 IF BE$<>"IF" THEN 1870
  211. 1820 POKE VOC,32:POKE VOC+1,180
  212. 1830 POKE VOC+2,194:POKE VOC+3,176
  213. 1840 POKE VOC+4,3:POKE VOC+5,76
  214. 1850 ST(SP)=VOC+6:SP=SP+1
  215. 1860 VOC=VOC+8:GOTO 1570
  216. 1870 :
  217. 1880 IF BE$<>"ENDIF" THEN 1930
  218. 1890 SP=SP-1:AD=ST(SP)
  219. 1900 POKE AD,FN L(VOC)
  220. 1910 POKE AD+1,FN H(VOC)
  221. 1920 GOTO 1570
  222. 1930 :
  223. 1940 IF BE$<>"ELSE" THEN 2010
  224. 1950 AD=ST(SP-1)
  225. 1960 ST(SP-1)=VOC+1
  226. 1970 POKE VOC,76:VOC=VOC+3
  227. 1980 POKE AD,FN L(VOC)
  228. 1990 POKE AD+1,FN H(VOC)
  229. 2000 GOTO 1570
  230. 2010 :
  231. 2020 IF BE$="WHILE" THEN 1820
  232. 2030 :
  233. 2040 IF BE$<>"REPEAT" THEN 2110
  234. 2050 AD=ST(SP-1):A2=ST(SP-2)
  235. 2060 SP=SP-1
  236. 2070 POKE VOC,76
  237. 2080 POKE VOC+1,FN L(A2)
  238. 2090 POKE VOC+2,FN H(A2)
  239. 2100 VOC=VOC+3:GOTO 1980
  240. 2110 :
  241. 2120 IF BE$<>"."+CHR$(34) THEN 2225
  242. 2125 A$="":ZE$=MID$(ZE$,2)
  243. 2130 IF LEFT$(ZE$,1)<>CHR$(34) THEN A$=A$+LEFT$(ZE$,1):ZE$=MID$(ZE$,2):GOTO2130
  244. 2135 ZE$=MID$(ZE$,2):A$=A$+CHR$(0)
  245. 2140 AD=VOC+10
  246. 2145 POKE VOC,169
  247. 2150 POKE VOC+1,FN H(AD)
  248. 2155 POKE VOC+2,162
  249. 2160 POKE VOC+3,FN L(AD)
  250. 2165 POKE VOC+4,32:POKE VOC+5,234
  251. 2170 POKE VOC+6,194:POKE VOC+7,76
  252. 2175 AD=VOC+10+LEN(A$)
  253. 2180 POKE VOC+8,FN L(AD)
  254. 2185 POKE VOC+9,FN H(AD)
  255. 2190 VOC=VOC+10
  256. 2200 FOR I=0 TO LEN(A$)-1
  257. 2205 POKE VOC+I,ASC(MID$(A$,I+1,1))
  258. 2210 IF LEFT$(ZE$,1)=" " THEN ZE$=MID$(ZE$,2):GOTO 2210
  259. 2215 NEXT I
  260. 2220 VOC=AD:GOTO 1570
  261. 2225 :
  262. 2230 IF BE$<>"TEXT"+CHR$(34) THEN2320
  263. 2235 A$="":ZE$=MID$(ZE$,2)
  264. 2240 IF LEFT$(ZE$,1)<>CHR$(34) THEN A$=A$+LEFT$(ZE$,1):ZE$=MID$(ZE$,2):GOTO2240
  265. 2245 ZE$=MID$(ZE$,2):A$=A$+CHR$(0)
  266. 2250 AD=VOC+10
  267. 2255 POKE VOC,169
  268. 2260 POKE VOC+1,FN H(AD)
  269. 2265 POKE VOC+2,162
  270. 2270 POKE VOC+3,FN L(AD)
  271. 2273 POKE VOC+4,32:POKE VOC+5,42:POKE VOC+6,192
  272. 2275 POKE VOC+7,76
  273. 2280 AD=VOC+10+LEN(A$)
  274. 2285 POKE VOC+8,FN L(AD)
  275. 2290 POKE VOC+9,FN H(AD)
  276. 2295 VOC=VOC+10
  277. 2300 FOR I=0 TO LEN(A$)-1
  278. 2305 POKE VOC+I,ASC(MID$(A$,I+1,1)):NEXT
  279. 2310 IF LEFT$(ZE$,1)=" " THEN ZE$=MID$(ZE$,2):GOTO 2310
  280. 2315 VOC=AD:GOTO 1570
  281. 2320 :
  282. 2330 IF BE$<>"DO" THEN 2390
  283. 2340 POKE VOC,32
  284. 2350 POKE VOC+1,FN L(AD)
  285. 2360 POKE VOC+2,FN H(AD)
  286. 2370 VOC=VOC+3:ST(SP)=VOC
  287. 2380 SP=SP+1:GOTO 1570
  288. 2390 :
  289. 2400 IF BE$<>"LOOP" AND BE$<>"+LOOP" THEN 2500
  290. 2410 POKE VOC,32
  291. 2420 POKE VOC+1,FN L(AD)
  292. 2430 POKE VOC+2,FN H(AD)
  293. 2440 POKE VOC+3,176:POKE VOC+4,3
  294. 2450 SP=SP-1:AD=ST(SP)
  295. 2460 POKE VOC+5,76
  296. 2470 POKE VOC+6,AD-256*INT(AD/256)
  297. 2480 POKE VOC+7,INT(AD/256)
  298. 2490 VOC=VOC+8:GOTO 1570
  299. 2500 :
  300. 2510 IF BE$<>"(" THEN 2540
  301. 2520 GOSUB 2630:IF BE$<>")" THEN 2520
  302. 2530 GOTO 1570
  303. 2540 :
  304. 2550 IF BE$=";S" THEN POKE VOC,96:VOC=VOC+1:GOTO 1570
  305. 2560 :
  306. 2570 IF I>AN THEN PRINT BE$" [201] CAN'T FIND":COMP=0:GOTO 700
  307. 2575 :
  308. 2580 POKE VOC,32
  309. 2590 POKE VOC+1,AD-256*INT(AD/256)
  310. 2600 POKE VOC+2,INT(AD/256)
  311. 2610 VOC=VOC+3:GOTO 1570
  312. 26