... | ... |
@@ -5,8 +5,10 @@ |
5 | 5 |
%++ { ADD2 } %-- { SUB2 } %** { MUL2 } %// { DIV2 } |
6 | 6 |
%<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 } |
7 | 7 |
|
8 |
-%DEBUG { .Console/byte DEO #0a .Console/char DEO } |
|
9 |
-%DEBUG2 { .Console/short DEO2 #0a .Console/char DEO } |
|
8 |
+%DEBUG { ;print-hex JSR2 #0a .Console/write DEO } |
|
9 |
+%DEBUG2 { SWP ;print-hex JSR2 ;print-hex JSR2 #0a .Console/write DEO } |
|
10 |
+ |
|
11 |
+%RTN { JMP2r } |
|
10 | 12 |
|
11 | 13 |
( devices ) |
12 | 14 |
|
... | ... |
@@ -27,20 +29,68 @@ |
27 | 29 |
|
28 | 30 |
|0000 |
29 | 31 |
|
32 |
+@lista $3 |
|
33 |
+@listb $3 |
|
34 |
+@listc $3 |
|
35 |
+ |
|
30 | 36 |
( program ) |
31 | 37 |
|
32 | 38 |
|0100 ( -> ) |
33 | 39 |
|
34 |
- ;deferred |
|
35 |
- ,relative |
|
36 |
- .zero-page |
|
37 |
- :immediate |
|
40 |
+ ( theme ) |
|
41 |
+ #0fe5 .System/r DEO2 |
|
42 |
+ #0fc5 .System/g DEO2 |
|
43 |
+ #0f25 .System/b DEO2 |
|
44 |
+ |
|
45 |
+ #01 .lista #00 + STZ |
|
46 |
+ #02 .lista #01 + STZ |
|
47 |
+ #03 .lista #02 + STZ |
|
48 |
+ |
|
49 |
+ #10 .listb #00 + STZ |
|
50 |
+ #20 .listb #01 + STZ |
|
51 |
+ #30 .listb #02 + STZ |
|
52 |
+ |
|
53 |
+ .lista .listb .listc ;add-lists-loop JSR2 |
|
54 |
+ |
|
55 |
+ .listc LDZ DEBUG |
|
56 |
+ .listc #01 + LDZ DEBUG |
|
57 |
+ .listc #02 + LDZ DEBUG |
|
58 |
+ |
|
59 |
+BRK |
|
60 |
+ |
|
61 |
+( Write a Forth word to add together two integer |
|
62 |
+vectors (a.k.a. arrays) of three elements each. ) |
|
63 |
+ |
|
64 |
+@add-lists-linear ( a b c -- ) |
|
65 |
+ |
|
66 |
+ STH |
|
67 |
+ ( a[0] b[0] + ) LDZk STH SWP LDZk STHr + STHkr STZ |
|
68 |
+ ( a[1] b[1] + ) #01 + LDZk STH SWP #01 + LDZk STHr + STHkr #01 + STZ |
|
69 |
+ ( a[2] b[2] + ) #01 + LDZ SWP #01 + LDZ + STHr #02 + STZ |
|
70 |
+ |
|
71 |
+RTN |
|
72 |
+ |
|
73 |
+@add-lists-loop ( a b c -- ) |
|
74 |
+ |
|
75 |
+ STH |
|
76 |
+ #00 #03 |
|
77 |
+ &loop |
|
78 |
+ ( get incr ) OVR STH |
|
79 |
+ ( get a[x] ) OVR2 STHkr ADD LDZ |
|
80 |
+ ( get b[x] ) SWP STHkr ADD LDZ |
|
81 |
+ ( set c[x] ) ADD STHr STHkr ADD STZ |
|
82 |
+ ( incr ) SWP #01 ADD SWP |
|
83 |
+ LTHk ,&loop JCN |
|
84 |
+ POP2 POP2 POPr |
|
38 | 85 |
|
39 |
- |goto |
|
40 |
- $padding |
|
86 |
+JMP2r |
|
41 | 87 |
|
42 |
- @label |
|
43 |
- &sublabel |
|
88 |
+@print-hex ( value -- ) |
|
89 |
+ |
|
90 |
+ STHk #04 SFT ,&parse JSR .Console/write DEO |
|
91 |
+ STHr #0f AND ,&parse JSR .Console/write DEO |
|
92 |
+ RTN |
|
93 |
+ &parse ( value -- char ) |
|
94 |
+ DUP #09 GTH ,&above JCN #30 ADD RTN &above #09 SUB #60 ADD RTN |
|
44 | 95 |
|
45 |
- #value |
|
46 |
- "string |
|
47 | 96 |
\ No newline at end of file |
97 |
+RTN |
|
48 | 98 |
\ No newline at end of file |
... | ... |
@@ -221,7 +221,7 @@ walktoken(char *w) |
221 | 221 |
res += walktoken(m->items[i]); |
222 | 222 |
return res; |
223 | 223 |
} |
224 |
- return error("Unknown label in first pass", w); |
|
224 |
+ return error("Invalid token", w); |
|
225 | 225 |
} |
226 | 226 |
|
227 | 227 |
static int |
... | ... |
@@ -328,7 +328,7 @@ pass2(FILE *f) |
328 | 328 |
if(skipblock(w, &cmacr, '{', '}')) continue; |
329 | 329 |
if(w[0] == '|') { |
330 | 330 |
if(p.length && shex(w + 1) < p.ptr) |
331 |
- return error("Pass 2 - Memory Overwrite", w); |
|
331 |
+ return error("Pass 2 - Memory overwrite", w); |
|
332 | 332 |
p.ptr = shex(w + 1); |
333 | 333 |
continue; |
334 | 334 |
} else if(w[0] == '$') { |
... | ... |
@@ -366,7 +366,7 @@ main(int argc, char *argv[]) |
366 | 366 |
{ |
367 | 367 |
FILE *f; |
368 | 368 |
if(argc < 3) |
369 |
- return !error("Input", "Missing"); |
|
369 |
+ return !error("Usage", "input.tal output.rom"); |
|
370 | 370 |
if(!(f = fopen(argv[1], "r"))) |
371 | 371 |
return !error("Open", "Failed"); |
372 | 372 |
if(!pass1(f) || !pass2(f)) |