| ... | ... |
@@ -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)) |