├── .gitignore
├── 6502.cpp
├── 6502.h
├── 6502.lua
├── FIG6502.ASM
├── Makefile
├── README.md
├── bootstrap.f
├── bootstrap.s
├── browser.cpp
├── config
├── coroutines.s
├── disassembler.s
├── done.f
├── end.s
├── font.chr
├── forth.inc
├── game.f
├── lit
    ├── .gitignore
    ├── 6502.cpp
    ├── 6502.h
    ├── Makefile
    ├── bootstrap.conf
    ├── bootstrap.f
    ├── bootstrap.s
    ├── css
    │   ├── style.css
    │   └── theme.css
    ├── done.f
    ├── editor.lit
    ├── font.chr
    ├── game.f
    ├── package.json
    ├── script
    │   └── syntax.js
    ├── test.f
    ├── test.html
    └── test.lit
├── macros.inc
├── minimizing-assembler.txt
├── neslib.s
├── note.s
├── posts
    └── 01-intro.md
├── relocation-ideas.txt
├── subroutines.f
└── visualize-ops.html


/.gitignore:
--------------------------------------------------------------------------------
1 | *.swp
2 | *.swo
3 | out/
4 | 


--------------------------------------------------------------------------------
/6502.cpp:
--------------------------------------------------------------------------------
 1 | 
 2 | #include "6502.h"
 3 | #include "stdint.h"
 4 | #include "stdio.h"
 5 | #include "stdbool.h"
 6 | #include <string>
 7 | #include <iostream>
 8 | #include <fstream>
 9 | #include <sstream>
10 | #include <exception>
11 | 
12 | int main(int argc, char **argv) {
13 |   trace = false;
14 | 
15 |   initOpcodes();
16 | 
17 |   FILE *bootstrap = fopen("out/bootstrap.bin", "r");
18 |   if (!fread(&m.memory, 1, sizeof(m.memory), bootstrap)) {
19 |     printf("Couldn't open bootstrap.bin");
20 |     return 1;
21 |   }
22 | 
23 | 	opsFile = fopen("out/ops.out", "w+");
24 | 
25 |   for (int i = 1; i < argc; i++) {
26 |     if (argv[i] == std::string("-b")) {
27 |       std::string binary = argv[i+1];
28 |       int splitPoint = binary.find(":");
29 |       std::string name = binary.substr(0, splitPoint);
30 |       std::string file = binary.substr(splitPoint+1);
31 |       std::ifstream in(file.c_str());
32 |       std::string fileContents(
33 |         (std::istreambuf_iterator<char>(in)),
34 |         std::istreambuf_iterator<char>());
35 |       std::stringstream ss;
36 |       ss << " " << std::hex << fileContents.size() << " heredoc " << name << " " << fileContents << " ";
37 |       lastLineInput += ss.str();
38 |       i++;
39 |     } else {
40 |       std::ifstream in(argv[i]);
41 |       std::string fileContents(
42 |         (std::istreambuf_iterator<char>(in)),
43 |         std::istreambuf_iterator<char>());
44 |       lastLineInput.append(fileContents);
45 |     }
46 |   }
47 | 
48 |   m.ip = m.memory[0xFFFC] + (m.memory[0xFFFD] << 8) - 1;
49 | 
50 |   while(emulate()) {
51 |     lastLineInput.clear();
52 |     std::getline(std::cin, lastLineInput);
53 |     lastLineInput += "\n";
54 |     lineIndex = 0;
55 |   }
56 | 
57 |   FILE *romout = fopen("out/game.nes", "w+");
58 |   FILE *ramout = fopen("out/ram.out", "w+");
59 | 
60 | 
61 |   fwrite("NES\x1A\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", 1, 16, romout);
62 |   fwrite(&m.memory[0x8000], 1, 0x8000, romout);
63 | 
64 |   fwrite(&m.memory, 1, 0x800, ramout);
65 | }
66 | 


--------------------------------------------------------------------------------
/6502.h:
--------------------------------------------------------------------------------
  1 | 
  2 | #include "stdint.h"
  3 | #include "stdio.h"
  4 | #include "stdbool.h"
  5 | #include <string>
  6 | 
  7 | #define IO_PORT 0x401C
  8 | #define MEMORY_SIZE (64*1024)
  9 | #define TRACE_OPS 1
 10 | 
 11 | typedef struct Machine {
 12 |   uint8_t a = 0;
 13 |   uint8_t x = 0;
 14 |   uint8_t y = 0;
 15 |   uint8_t sp = 0xFF;
 16 |   uint16_t ip = 0xFFFF;
 17 |   struct {
 18 |     bool n = false;
 19 |     bool v = false;
 20 |     bool z = false;
 21 |     bool s = false;
 22 |     bool c = false;
 23 |     bool d = false;
 24 |     bool i = false;
 25 |   } status;
 26 |   uint8_t memory[MEMORY_SIZE];
 27 | } Machine;
 28 | 
 29 | static Machine m;
 30 | static bool trace;
 31 | 
 32 | static FILE *opsFile;
 33 | static std::string lastLineInput;
 34 | static size_t lineIndex = 0;
 35 | 
 36 | typedef struct OutOfInputException
 37 |   : public std::exception
 38 |   {} OutOfInputException;
 39 | 
 40 | static uint8_t nextChar() {
 41 |   if (lineIndex == lastLineInput.size()) {
 42 |     throw OutOfInputException();
 43 |   }
 44 |   uint8_t result = lastLineInput[lineIndex];
 45 |   lineIndex++;
 46 |   return result;
 47 | }
 48 | 
 49 | static uint8_t read(uint16_t addr) {
 50 |   if (addr == IO_PORT) {
 51 |     const auto n = nextChar();
 52 |     if (TRACE_OPS) {
 53 | 			fprintf(opsFile, "r\t%d\n", n);
 54 | 		}
 55 |     return n;
 56 |   } else {
 57 | 
 58 |     return m.memory[addr];
 59 |   }
 60 | }
 61 | 
 62 | static void set(uint16_t addr, uint8_t val) {
 63 |   if (addr == IO_PORT) {
 64 |     putchar(val);
 65 |   } else {
 66 | 		if (TRACE_OPS) {
 67 | 			fprintf(opsFile, "w\t%d\t%d\n", addr, val);
 68 | 		}
 69 |     m.memory[addr] = val;
 70 |   }
 71 | }
 72 | 
 73 | static uint8_t pop() {
 74 |   m.sp = m.sp + 1;
 75 |   return read(0x100 + m.sp);
 76 | }
 77 | 
 78 | static void push(uint8_t val) {
 79 |   set(0x100 + m.sp, val);
 80 |   m.sp = m.sp - 1;
 81 | }
 82 | 
 83 | static uint16_t getAbsolute() {
 84 |   m.ip = m.ip + 2;
 85 |   uint8_t low = read(m.ip - 1);
 86 |   return low + (read(m.ip) << 8);
 87 | }
 88 | 
 89 | static uint8_t readImmediate() {
 90 |   m.ip = m.ip + 1;
 91 |   return read(m.ip);
 92 | }
 93 | 
 94 | static uint8_t readZeroPage() {
 95 |   m.ip = m.ip + 1;
 96 |   return read(read(m.ip));
 97 | }
 98 | 
 99 | static void storeZeroPage(uint8_t val) {
100 |   m.ip = m.ip + 1;
101 |   set(read(m.ip), val);
102 | }
103 | 
104 | static uint8_t readZeroPageX() {
105 |   m.ip = m.ip + 1;
106 |   return read(0xFF & (read(m.ip) + m.x));
107 | }
108 | 
109 | static void storeZeroPageX(uint8_t val) {
110 |   m.ip = m.ip + 1;
111 |   set(0xFF & (read(m.ip) + m.x), val);
112 | }
113 | 
114 | static uint8_t readZeroPageY() {
115 |   m.ip = m.ip + 1;
116 |   return read(0xFF & (read(m.ip) + m.y));
117 | }
118 | 
119 | static void storeZeroPageY(uint8_t val) {
120 |   m.ip = m.ip + 1;
121 |   uint16_t addr = read(m.ip) + m.y;
122 |   set(0xFF & addr, val);
123 | }
124 | 
125 | static uint8_t readAbsolute() {
126 |   return read(getAbsolute());
127 | }
128 | 
129 | static void storeAbsolute(uint8_t val) {
130 |   set(getAbsolute(), val);
131 | }
132 | 
133 | static uint8_t readAbsoluteX() {
134 |   return read(m.x + getAbsolute());
135 | }
136 | 
137 | static void storeAbsoluteX(uint8_t val) {
138 |   set(m.x + getAbsolute(), val);
139 | }
140 | 
141 | static uint8_t readAbsoluteY() {
142 |   return read(m.y + getAbsolute());
143 | }
144 | 
145 | static void storeAbsoluteY(uint8_t val) {
146 |   set(m.y + getAbsolute(), val);
147 | }
148 | 
149 | static uint16_t readIndirect() {
150 |   uint16_t addr = getAbsolute();
151 |   uint16_t addrPlus1 = addr + 1;
152 |   // adjust for jmp indirect bug
153 |   if ((addrPlus1 & 0xFF) == 0) {
154 |     addrPlus1 -= 0x100;
155 |   }
156 |   uint8_t low = read(addr);
157 |   return low + (read(addrPlus1) << 8);
158 | }
159 | 
160 | static uint8_t readIndirectX() {
161 |   uint8_t zpAddr = readImmediate() + m.x;
162 |   uint8_t addrPlus1 = zpAddr + 1;
163 |   uint8_t low = read(zpAddr);
164 |   return read(low + (read(addrPlus1) << 8));
165 | }
166 | 
167 | static void storeIndirectX(uint8_t val) {
168 |   uint8_t zpAddr = readImmediate() + m.x;
169 |   uint8_t addrPlus1 = zpAddr + 1;
170 |   uint8_t low = read(zpAddr);
171 |   set(low + (read(addrPlus1) << 8), val);
172 | }
173 | 
174 | static uint8_t readIndirectY() {
175 |   uint8_t addr = readImmediate();
176 |   uint8_t addrPlus1 = addr + 1;
177 |   uint8_t low = read(addr);
178 |   return read(low + (read(addrPlus1) << 8) + m.y);
179 | }
180 | 
181 | static void storeIndirectY(uint8_t val) {
182 |   uint8_t addr = readImmediate();
183 |   uint8_t addrPlus1 = addr + 1;
184 |   uint8_t low = read(addr);
185 |   set(low + (read(addrPlus1) << 8) + m.y, val);
186 | }
187 | 
188 | static uint8_t setSZ(uint8_t val) {
189 |   m.status.s = val >= 0x80;
190 |   m.status.z = val == 0;
191 |   return val;
192 | }
193 | 
194 | static void BIT(uint8_t read) {
195 |   m.status.z = m.a & read;
196 |   m.status.n = read & 0x80;
197 |   m.status.v = read & 0x40;
198 | }
199 | 
200 | static void LDA(uint8_t value) {
201 |   m.a = setSZ(value);
202 | }
203 | 
204 | static void LDX(uint8_t value) {
205 |   m.x = setSZ(value);
206 | }
207 | 
208 | static void LDY(uint8_t value) {
209 |   m.y = setSZ(value);
210 | }
211 | 
212 | static void INC(uint16_t addr) {
213 |   set(addr, setSZ(read(addr) + 1));
214 | }
215 | 
216 | static void DEC(uint16_t addr) {
217 |   set(addr, setSZ(read(addr) - 1));
218 | }
219 | 
220 | static void AND(uint8_t value) {
221 |   m.a = setSZ(m.a & value);
222 | }
223 | 
224 | static void ORA(uint8_t value) {
225 |   m.a = setSZ(m.a | value);
226 | }
227 | 
228 | static void EOR(uint8_t value) {
229 |   m.a = setSZ(m.a ^ value);
230 | }
231 | 
232 | static void ASL(uint16_t addr) {
233 |   uint8_t value = read(addr);
234 |   m.status.c = value >= 0x80;
235 |   set(addr, setSZ(value << 1));
236 | }
237 | 
238 | static void ROL(uint16_t addr) {
239 |   uint8_t value = read(addr);
240 |   uint8_t c = m.status.c ? 1 : 0;
241 |   m.status.c = value >= 0x80;
242 |   set(addr, setSZ((value << 1) + c));
243 | }
244 | 
245 | static void LSR(uint16_t addr) {
246 |   uint8_t value = read(addr);
247 |   m.status.c = value & 1;
248 |   set(addr, setSZ((value >> 1) & 0x7F));
249 | }
250 | 
251 | static void ROR(uint16_t addr) {
252 |   uint8_t value = read(addr);
253 |   uint8_t c = m.status.c ? 0x80 : 0;
254 |   m.status.c = value & 1;
255 |   set(addr, setSZ(((value >> 1) & 0x7F) + c));
256 | }
257 | 
258 | static void BRANCH(uint8_t condition) {
259 |   uint8_t disp = readImmediate();
260 |   if (condition) {
261 |     if (disp >= 0x80) {
262 |       m.ip = m.ip - 0x100;
263 |     }
264 |     m.ip = m.ip + disp;
265 |   }
266 | }
267 | 
268 | static void ADC(uint8_t value) {
269 |   uint16_t newValue = m.a + value + !!m.status.c;
270 |   m.status.c = newValue > 0xFF;
271 |   m.status.v = !((m.a ^ value) & 0x80) && ((m.a ^ newValue) & 0x80);
272 |   m.a = setSZ((uint8_t)newValue);
273 | }
274 | 
275 | static void SBC(uint8_t value) {
276 |   ADC(~value);
277 | }
278 | 
279 | static void CMP(uint8_t a, uint8_t b) {
280 |   uint8_t comparison = a - b;
281 |   m.status.z = comparison == 0;
282 |   m.status.c = a >= b;
283 |   m.status.n = comparison >= 0x80;
284 | }
285 | 
286 | static void SET_P(uint8_t a) {
287 |   m.status.n = a & 0x80;
288 |   m.status.v = a & 0x40;
289 |   m.status.d = a & 0x08;
290 |   m.status.i = a & 0x04;
291 |   m.status.z = a & 0x02;
292 |   m.status.c = a & 0x01;
293 | }
294 | 
295 | typedef struct Handler {
296 |   const char *name;
297 |   void (*handler)();
298 | } Handler;
299 | 
300 | static Handler opcodes[256] = { 0 };
301 | 
302 | void initOpcodes() {
303 |   opcodes[0x24] = {"BIT ZP", []{ BIT(readZeroPage()); }};
304 |   opcodes[0x24] = {"BIT ZP", []{ BIT(readZeroPage()); }};
305 |   opcodes[0x24] = {"BIT ZP", []{ BIT(readZeroPage()); }};
306 |   opcodes[0x24] = {"BIT ZP", []{ BIT(readZeroPage()); }};
307 |   opcodes[0x24] = {"BIT ZP", []{ BIT(readZeroPage()); }};
308 | 
309 |   // bit
310 |   opcodes[0x24] = {"BIT ZP", []{ BIT(readZeroPage()); }};
311 |   opcodes[0x2C] = {"BIT ABS", []{ BIT(readAbsolute()); }};
312 |   // lda
313 |   opcodes[0xA9] = {"LDA IMM", []{ LDA(readImmediate()); }};
314 |   opcodes[0xA5] = {"LDA ZP", []{ LDA(readZeroPage()); }};
315 |   opcodes[0xB5] = {"LDA ZPX", []{ LDA(readZeroPageX()); }};
316 |   opcodes[0xAD] = {"LDA ABS", []{ LDA(readAbsolute()); }};
317 |   opcodes[0xBD] = {"LDA ABSX", []{ LDA(readAbsoluteX()); }};
318 |   opcodes[0xB9] = {"LDA ABSY", []{ LDA(readAbsoluteY()); }};
319 |   opcodes[0xA1] = {"LDA INDX", []{ LDA(readIndirectX()); }};
320 |   opcodes[0xB1] = {"LDA INDY", []{ LDA(readIndirectY()); }};
321 |   // sta
322 |   opcodes[0x85] = {"STA", []{ storeZeroPage(m.a); }};
323 |   opcodes[0x95] = {"STA", []{ storeZeroPageX(m.a); }};
324 |   opcodes[0x8D] = {"STA", []{ storeAbsolute(m.a); }};
325 |   opcodes[0x9D] = {"STA", []{ storeAbsoluteX(m.a); }};
326 |   opcodes[0x99] = {"STA", []{ storeAbsoluteY(m.a); }};
327 |   opcodes[0x81] = {"STA", []{ storeIndirectX(m.a); }};
328 |   opcodes[0x91] = {"STA", []{ storeIndirectY(m.a); }};
329 | 
330 |   // ldx
331 |   opcodes[0xA2] = {"LDX", []{ LDX(readImmediate()); }};
332 |   opcodes[0xA6] = {"LDX", []{ LDX(readZeroPage()); }};
333 |   opcodes[0xB6] = {"LDX", []{ LDX(readZeroPageY()); }};
334 |   opcodes[0xAE] = {"LDX", []{ LDX(readAbsolute()); }};
335 |   opcodes[0xBE] = {"LDX", []{ LDX(readAbsoluteY()); }};
336 |   // stx
337 |   opcodes[0x86] = {"STX", []{ storeZeroPage(m.x); }};
338 |   opcodes[0x96] = {"STX", []{ storeZeroPageY(m.x); }};
339 |   opcodes[0x8E] = {"STX", []{ storeAbsolute(m.x); }};
340 | 
341 |   // ldy
342 |   opcodes[0xA0] = {"LDY", []{ LDY(readImmediate()); }};
343 |   opcodes[0xA4] = {"LDY", []{ LDY(readZeroPage()); }};
344 |   opcodes[0xB4] = {"LDY", []{ LDY(readZeroPageX()); }};
345 |   opcodes[0xAC] = {"LDY", []{ LDY(readAbsolute()); }};
346 |   opcodes[0xBC] = {"LDY", []{ LDY(readAbsoluteX()); }};
347 |   // sty
348 |   opcodes[0x84] = {"STY", []{ storeZeroPage(m.y); }};
349 |   opcodes[0x94] = {"STY", []{ storeZeroPageX(m.y); }};
350 |   opcodes[0x8C] = {"STY", []{ storeAbsolute(m.y); }};
351 | 
352 |   // tsx/txs
353 |   opcodes[0xBA] = {"TSX", []{ m.x = setSZ(m.sp); }};
354 |   opcodes[0x9A] = {"TXS", []{ m.sp = m.x; }};
355 | 
356 |   // pha/pla
357 |   opcodes[0x48] = {"PHA", []{ push(m.a); }};
358 |   opcodes[0x68] = {"PLA", []{ m.a = pop(); }};
359 | 
360 |   opcodes[0x08] = {"PHP", []{
361 |     push(
362 |       (m.status.n ? 0x80 : 0)
363 |       | (m.status.v ? 0x40 : 0)
364 |       | 0x20
365 |       | 0x10
366 |       | (m.status.d ? 0x08 : 0)
367 |       | (m.status.i ? 0x04 : 0)
368 |       | (m.status.z ? 0x02 : 0)
369 |       | (m.status.c ? 0x01 : 0));
370 |   }};
371 |   opcodes[0x28] = {"PLP", []{ SET_P(pop()); }};
372 | 
373 |   // tax/txa
374 |   opcodes[0xAA] = {"TAX", []{ m.x = setSZ(m.a); }};
375 |   opcodes[0x8A] = {"TXA", []{ m.a = setSZ(m.x); }};
376 | 
377 |   // dex/inx
378 |   opcodes[0xCA] = {"DEX", []{ m.x = setSZ(m.x - 1); }};
379 |   opcodes[0xE8] = {"INX", []{ m.x = setSZ(m.x + 1); }};
380 | 
381 |   // tay/tya
382 |   opcodes[0xA8] = {"TAY", []{ m.y = setSZ(m.a); }};
383 |   opcodes[0x98] = {"TYA", []{ m.a = setSZ(m.y); }};
384 | 
385 |   // dey/iny
386 |   opcodes[0x88] = {"DEY", []{ m.y = setSZ(m.y - 1); }};
387 |   opcodes[0xC8] = {"INY", []{ m.y = setSZ(m.y + 1); }};
388 | 
389 |   // nop
390 |   opcodes[0xEA] = {"NOP", []{; }};
391 | 
392 |   // inc
393 |   opcodes[0xE6] = {"INC", []{ INC(readImmediate()); }};
394 |   opcodes[0xF6] = {"INC", []{ INC((readImmediate() + m.x) & 0xFF); }};
395 |   opcodes[0xEE] = {"INC", []{ INC(getAbsolute()); }};
396 |   opcodes[0xFE] = {"INC", []{ INC(getAbsolute() + m.x); }};
397 | 
398 |   // dec
399 |   opcodes[0xC6] = {"DEC", []{ DEC(readImmediate()); }};
400 |   opcodes[0xD6] = {"DEC", []{ DEC((readImmediate() + m.x) & 0xFF); }};
401 |   opcodes[0xCE] = {"DEC", []{ DEC(getAbsolute()); }};
402 |   opcodes[0xDE] = {"DEC", []{ DEC(getAbsolute() + m.x); }};
403 | 
404 |   // jmp
405 |   opcodes[0x4C] = {"JMP", []{ m.ip = getAbsolute() - 1; }};
406 |   opcodes[0x6C] = {"JMPI", []{ m.ip = readIndirect() - 1; }};
407 | 
408 |   // flag instructions
409 |   opcodes[0x18] = {"CLC", []{ m.status.c = 0; }};
410 |   opcodes[0x38] = {"SEC", []{ m.status.c = 1; }};
411 |   opcodes[0x58] = {"CLI", []{ m.status.i = 0; }};
412 |   opcodes[0x78] = {"SEI", []{ m.status.i = 1; }};
413 |   opcodes[0xB8] = {"CLV", []{ m.status.v = 0; }};
414 |   opcodes[0xD8] = {"CLC", []{ m.status.c = 0; }};
415 |   opcodes[0xF8] = {"SEC", []{ m.status.c = 1; }};
416 | 
417 |   // and
418 |   opcodes[0x29] = {"AND", []{ AND(readImmediate()); }};
419 |   opcodes[0x25] = {"AND", []{ AND(readZeroPage()); }};
420 |   opcodes[0x35] = {"AND", []{ AND(readZeroPageX()); }};
421 |   opcodes[0x2D] = {"AND", []{ AND(readAbsolute()); }};
422 |   opcodes[0x3D] = {"AND", []{ AND(readAbsoluteX()); }};
423 |   opcodes[0x39] = {"AND", []{ AND(readAbsoluteY()); }};
424 |   opcodes[0x21] = {"AND", []{ AND(readIndirectX()); }};
425 |   opcodes[0x31] = {"AND", []{ AND(readIndirectY()); }};
426 | 
427 |   // ora
428 |   opcodes[0x09] = {"ORA", []{ ORA(readImmediate()); }};
429 |   opcodes[0x05] = {"ORA", []{ ORA(readZeroPage()); }};
430 |   opcodes[0x15] = {"ORA", []{ ORA(readZeroPageX()); }};
431 |   opcodes[0x0D] = {"ORA", []{ ORA(readAbsolute()); }};
432 |   opcodes[0x1D] = {"ORA", []{ ORA(readAbsoluteX()); }};
433 |   opcodes[0x19] = {"ORA", []{ ORA(readAbsoluteY()); }};
434 |   opcodes[0x01] = {"ORA", []{ ORA(readIndirectX()); }};
435 |   opcodes[0x11] = {"ORA", []{ ORA(readIndirectY()); }};
436 | 
437 |   // eor
438 |   opcodes[0x49] = {"EOR", []{ EOR(readImmediate()); }};
439 |   opcodes[0x45] = {"EOR", []{ EOR(readZeroPage()); }};
440 |   opcodes[0x55] = {"EOR", []{ EOR(readZeroPageX()); }};
441 |   opcodes[0x4D] = {"EOR", []{ EOR(readAbsolute()); }};
442 |   opcodes[0x5D] = {"EOR", []{ EOR(readAbsoluteX()); }};
443 |   opcodes[0x59] = {"EOR", []{ EOR(readAbsoluteY()); }};
444 |   opcodes[0x41] = {"EOR", []{ EOR(readIndirectX()); }};
445 |   opcodes[0x51] = {"EOR", []{ EOR(readIndirectY()); }};
446 | 
447 |   // asl
448 |   opcodes[0x0A] = {"ASL", []{
449 |     m.status.c = m.a & 0x80;
450 |     m.a = setSZ(m.a << 1);
451 |   }};
452 |   opcodes[0x06] = {"ASL", []{ ASL(readImmediate()); }};
453 |   opcodes[0x16] = {"ASL", []{ ASL((readImmediate() + m.x) & 0xFF); }};
454 |   opcodes[0x0E] = {"ASL", []{ ASL(getAbsolute()); }};
455 |   opcodes[0x1E] = {"ASL", []{ ASL(getAbsolute() + m.x); }};
456 | 
457 |   // lsr
458 |   opcodes[0x4A] = {"LSR", []{
459 |     m.status.c = m.a & 1;
460 |     m.a = setSZ((m.a >> 1) & 0x7F);
461 |   }};
462 |   opcodes[0x46] = {"LSR", []{ LSR(readImmediate()); }};
463 |   opcodes[0x56] = {"LSR", []{ LSR((readImmediate() + m.x) & 0xFF); }};
464 |   opcodes[0x4E] = {"LSR", []{ LSR(getAbsolute()); }};
465 |   opcodes[0x5E] = {"LSR", []{ LSR(getAbsolute() + m.x); }};
466 | 
467 |   // rol
468 |   opcodes[0x2A] = {"ROL", []{
469 |     bool c = m.status.c;
470 |     m.status.c = m.a & 0x80;
471 |     m.a = setSZ((m.a << 1) + c);
472 |   }};
473 |   opcodes[0x26] = {"ROL", []{ ROL(readImmediate()); }};
474 |   opcodes[0x36] = {"ROL", []{ ROL((readImmediate() + m.x) & 0xFF); }};
475 |   opcodes[0x2E] = {"ROL", []{ ROL(getAbsolute()); }};
476 |   opcodes[0x3E] = {"ROL", []{ ROL(getAbsolute() + m.x); }};
477 | 
478 |   // ror
479 |   opcodes[0x6A] = {"ROR", []{
480 |     uint8_t c = m.status.c ? 0x80 : 0;
481 |     m.status.c = m.a & 1;
482 |     m.a = setSZ(((m.a >> 1) & 0x7F) + c);
483 |   }};
484 |   opcodes[0x66] = {"ROR", []{ ROR(readImmediate()); }};
485 |   opcodes[0x76] = {"ROR", []{ ROR((readImmediate() + m.x) & 0xFF); }};
486 |   opcodes[0x6E] = {"ROR", []{ ROR(getAbsolute()); }};
487 |   opcodes[0x7E] = {"ROR", []{ ROR(getAbsolute() + m.x); }};
488 | 
489 |   // jsr
490 |   opcodes[0x20] = {"JSR", []{
491 |     uint16_t target = getAbsolute();
492 |     push(m.ip >> 8);
493 |     push(m.ip);
494 |     m.ip = target - 1;
495 |   }};
496 | 
497 |   // rts
498 |   opcodes[0x60] = {"RTS", []{
499 |     uint8_t lo = pop();
500 |     m.ip = lo + (pop() << 8);
501 |   }};
502 | 
503 |   opcodes[0x40] = {"RTI", []{
504 |     SET_P(pop());
505 |     uint8_t lo = pop();
506 |     m.ip = lo + (pop() << 8) - 1;
507 |   }};
508 | 
509 |   // branch
510 |   opcodes[0x10] = {"BPL", []{ BRANCH(!m.status.s); }};
511 |   opcodes[0x30] = {"BMI", []{ BRANCH(m.status.s); }};
512 |   opcodes[0x50] = {"BVC", []{ BRANCH(!m.status.v); }};
513 |   opcodes[0x70] = {"BVS", []{ BRANCH(m.status.v); }};
514 |   opcodes[0x90] = {"BCC", []{ BRANCH(!m.status.c); }};
515 |   opcodes[0xB0] = {"BCS", []{ BRANCH(m.status.c); }};
516 |   opcodes[0xD0] = {"BNE", []{ BRANCH(!m.status.z); }};
517 |   opcodes[0xF0] = {"BEQ", []{ BRANCH(m.status.z); }};
518 | 
519 |   opcodes[0x69] = {"ADC", []{ ADC(readImmediate()); }};
520 |   opcodes[0x65] = {"ADC", []{ ADC(readZeroPage()); }};
521 |   opcodes[0x75] = {"ADC", []{ ADC(readZeroPageX()); }};
522 |   opcodes[0x6D] = {"ADC", []{ ADC(readAbsolute()); }};
523 |   opcodes[0x7D] = {"ADC", []{ ADC(readAbsoluteX()); }};
524 |   opcodes[0x79] = {"ADC", []{ ADC(readAbsoluteY()); }};
525 |   opcodes[0x61] = {"ADC", []{ ADC(readIndirectX()); }};
526 |   opcodes[0x71] = {"ADC", []{ ADC(readIndirectY()); }};
527 | 
528 |   opcodes[0xE9] = {"SBC", []{ SBC(readImmediate()); }};
529 |   opcodes[0xE5] = {"SBC", []{ SBC(readZeroPage()); }};
530 |   opcodes[0xF5] = {"SBC", []{ SBC(readZeroPageX()); }};
531 |   opcodes[0xED] = {"SBC", []{ SBC(readAbsolute()); }};
532 |   opcodes[0xFD] = {"SBC", []{ SBC(readAbsoluteX()); }};
533 |   opcodes[0xF9] = {"SBC", []{ SBC(readAbsoluteY()); }};
534 |   opcodes[0xE1] = {"SBC", []{ SBC(readIndirectX()); }};
535 |   opcodes[0xF1] = {"SBC", []{ SBC(readIndirectY()); }};
536 | 
537 |   opcodes[0xC9] = {"CMP", []{ CMP(m.a, readImmediate()); }};
538 |   opcodes[0xC5] = {"CMP", []{ CMP(m.a, readZeroPage()); }};
539 |   opcodes[0xD5] = {"CMP", []{ CMP(m.a, readZeroPageX()); }};
540 |   opcodes[0xCD] = {"CMP", []{ CMP(m.a, readAbsolute()); }};
541 |   opcodes[0xDD] = {"CMP", []{ CMP(m.a, readAbsoluteX()); }};
542 |   opcodes[0xD9] = {"CMP", []{ CMP(m.a, readAbsoluteY()); }};
543 |   opcodes[0xC1] = {"CMP", []{ CMP(m.a, readIndirectX()); }};
544 |   opcodes[0xD1] = {"CMP", []{ CMP(m.a, readIndirectY()); }};
545 | 
546 |   opcodes[0xE0] = {"CPX", []{ CMP(m.x, readImmediate()); }};
547 |   opcodes[0xE4] = {"CPX", []{ CMP(m.x, readZeroPage()); }};
548 |   opcodes[0xEC] = {"CPX", []{ CMP(m.x, readAbsolute()); }};
549 | 
550 |   opcodes[0xC0] = {"CPY", []{ CMP(m.y, readImmediate()); }};
551 |   opcodes[0xC4] = {"CPY", []{ CMP(m.y, readZeroPage()); }};
552 |   opcodes[0xCC] = {"CPY", []{ CMP(m.y, readAbsolute()); }};
553 | 
554 |   opcodes[0xFF] = {"DBG_START", []{
555 |     printf("DEBUGGER STARTED");
556 |     trace = true;
557 |   }};
558 |   opcodes[0xEF] = {"DBG_END", []{
559 |     printf("DEBUGGER ENDED");
560 |     trace = false;
561 |   }};
562 |   opcodes[0xDF] = {"DBG_TRACE", []{
563 |     m.ip = m.ip + 1;
564 |     while (m.memory[m.ip]) {
565 |       putchar(m.memory[m.ip]);
566 |       m.ip = m.ip + 1;
567 |     }
568 |     printf("\n");
569 |   }};
570 | }
571 | 
572 | // Runs the emulator until it needs more input or
573 | // stops. Returns true if it needs more input, and
574 | // false if emulation is done.
575 | bool emulate() {
576 |   while (true) {
577 |     if (m.ip == 0xFFFF) { return false; }
578 | 
579 |     uint16_t ip = m.ip;
580 |     uint8_t opcode = readImmediate();
581 |     if (opcodes[opcode].handler == nullptr) {
582 |       printf("\n\nUnknown opcode $%02x\n", opcode);
583 |       printf("IP:\t%04x\t%02x\ta:%02x\tx:%02x\ty:%02x", m.ip, opcode, m.a, m.x, m.y);
584 |       printf("\n");
585 |       for (int i = 0; i < 256; i++) {
586 |         printf("%02x ", m.memory[0x100+i]);
587 |       }
588 |       return false;
589 |     } else {
590 |       if (trace) {
591 |         // Output some spaces to visualize the call stack depth.
592 |         for (int i = 0; i < (0xFF - m.sp)/2; i++) {
593 |           putchar(' ');
594 |         }
595 |         printf("IP:\t%04x\t%02x\t%s\ta:%02x\tx:%02x\ty:%02x\tv:%01x\n",
596 |           m.ip,
597 |           opcode,
598 |           opcodes[opcode].name,
599 |           m.a,
600 |           m.x,
601 |           m.y,
602 |           m.status.v);
603 |       }
604 |       try {
605 |         opcodes[opcode].handler();
606 |       } catch (OutOfInputException &e) {
607 |         // The instruction ran, but didn't have
608 |         // enough user input to finish. Reset the
609 |         // instruction pointer, and return a request
610 |         // for more input.
611 |         m.ip = ip;
612 |         return true;
613 |       }
614 |     }
615 |   }
616 |   return false;
617 | }
618 | 
619 | 


--------------------------------------------------------------------------------
/6502.lua:
--------------------------------------------------------------------------------
  1 | 
  2 | local bit = require 'bit'
  3 | local ffi = require 'ffi'
  4 | 
  5 | local IO_PORT = 0x401C -- pick a register which is not used on a real NES
  6 | local MEMORY_SIZE = 512 * 1024
  7 | 
  8 | local args = {...}
  9 | local lastLineInput = ''
 10 | do
 11 |   local i = 1
 12 |   while i <= #args do
 13 |     if args[i] == '-b' then
 14 |       -- handle binary files with the syntax 6502.lua -b name:file.bin
 15 |       local name, file = args[i+1]:match('(.+):(.+)')
 16 |       local contents = io.open(file, 'rb'):read'*all'
 17 |       lastLineInput = string.format(' %s %x heredoc %s ', lastLineInput, #contents, name) .. contents
 18 |       i = i + 1
 19 |     else
 20 |       -- handle forth files
 21 |       lastLineInput = lastLineInput .. io.open(args[i], 'r'):read'*a'
 22 |     end
 23 |     i = i + 1
 24 |   end
 25 | end
 26 | 
 27 | --local forthCode = io.open('bootstrap.f', 'r')
 28 | --local forthCode2 = io.open('game.f', 'r')
 29 | --local lastLineInput = forthCode:read'*a' .. forthCode2:read'*a'
 30 | 
 31 | local trace = false
 32 | 
 33 | local reads_and_writes = {}
 34 | 
 35 | local m
 36 | m = {
 37 |   a = 0, x = 0, y = 0, sp = 0xFF, ip = -1,
 38 |   status = {
 39 |     n = 0, v = 0, z = 0, s = 0, c = 0
 40 |   },
 41 |   memory = ffi.new("unsigned char[?]", MEMORY_SIZE),
 42 |   read = function(addr)
 43 |     if addr == IO_PORT then
 44 |       if lastLineInput:len() == 0 then
 45 |         lastLineInput = io.read("*l") .. '\n'
 46 |       end
 47 |       local result = lastLineInput:byte()
 48 |       reads_and_writes[#reads_and_writes+1] = 'r\t' .. result
 49 |       lastLineInput = lastLineInput:sub(2)
 50 |       return result
 51 |     else
 52 |       --print(string.format("read %04x: %02x", addr, m.memory[addr]))
 53 |       --reads_and_writes[#reads_and_writes+1] = 'r\t'.. addr
 54 |       return m.memory[addr]
 55 |     end
 56 |   end,
 57 |   set = function(addr, val)
 58 |     --print(string.format("set %04x to %02x", addr, val))
 59 |     if addr == IO_PORT then
 60 |       --print("Output: [")
 61 |       val = bit.band(val, 0xFF)
 62 |       io.write(string.char(val))
 63 |       --io.write("]")
 64 |     else
 65 |       reads_and_writes[#reads_and_writes+1] = 'w\t'..addr.."\t"..bit.band(val, 0xFF)
 66 |       m.memory[addr] = bit.band(val, 0xFF)
 67 |     end
 68 |   end,
 69 |   pop = function()
 70 |     m.sp = bit.band(m.sp + 1, 0xFF)
 71 |     return m.read(0x100 + m.sp)
 72 |   end,
 73 |   push = function(v)
 74 |     m.set(0x100 + m.sp, v)
 75 |     m.sp = bit.band(m.sp - 1, 0xFF)
 76 |   end,
 77 |   getAbsolute = function()
 78 |     m.ip = m.ip + 2
 79 |     return m.read(m.ip - 1) + m.read(m.ip) * 256
 80 |   end,
 81 |   readImmediate = function()
 82 |     m.ip = m.ip + 1
 83 |     return m.read(m.ip)
 84 |   end,
 85 |   readZeroPage = function()
 86 |     m.ip = m.ip + 1
 87 |     return m.read(m.read(m.ip))
 88 |   end,
 89 |   storeZeroPage = function(val)
 90 |     m.ip = m.ip + 1
 91 |     m.set(m.read(m.ip), val)
 92 |   end,
 93 |   readZeroPageX = function()
 94 |     m.ip = m.ip + 1
 95 |     return m.read(bit.band(m.read(m.ip) + m.x, 0xFF))
 96 |   end,
 97 |   storeZeroPageX = function(val)
 98 |     m.ip = m.ip + 1
 99 |     return m.set(bit.band(m.read(m.ip) + m.x, 0xFF), val)
100 |   end,
101 |   readZeroPageY = function()
102 |     m.ip = m.ip + 1
103 |     return m.read(bit.band(m.read(m.ip) + m.y, 0xFF))
104 |   end,
105 |   storeZeroPageY = function(val)
106 |     m.ip = m.ip + 1
107 |     local addr = m.read(m.ip) + m.y
108 |     return m.set(bit.band(addr, 0xFF), val)
109 |   end,
110 |   readAbsolute = function()
111 |     return m.read(m.getAbsolute())
112 |   end,
113 |   storeAbsolute = function(val)
114 |     m.set(m.getAbsolute(), val)
115 |   end,
116 |   readAbsoluteX = function()
117 |     return m.read(m.x + m.getAbsolute())
118 |   end,
119 |   storeAbsoluteX = function(val)
120 |     return m.set(m.x + m.getAbsolute(), val)
121 |   end,
122 |   readAbsoluteY = function()
123 |     return m.read(m.y + m.getAbsolute())
124 |   end,
125 |   storeAbsoluteY = function(val)
126 |     return m.set(m.y + m.getAbsolute(), val)
127 |   end,
128 |   readIndirect = function()
129 |     local addr = m.getAbsolute()
130 |     local addrPlus1 = addr + 1
131 |     -- adjust for jump indirect bug
132 |     if bit.band(addrPlus1, 0xFF) == 0 then
133 |       addrPlus1 = addrPlus1 - 256
134 |     end
135 |     return m.read(addr) + m.read(addrPlus1) * 256
136 |   end,
137 |   readIndirectX = function()
138 |     local zpAddr = m.readImmediate()
139 |     zpAddr = bit.band(zpAddr + m.x, 0xFF)
140 |     local addrPlus1 = bit.band(zpAddr + 1, 0xFF)
141 |     return m.read(m.read(zpAddr) + m.read(addrPlus1) * 256)
142 |   end,
143 |   storeIndirectX = function(val)
144 |     m.ip = m.ip + 1
145 |     local addr = bit.band(m.read(m.ip) + m.x, 0xFF)
146 |     local addrPlus1 = bit.band(addr + 1, 0xFF)
147 |     return m.set(m.read(addr) + m.read(addrPlus1) * 256, val)
148 |   end,
149 |   readIndirectY = function()
150 |     local addr = m.readImmediate()
151 |     local addrPlus1 = bit.band(addr + 1, 0xFF)
152 |     return m.read(m.read(addr) + m.read(addrPlus1) * 256 + m.y)
153 |   end,
154 |   storeIndirectY = function(val)
155 |     m.ip = m.ip + 1
156 |     local addr = m.read(m.ip)
157 |     local addrPlus1 = bit.band(addr + 1, 0xFF)
158 |     return m.set(m.read(addr) + m.read(addrPlus1) * 256 + m.y, val)
159 |   end,
160 | 
161 |   setSZ = function(val)
162 |     val = bit.band(val, 0xFF)
163 |     if val >= 0x80 then
164 |       m.status.s = 1
165 |     else
166 |       m.status.s = 0
167 |     end
168 |     if val == 0 then
169 |       m.status.z = 1
170 |     else
171 |       m.status.z = 0
172 |     end
173 |     return val
174 |   end
175 | }
176 | 
177 | local function printStack()
178 |   io.write(string.format('STACK: sp:%02x ', m.sp))
179 |   for i = 0xFF, m.sp+1, -1 do
180 |     io.write(string.format('%02x ', m.memory[0x100 + i]))
181 |   end
182 |   io.write('\n')
183 | end
184 | 
185 | local function BIT(read)
186 |   m.status.z = bit.band(m.a, read)
187 |   m.status.n = bit.band(read, 0x80) == 0x80 and 1 or 0
188 |   m.status.v = bit.band(read, 0x40) == 0x40 and 1 or 0
189 | end
190 | 
191 | local function LDA(value)
192 |   m.a = m.setSZ(value)
193 | end
194 | 
195 | local function LDX(value)
196 |   m.x = m.setSZ(value)
197 | end
198 | 
199 | local function LDY(value)
200 |   m.y = m.setSZ(value)
201 | end
202 | 
203 | local function INC(addr)
204 |   m.set(addr, m.setSZ(m.read(addr) + 1))
205 | end
206 | 
207 | local function DEC(addr)
208 |   m.set(addr, m.setSZ(m.read(addr) - 1))
209 | end
210 | 
211 | local function AND(value)
212 |   m.a = m.setSZ(bit.band(m.a, value))
213 | end
214 | 
215 | local function ORA(value)
216 |   m.a = m.setSZ(bit.bor(m.a, value))
217 | end
218 | 
219 | local function EOR(value)
220 |   m.a = m.setSZ(bit.bxor(m.a, value))
221 | end
222 | 
223 | local function ASL(addr)
224 |   local value = m.read(addr)
225 |   m.status.c = value >= 0x80 and 1 or 0
226 |   m.set(addr, m.setSZ(bit.lshift(value, 1)))
227 | end
228 | 
229 | local function ROL(addr)
230 |   local value = m.read(addr)
231 |   local c = m.status.c
232 |   m.status.c = value >= 0x80 and 1 or 0
233 |   m.set(addr, m.setSZ(bit.lshift(value, 1) + c))
234 | end
235 | 
236 | local function LSR(addr)
237 |   local value = m.read(addr)
238 |   m.status.c = value % 2
239 |   m.set(addr, m.setSZ(bit.rshift(value, 1)))
240 | end
241 | 
242 | local function ROR(addr)
243 |   local value = m.read(addr)
244 |   local c = m.status.c ~= 0 and 0x80 or 0
245 |   m.status.c = value % 2
246 |   m.set(addr, m.setSZ(bit.rshift(value, 1) + c))
247 | end
248 | 
249 | local function BRANCH(condition)
250 |   local disp = m.readImmediate()
251 |   if condition then
252 |     if disp >= 0x80 then
253 |       disp = -0x100 + disp
254 |     end
255 |     m.ip = m.ip + disp
256 |   end
257 | end
258 | 
259 | local function ADC(value)
260 |   local newValue = m.a + value + m.status.c
261 |   if newValue > 0xFF then
262 |     m.status.c = 1
263 |   else
264 |     m.status.c = 0
265 |   end
266 |   m.status.v = bit.band(bit.band(bit.bnot(bit.bxor(m.a, value)), bit.bxor(m.a, newValue)), 0x80) == 0x80 and 1 or 0
267 |   m.a = m.setSZ(newValue)
268 | end
269 | 
270 | local function SBC(value)
271 |   return ADC(bit.band(bit.bnot(value), 0xFF))
272 | end
273 | 
274 | local function CMP(a, b)
275 |   local comparison = bit.band(a - b, 0xFF)
276 |   m.status.z = comparison == 0 and 1 or 0
277 |   m.status.c = a >= b and 1 or 0
278 |   m.status.n = comparison > 0x7F and 1 or 0
279 | end
280 | 
281 | local function SET_P(a)
282 |   m.status.n = bit.band(a, 0x80) and 1 or 0
283 |   m.status.v = bit.band(a, 0x40) and 1 or 0
284 |   m.status.d = bit.band(a, 0x08) and 1 or 0
285 |   m.status.i = bit.band(a, 0x04) and 1 or 0
286 |   m.status.z = bit.band(a, 0x02) and 1 or 0
287 |   m.status.c = bit.band(a, 0x01) and 1 or 0
288 | end
289 | 
290 | local opcodes = {
291 |   -- bit
292 |   [0x24] = {'BIT ZP', function() BIT(m.readZeroPage()) end},
293 |   [0x2C] = {'BIT ABS', function() BIT(m.readAbsolute()) end},
294 |   -- lda
295 |   [0xA9] = {'LDA IMM', function() LDA(m.readImmediate()) end},
296 |   [0xA5] = {'LDA ZP', function() LDA(m.readZeroPage()) end},
297 |   [0xB5] = {'LDA ZPX', function() LDA(m.readZeroPageX()) end},
298 |   [0xAD] = {'LDA ABS', function() LDA(m.readAbsolute()) end},
299 |   [0xBD] = {'LDA ABSX', function() LDA(m.readAbsoluteX()) end},
300 |   [0xB9] = {'LDA ABSY', function() LDA(m.readAbsoluteY()) end},
301 |   [0xA1] = {'LDA INDX', function() LDA(m.readIndirectX()) end},
302 |   [0xB1] = {'LDA INDY', function() LDA(m.readIndirectY()) end},
303 |   -- sta
304 |   [0x85] = {'STA', function() m.storeZeroPage(m.a) end},
305 |   [0x95] = {'STA', function() m.storeZeroPageX(m.a) end},
306 |   [0x8D] = {'STA', function() m.storeAbsolute(m.a) end},
307 |   [0x9D] = {'STA', function() m.storeAbsoluteX(m.a) end},
308 |   [0x99] = {'STA', function() m.storeAbsoluteY(m.a) end},
309 |   [0x81] = {'STA', function() m.storeIndirectX(m.a) end},
310 |   [0x91] = {'STA', function() m.storeIndirectY(m.a) end},
311 | 
312 |   -- ldx
313 |   [0xA2] = {'LDX', function() LDX(m.readImmediate()) end},
314 |   [0xA6] = {'LDX', function() LDX(m.readZeroPage()) end},
315 |   [0xB6] = {'LDX', function() LDX(m.readZeroPageY()) end},
316 |   [0xAE] = {'LDX', function() LDX(m.readAbsolute()) end},
317 |   [0xBE] = {'LDX', function() LDX(m.readAbsoluteY()) end},
318 |   -- stx
319 |   [0x86] = {'STX', function() m.storeZeroPage(m.x) end},
320 |   [0x96] = {'STX', function() m.storeZeroPageY(m.x) end},
321 |   [0x8E] = {'STX', function() m.storeAbsolute(m.x) end},
322 | 
323 |   -- ldy
324 |   [0xA0] = {'LDY', function() LDY(m.readImmediate()) end},
325 |   [0xA4] = {'LDY', function() LDY(m.readZeroPage()) end},
326 |   [0xB4] = {'LDY', function() LDY(m.readZeroPageX()) end},
327 |   [0xAC] = {'LDY', function() LDY(m.readAbsolute()) end},
328 |   [0xBC] = {'LDY', function() LDY(m.readAbsoluteX()) end},
329 |   -- sty
330 |   [0x84] = {'STY', function() m.storeZeroPage(m.y) end},
331 |   [0x94] = {'STY', function() m.storeZeroPageX(m.y) end},
332 |   [0x8C] = {'STY', function() m.storeAbsolute(m.y) end},
333 | 
334 |   -- tsx/txs
335 |   [0xBA] = {'TSX', function() m.x = m.setSZ(m.sp) end},
336 |   [0x9A] = {'TXS', function() m.sp = m.x end},
337 | 
338 |   -- pha/pla
339 |   [0x48] = {'PHA', function() m.push(m.a) end},
340 |   [0x68] = {'PLA', function() m.a = m.pop() end},
341 | 
342 |   -- php/plp
343 |   [0x08] = {'PHP', function()
344 |     m.push(
345 |       (m.status.n ~= 0 and 0x80 or 0)
346 |       + (m.status.v ~= 0 and 0x40 or 0)
347 |       + 0x20
348 |       + 0x10
349 |       + (m.status.d ~= 0 and 0x08 or 0)
350 |       + (m.status.i ~= 0 and 0x04 or 0)
351 |       + (m.status.z ~= 0 and 0x02 or 0)
352 |       + (m.status.c ~= 0 and 0x01 or 0))
353 |   end},
354 |   [0x28] = {'PLP', function()
355 |     local val = m.pop()
356 |     SET_P(val)
357 |   end},
358 | 
359 |   -- tax/txa
360 |   [0xAA] = {'TAX', function() m.x = m.setSZ(m.a) end},
361 |   [0x8A] = {'TXA', function() m.a = m.setSZ(m.x) end},
362 | 
363 |   -- dex/inx
364 |   [0xCA] = {'DEX', function() m.x = m.setSZ(m.x - 1) end},
365 |   [0xE8] = {'INX', function() m.x = m.setSZ(m.x + 1) end},
366 | 
367 |   -- tay/tya
368 |   [0xA8] = {'TAY', function() m.y = m.setSZ(m.a) end},
369 |   [0x98] = {'TYA', function() m.a = m.setSZ(m.y) end},
370 | 
371 |   -- dey/iny
372 |   [0x88] = {'DEY', function() m.y = m.setSZ(m.y - 1) end},
373 |   [0xC8] = {'INY', function() m.y = m.setSZ(m.y + 1) end},
374 | 
375 |   -- nop
376 |   [0xEA] = {'NOP', function() end},
377 | 
378 |   -- inc
379 |   [0xE6] = {'INC', function() INC(m.readImmediate()) end},
380 |   [0xF6] = {'INC', function() INC(bit.band(m.readImmediate() + m.x), 0xFF) end},
381 |   [0xEE] = {'INC', function() INC(m.getAbsolute()) end},
382 |   [0xFE] = {'INC', function() INC(m.getAbsolute() + m.x) end},
383 | 
384 |   -- dec
385 |   [0xC6] = {'DEC', function() DEC(m.readImmediate()) end},
386 |   [0xD6] = {'DEC', function() DEC(bit.band(m.readImmediate() + m.x), 0xFF) end},
387 |   [0xCE] = {'DEC', function() DEC(m.getAbsolute()) end},
388 |   [0xDE] = {'DEC', function() DEC(m.getAbsolute() + m.x) end},
389 | 
390 |   -- jmp
391 |   [0x4C] = {'JMP', function() m.ip = m.getAbsolute() - 1 end},
392 |   [0x6C] = {'JMPI', function() m.ip = m.readIndirect() - 1 end},
393 | 
394 |   -- flag instructions
395 |   [0x18] = {'CLC', function() m.status.c = 0 end},
396 |   [0x38] = {'SEC', function() m.status.c = 1 end},
397 |   [0x58] = {'CLI', function() m.status.i = 0 end},
398 |   [0x78] = {'SEI', function() m.status.i = 1 end},
399 |   [0xB8] = {'CLV', function() m.status.v = 0 end},
400 |   [0xD8] = {'CLC', function() m.status.c = 0 end},
401 |   [0xF8] = {'SEC', function() m.status.c = 1 end},
402 | 
403 |   -- and
404 |   [0x29] = {'AND', function() AND(m.readImmediate()) end},
405 |   [0x25] = {'AND', function() AND(m.readZeroPage()) end},
406 |   [0x35] = {'AND', function() AND(m.readZeroPageX()) end},
407 |   [0x2D] = {'AND', function() AND(m.readAbsolute()) end},
408 |   [0x3D] = {'AND', function() AND(m.readAbsoluteX()) end},
409 |   [0x39] = {'AND', function() AND(m.readAbsoluteY()) end},
410 |   [0x21] = {'AND', function() AND(m.readIndirectX()) end},
411 |   [0x31] = {'AND', function() AND(m.readIndirectY()) end},
412 | 
413 |   -- ora
414 |   [0x09] = {'ORA', function() ORA(m.readImmediate()) end},
415 |   [0x05] = {'ORA', function() ORA(m.readZeroPage()) end},
416 |   [0x15] = {'ORA', function() ORA(m.readZeroPageX()) end},
417 |   [0x0D] = {'ORA', function() ORA(m.readAbsolute()) end},
418 |   [0x1D] = {'ORA', function() ORA(m.readAbsoluteX()) end},
419 |   [0x19] = {'ORA', function() ORA(m.readAbsoluteY()) end},
420 |   [0x01] = {'ORA', function() ORA(m.readIndirectX()) end},
421 |   [0x11] = {'ORA', function() ORA(m.readIndirectY()) end},
422 | 
423 |   -- eor
424 |   [0x49] = {'EOR', function() EOR(m.readImmediate()) end},
425 |   [0x45] = {'EOR', function() EOR(m.readZeroPage()) end},
426 |   [0x55] = {'EOR', function() EOR(m.readZeroPageX()) end},
427 |   [0x4D] = {'EOR', function() EOR(m.readAbsolute()) end},
428 |   [0x5D] = {'EOR', function() EOR(m.readAbsoluteX()) end},
429 |   [0x59] = {'EOR', function() EOR(m.readAbsoluteY()) end},
430 |   [0x41] = {'EOR', function() EOR(m.readIndirectX()) end},
431 |   [0x51] = {'EOR', function() EOR(m.readIndirectY()) end},
432 | 
433 |   -- asl
434 |   [0x0A] = {'ASL', function() m.status.c = bit.band(m.a, 0x80) ~= 0 and 1 or 0; m.a = m.setSZ(bit.lshift(m.a, 1)) end},
435 |   [0x06] = {'ASL', function() ASL(m.readImmediate()) end},
436 |   [0x16] = {'ASL', function() ASL(bit.band(m.readImmediate() + m.x, 0xFF)) end},
437 |   [0x0E] = {'ASL', function() ASL(m.getAbsolute()) end},
438 |   [0x1E] = {'ASL', function() ASL(m.getAbsolute() + m.x) end},
439 | 
440 |   -- lsr
441 |   [0x4A] = {'LSR', function() m.status.c = m.a % 2; m.a = m.setSZ(bit.rshift(m.a, 1)) end},
442 |   [0x46] = {'LSR', function() LSR(m.readImmediate()) end},
443 |   [0x56] = {'LSR', function() LSR(bit.band(m.readImmediate() + m.x, 0xFF)) end},
444 |   [0x4E] = {'LSR', function() LSR(m.getAbsolute()) end},
445 |   [0x5E] = {'LSR', function() LSR(m.getAbsolute() + m.x) end},
446 | 
447 |   -- rol
448 |   [0x2A] = {'ROL', function()
449 |     local c = m.status.c
450 |     m.status.c = bit.band(m.a, 0x80) ~= 0 and 1 or 0
451 |     m.a = m.setSZ(bit.lshift(m.a, 1) + c)
452 |   end},
453 |   [0x26] = {'ROL', function() ROL(m.readImmediate()) end},
454 |   [0x36] = {'ROL', function() ROL(bit.band(m.readImmediate() + m.x, 0xFF)) end},
455 |   [0x2E] = {'ROL', function() ROL(m.getAbsolute()) end},
456 |   [0x3E] = {'ROL', function() ROL(m.getAbsolute() + m.x) end},
457 | 
458 |   -- ror
459 |   [0x6A] = {'ROR', function()
460 |     local c = m.status.c ~= 0 and 0x80 or 0
461 |     m.status.c = m.a % 2
462 |     m.a = m.setSZ(bit.rshift(m.a, 1) + c)
463 |   end},
464 |   [0x66] = {'ROR', function() ROR(m.readImmediate()) end},
465 |   [0x76] = {'ROR', function() ROR(bit.band(m.readImmediate() + m.x, 0xFF)) end},
466 |   [0x6E] = {'ROR', function() ROR(m.getAbsolute()) end},
467 |   [0x7E] = {'ROR', function() ROR(m.getAbsolute() + m.x) end},
468 | 
469 |   -- jsr
470 |   [0x20] = {'JSR', function()
471 |     local target = m.getAbsolute()
472 |     --print(string.format("JSR %04x from %04x", target, m.ip))
473 |     m.push(bit.rshift(m.ip, 8))
474 |     m.push(m.ip)
475 |     m.ip = target - 1
476 |   end},
477 | 
478 |   -- rts
479 |   [0x60] = {'RTS', function()
480 |     m.ip = m.pop() + 256*m.pop()
481 |     --print(string.format("NEW IP %04x", m.ip))
482 |   end},
483 | 
484 |   [0x40] = {'RTI', function()
485 |     SET_P(m.pop())
486 |     m.ip = m.pop() + 256*m.pop() - 1
487 |   end},
488 | 
489 |   -- branch
490 |   [0x10] = {'BPL', function() BRANCH(m.status.s == 0) end},
491 |   [0x30] = {'BMI', function() BRANCH(m.status.s ~= 0) end},
492 |   [0x50] = {'BVC', function() BRANCH(m.status.v == 0) end},
493 |   [0x70] = {'BVS', function() BRANCH(m.status.v ~= 0) end},
494 |   [0x90] = {'BCC', function() BRANCH(m.status.c == 0) end},
495 |   [0xB0] = {'BCS', function() BRANCH(m.status.c ~= 0) end},
496 |   [0xD0] = {'BNE', function() BRANCH(m.status.z == 0) end},
497 |   [0xF0] = {'BEQ', function() BRANCH(m.status.z ~= 0) end},
498 | 
499 |   [0x69] = {'ADC', function() ADC(m.readImmediate()) end},
500 |   [0x65] = {'ADC', function() ADC(m.readZeroPage()) end},
501 |   [0x75] = {'ADC', function() ADC(m.readZeroPageX()) end},
502 |   [0x6D] = {'ADC', function() ADC(m.readAbsolute()) end},
503 |   [0x7D] = {'ADC', function() ADC(m.readAbsoluteX()) end},
504 |   [0x79] = {'ADC', function() ADC(m.readAbsoluteY()) end},
505 |   [0x61] = {'ADC', function() ADC(m.readIndirectX()) end},
506 |   [0x71] = {'ADC', function() ADC(m.readIndirectY()) end},
507 | 
508 |   [0xE9] = {'SBC', function() SBC(m.readImmediate()) end},
509 |   [0xE5] = {'SBC', function() SBC(m.readZeroPage()) end},
510 |   [0xF5] = {'SBC', function() SBC(m.readZeroPageX()) end},
511 |   [0xED] = {'SBC', function() SBC(m.readAbsolute()) end},
512 |   [0xFD] = {'SBC', function() SBC(m.readAbsoluteX()) end},
513 |   [0xF9] = {'SBC', function() SBC(m.readAbsoluteY()) end},
514 |   [0xE1] = {'SBC', function() SBC(m.readIndirectX()) end},
515 |   [0xF1] = {'SBC', function() SBC(m.readIndirectY()) end},
516 | 
517 |   [0xC9] = {'CMP', function() CMP(m.a, m.readImmediate()) end},
518 |   [0xC5] = {'CMP', function() CMP(m.a, m.readZeroPage()) end},
519 |   [0xD5] = {'CMP', function() CMP(m.a, m.readZeroPageX()) end},
520 |   [0xCD] = {'CMP', function() CMP(m.a, m.readAbsolute()) end},
521 |   [0xDD] = {'CMP', function() CMP(m.a, m.readAbsoluteX()) end},
522 |   [0xD9] = {'CMP', function() CMP(m.a, m.readAbsoluteY()) end},
523 |   [0xC1] = {'CMP', function() CMP(m.a, m.readIndirectX()) end},
524 |   [0xD1] = {'CMP', function() CMP(m.a, m.readIndirectY()) end},
525 | 
526 |   [0xE0] = {'CPX', function() CMP(m.x, m.readImmediate()) end},
527 |   [0xE4] = {'CPX', function() CMP(m.x, m.readZeroPage()) end},
528 |   [0xEC] = {'CPX', function() CMP(m.x, m.readAbsolute()) end},
529 | 
530 |   [0xC0] = {'CPY', function() CMP(m.y, m.readImmediate()) end},
531 |   [0xC4] = {'CPY', function() CMP(m.y, m.readZeroPage()) end},
532 |   [0xCC] = {'CPY', function() CMP(m.y, m.readAbsolute()) end},
533 | 
534 |   -- illegal opcodes
535 |   [0xE3] = {'ISC', function() INC(m.readIndirectX()) SBC(m.readIndirectX()) end},
536 |   [0xE7] = {'ISC', function() INC(m.readZeroPage()) SBC(m.readZeroPage()) end},
537 |   [0xEF] = {'ISC', function() INC(m.readAbsolute()) SBC(m.readAbsolute()) end},
538 |   [0xF3] = {'ISC', function() INC(m.readIndirectY()) SBC(m.readIndirectY()) end},
539 |   [0xF7] = {'ISC', function() INC(m.readZeroPageX()) SBC(m.readZeroPageX()) end},
540 |   [0xFB] = {'ISC', function() INC(m.readAbsoluteY()) SBC(m.readAbsoluteY()) end},
541 |   [0xFF] = {'ISC', function() INC(m.readAbsoluteX()) SBC(m.readAbsoluteX()) end},
542 | 
543 |   [0xFF] = {'DBG_START', function()
544 |     print"DEBUGGER STARTED"
545 |     trace = true
546 |   end},
547 |   [0xEF] = {'DBG_END', function()
548 |     print "DEBUGGER ENDED"
549 |     trace = false
550 |   end},
551 |   [0xDF] = {'DBG_TRACE', function()
552 |     m.ip = m.ip + 1
553 |     while m.memory[m.ip] ~= 0 do
554 |       io.write(string.char(m.memory[m.ip]))
555 |       m.ip = m.ip + 1
556 |     end
557 |     print()
558 |   end}
559 | }
560 | 
561 | function emulate()
562 |   while true do
563 |     if m.ip == -1 then
564 |       return
565 |     end
566 |     local opcode = m.readImmediate()
567 |     if not opcodes[opcode] then
568 |       print(string.format("\n\nUnknown opcode $%02x", opcode))
569 |       print(string.format("IP:\t%04x\t%02x\ta:%02x\tx:%02x\ty:%02x", m.ip, opcode, m.a, m.x, m.y))
570 |       io.write('\n')
571 |       for i = 0, 256 do
572 |         io.write(string.format("%02x ", m.memory[0x200+i]))
573 |       end
574 |       return
575 |     else
576 |       if trace then
577 |         print(
578 |           string.format("%sIP:\t%04x\t%02x\t%s\ta:%02x\tx:%02x\ty:%02x\tv:%01x",
579 |             (' '):rep(math.floor((0xFF - m.sp)/2)),
580 |             m.ip,
581 |             opcode,
582 |             opcodes[opcode][1],
583 |             m.a,
584 |             m.x,
585 |             m.y,
586 |             m.status.v))
587 |       end
588 |       --printStack()
589 |       opcodes[opcode][2]()
590 |     end
591 |   end
592 | end
593 | 
594 | local bootstrap = io.open('bootstrap.bin', 'r')
595 | local rom = bootstrap:read('*a')
596 | for i = 0, 0xFFFF do
597 |   -- print(i, rom:byte(i+1, i+2), rom:len())
598 |   m.memory[i] = rom:byte(i+1, i+2)
599 | end
600 | 
601 | m.ip = m.memory[0xFFFC] + bit.lshift(m.memory[0xFFFD], 8) - 1
602 | emulate()
603 | 
604 | print [[
605 | ==============================
606 | Execution halted. Freezing ROM
607 | ==============================
608 | ]]
609 | 
610 | local romout = io.open('out.nes', 'w')
611 | local ramout = io.open('ram.out', 'w')
612 | local oplog = io.open('ops.out', 'w')
613 | 
614 | romout:write("NES\x1A\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00")
615 | 
616 | for i = 0x8000, 0xFFFF do
617 |   romout:write(string.char(m.memory[i]))
618 | end
619 | 
620 | for i = 0, 0x7FF do
621 |   ramout:write(string.char(m.memory[i]))
622 | end
623 | 
624 | for i = 1, #reads_and_writes do
625 |   oplog:write(reads_and_writes[i], '\n')
626 | end
627 | 


--------------------------------------------------------------------------------
/Makefile:
--------------------------------------------------------------------------------
 1 | 
 2 | # Change these configs
 3 | CC65=../cc65/bin
 4 | MESEN=../emus/mesen/Mesen.exe
 5 | LIT=../literate/lit
 6 | 
 7 | S_FILES=note.s bootstrap.s coroutines.s disassembler.s end.s neslib.s
 8 | 
 9 | out/bootstrap.bin: $(S_FILES) forth.inc
10 | 	$(CC65)/ca65 --cpu 6502x -g note.s -o out/note.o
11 | 	$(CC65)/ca65 --cpu 6502x -g bootstrap.s -o out/bootstrap.o
12 | 	$(CC65)/ca65 --cpu 6502x -g coroutines.s -o out/coroutines.o
13 | 	$(CC65)/ca65 --cpu 6502x -g disassembler.s -o out/disassembler.o
14 | 	$(CC65)/ca65 --cpu 6502x -g end.s -o out/end.o
15 | 	$(CC65)/ca65 --cpu 6502x -g neslib.s -o out/neslib.o
16 | 	$(CC65)/ld65 --dbgfile out/debug.txt -C config out/note.o out/bootstrap.o out/coroutines.o out/disassembler.o out/neslib.o out/end.o -o out/bootstrap.bin
17 | 
18 | out/bootstrap.bin.h: out/bootstrap.bin
19 | 	xxd -i out/bootstrap.bin out/bootstrap.bin.h
20 | 
21 | out/6502: 6502.cpp 6502.h
22 | 	g++ -O2 -Wall -Wpedantic -Wsequence-point -std=c++11 6502.cpp -o out/6502
23 | 
24 | out/game.nes: out/bootstrap.bin bootstrap.f font.chr subroutines.f game.f done.f out/6502
25 | 	./out/6502 bootstrap.f -b font:font.chr subroutines.f game.f done.f
26 | 
27 | run: out/game.nes
28 | 	mono $(MESEN) out/game.nes
29 | 
30 | repl: out/bootstrap.bin bootstrap.f font.chr subroutines.f game.f out/6502
31 | 	./out/6502 bootstrap.f -b font:font.chr subroutines.f game.f
32 | 
33 | lit: lit/test.lit
34 | 	$(LIT) lit/test.lit
35 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
  1 | # Ice Forth
  2 | 
  3 | A Forth implementation self-hosted on the 6502, for creating NES ROMs.
  4 | 
  5 | Compiling a ROM has several stages.
  6 | 
  7 | 1. The assembly code (.s files) are compiled into an initial cartridge
  8 |    `bootstrap.bin`. This is a 64kb file containing the full memory space at
  9 |    startup for the next step. In that space we have the the basics of a Forth
 10 |    interpreter with an integrated assembler. (This only takes up a few kb of the
 11 |    full 64).
 12 | 
 13 | 2. `6502.cpp` loads `bootstrap.bin` into its memory, and emulates running the
 14 |    interpreter on the NES processor, using a virtual cartridge with RAM everywhere.
 15 |    The emulator has the crucial addition of an IO port, which is used to input
 16 |    Forth code and get Forth output.
 17 | 
 18 | 3. A minimal subset of the Forth environment is defined in assembly, so next we
 19 |    stream in the contents of `bootstrap.f` to the running cartridge. This defines 
 20 |    the rest of the base Forth environment.
 21 | 
 22 | 4. Other Forth code is defined in other files which are streamed in, and afterward
 23 |    the REPL opens for the user to test words. This Forth code is compiled into what
 24 |    will become cartridge space on the NES, and defines the NES program. The emulation
 25 |    finishes at the execution of the word `freeze`.
 26 | 
 27 | 5. `freeze` will turn the running interpreter into a ROM. The contents of NES RAM in the
 28 |    intepreter are compressed and moved into the cartridge space so they can be restored
 29 |    after freeze finishes, but the Forth data, return, and control flow stacks are
 30 |    emptied. The Forth internal temp locations are also emptied. Once the compressed data
 31 |    is written, the memory space from $8000-$FFFF is now permanently frozen. This section
 32 |    of memory becomes the PRG data of the `out.nes` file.
 33 | 
 34 | 6. The NES ROM is now created. The word `thaw` is the startup word. It will restore
 35 |    the state of the machine and return as if returning from the word freeze.
 36 |    
 37 | ## Features
 38 | 
 39 | - Not really compliant with ANS Forth :/
 40 | - Subroutine-threaded compilation
 41 | - Includes assembler and disassembler for NMOS 6502, written in 6502 assembly.
 42 | - Alpha state -- very buggy
 43 | 
 44 | ## Running
 45 | 
 46 | Edit `Makefile` with the path to your [ca65 and ld65](https://cc65.github.io) executables.
 47 | 
 48 | ```
 49 | $ make repl
 50 | ```
 51 | 
 52 | Try some commands:
 53 | 
 54 | ```
 55 | Welcome to Forth!
 56 | \ Math examples
 57 | 1 2 + .
 58 | 
 59 | hex FF . decimal
 60 | ```
 61 | 
 62 | ```
 63 | Welcome to Forth!
 64 | \ Disassemble the dup word
 65 | show-disas dup
 66 | ```
 67 | 
 68 | ```
 69 | Welcome to Forth!
 70 | \ Defining new words
 71 | : six  1 2 3 + + ;
 72 | ```
 73 | 
 74 | ```
 75 | Welcome to Forth!
 76 | \ Assembler usage
 77 | : oam-dma [
 78 |   hex
 79 |   sprites >byte LDA.#
 80 |   4014          STA
 81 |   decimal
 82 | ] ;
 83 | ```
 84 | 
 85 | Once you are ready to try the NES cartridge, use the word `done`.
 86 | `out/game.nes` will contain the ROM file. See game.f for a sample
 87 | of using the NES registers.
 88 | 
 89 | ## Implementation details
 90 | 
 91 | ### Dictionary format
 92 | 
 93 | A dictionary entry looks like this:
 94 | 
 95 | ```
 96 | DUP:
 97 | jmp DUP_IMPL
 98 | .byte reserved
 99 | .byte name-length | Flags
100 | .byte "DUP"
101 | ```
102 | 
103 | There is no previous pointer since the next entry comes right after
104 | the name.
105 | 
106 | There are 5 + name-length bytes in each entry. The dictionary
107 | grows downwards from the end of the address space, while the
108 | actual code of the code starts near the start of the address
109 | space and grows up. This separation is so that code can theoretically
110 | be relocated. Eventually, words will be optimized by bringing them
111 | to the front of the code area, shifting everything back, and then
112 | modifying their code. The only thing that needs to change when a word
113 | is relocated is to update the target of the jmp instruction.
114 | (Assuming the word itself is written with relocatable code).
115 | 
116 | Since the same address is the entry point for the code and the
117 | start of the dictionary entry, execution tokens and dictionary
118 | entry pointers are the same.
119 | 
120 | ### Separate dictionaries
121 | 
122 | Using the phrases `<tmp> definitions:` and `<perm> definitions:`, you can switch
123 | between defining words in the temporary space or permanent space. The temporary
124 | space will not be present in the final ROM.
125 | 
126 | ### Subroutine threaded code
127 | 
128 | The code is compiled to subrouting-threaded code with many inlined
129 | functions. Try `show-disas val` to the see the disassembly
130 | for the `val` word.
131 | 
132 | ### Assembler/Disassembler
133 | 
134 | The bootstrap assembly includes a 6502 assembler and disassembler.
135 | Having all 130+ instructions in the dictionary would be too much,
136 | so information about each instruction is stored in a more compact form.
137 | The main data table stores only 4 nibbles (2 bytes) for each instruction.
138 | These 4 values give the indices of the 3 opcode letters, and the addressing
139 | mode. For example, from `disassembler.s`:
140 | 
141 | ```
142 | FirstLetter:  .byte "ABCDEIJLNOPRST"
143 | ```
144 | 
145 | Each instruction has a value from 0-13 indicating the index of the first
146 | letter of the opcode in this list of letters. There are similar lists for
147 | the second and third letters of each opcode. A slight complication arises
148 | for the second letters. Among all of the opcodes, there are 18 different
149 | letters used. The easiest way to work around this was to have special cases
150 | for `txa`, `tya`, and `txs`, which are the only instructions which use
151 | x or y as the second letter, and have only an implied addressing mode.
152 |  This brings the list of second letters down to 16.
153 | 
154 | To save a bit more space, we make use of the fact that there are no
155 | legal 6502 instructions which end in the binary sequence `%11`. These are
156 | excluded from the table of instructions, giving 25% savings.
157 | 
158 | The syntax of the assembler is based on the [Typist's Assembler Notation](https://docs.google.com/document/d/16Sv3Y-3rHPXyxT1J3zLBVq4reSPYtY2G6OSojNTm4SQ/edit#). To indicate the addressing mode
159 | of an instruction, a tail like `.ZX` is added, here indicating the ZeroPage,X
160 | addressing mode.
161 | 
162 | When a dictionary lookup fails, the Forth interpreter will try to parse
163 | the word as an instruction. If it succeeds, then it will either execute
164 | or compile the instruction word. An instruction word has these semantics:
165 | 
166 | 1. At runtime, appends the instruction and its arguments to the code area
167 | at `chere`. For example, a Forth definition for LDA would look like this:
168 | 
169 | ```
170 | ( addr -- )
171 | : LDA  [ hex ] AD c, , ;
172 | ```
173 | 
174 | 2. At compile time, compiles a call to `[asm]` (`RUN_ASM`), with inline
175 | parameters indicating the opcode and number of argument bytes for the
176 | instruction. `[asm]` will handle the runtime semantics of the instruction.
177 | 
178 | ### The 6502 emulator
179 | 
180 | A simple emulator written in C++ is included. It is a very basic emulator,
181 | probably has bugs even in basic operations, and not all instructions are
182 | supported. (e.g. BRK and interrupts are unsupported). Like the NES, it doesn't
183 | include the decimal mode.
184 | 
185 | To assist in debugging, these extra instructions are added:
186 | - `$FF` enters trace mode. In trace mode, each instruction is logged with info about the machine state.
187 | - `$EF` exits trace mode.
188 | - `$DF` Takes a zero-terminated string as an argument, and prints it to the console.
189 | 
190 | An IO port at `$401C` powers the REPL. The emulator reads from stdin line-by-line,
191 | and reads on `$401C` return the next byte from the input, blocking if there are none.
192 | Writes are immediately sent to stdout.
193 | 
194 | The emulator exits cleanly when executing `jmp 0`. On exit, the emulator writes out several files:
195 | 
196 | - `out.nes` - The resulting NES file. This is the contents of memory at $8000-$FFFF on exit.
197 |   The 16 byte iNES header is added.
198 | - `ram.out` - The contents of RAM from $00-$7FF on exit, for debugging purposes
199 | - `ops.out` - A log of the memory writes and IO input that the emulator has processed since startup.
200 |   Using `visualize-ops.html`, you can see an animation of the Forth compiler working. It shows
201 |   a 256x256 grid representing each byte as a single square, as well as each character that is read
202 |   from the IO port.
203 | 
204 | ### Future work
205 | 
206 | There's a lot of code defined in the assembly files. Ideally, most of it should be moved to .f files, leaving just the minimal core in assembly.


--------------------------------------------------------------------------------
/bootstrap.f:
--------------------------------------------------------------------------------
  1 | 
  2 | <tmp> definitions:
  3 | 
  4 |   \ Define addresses of the stack and tmp variables.
  5 |   : stack 8 ;
  6 |   : tmp 0 ;
  7 |   : io-port 16412 ;
  8 | 
  9 | 
 10 |   \ Macro to move the top of stack into tmp.
 11 |   : >TMP
 12 |     stack    LDA.ZX
 13 |     tmp      STA.Z
 14 |     stack 1+ LDA.ZX
 15 |     tmp 1+   STA.Z
 16 |   ;
 17 | 
 18 |   \ special case these instructions
 19 |   : TXA 138 c, ;
 20 |   : TYA 152 c, ;
 21 |   : TXS 154 c, ;
 22 | 
 23 |   : emit [
 24 |     stack LDA.ZX
 25 |     io-port STA \ $401C
 26 |     INX
 27 |     INX
 28 |   ] ;
 29 | 
 30 |   : cr
 31 |     10 emit ;
 32 | 
 33 | <perm> definitions:
 34 | 
 35 |   : and [
 36 |     stack     LDA.ZX
 37 |     stack 2 + AND.ZX
 38 |     stack 2 + STA.ZX
 39 |     
 40 |     stack 1+  LDA.ZX
 41 |     stack 3 + AND.ZX
 42 |     stack 3 + STA.ZX
 43 |     
 44 |     INX INX
 45 |   ] ;
 46 | 
 47 |   : or [
 48 |     stack     LDA.ZX
 49 |     stack 2 + ORA.ZX
 50 |     stack 2 + STA.ZX
 51 | 
 52 |     stack 1+  LDA.ZX
 53 |     stack 3 + ORA.ZX
 54 |     stack 3 + STA.ZX
 55 | 
 56 |     INX INX
 57 |   ] ;
 58 | 
 59 |   : xor [
 60 |     stack     LDA.ZX
 61 |     stack 2 + EOR.ZX
 62 |     stack 2 + STA.ZX
 63 | 
 64 |     stack 1+  LDA.ZX
 65 |     stack 3 + EOR.ZX
 66 |     stack 3 + STA.ZX
 67 | 
 68 |     INX INX
 69 |   ] ;
 70 | 
 71 |   \ a b -- a b a
 72 |   : over [
 73 |     DEX
 74 |     DEX
 75 |     stack 4 + LDA.ZX
 76 |     stack     STA.ZX
 77 |     stack 5 + LDA.ZX
 78 |     stack 1 + STA.ZX  ] ;
 79 | 
 80 |   \ ( a b c -- b c a )
 81 |   : rot [
 82 |     stack     LDA.ZX
 83 |     PHA
 84 |     stack 2 + LDY.ZX
 85 |     stack 4 + LDA.ZX
 86 |     stack     STA.ZX
 87 |     stack 4 + STY.ZX
 88 |     PLA
 89 |     stack 2 + STA.ZX
 90 |     stack 1 + LDA.ZX
 91 |     PHA
 92 |     stack 3 + LDY.ZX
 93 |     stack 5 + LDA.ZX
 94 | 
 95 |     stack 1 + STA.ZX
 96 |     stack 5 + STY.ZX
 97 |     PLA
 98 |     stack 3 + STA.ZX
 99 |   ] ;
100 | 
101 | <tmp> definitions:
102 | 
103 |   \ Define the inline assembly language IF and THEN constructs.
104 |   \ Rather than using labeled branches, we can do structured
105 |   \ control flow. IFEQ, for example, will branch to the matching
106 |   \ THEN if the Z flag is non-zero.
107 |   : IF  chere @ ;
108 |   : IFEQ  0 BNE IF ;
109 |   : IFNE  0 BEQ IF ;
110 |   : IFCC  0 BCS IF ;
111 |   : IFCS  0 BCC IF ;
112 |   : IFVC  0 BVS IF ;
113 |   : IFVS  0 BVC IF ;
114 |   : IFPL  0 BMI IF ;
115 |   : IFMI  0 BPL IF ;
116 | 
117 |   : THEN
118 |     dup
119 |     chere @ swap -
120 |     swap 1- c! 
121 |   ;
122 | 
123 |   : ELSE
124 |     CLV
125 |     IFVS
126 |     swap
127 |     THEN
128 |   ;
129 | 
130 |   \ Define the assembly language looping constructs.
131 |   \ A BEGIN..UNTIL loop will continue looping until
132 |   \ the condition code given is set.
133 |   : BEGIN  chere @ ;
134 |   : UNTIL  chere @ - 2 - ;
135 |   : UNTILEQ  UNTIL BNE ;
136 |   : UNTILNE  UNTIL BEQ ;
137 |   : UNTILCC  UNTIL BCS ;
138 |   : UNTILCS  UNTIL BCC ;
139 |   : UNTILVC  UNTIL BVS ;
140 |   : UNTILVS  UNTIL BVC ;
141 |   : UNTILPL  UNTIL BMI ;
142 |   : UNTILMI  UNTIL BPL ;
143 | 
144 |   \ Define BEGIN..WHILE..REPEAT loops,
145 |   \ which are like while loops in C:
146 |   \ while (/* BEGIN */ cond /* WHILE */) { ... /* REPEAT */} 
147 |   : WHILE  chere @ ;
148 |   : WHILEEQ  0 BNE WHILE ;
149 |   : WHILENE  0 BEQ WHILE ;
150 |   : WHILECC  0 BCS WHILE ;
151 |   : WHILECS  0 BCC WHILE ;
152 |   : WHILEVC  0 BVS WHILE ;
153 |   : WHILEVS  0 BVC WHILE ;
154 |   : WHILEPL  0 BMI WHILE ;
155 |   : WHILEMI  0 BPL WHILE ;
156 | 
157 |   : REPEAT
158 |     CLV
159 |     swap chere @ - 2 - BVC \ bra to start of loop
160 |     dup
161 |     chere @ swap -
162 |     swap 1- c!
163 |   ;
164 | 
165 |   \ Gets the flags1 byte of the dictionary entry
166 |   : flags  dhere @ dict::len + ;
167 |   : immediate  flags @ 128 xor flags ! ;
168 |   immediate \ mark the word immediate as immediate
169 | 
170 |   : always-inline immediate
171 |     flags @ 64 xor flags ! ;
172 | 
173 |   \ Prints out the whole stack
174 |   : .s [
175 |     BEGIN
176 |       TXA
177 |       79 CMP.#
178 |     WHILENE
179 |       ] . [
180 |     REPEAT
181 |   ] ;
182 | 
183 | <perm> definitions:
184 | 
185 |   : >byte [
186 |     stack 1+ LDA.ZX
187 |     stack    STA.ZX
188 |     0        LDA.#
189 |     stack 1+ STA.ZX
190 |   ] ;
191 | 
192 |   : <byte always-inline [
193 |     0 LDA.#
194 |     stack 1+ STA.ZX
195 |   ] ;
196 | 
197 | <tmp> definitions:
198 | 
199 |   \ Pronounces tick, finds the given word
200 |   : ' word find ;
201 | 
202 |   \ Takes the next word and compiles it even if it's immediate
203 |   : [compile] immediate
204 |     ' JSR
205 |   ;
206 | 
207 |   : literal immediate
208 |     DEX DEX
209 |     dup
210 |     <byte LDA.#
211 |     stack STA.ZX
212 |     >byte LDA.#
213 |     stack 1+ STA.ZX
214 |   ;
215 | 
216 |   : ['] immediate ' [compile] literal ;
217 |  
218 | <perm> definitions:
219 | 
220 |   : = [
221 |     INX INX
222 |     stack 2 - LDA.ZX
223 |     stack     CMP.ZX
224 |     IFNE
225 |       0        LDA.#
226 |       stack    STA.ZX
227 |       stack 1+ STA.ZX
228 |       RTS
229 |     THEN
230 |     0        LDY.#
231 |     stack 1- LDA.ZX
232 |     stack 1+ CMP.ZX
233 |     IFEQ
234 |       DEY
235 |     THEN
236 |     stack    STY.ZX
237 |     stack 1+ STY.ZX
238 |   ] ;
239 | 
240 |   : <> [
241 |     INX INX
242 |     stack 2 - LDA.ZX
243 |     stack     CMP.ZX
244 |     IFNE
245 |      255      LDA.#
246 |      stack    STA.ZX
247 |      stack 1+ STA.ZX
248 |      RTS
249 |    THEN
250 |    0 LDY.#
251 |    stack 1- LDA.ZX
252 |    stack 1+ CMP.ZX
253 |    IFNE
254 |      DEY
255 |    THEN
256 |    stack    STY.ZX
257 |    stack 1+ STY.ZX
258 |    ] ;
259 | 
260 |   : 0= [
261 |     0        LDY.#
262 |     stack    LDA.ZX
263 |     stack 1+ ORA.ZX
264 |     IFEQ
265 |       DEY
266 |     THEN
267 |     stack    STY.ZX
268 |     stack 1+ STY.ZX
269 |   ] ;
270 | 
271 |   : 0> [
272 |     0        LDY.#
273 |     stack 1+ LDA.ZX
274 |     IFPL
275 |       DEY
276 |     THEN
277 |     stack    STY.ZX
278 |     stack 1+ STY.ZX
279 |   ] ;
280 | 
281 |   \ See http://www.6502.org/tutorials/compare_beyond.html#6
282 |   : > [
283 |     255 LDY.#
284 |     stack     LDA.ZX
285 |     stack 2 + CMP.ZX
286 |     stack 1+  LDA.ZX
287 |     stack 3 + SBC.ZX
288 |     IFVS
289 |       128 EOR.#
290 |     THEN
291 |     \ Now N flag contains comparison result
292 |     IFPL
293 |       INY
294 |     THEN
295 |     INX INX
296 |     stack    STY.ZX
297 |     stack 1+ STY.ZX
298 |   ] ;
299 | 
300 |   : < [
301 |     255 LDY.#
302 |     stack 2 + LDA.ZX
303 |     stack     CMP.ZX
304 |     stack 3 + LDA.ZX
305 |     stack 1+  SBC.ZX
306 |     IFVS
307 |       128 EOR.#
308 |     THEN
309 |     \ Now N flag contains comparison result
310 |     IFPL
311 |       INY
312 |     THEN
313 |     INX INX
314 |     stack    STY.ZX
315 |     stack 1+ STY.ZX
316 |   ] ;
317 | 
318 |   : u< [
319 |     \ TODO
320 |     255 LDY.#
321 |     stack 1+  LDA.ZX
322 |     stack 3 + CMP.ZX
323 |     IFCS
324 |       IFEQ
325 |         stack     LDA.ZX
326 |         stack 2 + CMP.ZX
327 |         
328 |       ELSE
329 |         
330 |       THEN
331 |     THEN
332 |   ] ;
333 | 
334 |   : u> [
335 |     \ TODO
336 |   ] ;
337 | 
338 |   \ Logical shift right
339 |   \ ( u -- u )
340 |   : lsr [
341 |     stack 1+ LSR.ZX
342 |     stack    ROR.ZX
343 |   ] ;
344 | 
345 |   \ Arithmetic shift right
346 |   \ ( i -- i )
347 |   : asr [
348 |     stack 1+ LDA.ZX
349 |     128      CMP.#
350 |     stack 1+ ROR.ZX
351 |     stack    ROR.ZX
352 |   ] ;
353 | 
354 |   \ Arithmetic shift left
355 |   : asl [
356 |     stack    ASL.ZX
357 |     stack 1+ ROL.ZX
358 |   ] ;
359 | 
360 |   : +! [
361 |     >TMP
362 | 
363 |     0         LDY.#
364 |     tmp       LDA.IY
365 |     CLC
366 |     stack 2 + ADC.ZX
367 |     tmp       STA.IY
368 | 
369 |     INY
370 |     tmp       LDA.IY
371 |     stack 3 + ADC.ZX
372 |     tmp       STA.IY
373 | 
374 |     INX INX
375 |     INX INX
376 |   ] ;
377 | 
378 |   : -! [
379 |     >TMP
380 | 
381 |     0         LDY.#
382 |     tmp       LDA.IY
383 |     SEC
384 |     stack 2 + SBC.ZX
385 |     tmp       STA.IY
386 | 
387 |     INY
388 |     tmp       LDA.IY
389 |     stack 3 + SBC.ZX
390 |     tmp       STA.IY
391 | 
392 |     INX INX
393 |     INX INX
394 |   ] ;
395 | 
396 |   : c>r always-inline [
397 |     stack LDA.ZX
398 |     PHA
399 |     INX
400 |     INX
401 |   ] ;
402 | 
403 |   : cr> always-inline [
404 |     DEX
405 |     DEX
406 |     PLA
407 |     stack    STA.ZX
408 |     0        LDA.#
409 |     stack 1+ STA.ZX
410 |   ] ;
411 | 
412 |   : >r always-inline [
413 |     stack 1+ LDA.ZX
414 |     PHA
415 |     stack    LDA.ZX
416 |     PHA
417 |     INX
418 |     INX
419 |   ] ;
420 | 
421 |   : r> always-inline [
422 |     DEX
423 |     DEX
424 |     PLA
425 |     stack    STA.ZX
426 |     PLA
427 |     stack 1+ STA.ZX
428 |   ] ;
429 | 
430 |   \ ( r: a -- )
431 |   : rdrop always-inline [
432 |     PLA
433 |     PLA
434 |   ] ;
435 | 
436 |   \ ( -- sp )
437 |   : dsp@ [
438 |     DEX
439 |     DEX
440 |     TXA
441 |     stack    STA.ZX
442 |     0        LDY.#
443 |     stack 1+ STY.ZX
444 |   ] ;
445 | 
446 |   \ ( sp -- )
447 |   : dsp! [
448 |     stack LDA.ZX
449 |     TAX
450 |   ] ;
451 | 
452 | <tmp> definitions:
453 |   : hex 16 base ! ;
454 |   : decimal 10 base ! ;
455 |   : '\n' 10 ;
456 |   : bl 32 ;
457 |   : space bl emit ;
458 | 
459 |   \ Recursively call the current word
460 |   : recurse immediate
461 |     dhere @
462 |     JSR
463 |   ;
464 | 
465 |   : recurse-tail immediate
466 |     dhere @
467 |     JMP
468 |   ;
469 | 
470 |   : POP INX INX ;
471 | 
472 | <perm> definitions:
473 |   : negate 0 swap - ;
474 |   : true 0 1 - ;
475 |   : false 0 ;
476 |   : not 0= ;
477 | 
478 |   : 2- 2 - ;
479 |   : 2+ 2 + ;
480 | 
481 |   : allot
482 |     vhere +!
483 |   ;
484 | 
485 | <tmp> definitions:
486 | 
487 |   \ Save branch instruction address
488 |   : if immediate
489 |     POP
490 |     stack 2- LDA.ZX
491 |     stack 1- ORA.ZX
492 |     chere @
493 |     0 BEQ
494 |   ;
495 | 
496 |   : unless immediate
497 |     ['] not JSR
498 |     [compile] if
499 |   ;
500 | 
501 |   \ Write the branch target to here.
502 |   : then immediate
503 |     dup
504 |     chere @ swap - 2-
505 |     swap 1+ c! 
506 |   ;
507 | 
508 |   : else immediate
509 |     chere @ 1+
510 |     swap
511 |     CLV 0 BVC
512 |     dup
513 |     chere @ swap - 2-
514 |     swap 1+ c!
515 |   ;
516 | 
517 |   : begin immediate
518 |     \ [compile] debug
519 |     chere @
520 |   ;
521 | 
522 |   \ ( branch-target -- )
523 |   : repeat immediate
524 |     CLV
525 |     chere @ - 2- BVC
526 |   ;
527 | 
528 |   \ ( branch-target -- )
529 |   : until immediate
530 |     POP
531 |     stack 2- LDA.ZX
532 |     stack 1- ORA.ZX
533 |     chere @ - 2- BEQ
534 |   ;
535 | 
536 |   : while
537 |     POP
538 |     stack 2- LDA.ZX
539 |     stack 1- ORA.ZX
540 |     chere @ - 2- BNE
541 |   ;
542 | 
543 |   : char  word drop @ ;
544 | 
545 |   : '(' [ char ( ] literal ;
546 |   : ')' [ char ) ] literal ;
547 |   : '"' [ char " ] literal ;
548 | 
549 |   : ( immediate
550 |     1
551 |     begin
552 |       key
553 |       dup '(' = if
554 |         drop
555 |         1+
556 |       else
557 |         ')' = if
558 |           1-
559 |         then
560 |       then
561 |     dup 0= until
562 |     drop
563 |   ;
564 | 
565 |   ( Now I can write comments using (nested) parens )
566 | 
567 |   ( Declares a constant value. Use like `10 constant VariableName`)
568 |   : constant immediate
569 |     word
570 |     create
571 |     [compile] literal
572 |     RTS
573 |   ;
574 | 
575 |   ( Declares an uninitialized variable, giving it space
576 |     after vhere )
577 |   : variable immediate
578 |     vhere @
579 |     2 allot
580 |     [compile] constant
581 |   ;
582 | 
583 |   ( xt -- impl )
584 |   : >impl
585 |     dict::impl + @
586 |   ;
587 | 
588 |   ( Takes a dictionary entry and prints the name of the word )
589 |   : id.
590 |     dict::len +    ( Skip the pointers )
591 |     dup c@ ( get the length )
592 |     31 and ( Mask the flags )
593 |     
594 |     begin
595 |       swap 1+ ( addr len -- len addr+1 )
596 |       dup c@ ( len addr -- len addr char )
597 |       emit
598 |       swap 1- ( len addr -- addr len-1 )
599 | 
600 |       dup 0=
601 |     until 
602 |     drop
603 |     drop
604 |   ;
605 | 
606 |   ( True to hide the word from dictionary searches )
607 |   : ?hidden
608 |     dict::len +
609 |     c@
610 |     32 and
611 |   ;
612 | 
613 |   ( True if the word is the last in the dictionary )
614 |   : ?end
615 |     dict::flags +
616 |     c@
617 |     128 and
618 |   ;
619 | 
620 |   ( True if the word is a single-byte val )
621 |   : ?byte
622 |     dict::flags +
623 |     c@
624 |     64 and
625 |   ;
626 | 
627 |   ( True if the word should execute immediately in compile mode )
628 |   : ?immediate
629 |     dict::len +
630 |     c@
631 |     128 and
632 |   ;
633 | 
634 |   ( Returns the next dictionary entry. )
635 |   : next
636 |     dup ?end if
637 |       drop
638 |       0
639 |     else
640 |       dup dict::len + c@ 63 and + dict::name +
641 |     then
642 |   ;
643 | 
644 |   ( Prints all the words in the dictionary )
645 |   ( dict-start -- )
646 |   : words'
647 |     begin
648 |       dup ?hidden not if
649 |         dup id.
650 |         space
651 |       then
652 |       next
653 |       dup 0=
654 |     until
655 |     drop ( drop null pointer )
656 |     cr
657 |   ;
658 | 
659 |   ( Prints all the words in all the dictionaries )
660 |   : words
661 |     dicts
662 |     begin
663 |       words'
664 |     dup 0= until
665 |     drop
666 |   ;
667 | 
668 |   : compiling? state @ ;
669 | 
670 |   ( -- )
671 |   : ." immediate
672 |     compiling? if
673 |       ['] (.') JSR ( compile jsr (.") )
674 | 
675 |       begin
676 |         key
677 |         dup '"' <> if
678 |           c,
679 |           0
680 |         then
681 |       until
682 |       0 c,
683 |     else
684 |       begin
685 |         key
686 |         dup '"' <> if
687 |           emit
688 |           0
689 |         then
690 |       until
691 |     then
692 |   ;
693 | 
694 |   : welcome
695 |     ." Welcome to Forth!" cr
696 |   ;
697 | 
698 |   welcome
699 | 
700 |   ( A variable which, when called, pushes its value instead of its address )
701 |   : val
702 |     vhere @ ( get the variable address )
703 |     2 allot ( allot two variables )
704 |     word
705 |     create ( create a new dictionary entry )
706 |     DEX DEX
707 |     dup LDA ( load the value from the variable and push it to the stack )
708 |     stack STA.ZX
709 |     dup 1+ LDA
710 |     stack 1+ STA.ZX 
711 |     RTS
712 | 
713 |     ( initialize val )
714 |     !
715 | 
716 |     ['] always-inline execute
717 |   ;
718 | 
719 |   : c-val
720 |     vhere @ ( get the variable address )
721 |     1 allot
722 |     word
723 |     create ( create a new dictionary entry )
724 |     dhere @ c-val-tog
725 |     DEX DEX
726 |     dup LDA ( load the value and push it )
727 |     stack STA.ZX
728 |     0 LDA.#
729 |     stack 1+ STA.ZX
730 |     RTS
731 |     ( initialize )
732 |     !
733 |   ;
734 | 
735 |   ( Gets the address of a val and it's size )
736 |   : val-addr
737 |     word
738 |     find
739 |     dup 0= if
740 |       drop
741 |       drop
742 |       drop
743 |       ." Cannot get address of unknown val." cr
744 |       quit
745 |     then
746 |     dup >impl 3 + @ ( read variable address from val impl )
747 |     swap ?byte
748 |   ;
749 | 
750 |   ( Writes a value to a `val` variable )
751 |   : to immediate
752 |     val-addr
753 |     compiling? if
754 |       if ( single byte )
755 |         stack LDA.ZX
756 |         STA
757 |         INX INX
758 |       else
759 |         dup
760 |         stack LDA.ZX
761 |         STA
762 |         stack 1+ LDA.ZX
763 |         1+ STA
764 |         INX INX
765 |       then
766 |     else
767 |       if ( single byte )
768 |         c!
769 |       else
770 |         !
771 |       then
772 |     then
773 |   ;
774 | 
775 |   : heredoc immediate
776 |     word
777 |     create
778 |     chere @ 21 +
779 |     DEX
780 |     DEX
781 |     dup <byte LDA.#
782 |     stack     STA.ZX
783 |     >byte     LDA.#
784 |     stack 1+  STA.ZX
785 | 
786 |     DEX
787 |     DEX
788 |     dup <byte LDA.#
789 |     stack     STA.ZX
790 |     dup >byte LDA.#
791 |     stack 1+  STA.ZX
792 |     RTS
793 | 
794 |     begin
795 |       key c,
796 |       1-
797 |     dup 0= until
798 |     drop
799 |   ;
800 | 
801 |   hex
802 |   ( xt -- )
803 |   : set-reset! 0FFFC ! ;
804 |   ( xt -- )
805 |   : set-nmi! 0FFFA ! ;
806 |   ( xt -- )
807 |   : set-irq! 0FFFE ! ;
808 | 
809 | 
810 |   ' thaw set-reset!
811 | 
812 |   ( Ends an interrupt handler definiton )
813 |   : ;int immediate
814 |     40 c, \ append rti
815 |     dhere @ hidden \ unhide
816 |     [compile] [
817 |   ;
818 |   decimal
819 | 
820 |   : int-handle ;int
821 | 
822 |   ' int-handle set-nmi!
823 |   ' int-handle set-irq!
824 | 
825 |   ( new-xt old-xt -- )
826 |   ( Redefines old as new, so that all calls to old
827 |     will instead call new. Doesn't rePLAce inlined calls )
828 |   : monkey-patch
829 |     dict::impl + !
830 |   ;
831 | 
832 |   : inline,
833 |     1-
834 |     begin
835 |       1+ dup
836 |       c@ dup c,
837 |       96 =
838 |     until
839 |     drop
840 |     \ undo writing the rts
841 |     chere @ 1- chere !
842 |   ;
843 | 
844 |   ( a simple inline which just copies the impl until hitting an rts.
845 |     It will be confused by any 0x60 byte )
846 |   : [inline] immediate
847 |     word find >impl inline,
848 |   ;
849 | 
850 |   : disas
851 |     20
852 |     begin
853 |       swap
854 |       see
855 |       swap 1-
856 |       dup 0=
857 |     until
858 |     drop
859 |     drop
860 |   ;
861 | 
862 |   : show-disas ' >impl disas ;
863 | 
864 |   : do immediate
865 |     \ inline code to put the loop bound then 
866 |     c-sp      LDY.Z
867 |     DEY
868 |     DEY
869 |     c-sp      STY.Z
870 |     stack     LDA.ZX
871 |     cstack    STA.Y
872 |     stack  2+ LDA.ZX
873 |     cstack 1+ STA.Y
874 |     INX
875 |     INX
876 |     INX
877 |     INX \ drop the values on the stack
878 | 
879 |     \ save the address of the beginning of the loop
880 |     chere @
881 |   ;
882 | 
883 |   : loop immediate
884 |     c-sp   LDY.Z
885 |     cstack LDA.Y
886 |     CLC
887 |     1      ADC.#
888 |     cstack 1+ CMP.Y
889 |     cstack STA.Y
890 |     UNTILEQ 
891 |   ;
892 | 
893 | <perm> definitions:
894 |   : i [
895 |     DEX
896 |     DEX
897 |     0 LDA.#
898 |     stack 1+ STA.ZX
899 |     c-sp LDY.Z
900 |     cstack LDA.Y
901 |     stack STA.ZX
902 |   ] ;
903 | 
904 |   : save-for-interrupt always-inline [
905 |     DEX DEX \ make room for the red zone
906 |     PHA
907 |     TYA
908 |     PHA
909 |     tmp LDA.Z
910 |     PHA
911 |     tmp 1+  LDA.Z
912 |     PHA
913 |     tmp 2 + LDA.Z
914 |     PHA
915 |     tmp 3 + LDA.Z
916 |     PHA
917 |     tmp 4 + LDA.Z
918 |     PHA
919 |     tmp 5 + LDA.Z
920 |     PHA
921 |     tmp 6 + LDA.Z
922 |     PHA
923 |     tmp 7 + LDA.Z
924 |     PHA
925 |   ] ;
926 | 
927 |   : restore-for-interrupt always-inline [
928 |     PLA
929 |     tmp 7 + STA.Z
930 |     PLA
931 |     tmp 6 + STA.Z
932 |     PLA
933 |     tmp 5 + STA.Z
934 |     PLA
935 |     tmp 4 + STA.Z
936 |     PLA
937 |     tmp 3 + STA.Z
938 |     PLA
939 |     tmp 2 + STA.Z
940 |     PLA
941 |     tmp 1+  STA.Z
942 |     PLA
943 |     tmp     STA.Z
944 |     
945 |     PLA
946 |     TAY
947 |     PLA
948 |     INX INX \ remove the red zone
949 |   ] ;
950 | 
951 |   hex
952 |   \ Wait a few frames for the PPU to stabilize on power-on
953 |   : wait-for-ppu [
954 |     BEGIN
955 |       2002 BIT
956 |     UNTILMI
957 |     BEGIN
958 |       2002 BIT
959 |     UNTILMI
960 |     BEGIN
961 |       2002 BIT
962 |     UNTILMI
963 |     BEGIN
964 |       2002 BIT
965 |     UNTILMI
966 |   ] ;
967 | 
968 |   ' nmi set-nmi!
969 | 


--------------------------------------------------------------------------------
/bootstrap.s:
--------------------------------------------------------------------------------
   1 | ; This file bootstraps enough code to start a STC Forth
   2 | ; for the 6502 system. It will allow programming NES programs
   3 | ; using Forth. It's modelled using a NES-like memory
   4 | ; map:
   5 | ;   00-FF: zero page
   6 | ;   100-1FF: hardware stack
   7 | ;   200-7FF: User RAM
   8 | ;   8000-FFFF: Cartridge space
   9 | ;
  10 | ; Unlike a NES cartridge, initially the cartridge space is
  11 | ; RAM. The code will run in the simulator, and the user can
  12 | ; interact with it, test functions, etc. Once they execute
  13 | ; The word FREEZE, however, the contents of RAM from 8000-FFFF
  14 | ; will be extracted and put into a .nes file with an appropriate
  15 | ; header.
  16 | ;
  17 | ; The implementation loosely follows Jones Forth.
  18 | ;
  19 | ; Specifics:
  20 | ;
  21 | ; - The data stack is stored in the zero page with the x register
  22 | ; as the stack pointer.
  23 | ; - Words are compiled to a series of jsr instructions, or to inline
  24 | ; code.
  25 | ; - The words are relocatable. The entry point for each word is the same
  26 | ; as the dictionary entry.
  27 | 
  28 | .macpack generic
  29 | .include "forth.inc"
  30 | 
  31 | .import DICT_END, TMP_DICT_END
  32 | .import CHERE_PERM_INIT, CHERE_TMP_INIT
  33 | .import VHERE_PERM_INIT, VHERE_TMP_INIT
  34 | 
  35 | ; The simulator uses this address as the IO port.
  36 | ; A write to this address will output that character
  37 | ; to stdout, and a read will read the next character from
  38 | ; stdin, possibly blocking, since the simulator reads line-by-
  39 | ; line.
  40 | IO_PORT := $401C
  41 | ; Flags for the dictionary entries.
  42 | ; The word should execute immediately even in compile mode
  43 | F_IMMED = $80
  44 | ; The word should not be found in a dictionary search.
  45 | F_HIDDEN = $20
  46 | ; Always inline the word
  47 | F_INLINE = $40
  48 | ; This is the last entry in the dictionary
  49 | F_END = $8000
  50 | ; This is a single-byte val
  51 | F_SINGLE_BYTE = $4000
  52 | 
  53 | .segment "DICT"
  54 | ; Reserve space to push the dictionary to the end of the memory
  55 | ; space, since it now grows down.
  56 | .res $D13
  57 | DHERE_PERM_INIT:
  58 | 
  59 | .segment "TMP_DICT"
  60 | .res $671
  61 | DHERE_TMP_INIT:
  62 | 
  63 | .segment "ZEROPAGE": zeropage
  64 | TMP1: .res 1
  65 | TMP2: .res 1
  66 | TMP3: .res 1
  67 | TMP4: .res 1
  68 | TMP5: .res 1
  69 | TMP6: .res 1
  70 | TMP7: .res 1
  71 | TMP8: .res 1
  72 | 
  73 | Stack: .res 80
  74 | Stack_End: .res 8 ; buffer zone
  75 | 
  76 | ControlFlowSP: .res 1
  77 | ControlFlowStack: .res 32
  78 | ControlFlowStackEnd:
  79 | 
  80 | .segment "STACK"
  81 | ; Reserve the hardware stack.
  82 | RStack: .res $100
  83 | 
  84 | defconsttmp "dict::impl", DictEntry::CodePtr, DictEntryCodePtr
  85 | defconsttmp "dict::len", DictEntry::Len, DictEntryLen
  86 | defconsttmp "dict::flags", DictEntry::Flags2, DictEntryFlags
  87 | defconsttmp "dict::name", DictEntry::Name, DictEntryName
  88 | defconst "c-sp", ControlFlowSP, C_SP
  89 | defconst "cstack", ControlFlowStack, CSTACK
  90 | 
  91 | ; ( a -- )
  92 | defword "drop", F_INLINE, DROP
  93 |   pop
  94 |   rts
  95 | 
  96 | ; ( a b -- b a )
  97 | defword "swap", 0, SWAP
  98 |   lda Stack+0, x
  99 |   ldy Stack+2, x
 100 |   sty Stack+0, x
 101 |   sta Stack+2, x
 102 |   lda Stack+1, x
 103 |   ldy Stack+3, x
 104 |   sty Stack+1, x
 105 |   sta Stack+3, x
 106 |   rts
 107 | 
 108 | ; ( a -- a a )
 109 | defword "dup", 0, DUP
 110 |   dex
 111 |   dex
 112 |   lda Stack+2, x
 113 |   sta Stack+0, x
 114 |   lda Stack+3, x
 115 |   sta Stack+1, x
 116 |   rts
 117 | 
 118 | ; ( a -- a + 1 )
 119 | defword "1+", 0, INCR
 120 |   inc Stack, x
 121 |   beq @hi
 122 |   rts
 123 | @hi:
 124 |   inc Stack+1, x
 125 |   rts
 126 | 
 127 | defword "1-", 0, DECR
 128 |   sec
 129 |   lda Stack, x
 130 |   sbc #1
 131 |   sta Stack, x
 132 |   lda Stack+1, x
 133 |   sbc #0
 134 |   sta Stack+1, x
 135 |   rts
 136 | 
 137 | defword "+", 0, ADD
 138 |   clc
 139 |   lda Stack, x
 140 |   adc Stack+2, x
 141 |   sta Stack+2, x
 142 |   lda Stack+1, x
 143 |   adc Stack+3, x
 144 |   sta Stack+3, x
 145 |   pop
 146 |   rts
 147 | 
 148 | ; Divides a single byte by 3, truncating:
 149 | defword "3/", 0, DIV3
 150 |   ldy #$FF
 151 |   lda #$FD
 152 | :
 153 |   clc
 154 |   adc #3
 155 |   iny
 156 |   cpy #86
 157 |   bge @done
 158 |   cmp Stack, x
 159 |   beq @exact
 160 |   blt :-
 161 | @done:
 162 |   dey
 163 | @exact:
 164 |   sty Stack, x
 165 |   lda #0
 166 |   sta Stack+1, x
 167 |   rts
 168 | 
 169 | defword "-", 0, SUB
 170 |   sec
 171 |   lda Stack+2, x
 172 |   sbc Stack, x
 173 |   sta Stack+2, x
 174 |   lda Stack+3, x
 175 |   sbc Stack+1, x
 176 |   sta Stack+3, x
 177 |   pop
 178 |   rts
 179 | 
 180 | defword "!", 0, STORE
 181 |   toTMP1
 182 |   ldy #0
 183 |   lda Stack+2, x
 184 |   sta (TMP1), y
 185 |   lda Stack+3, x
 186 |   iny
 187 |   sta (TMP1), y
 188 |   pop
 189 |   pop
 190 |   rts
 191 | 
 192 | defword "c!", 0, CSTORE
 193 |   lda Stack+2, x
 194 |   sta (Stack, x)
 195 |   pop
 196 |   pop
 197 |   rts
 198 | 
 199 | defword "@", 0, FETCH
 200 |   toTMP1
 201 |   
 202 |   ldy #0
 203 |   lda (TMP1), y
 204 |   sta Stack, x
 205 |   iny
 206 |   lda (TMP1), y
 207 |   sta Stack+1, x
 208 |   rts
 209 | 
 210 | defword "c@", 0, CFETCH
 211 |   lda (Stack, x)
 212 |   sta Stack, x
 213 |   lda #0
 214 |   sta Stack+1, x
 215 |   rts
 216 | 
 217 | ; ( ptr1 ptr2 n -- )
 218 | defword "cmove", 0, CMOVE
 219 | 
 220 | defwordtmp "key", 0, KEY
 221 |   dex
 222 |   dex
 223 |   lda IO_PORT
 224 |   ldy #0
 225 |   sta Stack, x
 226 |   sty Stack+1, x
 227 |   rts
 228 | 
 229 | ; ( -- str-ptr len )
 230 | defwordtmp "word", 0, WORD
 231 |   lda #0
 232 |   sta TMP1
 233 |   jsr KEY
 234 |   lda Stack, x
 235 |   pop
 236 |   cmp #'\'
 237 |   beq @skipComment
 238 |   cmp #' ' + 1
 239 |   bcc WORD_IMPL
 240 | 
 241 | @loop:
 242 |   ldy TMP1
 243 |   sta word_buffer, y
 244 |   inc TMP1
 245 |   jsr KEY
 246 |   lda Stack, x
 247 |   pop
 248 |   cmp #' ' + 1
 249 |   bge @loop
 250 | 
 251 |   ldy TMP1
 252 |   ; iny
 253 |   lda #0
 254 |   sta word_buffer, y ; zero terminate
 255 | 
 256 |   push word_buffer
 257 |   dex
 258 |   dex
 259 |   lda TMP1
 260 |   sta Stack, x
 261 |   lda #0
 262 |   sta Stack+1, x
 263 |   rts
 264 | 
 265 | @skipComment:
 266 |   jsr KEY
 267 |   lda Stack, x
 268 |   pop
 269 |   cmp #$A ; \n
 270 |   bne @skipComment
 271 |   beq WORD_IMPL ; bra
 272 | 
 273 | .segment "TMP_VARIABLES"
 274 |   word_buffer: .res 32
 275 | 
 276 | defvartmp "base", 10, BASE
 277 | 
 278 | ; ( str len -- parsed-number non-zero )
 279 | ; or ( str len -- str len 0 ) on error
 280 | defwordtmp "number", 0, NUMBER
 281 | 
 282 |   Str := TMP1
 283 |   Result := TMP3
 284 |   Len := TMP5
 285 |   ResultAcc := TMP6
 286 |   
 287 |   lda Stack, x
 288 |   sta Len ; save string length
 289 | 
 290 |   lda Stack+2, x
 291 |   sta Str
 292 |   lda Stack+3, x
 293 |   sta Str+1 ; save str pointer
 294 | 
 295 |   lda #0
 296 |   sta Result
 297 |   sta Result+1
 298 | 
 299 |   txa
 300 |   pha ; save the stack pointer
 301 |   
 302 |   ldy #0
 303 | @eachDigit:
 304 |   lda (Str), y
 305 |   cmp #'A'
 306 |   bcc @digit ; if ascii < 'A', treat is as a decimal digit
 307 |   and #<~$20 ; convert to uppercase letter.
 308 |   sbc #'A' - '9' - 1 ; move it to the range $3A+, right after '9'.
 309 | @digit:
 310 |   sec
 311 |   sbc #'0' ; now it should be in a range of 0-BASE-1
 312 |   cmp BASE_VALUE
 313 |   bcs @invalid ; if digit >= BASE
 314 |   pha ; save the digit
 315 | 
 316 |     ldx BASE_VALUE ; loop BASE times, to multiply Result by BASE using repeated addition
 317 |     lda #0
 318 |     sta ResultAcc
 319 |     sta ResultAcc+1 ; reset ResultAcc
 320 |   @multLoop:
 321 |     clc
 322 |     lda ResultAcc
 323 |     adc Result
 324 |     sta ResultAcc
 325 |     lda ResultAcc+1
 326 |     adc Result+1
 327 |     sta ResultAcc+1 ; add Result to ResultAcc
 328 |     dex
 329 |     bne @multLoop
 330 | 
 331 |   pla ; get the digit
 332 |   clc
 333 |   adc ResultAcc
 334 |   sta Result
 335 |   lda ResultAcc+1
 336 |   adc #0
 337 |   sta Result+1 ; Result = ResultAcc + Digit
 338 | 
 339 |   iny
 340 |   cpy Len
 341 |   bne @eachDigit ; loop again for the next digit until we've exhausted the string.
 342 | 
 343 |   pla
 344 |   tax
 345 |   pop ; drop the string length
 346 |   lda Result
 347 |   sta Stack, x
 348 |   lda Result+1
 349 |   sta Stack+1, x ; put parsed number of the stack.
 350 | 
 351 |   push HANDLE_NUMBER
 352 |   rts
 353 | 
 354 | @invalid:
 355 |   pla
 356 |   tax ; restore stack pointer
 357 |   push 0
 358 |   rts
 359 | 
 360 | defwordtmp "d:perm", 0, DICT_PERM
 361 |   push DHERE_PERM
 362 |   jsr FETCH
 363 |   jmp DFIND
 364 | 
 365 | defwordtmp "d:tmp", 0, DICT_TMP
 366 |   push DHERE_TMP
 367 |   jsr FETCH
 368 |   jmp DFIND
 369 | 
 370 | defwordtmp "hDict", 0, HANDLE_DICT
 371 |   ; now that we have the dictionary entry, check if it's immediate.
 372 |   toTMP1
 373 |   ldy #(DictEntry::Len)
 374 |   lda (TMP1), y
 375 |   and #F_IMMED
 376 |   bne @execute
 377 | 
 378 |   lda STATE_VALUE
 379 |   beq @execute
 380 | @compiling:
 381 |   lda (TMP1), y
 382 |   and #F_INLINE
 383 |   bne @inline
 384 |   push JSR_OP
 385 |   jsr CCOMMA
 386 |   jmp COMMA
 387 | 
 388 | @inline: ; simple inlining -- just copy until you see an rts.
 389 |   jmp INLINE
 390 | 
 391 | @execute:
 392 |   pop ; drop dictionary pointer
 393 |   jmp (TMP1) ; tailcall to the word, which will return to QUIT
 394 | 
 395 | ; ( str-ptr len dict-start -- dictionary-pointer handler )
 396 | ; or ( str-ptr len dict-start -- str-ptr len 0 ) if it wasn't found
 397 | ; Searches the dictionary at the given start for the given word.
 398 | defwordtmp "dfind", 0, DFIND
 399 |   LPointer := TMP1
 400 |   MyStr := TMP3
 401 | 
 402 |   lda Stack, x
 403 |   sta LPointer
 404 |   lda Stack+1, x
 405 |   sta LPointer+1
 406 |   inx
 407 |   inx
 408 |   
 409 |   sec
 410 |   lda Stack+2, x
 411 |   sbc #<(DictEntry::Name)
 412 |   sta MyStr
 413 |   lda Stack+3, x
 414 |   sbc #>(DictEntry::Name)
 415 |   sta MyStr+1 ; put the string pointer - name offset in MyStr
 416 |               ; that way we can use lda (MyStr), y to read
 417 |               ; MyStr using the same offset that we do from LPointer
 418 | 
 419 | ; check if LPointer matches
 420 | @loop:
 421 |   ldy #(DictEntry::Len)
 422 |   lda (LPointer), y ; get length from dictionary entry
 423 |   and #$1F | F_HIDDEN ; mask to get length, allowing hidden to change length.
 424 |   cmp Stack, x ; compare to the length on the stack
 425 |   bne @next ; if lengths don't match, follow the next pointer.
 426 | 
 427 |   ; now compare the strings.
 428 |   lda Stack, x
 429 |   clc
 430 |   adc #(DictEntry::Name) - 1
 431 |   tay ; Init y to check the end of the string
 432 | 
 433 | @strcmpLoop:
 434 |   lda (LPointer), y
 435 |   cmp (MyStr), y
 436 |   bne @next
 437 |   dey
 438 |   cpy #(DictEntry::Len)
 439 |   beq @found
 440 |   bne @strcmpLoop ; bra
 441 | 
 442 | @next:
 443 | 
 444 |   ; Check if this is the last dictionary entry
 445 |   ldy #(DictEntry::Flags2)
 446 |   lda (LPointer), y
 447 |   and #>F_END
 448 |   bne @notFound
 449 | 
 450 |   ldy #(DictEntry::Len)
 451 |   lda (LPointer), y
 452 |   and #$1F ; TODO - magic constant
 453 |   clc
 454 |   adc LPointer
 455 |   sta LPointer
 456 |   lda #0
 457 |   adc LPointer + 1
 458 |   sta LPointer + 1 ; add string length to LPointer
 459 | 
 460 |   lda #DictEntry::Name
 461 |   clc
 462 |   adc LPointer
 463 |   sta LPointer
 464 |   lda #0
 465 |   adc LPointer + 1
 466 |   sta LPointer + 1 ; add the other bytes of the header.
 467 | 
 468 |   clv
 469 |   bvc @loop ; bra
 470 | 
 471 | @notFound:
 472 |   dex
 473 |   dex
 474 |   lda #0
 475 |   sta Stack, x
 476 |   sta Stack+1, x
 477 |   rts
 478 | @found:
 479 |   pop
 480 |   lda LPointer
 481 |   sta Stack, x
 482 |   lda LPointer+1
 483 |   sta Stack+1, x
 484 |   push HANDLE_DICT
 485 |   rts
 486 | 
 487 | defwordtmp "hNum", 0, HANDLE_NUMBER
 488 |   lda STATE_VALUE
 489 |   beq @executeLiteral
 490 | @compileLiteral:
 491 |   jsr ASM
 492 |   .byte 1, DEX_OP ; DEX
 493 |   jsr ASM
 494 |   .byte 1, DEX_OP ; DEX
 495 |   jsr DUP         ; dup
 496 |   jsr ASM
 497 |   .byte 2, LDA_IMM_OP ; LDA.#
 498 |   push Stack
 499 |   jsr ASM
 500 |   .byte 2, STA_ZP_X_OP ; stack STA.ZX
 501 |   lda Stack+1, x
 502 |   sta Stack, x ; >byte
 503 |   jsr ASM
 504 |   .byte 2, LDA_IMM_OP ; LDA.#
 505 |   push Stack+1
 506 |   jsr ASM
 507 |   .byte 2, STA_ZP_X_OP ; stack 1+ STA.ZX
 508 |   rts
 509 | @executeLiteral:
 510 |   rts
 511 | 
 512 | PushTemplate:
 513 |   dex
 514 |   dex
 515 | PushTemplateLo := *+1
 516 |   lda #0
 517 |   sta Stack, x
 518 | PushTemplateHi := *+1
 519 |   lda #0
 520 |   sta Stack+1, x
 521 | EndPushTemplate:
 522 | 
 523 | defwordtmp "d:asm", 0, DICT_ASM
 524 |   lda Stack+2, x
 525 |   sta TMP1
 526 |   lda Stack+3, x
 527 |   sta TMP2
 528 |   jsr ParseInstruction
 529 |   lda Stack, x ; check the length of the instruction parsed.
 530 |   beq :+
 531 |   ; Remove the string
 532 |   lda Stack, x
 533 |   sta Stack+4, x
 534 |   lda Stack+1, x
 535 |   sta Stack+5, x
 536 |   lda Stack+2, x
 537 |   sta Stack+6, x
 538 |   lda Stack+3, x
 539 |   sta Stack+7, x
 540 |   pop
 541 |   pop
 542 |   jsr SWAP
 543 |   jsr DUP
 544 |   jsr DIV3
 545 |   jsr ADD
 546 |   jsr SWAP
 547 |   push ASM_COMP
 548 | : rts
 549 | 
 550 | ; ( str-ptr len -- dictionary-pointer )
 551 | ; or ( str-ptr len -- str-ptr len 0 ) if it wasn't found
 552 | ; Searches the dictionary for a definition of the given word.
 553 | defwordtmp "find", 0, FIND
 554 |   
 555 |   jsr DICT_PERM
 556 |   cmpTopZero
 557 |   beq :+
 558 |   pop
 559 |   rts
 560 | : pop
 561 |   jsr DICT_TMP
 562 |   cmpTopZero
 563 |   beq :+
 564 |   pop
 565 | : rts
 566 | 
 567 | ; Given a pointer, gets the name of the dictionary entry,
 568 | ; or an empty string if it's not in the dictionary.
 569 | ; ( addr -- addr len )
 570 | defwordtmp "rfind", 0, RFIND
 571 |   @LPointer := TMP1
 572 | 
 573 |   push DHERE_PERM
 574 |   jsr FETCH
 575 |   jsr @rfind_impl
 576 |   lda Stack, x
 577 |   ora Stack+1, x
 578 |   bne @found
 579 |   pop
 580 |   push DHERE_TMP
 581 |   jsr FETCH
 582 |   jsr @rfind_impl
 583 | @found:
 584 |   rts
 585 | 
 586 | @rfind_impl:
 587 |   lda Stack, x
 588 |   sta @LPointer
 589 |   lda Stack+1, x
 590 |   sta @LPointer+1
 591 |   pop
 592 | 
 593 | @loop:
 594 |   lda @LPointer
 595 |   cmp Stack, x
 596 |   bne @ne
 597 |   lda @LPointer+1
 598 |   cmp Stack+1, x
 599 |   bne @ne
 600 |   ; We've found the dictionary entry, now return the string.
 601 |   ldy #DictEntry::Len
 602 |   lda (@LPointer), y
 603 |   and #$1F ; mask just the length, no flags.
 604 |   dex
 605 |   dex
 606 |   sta Stack, x
 607 |   lda #0
 608 |   sta Stack+1, x
 609 |   lda @LPointer
 610 |   clc
 611 |   adc #DictEntry::Name
 612 |   sta Stack+2, x
 613 |   lda @LPointer+1
 614 |   adc #0
 615 |   sta Stack+3, x
 616 |   rts
 617 | @ne:
 618 |   ldy #DictEntry::Len
 619 |   lda (@LPointer), y
 620 |   and #31 ; TODO - magic number
 621 |   clc
 622 |   adc @LPointer
 623 |   sta @LPointer
 624 |   lda #0
 625 |   adc @LPointer+1
 626 |   sta @LPointer+1
 627 | 
 628 |   lda #DictEntry::Name
 629 |   clc
 630 |   adc @LPointer
 631 |   sta @LPointer
 632 |   lda #0
 633 |   adc @LPointer+1
 634 |   sta @LPointer+1
 635 | 
 636 |   lda @LPointer+1
 637 |   cmp #>DICT_END ; assumes DICT_END is the last entry in the dictionary
 638 |   blt @loop
 639 |   lda @LPointer
 640 |   cmp #<DICT_END
 641 |   beq @loop
 642 |   blt @loop
 643 | @notFound:
 644 |   ; Didn't find anything, so return 0 len string and the original address.
 645 |   dex
 646 |   dex
 647 |   lda #0
 648 |   sta Stack, x
 649 |   sta Stack+1, x
 650 |   rts
 651 | 
 652 | defconst "<perm>", HERE_PERM, PERM_LATEST
 653 | defconst "<tmp>", HERE_TMP, TMP_LATEST
 654 | 
 655 | defwordtmp "definitions:", 0, DEFINITIONS
 656 |   jsr HERE
 657 |   jsr STORE
 658 |   rts
 659 | 
 660 | defword "dicts", 0, DICTS
 661 |   push 0
 662 |   push DHERE_TMP
 663 |   jsr FETCH
 664 |   push DHERE_PERM
 665 |   jmp FETCH
 666 | 
 667 | ; Points to a list of 3 RAM addresses, holding
 668 | ; the current HERE pointers, representing where
 669 | ; to place the next code, dictionary, or variable bytes.
 670 | defvartmp "here", HERE_PERM, HERE
 671 | 
 672 | ; Gives the address of the next free byte of code
 673 | defwordtmp "chere", 0, CHERE
 674 |   jsr HERE
 675 |   jmp FETCH
 676 | 
 677 | ; Gives the address of the next byte to add to the dictionary
 678 | defwordtmp "dhere", 0, DHERE
 679 |   jsr HERE
 680 |   jsr FETCH
 681 |   push 2
 682 |   jmp ADD
 683 | 
 684 | ; Gives the address of the next free byte of RAM
 685 | defwordtmp "vhere", 0, VHERE
 686 |   jsr HERE
 687 |   jsr FETCH
 688 |   push 4
 689 |   jmp ADD
 690 | 
 691 | .segment "TMP_VARIABLES"
 692 | HERE_TMP:
 693 |   CHERE_TMP: .word CHERE_TMP_INIT
 694 |   DHERE_TMP: .word DHERE_TMP_INIT
 695 |   VHERE_TMP: .word VHERE_TMP_INIT
 696 | 
 697 | HERE_PERM:
 698 |   CHERE_PERM: .word CHERE_PERM_INIT
 699 |   DHERE_PERM: .word DHERE_PERM_INIT
 700 |   VHERE_PERM: .word VHERE_PERM_INIT
 701 | 
 702 | JMP_OP = $4C
 703 | 
 704 | ; ( str-ptr len -- )
 705 | ; Creates a new dictionary entry
 706 | defwordtmp "create", 0, CREATE
 707 |   ; The dict entry needs str-len + DictEntry::Name bytes of space.
 708 |   ; Subtract from DHERE to allocate the space.
 709 |   jsr DUP ; str length
 710 |   push DictEntry::Name
 711 |   jsr ADD
 712 |   jsr DHERE
 713 |   jsr FETCH
 714 |   jsr SWAP
 715 |   jsr SUB
 716 |   jsr DHERE
 717 |   jsr STORE
 718 | 
 719 |   ; Update LATEST to the new entry
 720 |   ;jsr DHERE
 721 |   ;jsr FETCH
 722 |   ;jsr LATEST
 723 |   ;jsr STORE
 724 | 
 725 |   ; ( stack is now string-ptr len )
 726 |   ; Store length in new entry
 727 |   ; DUP DHERE Len + C!
 728 |   jsr DUP
 729 |   jsr DHERE
 730 |   jsr FETCH
 731 |   push DictEntry::Len
 732 |   jsr ADD
 733 |   jsr CSTORE
 734 | 
 735 |   ; Write jmp CHERE to the dictionary entry.
 736 |   ; JMP_OP dhere @ Jmp + c!
 737 |   push JMP_OP
 738 |   jsr DHERE
 739 |   jsr FETCH
 740 |   push DictEntry::Jmp
 741 |   jsr ADD
 742 |   jsr CSTORE
 743 |   ; chere @ dhere @ codeptr + !
 744 |   jsr CHERE
 745 |   jsr FETCH
 746 |   jsr DHERE
 747 |   jsr FETCH
 748 |   push DictEntry::CodePtr
 749 |   jsr ADD
 750 |   jsr STORE  
 751 |   
 752 |   ; Get DHERE value
 753 |   jsr DHERE
 754 |   jsr FETCH
 755 |   ; Add the offset to the name part
 756 |   clc
 757 |   lda #<(DictEntry::Name)
 758 |   adc Stack, x
 759 |   sta TMP3
 760 |   lda #>(DictEntry::Name)
 761 |   adc Stack+1, x
 762 |   sta TMP4
 763 |   pop ; Drop DHERE value
 764 | 
 765 |   ; now we need to copy the name string.
 766 |   lda Stack, x ; get length
 767 |   tay
 768 |   dey
 769 | 
 770 |   lda Stack+2, x
 771 |   sta TMP1
 772 |   lda Stack+3, x
 773 |   sta TMP2 ; copy str pointer into TMP1
 774 | 
 775 | @loop:
 776 |   lda (TMP1), y
 777 |   sta (TMP3), y
 778 |   dey
 779 |   bpl @loop
 780 | 
 781 |   pop
 782 |   pop
 783 |   rts
 784 | 
 785 | defwordtmp ",", 0, COMMA
 786 |   jsr CHERE
 787 |   jsr FETCH
 788 |   jsr STORE
 789 | 
 790 |   jsr CHERE
 791 |   jsr FETCH
 792 |   jsr INCR
 793 |   jsr INCR
 794 |   jsr CHERE
 795 |   jmp STORE
 796 | 
 797 | defwordtmp "c,", 0, CCOMMA
 798 |   jsr CHERE
 799 |   jsr FETCH
 800 |   jsr CSTORE
 801 | 
 802 |   jsr CHERE
 803 |   jsr FETCH
 804 |   jsr INCR
 805 |   jsr CHERE
 806 |   jmp STORE
 807 | 
 808 | defvartmp "state", 0, STATE
 809 | 
 810 | defwordtmp "[", F_IMMED, LSQUARE
 811 |   lda #0
 812 |   sta STATE_VALUE
 813 |   sta STATE_VALUE+1
 814 |   rts
 815 | 
 816 | defwordtmp "]", 0, RSQUARE
 817 |   lda #1
 818 |   sta STATE_VALUE
 819 |   lda #0
 820 |   sta STATE_VALUE+1
 821 |   rts
 822 | 
 823 | defwordtmp ":", 0, COLON
 824 |   jsr WORD
 825 |   jsr CREATE ; create the dictionary entry
 826 |   jsr DHERE
 827 |   jsr FETCH
 828 |   jsr HIDDEN ; toggle hidden in the entry
 829 |   jmp RSQUARE ; enter compile mode
 830 | 
 831 | RTS_OP = $60
 832 | 
 833 | defwordtmp ";", F_IMMED, SEMICOLON
 834 |   ; append rts to code
 835 |   jsr ASM
 836 |   .byte 1, RTS_OP
 837 | 
 838 |   jsr DHERE
 839 |   jsr FETCH
 840 |   jsr HIDDEN ; toggle hidden flag
 841 |   jmp LSQUARE ; go back to immediate mode
 842 | 
 843 | ; ( dict-ptr -- )
 844 | ; Marks the dictionary entry as hidden
 845 | defwordtmp "hidden", 0, HIDDEN
 846 |   toTMP1
 847 | 
 848 |   ldy #(DictEntry::Len)
 849 |   lda #F_HIDDEN
 850 |   eor (TMP1), y
 851 |   sta (TMP1), y
 852 | 
 853 |   pop
 854 |   rts
 855 | 
 856 | defwordtmp "c-val-tog", 0, C_VAL_TOGGLE
 857 |   toTMP1
 858 |   ldy #(DictEntry::Flags2)
 859 |   lda #>F_SINGLE_BYTE
 860 |   eor (TMP1), y
 861 |   sta (TMP1), y
 862 | 
 863 |   pop
 864 |   rts
 865 | 
 866 | defwordtmp "hide", 0, HIDE
 867 |   jsr WORD
 868 |   jsr FIND
 869 |   jmp HIDDEN
 870 | 
 871 | JSR_OP = $20
 872 | 
 873 | defwordtmp "[asm]", 0, ASM
 874 |   pla
 875 |   sta TMP1
 876 |   pla
 877 |   sta TMP2
 878 |   
 879 |   lda TMP1
 880 |   clc
 881 |   adc #2
 882 |   tay
 883 | 
 884 |   lda TMP2
 885 |   adc #0
 886 |   pha ; add 2 to the return address because there are 2 bytes of parameters.
 887 |   tya
 888 |   pha
 889 | 
 890 |   ; Move the two parmeters to the stack.
 891 |   ldy #2
 892 |   lda (TMP1), y
 893 |   dex
 894 |   dex
 895 |   sta Stack, x
 896 |   lda #0
 897 |   sta Stack+1, x
 898 | 
 899 |   dey
 900 |   lda (TMP1), y
 901 |   dex
 902 |   dex
 903 |   sta Stack, x
 904 |   lda #0
 905 |   sta Stack+1, x
 906 | 
 907 |   jmp AsmCompExec
 908 |   
 909 | 
 910 | ; ( arg? instruction n-bytes -- )
 911 | ; Given an optional argument, the number
 912 | ; of bytes in the instruction, and the instruction
 913 | ; number, compiles the instruction and arg to
 914 | ; the code space.
 915 | defwordtmp "asm-comp", 0, ASM_COMP
 916 |   lda STATE_VALUE
 917 |   beq AsmCompExec
 918 | @compile:
 919 |   push JSR_OP
 920 |   jsr CCOMMA
 921 |   push ASM
 922 |   jsr COMMA
 923 |   jsr CCOMMA
 924 |   jsr CCOMMA
 925 |   rts
 926 | AsmCompExec:
 927 |   lda Stack, x
 928 |   pha
 929 |     pop
 930 |     jsr CCOMMA ; write instruction byte
 931 |   pla
 932 |   cmp #2
 933 |   beq @two
 934 |   blt @one
 935 | @three:
 936 |   jmp COMMA
 937 | @two:
 938 |   jmp CCOMMA
 939 | @one:
 940 |   rts
 941 |   
 942 | defwordtmp "quit", 0, QUIT
 943 |   stx TMP1
 944 |     cpx #Stack_End - Stack
 945 |     bge @underflow
 946 |     ldx #$FF
 947 |     txs
 948 |   ldx TMP1
 949 |   jsr INTERPRET
 950 |   jmp QUIT
 951 | @underflow:
 952 |   jsr DODOTQUOTE
 953 |   .asciiz "Stack underflow detected!"
 954 |   ldx #Stack_End - Stack - 1
 955 |   jmp QUIT
 956 | 
 957 | ; ( xt -- )
 958 | ; Inlines the code of the execution token,
 959 | ; stopping when it reaches an RTS instruction.
 960 | INLINE:
 961 |   push DictEntry::CodePtr
 962 |   jsr ADD
 963 |   jsr FETCH
 964 | @loop2:
 965 |   jsr DUP
 966 |   jsr CFETCH
 967 |   lda Stack, x
 968 |   cmp #$60
 969 |   beq @doneInlining2
 970 |   jsr CCOMMA
 971 |   jsr INCR
 972 |   clv
 973 |   bvc @loop2
 974 | @doneInlining2:
 975 |   pop ; drop the two stack values
 976 |   pop
 977 |   rts
 978 | 
 979 | DEX_OP = $CA
 980 | LDA_IMM_OP = $A9
 981 | STA_ZP_X_OP = $95
 982 | 
 983 | defword "execute", 0, EXECUTE
 984 |   toTMP1
 985 |   pop
 986 |   jmp (TMP1)
 987 | 
 988 | defwordtmp "interpret", 0, INTERPRET
 989 |   .macro tryDict dict
 990 |     jsr dict
 991 |     cmpTopZero
 992 |     bne @found
 993 |     pop
 994 |   .endmacro
 995 |   jsr WORD
 996 |   tryDict DICT_PERM
 997 |   tryDict DICT_TMP
 998 |   tryDict NUMBER
 999 |   tryDict DICT_ASM
1000 | @notFound:
1001 |   jsr DODOTQUOTE
1002 |   .byte "ERROR: Couldn't find word ", '"', 0
1003 |   jsr TYPE
1004 |   lda #'"'
1005 |   sta IO_PORT
1006 |   rts
1007 | @found:
1008 |   jmp EXECUTE
1009 | 
1010 | defwordtmp ".", 0, DOT
1011 |   ; Set the V flag. While v is set, we will skip
1012 |   ; leading 0s. Once we see a digit which is non-zero, clv.
1013 |   bit @setV
1014 |   pop
1015 | 
1016 |   lda Stack-1, x
1017 |   ora Stack-2, x
1018 |   bne @nonZero
1019 |   jsr @zero
1020 | @nonZero:
1021 | 
1022 |   lda Stack-1, x
1023 |   jsr @digit
1024 |   lda Stack-2, x
1025 |   jsr @digit
1026 | @ending:
1027 |   lda #' '
1028 |   sta IO_PORT
1029 |   rts
1030 | 
1031 | @digit:
1032 |   sta TMP1
1033 |   lsr
1034 |   lsr
1035 |   lsr
1036 |   lsr
1037 |   beq :+
1038 |   clv
1039 | : bvs :+
1040 |   tay
1041 |   lda HexDigits, y
1042 |   sta IO_PORT
1043 | : lda TMP1
1044 |   and #$F
1045 |   beq :+
1046 |   clv
1047 | : bvs @setV
1048 | @zero:
1049 |   tay
1050 |   lda HexDigits, y
1051 |   sta IO_PORT
1052 | @setV:
1053 |   rts
1054 | 
1055 | HexDigits: .byte "0123456789ABCDEF"
1056 | 
1057 | ; Prints out the following bytes as a zero-terminated string.
1058 | ; Use like:
1059 | ;   jsr DODOTQUOTE
1060 | ;   .asciiz "Some string"
1061 | defwordtmp "(.')", 0, DODOTQUOTE
1062 |   pla
1063 |   sta TMP1
1064 |   pla
1065 |   sta TMP2
1066 | 
1067 |   ldy #1 ; add 1 because the jsr pushes the last byte of the jsr
1068 | @loop:
1069 |   lda (TMP1), y
1070 |   beq @done
1071 |   sta IO_PORT
1072 |   iny
1073 |   bne @loop  
1074 | @done:
1075 |   clc ; fix up the return address to the address after the
1076 |   tya ; string
1077 |   adc TMP1
1078 |   sta TMP1
1079 |   lda TMP2
1080 |   adc #0
1081 |   pha
1082 |   lda TMP1
1083 |   pha
1084 |   rts
1085 | 
1086 | ; ( str-addr len -- )
1087 | ; Prints a string
1088 | defwordtmp "type", 0, TYPE
1089 |   clc
1090 |   lda Stack, x
1091 |   adc Stack+2, x
1092 |   sta Stack, x
1093 |   lda Stack+1, x
1094 |   adc Stack+3, x
1095 |   sta Stack+1, x
1096 | 
1097 | @loop:
1098 |   lda Stack, x
1099 |   cmp Stack+2, x
1100 |   bne :+
1101 |   lda Stack+1, x
1102 |   cmp Stack+3, x
1103 |   beq @done
1104 | : lda (Stack+2, x)
1105 |   sta IO_PORT
1106 | 
1107 |   inc Stack+2, x
1108 |   bne :+
1109 |   inc Stack+3, x
1110 | : clv
1111 |   bvc @loop ; bra
1112 | @done:
1113 |   pop
1114 |   pop
1115 |   rts
1116 | 
1117 | ; ( addr -- addr+1 c )
1118 | defword "c@1+", 0, FETCH_INC
1119 |   jsr DUP
1120 |   jsr INCR
1121 |   jsr SWAP
1122 |   jmp CFETCH 
1123 | 
1124 | defwordtmp "see", 0, SEE
1125 |   .import Instruction
1126 |   jmp Instruction
1127 | 
1128 | defwordtmp "ins", 0, INS
1129 |   jsr WORD
1130 |   pop ; drop string length
1131 |   toTMP1
1132 |   pop
1133 |   .import ParseInstruction
1134 |   jsr ParseInstruction
1135 |   beq :+
1136 |   jsr SWAP
1137 |   jsr DUP
1138 |   jsr DIV3
1139 |   jsr ADD
1140 |   jsr SWAP
1141 | : rts
1142 | 
1143 | defword "thaw", 0, THAW
1144 |   Source := TMP1
1145 |   Target := TMP3
1146 | 
1147 |   ; Basic setup
1148 |   sei
1149 |   cld
1150 | 
1151 |   ; Set source pointer
1152 |   ; (Self-modifying code set by freeze)
1153 | SourcePtrLo:
1154 |   lda #<0000
1155 |   sta Source
1156 | SourcePtrHi:
1157 |   lda #>0000
1158 |   sta Source+1
1159 | 
1160 |   ; Set target pointer (just after TMP1-8)
1161 |   lda #<Stack
1162 |   sta Target
1163 |   lda #>Stack
1164 |   sta Target+1
1165 | 
1166 | SrcAgain:
1167 |   ldy #0
1168 |   lda (Source), y ; read byte
1169 |   iny
1170 |   cmp (Source), y ; peek a comparison with next byte
1171 |   beq @run
1172 | @single:
1173 |   ; it's a single byte, not a run
1174 |   ldy #0
1175 |   sta (Target), y
1176 |   ldx #1 ; signal to increment source by 1
1177 |   bne @then ; bra
1178 | @run:
1179 |   ; It's a run of the same byte
1180 |   sta TMP6
1181 |     iny
1182 |     lda (Source), y ; read run length
1183 |     sta TMP5
1184 |     tay
1185 |   lda TMP6
1186 |   iny
1187 |   iny ; add 2 to run length
1188 | @loop:
1189 |   dey
1190 |   sta (Target), y
1191 |   bne @loop
1192 | 
1193 |   ldy TMP5
1194 |   iny
1195 |   ldx #3 ; signal to increment source by 3
1196 | @then:
1197 |   ; Now we need to increment source and target
1198 |   ; y+1 tells us how much to increment target
1199 |   ; x tells us how much to increment source
1200 |   sty TMP5
1201 |   lda Target
1202 |   sec ; adjust +1
1203 |   adc TMP5
1204 |   sta Target
1205 | 
1206 |   lda Target+1
1207 |   adc #0
1208 |   sta Target+1 ; adjusted target
1209 | 
1210 |   stx TMP5
1211 |   lda Source
1212 |   clc
1213 |   adc TMP5
1214 |   sta Source
1215 | 
1216 |   lda Source+1
1217 |   adc #0
1218 |   sta Source+1 ; adjusted source
1219 | 
1220 |   lda EndPtrLo+1
1221 |   lda Source
1222 | EndPtrLo:
1223 |   cmp #<0000
1224 |   bne SrcAgain
1225 | 
1226 |   lda Source+1
1227 | EndPtrHi:
1228 |   cmp #>0000
1229 |   bne SrcAgain
1230 | 
1231 |   ; Source has now reached the end, so we've restored all of RAM.
1232 | @restoreRegs:
1233 |   ; Restore the register states (self-modifying code -- modified in freeze)
1234 | SPSave:
1235 |   ldx #0
1236 |   txs
1237 | 
1238 |   ; We're going to finish with an rti,
1239 |   ; but rts pushes return-1, while an interrupt
1240 |   ; pushes the return address directly. So,
1241 |   ; we need to increment our return address by 1.
1242 |   inc $101, x
1243 |   bne PSave
1244 |   inc $102, x
1245 | 
1246 | PSave:
1247 |   lda #0
1248 |   pha ; store processor flag on stack
1249 | ASave:
1250 |   lda #0
1251 | XSave:
1252 |   ldx #0
1253 | YSave:
1254 |   ldy #0
1255 |   rti
1256 | 
1257 | defwordtmp "freeze", 0, FREEZE
1258 |   @source := TMP1
1259 |   @target := TMP3
1260 | 
1261 |   ; Save register states.
1262 |   sta ASave+1
1263 | 
1264 |   php
1265 |   pla
1266 |   sta PSave+1
1267 |   stx XSave+1
1268 |   sty YSave+1
1269 |   tsx
1270 |   stx SPSave+1
1271 | 
1272 |   ; Set source pointer
1273 |   lda #<Stack
1274 |   sta @source
1275 |   lda #>Stack
1276 |   sta @source+1
1277 | 
1278 |   ; Set target pointer, and source pointer of decompress
1279 |   lda CHERE_PERM
1280 |   sta SourcePtrLo+1
1281 |   sta @target
1282 |   lda CHERE_PERM+1
1283 |   sta SourcePtrHi+1
1284 |   sta @target+1
1285 | 
1286 | @again:
1287 |   ; Encode a single run
1288 |   lda @source+1
1289 |   cmp #>$800
1290 |   beq @done
1291 |   ldy #0
1292 |   lda (@source), y
1293 | @loop:
1294 |   iny
1295 |   beq @loopEnd
1296 |   cmp (@source), y
1297 |   beq @loop
1298 | @loopEnd:
1299 |   ; Now we've found the end of the run, or found 256 in a row.
1300 |   sta TMP6
1301 |     dey ; adjust y to 0-FF range
1302 |     ; Increment source to the byte after the run.
1303 |     sty TMP5
1304 |     lda @source
1305 |     sec ; add a plus 1 adjustment
1306 |     adc TMP5
1307 |     sta @source
1308 |     lda @source+1
1309 |     adc #0
1310 |     sta @source+1
1311 |   lda TMP6
1312 | 
1313 |   cpy #0
1314 |   bne @multiple
1315 | @single:
1316 |   ; A run of a single byte is encoded as itself.
1317 |   ldy #0
1318 |   sta (@target), y
1319 |   beq @incrementTarget ; bra
1320 | @multiple:
1321 |   ; A run of multiple is encoded as 2 repeated bytes, followed by a
1322 |   ; byte indicating the remaining repeats. So 5 0 bytes is encoded as 0 0 3
1323 |   ldy #0
1324 |   sta (@target), y
1325 |   iny
1326 |   sta (@target), y
1327 |   lda TMP5 ; load repeat count - 1
1328 |   sec
1329 |   sbc #1 ; subtract 1 from it 
1330 |   iny
1331 |   sta (@target), y
1332 | 
1333 | @incrementTarget:
1334 |   ; y now tells us how far to increment target
1335 |   sty TMP5
1336 |   lda @target
1337 |   sec ; adjust +1, since y is either 0 or 2.
1338 |   adc TMP5
1339 |   sta @target
1340 |   lda @target+1
1341 |   adc #0
1342 |   sta @target+1
1343 | 
1344 |   clv
1345 |   bvc @again ; bra
1346 | 
1347 | @done:
1348 |   lda @source
1349 |   beq @noOvershoot
1350 | 
1351 |   ; The last run has a length that takes it past
1352 |   ; the end of RAM.
1353 |   lda @target
1354 |   sec
1355 |   sbc #1
1356 |   sta @target
1357 |   lda @target+1
1358 |   sbc #0
1359 |   sta @target+1
1360 |   
1361 |   ldy #0
1362 |   lda (@target), y ; get the length of the last one
1363 |   sec
1364 |   sbc @source ; subtract by the overshoot amount
1365 |   sta (@target), y
1366 | 
1367 |   inc @target
1368 |   bne @noOvershoot
1369 |   inc @target+1
1370 | 
1371 | @noOvershoot:
1372 |   ; Save end pointer
1373 |   lda @target
1374 |   sta EndPtrLo+1
1375 |   lda @target+1
1376 |   sta EndPtrHi+1
1377 | 
1378 |   jmp 0 ; signal emulator to stop
1379 | 
1380 | .segment "CODE"
1381 | 
1382 | reset:
1383 |   sei
1384 |   cld
1385 |   ldx #$FF
1386 |   txs
1387 | 
1388 |   ldx #Stack_End - Stack - 1
1389 |   lda #ControlFlowStackEnd - ControlFlowStack - 1
1390 |   sta ControlFlowSP
1391 | 
1392 |   jmp QUIT
1393 | 
1394 | .segment "VECTORS"
1395 | .word 0
1396 | .word reset
1397 | .word 0
1398 | 


--------------------------------------------------------------------------------
/browser.cpp:
--------------------------------------------------------------------------------
 1 | 
 2 | #include "6502.h"
 3 | #include "out/bootstrap.bin.h"
 4 | #include <iostream>
 5 | 
 6 | int main(int argc, char **argv) {
 7 |   initOpcodes();
 8 | 
 9 |   for (int i = 0; i < bootstrap_bin_len; i++) {
10 |     m.memory[i] = bootstrap_bin[i];
11 |   }
12 | 
13 |   m.ip = m.memory[0xFFFC] + (m.memory[0xFFFD] << 8) - 1;
14 | 
15 |   while (emulate()) {
16 |     lastLineInput.clear();
17 |     std::getline(std::cin, lastLineInput);
18 |     lastLineInput += "\n";
19 |     lineIndex = 0;
20 |   }
21 | }
22 | 


--------------------------------------------------------------------------------
/config:
--------------------------------------------------------------------------------
 1 | 
 2 | MEMORY {
 3 |   ZEROPAGE: start = $00, size = $100, file = %O, fill = yes;
 4 |   STACK: start = $200, size = $100, file = %O, fill = yes;
 5 |   RAM: start = $200, size = $600, file = %O, fill = yes;
 6 |   PADDING: start = $800, size = $3820, file = %O, fill = yes;
 7 |   TMP_RAM:  start = $4020, size = $E0, file = %O, fill = yes;
 8 |   TMP_CODE: start = $4100, size = $1700, file = %O, fill = yes;
 9 |   TMP_DICT: start = $5800, size = $800, file = %O, fill = yes;
10 |   RAM2: start = $6000, size = $2000, file = %O, fill = yes;
11 |   CODE: start = $8000, size = $7000, file = %O, fill = yes; 
12 |   DICT: start = $F000, size = $FFA, file = %O, fill = yes;
13 |   VECTORS: start = $FFFA, size = $6, file = %O, fill = yes;
14 | }
15 | SEGMENTS {
16 |   ZEROPAGE: load = ZEROPAGE, type = ro;
17 |   STACK: load = STACK, type = ro, optional = true;
18 |   RAM: load = RAM, type = ro, optional = true, align = $100;
19 |   VARIABLES: load = RAM, type = ro, optional = true;
20 |   TMP_VARIABLES: load = TMP_RAM, type = ro, optional = true;
21 |   TMP_CODE: load = TMP_CODE, type = ro, optional = true;
22 |   TMP_DICT_CODE: load = TMP_CODE, type = ro, optional = true;
23 |   TMP_DICT: load = TMP_DICT, type = ro, optional = true;
24 |   RAM2: load = RAM2, type = ro, optional = true;
25 |   CODE: load = CODE, type = ro;
26 |   DICT_CODE: load = CODE, type = ro;
27 |   DICT: load = DICT, type = ro, optional = true;
28 |   VECTORS: load = VECTORS, type = ro;
29 | }
30 | 


--------------------------------------------------------------------------------
/coroutines.s:
--------------------------------------------------------------------------------
  1 | 
  2 | .include "forth.inc"
  3 | 
  4 | ; How many coroutines to support
  5 | N_COS = 4
  6 | ; How much data stack RAM for each one
  7 | N_RAM_EACH = (Stack_End-Stack) / N_COS
  8 | ; How much return stack RAM for each one
  9 | N_RSTACK_EACH = $20
 10 | ; How many bytes of control flow stack per coroutine
 11 | N_CONTROL_FLOW_STACK = (ControlFlowStackEnd-ControlFlowStack) / N_COS
 12 | 
 13 | .segment "ZEROPAGE"
 14 | 
 15 | XSave: .res N_COS
 16 | SPSave: .res N_COS
 17 | CFSSave: .res N_COS
 18 | 
 19 | .segment "RAM"
 20 | 
 21 | CurrentCo: .res 1
 22 | ActiveCos: .res 1, $1 ; initially, only the first coroutine is active.
 23 | 
 24 | .segment "CODE"
 25 | 
 26 | Bits:
 27 | .repeat N_COS, I
 28 |   .byte 1 << I
 29 | .endrepeat
 30 | 
 31 | XInit:
 32 | .repeat N_COS, I
 33 |   .byte Stack_End - Stack - 1 - (N_RAM_EACH * I)
 34 | .endrepeat
 35 | 
 36 | SPInit:
 37 | .repeat N_COS, I
 38 |   ; Reserve 4 bytes for the initial stack contents.
 39 |   .byte $FF - 4 - (N_RSTACK_EACH * I)
 40 | .endrepeat
 41 | 
 42 | CFSInit:
 43 | .repeat N_COS, I
 44 |   .byte ControlFlowStackEnd - ControlFlowStack - 1 - (N_CONTROL_FLOW_STACK * I)
 45 | .endrepeat
 46 | 
 47 | ; Yields the current coroutine execution
 48 | ; and resumes the next one.
 49 | ; If there are no other routines to resume, it's a no-op.
 50 | defword "yield", 0, YIELD
 51 | 
 52 |   ; Save current register values
 53 |   ldy CurrentCo
 54 |   stx XSave, y
 55 |   tsx
 56 |   stx SPSave, y
 57 |   lda ControlFlowSP
 58 |   sta CFSSave, y
 59 | 
 60 |   ; If there are no active coroutines, then do nothing.
 61 |   lda ActiveCos
 62 |   beq @none
 63 | 
 64 |   ; Check the coroutines until we find the next active one.
 65 | : iny
 66 |   tya
 67 |   and #N_COS-1
 68 |   tay
 69 | 
 70 |   lda Bits, y
 71 |   and ActiveCos
 72 |   beq :-
 73 | 
 74 |   sty CurrentCo
 75 | 
 76 |   lda CFSSave, y
 77 |   sta ControlFlowSP
 78 |   ldx SPSave, y
 79 |   txs
 80 |   ldx XSave, y
 81 | 
 82 | @none:
 83 |   rts
 84 | 
 85 | ; Given an execution token on the stack,
 86 | ; puts the coroutine in the next empty slot.
 87 | ; It will be start when it reaches its turn.
 88 | ; ( xt -- coroutine-id )
 89 | defword "co-start", 0, CO_START
 90 | 
 91 |   ldy CurrentCo
 92 | 
 93 |   ; Find the next inactive coroutine slot.
 94 | : iny
 95 |   tya
 96 |   and #N_COS-1
 97 |   tay
 98 |   
 99 |   lda Bits, y 
100 |   and ActiveCos
101 |   bne :-
102 | 
103 |   ; Mark this coroutine as active
104 |   lda ActiveCos
105 |   ora Bits, y
106 |   sta ActiveCos
107 | 
108 |   ; Set the values to restore
109 |   lda XInit, y
110 |   sta XSave, y
111 | 
112 |   lda CFSInit, y
113 |   sta CFSSave, y
114 | 
115 |   lda SPInit, y
116 |   sta SPSave, y
117 | 
118 |   sty TMP1
119 | 
120 |   tay ; initialize the return
121 |       ; stack with co-exit and the execution token,
122 |       ; so that the routine will start right away.
123 |   lda #>(CO_EXIT - 1)
124 |   sta $104, y
125 |   lda #<(CO_EXIT - 1)
126 |   sta $103, y
127 | 
128 |   ; Decrement xt on stack, since rts returns to addr+1
129 |   lda Stack, x
130 |   bne :+
131 |   dec Stack+1, x
132 | : dec Stack, x
133 | 
134 |   ; Put xt on return stack
135 |   lda Stack+1, x
136 |   sta $102, y
137 |   lda Stack, x
138 |   sta $101, y
139 | 
140 |   ; Put the coroutine number of the stack.
141 |   lda TMP1
142 |   sta Stack, x
143 |   lda #0
144 |   sta Stack+1, x
145 | 
146 |   rts
147 | 
148 | ; Exits the current coroutine, and marks it
149 | ; as inactive.
150 | defword "co-exit", 0, CO_EXIT
151 |   ldy CurrentCo
152 |   lda Bits, y
153 |   eor #$FF
154 |   and ActiveCos
155 |   sta ActiveCos
156 |   jmp YIELD
157 | 
158 | ; Transfers val to the top of stack of the coroutine.
159 | ; ( val coroutine-id -- )
160 | defword ">co", 0, TO_CO
161 |   ; Get val from stack
162 |   lda Stack+2, x
163 |   sta TMP1
164 |   lda Stack+3, x
165 |   sta TMP2
166 | 
167 |   ; Get coroutine ID from the stack, save original stack pointer
168 |   lda Stack, x
169 |   tay
170 |   lda XSave, y
171 |   stx TMP3
172 |   tax
173 | 
174 |     ; Now x is the other routine's data stack pointer.
175 |     ; Push the value there.
176 |     dex
177 |     dex
178 |     lda TMP1
179 |     sta Stack, x
180 |     lda TMP2
181 |     sta Stack+1, x
182 | 
183 |     stx XSave, y
184 | 
185 |     ; Restore our stack pointer
186 |     lda TMP3
187 |     clc
188 |     adc #4 ; deallocate the 2 values
189 |   tax
190 |   rts
191 | 


--------------------------------------------------------------------------------
/disassembler.s:
--------------------------------------------------------------------------------
  1 | ; This file has a simple assembler and disassembler
  2 | ; for 6502 code.
  3 | ;
  4 | ; The assembler words are the standard 6502 mnemonics
  5 | ; in all uppercase, and are available from Forth.
  6 | ; A tail like `.ZX` defines the addressing mode of the
  7 | ; instruction.
  8 | ; There are 139 instructions, so it would take a lot
  9 | ; of space to include all of them in the dictionary. Instead,
 10 | ; there's a table with 16 bits for each instruction, enough
 11 | ; information to identify the instruction name and addressing
 12 | ; mode.
 13 | 
 14 | .segment "TMP_CODE"
 15 | 
 16 | .macpack generic
 17 | .include "forth.inc"
 18 | .import DUP, FETCH, CFETCH, INCR, SWAP, DOT, DODOTQUOTE, RFIND, ASM
 19 | .importzp Stack, TMP1, TMP2, TMP3, TMP4
 20 | 
 21 | ; To save space, the 3 letters and addressing mode of the
 22 | ; instruction are stored in 4-bits each.
 23 | ; Turns out we can almost fit all of the letters with
 24 | ; just 16 possiblitiies for each one. (See below for the
 25 | ; exceptions).
 26 | 
 27 | ; See http://www.obelisk.me.uk/6502/addressing.html for an explanation
 28 | ; of the different addressing modes.
 29 | .enum mode
 30 |   impl = 0 ; no args
 31 |   acc = $10 ; accumulator is arg, used for modifying instructions which can take A.
 32 |   
 33 |   ; 1 byte arg
 34 |   imm = $20  ; immediate mode
 35 |   rel = $30  ; relative mode, used by branch instructions
 36 |   indx = $40 ; (indirect, x) addressing mode
 37 |   indy = $50 ; (indirect), y addressing mode
 38 |   zpg = $60  ; zero page
 39 |   zpgx = $70 ; zero page, x 
 40 |   zpgy = $80 ; zero page, y
 41 | 
 42 |   ; 2 byte arg
 43 |   ind = $90  ; (indirect), only used by jmp (indirect)
 44 |   abs = $A0  ; absolute
 45 |   absx = $B0 ; absolute, x
 46 |   absy = $C0 ; absolute, y
 47 | .endenum
 48 | 
 49 | ; Letters used in the instruction names.
 50 | ; Checking all of the instruction names, these
 51 | ; are the letters that can appear in each position
 52 | ; of the name (with some exceptions).
 53 | ;
 54 | ; FirstLetter:  .byte "ABCDEIJLNOPRSTxx"
 55 | ; SecondLetter: .byte "ABCDEHILMNOPRSTV"
 56 | ; ThirdLetter:  .byte "ACDEIKLPQRSTVXYx"
 57 | 
 58 | ; By re-arranging the letters, we can overlap the lists and save space:
 59 | SecondLetter:
 60 |   .byte "HMV" ; only second
 61 | FirstLetter:
 62 |   ; Overlap of first and second
 63 |   .byte "BNO"
 64 | ThirdLetter:
 65 |   ; Overlap of all 3
 66 |   .byte "ACDEILPRST"
 67 |   ; Overlap of first and third
 68 |   .byte "JKQ"
 69 |   ; Only third
 70 |   .byte "VXY"
 71 | 
 72 | ; The resulting lists look like this:
 73 | ; FirstLetter:  .byte "BNOACDEILPRSTJKQ"
 74 | ; SecondLetter: .byte "HMVBNOACDEILPRST"
 75 | ; ThirdLetter:  .byte "ACDEILPRSTJKQVXY"
 76 | 
 77 | ; Enum for first letter in an instruction
 78 | .enum l1
 79 |   B
 80 |   N
 81 |   O
 82 |   A_
 83 |   C
 84 |   D
 85 |   E
 86 |   I
 87 |   L
 88 |   P
 89 |   R
 90 |   S
 91 |   T
 92 |   J
 93 |   K_unused
 94 |   Q_unused
 95 | .endenum
 96 | 
 97 | ; Enum for second letter in an instruction
 98 | ; (Store in high nybble)
 99 | .enum l2
100 |   H = $00
101 |   M = $10
102 |   V = $20
103 |   B = $30
104 |   N = $40
105 |   O = $50
106 |   A_= $60
107 |   C = $70
108 |   D = $80
109 |   E = $90
110 |   I = $A0
111 |   L = $B0
112 |   P = $C0
113 |   R = $D0
114 |   S = $E0
115 |   T = $F0
116 | .endenum
117 | 
118 | ; Enum for third letter in an instruction
119 | .enum l3
120 |   A_
121 |   C
122 |   D
123 |   E
124 |   I
125 |   L
126 |   P
127 |   R
128 |   S
129 |   T
130 |   J_unused
131 |   K
132 |   Q
133 |   V
134 |   X_
135 |   Y_
136 | .endenum
137 | message: .byte "(.')", $0A, ".byte ", $22, $0
138 | 
139 | ; Handles disassembly of DODOTQUOTE, which takes
140 | ; its argument inline after the jsr DOTQUOTE
141 | PrintString:
142 |   inx
143 |   inx
144 |   ldy #0
145 | @loop:
146 |   lda message, y
147 |   bze @done
148 |   sta IO_PORT
149 |   iny
150 |   bne @loop
151 | @done:
152 |   lda Stack, x
153 |   sta TMP1
154 |   lda Stack+1, x
155 |   sta TMP2
156 |   ldy #0
157 | @loop2:
158 |   lda (TMP1), y
159 |   bze @done2
160 |   sta IO_PORT
161 |   iny
162 |   bne @loop2
163 | @done2:
164 |   lda #'"'
165 |   sta IO_PORT
166 |   sty TMP1
167 |   sec
168 |   lda Stack, x
169 |   adc TMP1
170 |   sta Stack, x
171 |   lda Stack+1, x
172 |   adc #0
173 |   sta Stack+1, x
174 |   rts
175 | 
176 | ; Prints the argument with the IP at the top of the stack,
177 | ; and a as the addressing mode, and returns the new IP.
178 | PrintArg:
179 |   cmp #$1
180 |   ble @return ; no arg implied or accumulator instruction
181 |   pha
182 |     jsr DUP
183 |   pla
184 |   cmp #$9
185 |   bge @two ; modes >= $9 are two byte modes. 
186 | @one:
187 |   jsr INCR
188 |   jsr SWAP
189 |   jsr CFETCH
190 |   jmp DOT ; print one byte
191 | @two:
192 |   jsr INCR
193 |   jsr INCR
194 |   jsr SWAP
195 |   jsr FETCH
196 |   ; If the address is DOODOTQUOTE, then this is probably
197 |   ; a JSR DODOTQUOTE call, so we should check the string
198 |   ; that comes after it.
199 |   lda Stack, x
200 |   cmp #<DODOTQUOTE
201 |   bne :+
202 |   lda Stack+1, x
203 |   cmp #>DODOTQUOTE
204 |   bne :+
205 |   jmp PrintString
206 | :
207 |   jsr RFIND
208 |   lda Stack, x
209 |   ora Stack+1, x
210 |   beq @notInDict
211 |   lda Stack+2, x
212 |   sta TMP1
213 |   lda Stack+3, x
214 |   sta TMP2
215 |   lda Stack, x
216 |   sta TMP3 ; save length in TMP3
217 |   ldy #0
218 | @nameLoop:
219 |   lda (TMP1), y
220 |   sta IO_PORT
221 |   iny
222 |   cpy TMP3
223 |   bne @nameLoop
224 |   inx
225 |   inx
226 |   inx
227 |   inx
228 |   rts
229 | @notInDict:
230 |   inx ; drop the zero length 
231 |   inx
232 |   jmp DOT ; print just the bytes.
233 |   
234 | @return:
235 |   rts
236 | 
237 | ; A lookup table for the ascii values of the
238 | ; l1, l2, and l3 enums.
239 | LetterIndicesLo:
240 |   .byte <FirstLetter, <SecondLetter, <ThirdLetter
241 | LetterIndicesHi:
242 |   .byte >FirstLetter, >SecondLetter, >ThirdLetter
243 | 
244 | ; Given a zero-terminated string address in TMP1-2, parses the string as
245 | ; an instruction, returning the number of bytes of it takes up and the
246 | ; instruction number on the stack. Returns 0 on the stack if the instruction
247 | ; was not found.
248 | .export ParseInstruction
249 | ParseInstruction:
250 |   ldy #0
251 | @instructionLoop:
252 |   lda LetterIndicesLo, y
253 |   sta TMP3
254 |   lda LetterIndicesHi, y
255 |   sta TMP4
256 |   tya
257 |   pha
258 |     lda (TMP1), y
259 |     bze @badLetter
260 |     jsr ParseLetter
261 |     bmi @badLetter
262 |     dex
263 |     sty Stack, x ; temporarily save on stack.
264 |   pla
265 |   tay
266 |   iny
267 |   cpy #3
268 |   bne @instructionLoop
269 | 
270 |   ; now the three bytes on the stack are the three letter indices.
271 |   lda (TMP1), y
272 |   beq @noTail
273 |   cmp #'.'
274 |   bne @notDot
275 |   iny
276 |   lda (TMP1), y ; get first letter of tail
277 |   dex
278 |   sta Stack, x ; store on stack
279 |   iny
280 |   lda (TMP1), y ; get second letter of tail
281 |   dex
282 |   sta Stack, x ; store on stack
283 | 
284 | @findMode:
285 |   ldy #0
286 | @findModeLoop:
287 |   lda ModeBeg2, y
288 |   cmp Stack, x
289 |   bne :+
290 |     lda ModeBeg, y
291 |     cmp Stack+1, x
292 |     bne :+
293 |     sty Stack+1, x
294 |     inx ; put mode number on the stack.
295 |     bne @foundAll ; bra
296 |   :
297 |   iny
298 |   cpy #13
299 |   bne @findModeLoop ; bra
300 | @badMode:
301 |   lda #5
302 |   pha
303 |   ; fall-through
304 | @badLetter:
305 |   pla ; get saved y value.
306 |   tay
307 |   ; discard stack values.
308 |   cpy #0
309 |   beq @discardDone
310 | @discardLoop:
311 |   inx
312 |   dey
313 |   bne @discardLoop
314 | @discardDone:
315 | @notDot:
316 |   lda #0
317 |   dex
318 |   dex
319 |   sta Stack, x
320 |   sta Stack+1, x
321 |   rts
322 | @noTail:
323 |   ; The three bytes bytes on the stack represent the letter indices,
324 |   ; and the mode is either implied, relative, or absolute (these modes
325 |   ; have no tail).
326 |   dex
327 |   lda #0
328 |   sta Stack, x
329 |   jsr CompactStack
330 | 
331 |   ldy #0
332 | @noTailLoop:
333 |   lda Instructions, y
334 |   cmp Stack+1, x
335 |   bne :+
336 |     lda Instructions_end, y
337 |     and #$F0
338 |     cmp #mode::impl
339 |     beq @ok
340 |     cmp #mode::rel
341 |     beq @ok
342 |     cmp #mode::abs
343 |     beq @ok
344 |     bne :+
345 |   @ok:
346 |     lda Instructions_end, y
347 |     and #$F
348 |     cmp Stack, x
349 |     bne :+
350 |     ; Found the instruction!
351 |     beq @success
352 |   :
353 |   iny
354 |   cpy #192
355 |   bne @noTailLoop
356 | @pushError:
357 |   lda #0
358 |   sta Stack, x
359 |   sta Stack+1, x
360 |   rts
361 | 
362 | @foundAll:
363 |   ; The four bytes on the stack represent the letter indices
364 |   ; and the mode.
365 |   jsr CompactStack
366 |   ldy #0
367 | @foundAllLoop:
368 |   lda Instructions, y
369 |   cmp Stack+1, x
370 |   bne :+
371 |     lda Instructions_end, y
372 |     cmp Stack, x
373 |     bne :+
374 |     ; Found the instruction!
375 |     beq @success
376 |   :
377 |   iny
378 |   cpy #192
379 |   bne @foundAllLoop
380 |   beq @pushError
381 | 
382 | @success:
383 |   ; y is the instruction.
384 |   sty Stack, x
385 |   lda #0
386 |   sta Stack+1, x
387 | 
388 |   dex
389 |   dex
390 |   lda #0
391 |   sta Stack+1, x
392 |   lda Instructions_end, y
393 |   lsr
394 |   lsr
395 |   lsr
396 |   lsr
397 |   cmp #1
398 |   ble @one
399 |   cmp #9
400 |   bge @three
401 | @two:
402 |   lda #2
403 |   sta Stack, x
404 |   rts
405 | @one:
406 |   lda #1
407 |   sta Stack, x
408 |   rts
409 | @three:
410 |   lda #3
411 |   sta Stack, x
412 |   rts
413 | 
414 | CompactStack:
415 |   ; Given four bytes on the stack are l1 l2 l3 m.
416 |   ; Compact it to two bytes as 21 m3, one nibble
417 |   ; for each.
418 |   lda Stack+2, x
419 |   asl
420 |   asl
421 |   asl
422 |   asl
423 |   ora Stack+3, x
424 |   sta Stack+3, x
425 | 
426 |   lda Stack, x
427 |   asl
428 |   asl
429 |   asl
430 |   asl
431 |   ora Stack+1, x
432 |   sta Stack+2, x
433 |   inx
434 |   inx
435 |   rts
436 | 
437 | Illegal:
438 |   lda #'*'
439 |   sta IO_PORT ; print *
440 |   jsr DOT
441 |   lda #$0A ; '\n'
442 |   sta IO_PORT
443 |   rts
444 | 
445 | ; Given a pointer to a list of up to 16 letters in TMP3-4,
446 | ; and a letter in A, returns the index of the letter in y.
447 | ; If not found, returns -1
448 | ParseLetter:
449 |   ldy #0
450 | @loop:
451 |   cmp (TMP3), y
452 |   beq @found
453 |   iny
454 |   cpy #16
455 |   bne @loop
456 |   ldy #$FF
457 | @found:
458 |   rts
459 | 
460 | ; After printing the instruction,
461 | ; print these characters, based on the mode.
462 | ; A zero means to print nothing.
463 | ; If the first character is non-zero, print a '.' to
464 | ; separate the mode from the instruction.
465 | ModeBeg:
466 |   .byte 0, 'A', '#', 0, 'X', 'I', 'Z', 'Z', 'Z', 'I', 0, 'X', 'Y' 
467 | 
468 | ModeBeg2:
469 |   .byte 0, 0,    0,  0, 'I', 'Y', 0,   'X', 'Y', 0,   0, 0,   0 
470 | 
471 | 
472 | ; Given an address, prints that instruction and then
473 | ; returns the address of the next instruction.
474 | .export Instruction
475 | Instruction:
476 |   jsr DUP
477 |   jsr INCR
478 |   jsr SWAP
479 |   jsr CFETCH ; get the instruction byte
480 |   lda Stack, x
481 |   and #%11
482 |   cmp #%11
483 |   ; All instructions which end in %11 are illegal
484 |   beq Illegal
485 | 
486 |   ; We can only have 16 different second letters, so
487 |   ; add special cases for txa:$8A txs:$9A tya:$98
488 |   ; so we eliminate X and Y as possible second letters.
489 |   lda Stack, x
490 |   ldy #0
491 |   cmp #$8A
492 |   beq @special_txa
493 |   cmp #$9A
494 |   beq @special_txs
495 |   cmp #$98
496 |   beq @special_tya
497 |   lsr
498 |   lsr
499 |   eor #$FF
500 |   sec
501 |   adc Stack, x ; Calculate ins - ins/4, because we ignore all %11 instructions
502 |   tay
503 |   lda Instructions_end, y ; get the last letter and addressing mode
504 |   pha ; save them
505 |     lda Instructions, y ; get the first two letters
506 |     pha ; save them
507 |       and #$F ; mask to get the first letter
508 |       tay
509 |       lda FirstLetter, y
510 |       sta IO_PORT
511 |     pla ; get the first two letters again
512 |     lsr
513 |     lsr
514 |     lsr
515 |     lsr
516 |     tay
517 |     lda SecondLetter, y
518 |     sta IO_PORT
519 |   pla
520 |   pha ; retrieve last letter and addressing mode
521 |     and #$F ; mask to get the last letter
522 |     tay
523 |     lda ThirdLetter, y
524 |     sta IO_PORT
525 |   pla
526 |   lsr
527 |   lsr
528 |   lsr
529 |   lsr
530 |   tay ; a is now the mode number
531 |   lda ModeBeg, y
532 |   beq :+
533 |     pha
534 |     lda #'.'
535 |     sta IO_PORT
536 |     pla
537 |     sta IO_PORT
538 |   :
539 |   lda ModeBeg2, y
540 |   beq :+
541 |     sta IO_PORT
542 |   :
543 |   lda #' '
544 |   sta IO_PORT
545 |   tya
546 |   pha
547 |     inx
548 |     inx ; drop the instruction, leaving the address of the next byte.
549 |     jsr PrintArg
550 |   pla
551 |   @newlineAndReturn:
552 |   lda #$0A ; '\n'
553 |   sta IO_PORT
554 |   rts
555 | 
556 | @special_txa:
557 |   iny
558 | @special_tya:
559 |   iny
560 | @special_txs:
561 |   ; now y is 0 for txs, 1 for tya, and 2 for txa.
562 |   lda #'T'
563 |   sta IO_PORT
564 |   lda @special2, y
565 |   sta IO_PORT
566 |   lda @special3, y
567 |   sta IO_PORT
568 |   bne @newlineAndReturn ; bra
569 | 
570 | @special2:
571 |   .byte "XYX"
572 | @special3:
573 |   .byte "SAA"
574 | 
575 | ; The first two letters of each instruction,
576 | ; stored as a nibble each.
577 | ; Illegal instructions are represented as
578 | ; EEE because E was already present as a possible
579 | ; letter in all three positions.
580 | ; Each instruction with byte b is stored at
581 | ; index b - floor(b/4). This is because we
582 | ; skip all instructions that end with the bits
583 | ; 11, which are all illegal.
584 | Instructions:
585 | .byte l1::B|l2::R,  l1::O|l2::R,  l1::E|l2::E
586 | .byte l1::E|l2::E,  l1::O|l2::R,  l1::A_|l2::S
587 | .byte l1::P|l2::H,  l1::O|l2::R,  l1::A_|l2::S
588 | .byte l1::E|l2::E,  l1::O|l2::R,  l1::A_|l2::S
589 | .byte l1::B|l2::P,  l1::O|l2::R,  l1::E|l2::E
590 | .byte l1::E|l2::E,  l1::O|l2::R,  l1::A_|l2::S
591 | .byte l1::C|l2::L,  l1::O|l2::R,  l1::E|l2::E
592 | .byte l1::E|l2::E,  l1::O|l2::R,  l1::A_|l2::S
593 | .byte l1::J|l2::S,  l1::A_|l2::N, l1::E|l2::E
594 | .byte l1::B|l2::I,  l1::A_|l2::N, l1::R|l2::O
595 | .byte l1::P|l2::L,  l1::A_|l2::N, l1::R|l2::O
596 | .byte l1::B|l2::I,  l1::A_|l2::N, l1::R|l2::O
597 | .byte l1::B|l2::M,  l1::A_|l2::N, l1::E|l2::E
598 | .byte l1::E|l2::E,  l1::A_|l2::N, l1::R|l2::O
599 | .byte l1::S|l2::E,  l1::A_|l2::N, l1::E|l2::E
600 | .byte l1::E|l2::E,  l1::A_|l2::N, l1::R|l2::O
601 | .byte l1::R|l2::T,  l1::E|l2::O,  l1::E|l2::E
602 | .byte l1::E|l2::E,  l1::E|l2::O,  l1::L|l2::S
603 | .byte l1::P|l2::H,  l1::E|l2::O,  l1::L|l2::S
604 | .byte l1::J|l2::M,  l1::E|l2::O,  l1::L|l2::S
605 | .byte l1::B|l2::V,  l1::E|l2::O,  l1::E|l2::E
606 | .byte l1::E|l2::E,  l1::E|l2::O,  l1::L|l2::S
607 | .byte l1::C|l2::L,  l1::E|l2::O,  l1::E|l2::E
608 | .byte l1::E|l2::E,  l1::E|l2::O,  l1::L|l2::S
609 | .byte l1::R|l2::T,  l1::A_|l2::D, l1::E|l2::E
610 | .byte l1::E|l2::E,  l1::A_|l2::D, l1::R|l2::O
611 | .byte l1::P|l2::L,  l1::A_|l2::D, l1::R|l2::O
612 | .byte l1::J|l2::M,  l1::A_|l2::D, l1::R|l2::O
613 | .byte l1::B|l2::V,  l1::A_|l2::D, l1::E|l2::E
614 | .byte l1::E|l2::E,  l1::A_|l2::D, l1::R|l2::O
615 | .byte l1::S|l2::E,  l1::A_|l2::D, l1::E|l2::E
616 | .byte l1::E|l2::E,  l1::A_|l2::D, l1::R|l2::O
617 | .byte l1::E|l2::E,  l1::S|l2::T,  l1::E|l2::E
618 | .byte l1::S|l2::T,  l1::S|l2::T,  l1::S|l2::T
619 | .byte l1::D|l2::E,  l1::E|l2::E,  l1::E|l2::E
620 | .byte l1::S|l2::T,  l1::S|l2::T,  l1::S|l2::T
621 | .byte l1::B|l2::C,  l1::S|l2::T,  l1::E|l2::E
622 | .byte l1::S|l2::T,  l1::S|l2::T,  l1::S|l2::T
623 | .byte l1::E|l2::E,  l1::S|l2::T,  l1::E|l2::E
624 | .byte l1::E|l2::E,  l1::S|l2::T,  l1::E|l2::E
625 | .byte l1::L|l2::D,  l1::L|l2::D,  l1::L|l2::D
626 | .byte l1::L|l2::D,  l1::L|l2::D,  l1::L|l2::D
627 | .byte l1::T|l2::A_, l1::L|l2::D,  l1::T|l2::A_
628 | .byte l1::L|l2::D,  l1::L|l2::D,  l1::L|l2::D
629 | .byte l1::B|l2::C,  l1::L|l2::D,  l1::E|l2::E
630 | .byte l1::L|l2::D,  l1::L|l2::D,  l1::L|l2::D
631 | .byte l1::C|l2::L,  l1::L|l2::D,  l1::T|l2::S
632 | .byte l1::L|l2::D,  l1::L|l2::D,  l1::L|l2::D
633 | .byte l1::C|l2::P,  l1::C|l2::M,  l1::E|l2::E
634 | .byte l1::C|l2::P,  l1::C|l2::M,  l1::D|l2::E
635 | .byte l1::I|l2::N,  l1::C|l2::M,  l1::D|l2::E
636 | .byte l1::C|l2::P,  l1::C|l2::M,  l1::D|l2::E
637 | .byte l1::B|l2::N,  l1::C|l2::M,  l1::E|l2::E
638 | .byte l1::E|l2::E,  l1::C|l2::M,  l1::D|l2::E
639 | .byte l1::C|l2::L,  l1::C|l2::M,  l1::E|l2::E
640 | .byte l1::E|l2::E,  l1::C|l2::M,  l1::D|l2::E
641 | .byte l1::C|l2::P,  l1::S|l2::B,  l1::E|l2::E
642 | .byte l1::C|l2::P,  l1::S|l2::B,  l1::I|l2::N
643 | .byte l1::I|l2::N,  l1::S|l2::B,  l1::N|l2::O
644 | .byte l1::C|l2::P,  l1::S|l2::B,  l1::I|l2::N
645 | .byte l1::B|l2::E,  l1::S|l2::B,  l1::E|l2::E
646 | .byte l1::E|l2::E,  l1::S|l2::B,  l1::I|l2::N
647 | .byte l1::S|l2::E,  l1::S|l2::B,  l1::E|l2::E
648 | .byte l1::E|l2::E,  l1::S|l2::B,  l1::I|l2::N
649 | 
650 | ; The last letter and addressing mode of each instruction.
651 | ; Each instruction with byte b is stored at index
652 | ; b - floor(b/4)
653 | Instructions_end:    
654 | .byte l3::K|mode::imm,  l3::A_|mode::indx, l3::E|mode::impl
655 | .byte l3::E|mode::impl,  l3::A_|mode::zpg,  l3::L|mode::zpg
656 | .byte l3::P|mode::impl,  l3::A_|mode::imm,  l3::L|mode::impl
657 | .byte l3::E|mode::impl,  l3::A_|mode::abs,  l3::L|mode::abs
658 | .byte l3::L|mode::rel,   l3::A_|mode::indy, l3::E|mode::impl
659 | .byte l3::E|mode::impl,  l3::A_|mode::zpgx, l3::L|mode::zpgx
660 | .byte l3::C|mode::impl,  l3::A_|mode::absy, l3::E|mode::impl
661 | .byte l3::E|mode::impl,  l3::A_|mode::absx, l3::L|mode::absx
662 | .byte l3::R|mode::abs,   l3::D|mode::indx,  l3::E|mode::impl
663 | .byte l3::T|mode::zpg,   l3::D|mode::zpg,   l3::L|mode::zpg
664 | .byte l3::P|mode::impl,  l3::D|mode::imm,   l3::L|mode::impl
665 | .byte l3::T|mode::abs,   l3::D|mode::abs,   l3::L|mode::abs
666 | .byte l3::I|mode::rel,   l3::D|mode::indy,  l3::E|mode::impl
667 | .byte l3::E|mode::impl,  l3::D|mode::zpgx,  l3::L|mode::zpgx
668 | .byte l3::C|mode::impl,  l3::D|mode::absy,  l3::E|mode::impl
669 | .byte l3::E|mode::impl,  l3::D|mode::absx,  l3::L|mode::absx
670 | .byte l3::I|mode::impl,  l3::R|mode::indx,  l3::E|mode::impl
671 | .byte l3::E|mode::impl,  l3::R|mode::zpg,   l3::R|mode::zpg
672 | .byte l3::A_|mode::impl, l3::R|mode::imm,   l3::R|mode::acc
673 | .byte l3::P|mode::abs,   l3::R|mode::abs,   l3::R|mode::abs
674 | .byte l3::C|mode::rel,   l3::R|mode::indy,  l3::E|mode::impl
675 | .byte l3::E|mode::impl,  l3::R|mode::zpgx,  l3::R|mode::zpgx
676 | .byte l3::I|mode::impl,  l3::R|mode::absy,  l3::E|mode::impl
677 | .byte l3::E|mode::impl,  l3::R|mode::absx,  l3::R|mode::absx
678 | .byte l3::S|mode::impl,  l3::C|mode::indx,  l3::E|mode::impl
679 | .byte l3::E|mode::impl,  l3::C|mode::zpg,   l3::R|mode::zpg
680 | .byte l3::A_|mode::impl, l3::C|mode::imm,   l3::R|mode::impl
681 | .byte l3::P|mode::ind,   l3::C|mode::abs,   l3::R|mode::abs
682 | .byte l3::S|mode::rel,   l3::C|mode::indy,  l3::E|mode::impl
683 | .byte l3::E|mode::impl,  l3::C|mode::zpgx,  l3::R|mode::zpgx
684 | .byte l3::I|mode::impl,  l3::C|mode::absy,  l3::E|mode::impl
685 | .byte l3::E|mode::impl,  l3::C|mode::absx,  l3::R|mode::absx
686 | .byte l3::E|mode::impl,  l3::A_|mode::indx, l3::E|mode::impl
687 | .byte l3::Y_|mode::zpg,  l3::A_|mode::zpg,  l3::X_|mode::zpg
688 | .byte l3::Y_|mode::impl, l3::E|mode::impl,  l3::A_|mode::impl
689 | .byte l3::Y_|mode::abs,  l3::A_|mode::abs,  l3::X_|mode::abs
690 | .byte l3::C|mode::rel,   l3::A_|mode::indy, l3::E|mode::impl
691 | .byte l3::Y_|mode::zpgx, l3::A_|mode::zpgx, l3::X_|mode::zpgy
692 | .byte l3::A_|mode::impl, l3::A_|mode::absy, l3::S|mode::impl
693 | .byte l3::E|mode::impl,  l3::A_|mode::absx, l3::E|mode::impl
694 | .byte l3::Y_|mode::imm,  l3::A_|mode::indx, l3::X_|mode::imm
695 | .byte l3::Y_|mode::zpg,  l3::A_|mode::zpg,  l3::X_|mode::zpg
696 | .byte l3::Y_|mode::impl, l3::A_|mode::imm,  l3::X_|mode::impl
697 | .byte l3::Y_|mode::abs,  l3::A_|mode::abs,  l3::X_|mode::abs
698 | .byte l3::S|mode::rel,   l3::A_|mode::indy, l3::E|mode::impl
699 | .byte l3::Y_|mode::zpgx, l3::A_|mode::zpgx, l3::X_|mode::zpgy
700 | .byte l3::V|mode::impl,  l3::A_|mode::absy, l3::X_|mode::impl
701 | .byte l3::Y_|mode::absx, l3::A_|mode::absx, l3::X_|mode::absy
702 | .byte l3::Y_|mode::imm,  l3::P|mode::indx,  l3::E|mode::impl
703 | .byte l3::Y_|mode::zpg,  l3::P|mode::zpg,   l3::C|mode::zpg
704 | .byte l3::Y_|mode::impl, l3::P|mode::imm,   l3::X_|mode::impl
705 | .byte l3::Y_|mode::abs,  l3::P|mode::abs,   l3::C|mode::abs
706 | .byte l3::E|mode::rel,   l3::P|mode::indy,  l3::E|mode::impl
707 | .byte l3::E|mode::impl,  l3::P|mode::zpgx,  l3::C|mode::zpgx
708 | .byte l3::D|mode::impl,  l3::P|mode::absy,  l3::E|mode::impl
709 | .byte l3::E|mode::impl,  l3::P|mode::absx,  l3::C|mode::absx
710 | .byte l3::X_|mode::imm,  l3::C|mode::indx,  l3::E|mode::impl
711 | .byte l3::X_|mode::zpg,  l3::C|mode::zpg,   l3::C|mode::zpg
712 | .byte l3::X_|mode::impl, l3::C|mode::imm,   l3::P|mode::impl
713 | .byte l3::X_|mode::abs,  l3::C|mode::abs,   l3::C|mode::abs
714 | .byte l3::Q|mode::rel,   l3::C|mode::indy,  l3::E|mode::impl
715 | .byte l3::E|mode::impl,  l3::C|mode::zpgx,  l3::C|mode::zpgx
716 | .byte l3::D|mode::impl,  l3::C|mode::absy,  l3::E|mode::impl
717 | .byte l3::E|mode::impl,  l3::C|mode::absx,  l3::C|mode::absx
718 | 
719 | 


--------------------------------------------------------------------------------
/done.f:
--------------------------------------------------------------------------------
1 | done
2 | 


--------------------------------------------------------------------------------
/end.s:
--------------------------------------------------------------------------------
 1 | 
 2 | .include "forth.inc"
 3 | 
 4 | .segment "VARIABLES"
 5 | .export VHERE_PERM_INIT
 6 | VHERE_PERM_INIT:
 7 | 
 8 | .segment "TMP_VARIABLES"
 9 | .export VHERE_TMP_INIT
10 | VHERE_TMP_INIT:
11 | 
12 | ; A marker for the end of the dictionary. This must be linked last.
13 | defword "E", F_END, DICT_END
14 |   rts
15 | 
16 | .segment "DICT_CODE"
17 | .export CHERE_PERM_INIT
18 | CHERE_PERM_INIT:
19 | 
20 | defwordtmp "E", F_END, TMP_DICT_END
21 |   rts
22 | 
23 | .segment "TMP_DICT_CODE"
24 | .export CHERE_TMP_INIT
25 | CHERE_TMP_INIT:
26 | 


--------------------------------------------------------------------------------
/font.chr:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/RussellSprouts/ice-forth/e8ee101a70bc89f81fd47eb452f0fb56685c1f8d/font.chr


--------------------------------------------------------------------------------
/forth.inc:
--------------------------------------------------------------------------------
  1 | 
  2 | .ifndef __FORTH_INC__
  3 | .define __FORTH_INC__
  4 | 
  5 | ; The address of the IO port in the 6502 emulator
  6 | .global IO_PORT
  7 | 
  8 | ; Flags for the dictionary
  9 | .globalzp F_IMMED
 10 | .globalzp F_INLINE
 11 | .globalzp F_HIDDEN
 12 | .global F_END
 13 | .global F_SINGLE_BYTE
 14 | 
 15 | ; Temporary storage
 16 | .globalzp TMP1, TMP2, TMP3, TMP4, TMP5, TMP6, TMP7, TMP8
 17 | 
 18 | ; The data stack
 19 | .globalzp Stack, Stack_End
 20 | 
 21 | ; The control flow stack
 22 | .globalzp ControlFlowSP, ControlFlowStack, ControlFlowStackEnd
 23 | 
 24 | ; The return stack
 25 | .global RStack
 26 | 
 27 | .global DUP
 28 | 
 29 | ; Pushes the given value onto the stack.
 30 | .macro push val
 31 |   dex
 32 |   dex
 33 |   lda #<val
 34 |   sta Stack, x
 35 |   lda #>val
 36 |   sta Stack+1, x
 37 | .endmacro
 38 | 
 39 | ; Removes the top of stack.
 40 | .macro pop
 41 |   inx
 42 |   inx
 43 | .endmacro
 44 | 
 45 | .macro toTMP1
 46 |   lda Stack, x
 47 |   sta TMP1
 48 |   lda Stack+1, x
 49 |   sta TMP2
 50 | .endmacro
 51 | 
 52 | .macro toTMP3
 53 |   lda Stack, x
 54 |   sta TMP3
 55 |   lda Stack+1, x
 56 |   sta TMP4
 57 | .endmacro
 58 | 
 59 | .macro toTMP5
 60 |   lda Stack, x
 61 |   sta TMP5
 62 |   lda Stack+1, x
 63 |   sta TMP6
 64 | .endmacro
 65 | 
 66 | .macro fromTMP1
 67 |   lda TMP1
 68 |   sta Stack, x
 69 |   lda TMP2
 70 |   sta Stack+1, x
 71 | .endmacro
 72 | 
 73 | .macro cmpTopZero
 74 |   lda Stack, x
 75 |   ora Stack+1, x
 76 | .endmacro
 77 | 
 78 | ; The structure of a dictionary entry.
 79 | ;
 80 | ;  0                   1                   2
 81 | ;  0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3
 82 | ; +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
 83 | ; |  $4C (jmp)    |          code pointer         |
 84 | ; +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
 85 | ; |E|S| reserved  |I|H|N| length  | name...       |
 86 | ; +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
 87 | ;
 88 | ; code ptr - the start of the implementation code
 89 | ; length - the length of the name, in bytes
 90 | ; E - this is the last entry in the dictionary
 91 | ; S - this is a single byte `val`
 92 | ; I - this is an immediate word
 93 | ; H - this word is hidden
 94 | ; N - always inline this word
 95 | ; name - the name, in ASCII
 96 | ;
 97 | .struct DictEntry
 98 |   Jmp .byte
 99 |   CodePtr .word
100 |   Flags2 .byte
101 |   Len .byte
102 |   Name .byte
103 | .endstruct
104 | 
105 | ; Defines a dictionary entry
106 | ; dict - the dictionary segment to place the entry in
107 | ; dict_code - the code segment to place the implementation in
108 | ; name - the forth name of the word, as a string
109 | ; flags - the dictionary flags
110 | ; label - the label of the word to use in assembly code
111 | .macro defword_dict dict, dict_code, name, flags, label
112 |   .segment dict
113 |     label:
114 |     .export label
115 |     jmp .ident(.concat(.string(label), "_IMPL"))
116 |     ; length and name
117 |     .byte >flags
118 |     .byte .strlen(name) | <flags
119 |     .byte name
120 |   .segment dict_code
121 |     .ident(.concat(.string(label), "_IMPL")):
122 | .endmacro
123 | 
124 | ; Defines a dictionary entry in the permanent dictionary
125 | .macro defword name, flags, label
126 |   defword_dict "DICT", "DICT_CODE", name, flags, label
127 | .endmacro
128 | 
129 | ; Defines a dictionary entry in the temporary dictionary
130 | .macro defwordtmp name, flags, label
131 |   defword_dict "TMP_DICT", "TMP_DICT_CODE", name, flags, label
132 | .endmacro
133 | 
134 | ; Variables are a special kind of word which reserve
135 | ; two bytes of space in the VARIABLES segment, and when
136 | ; executed, push that address on the stack.
137 | .macro defvar_dict vars, name, init, label
138 |   defword name, 0, label
139 |     push .ident(.concat(.string(label), "_VALUE"))
140 |     rts
141 |   .segment vars
142 |   .ident(.concat(.string(label), "_VALUE")):
143 |   .word init
144 | .endmacro
145 | 
146 | .macro defvar name, init, label
147 |   defvar_dict "VARIABLES", name, init, label
148 | .endmacro
149 | 
150 | .macro defvartmp name, init, label
151 |   defvar_dict "TMP_VARIABLES", name, init, label
152 | .endmacro
153 | 
154 | ; A constant is a word which pushes its value onto the stack
155 | ; when it is executed.
156 | .macro defconst name, value, label
157 |   defword name, 0, label
158 |     push value
159 |     rts
160 | .endmacro
161 | 
162 | .macro defconsttmp name, value, label
163 |   defwordtmp name, 0, label
164 |     push value
165 |     rts
166 | .endmacro
167 | 
168 | ; A val is a word which pushes its value onto the
169 | ; stack when executed, like constants, but stores the
170 | ; value in RAM, allowing it to be changed.
171 | .macro defval name, init, label
172 |   defword name, 0, label
173 |     dex
174 |     dex
175 |     lda .ident(.concat(.string(label), "_VALUE"))
176 |     sta Stack, x
177 |     lda .ident(.concat(.string(label), "_VALUE")) + 1
178 |     sta Stack + 1, x
179 |     rts
180 |   .segment "VARIABLES"
181 |     .ident(.concat(.string(label), "_VALUE")):
182 |     .word init
183 | .endmacro
184 | 
185 | ; A c-val is a `val` that only has values between 0 and 255.
186 | .macro defcval name, init, label
187 |   defword name, F_SINGLE_BYTE, label
188 |     dex
189 |     dex
190 |     lda .ident(.concat(.string(label), "_VALUE"))
191 |     sta Stack, x
192 |     lda #0
193 |     sta Stack + 1, x
194 |     rts
195 |   .segment "VARIABLES"
196 |   .ident(.concat(.string(label), "_VALUE")):
197 |     .byte init
198 | .endmacro
199 | 
200 | .endif
201 | 


--------------------------------------------------------------------------------
/game.f:
--------------------------------------------------------------------------------
  1 | <perm> definitions:
  2 | 
  3 | hex
  4 | 
  5 | 0 val colors
  6 | 0 val addr
  7 | 
  8 | 0 c-val spr
  9 | 80 c-val Y
 10 | 
 11 | 20 val ballvx
 12 | 20 val ballvy
 13 | 500 val ballx
 14 | 800 val bally
 15 | 
 16 | ballx val oldballx
 17 | bally val oldbally
 18 | 
 19 | ( x y -- )
 20 | : draw| 
 21 |   [ char | literal ]
 22 |   0
 23 |   spr oam-spr to spr ;
 24 | 
 25 | ( x y -- )
 26 | : draw-paddle
 27 |   over over 8 +
 28 |   draw| draw|
 29 | ;
 30 | 
 31 | ( x y -- )
 32 | : draw-ball
 33 |   [ char . literal ] 0 spr oam-spr to spr 
 34 | ;
 35 | 
 36 | : frame
 37 |     0 to spr
 38 | 
 39 |     joy1 btnU and if
 40 |       Y 4 - to Y
 41 |     then
 42 |     joy1 btnD and if
 43 |       Y 4 + to Y
 44 |     then
 45 | 
 46 |     ballvx ballx + to ballx
 47 |     ballvy bally + to bally
 48 | 
 49 |     ballx asr asr asr asr
 50 |     dup 100 > if
 51 |       1000 to ballx
 52 |       ballvx negate to ballvx
 53 |     else dup 0 < if
 54 |       0 to ballx
 55 |       ballvx negate to ballvx
 56 |     then then
 57 | 
 58 |     bally asr asr asr asr
 59 |     dup E0 > if
 60 |       E00 to bally
 61 |       ballvy negate to ballvy
 62 |     else dup 0 < if
 63 |       0 to bally
 64 |       ballvy negate to ballvy
 65 |     then then
 66 |     draw-ball
 67 | 
 68 |     10 \ x
 69 |     Y \ y
 70 |     draw-paddle
 71 | 
 72 |     E0 10 draw-paddle
 73 | 
 74 |     ballx to oldballx
 75 |     bally to oldbally
 76 | 
 77 |     addr 1+ 1FFF and to addr
 78 | 
 79 |     vppu-mask 1F and
 80 |     colors asl asl asl asl asl or to vppu-mask
 81 |     
 82 |     vppu-mask
 83 |     [
 84 |       stack LDA.ZX
 85 |       FE AND.#
 86 |       2001 STA
 87 |     ]
 88 |     drop
 89 | ;
 90 | 
 91 | : init
 92 |   font 200 mv>ppu
 93 |   font 1200 mv>ppu
 94 |   19 to vppu-mask
 95 | ;
 96 | 
 97 | : done
 98 |   freeze \ stop emulation and write NES ROM
 99 |   wait-for-ppu
100 |   \ Disable all rendering
101 |   [ 0 LDA.#
102 |     2000 STA ]
103 |   init
104 |   \ Enable frame interrupts
105 |   [ 80 LDA.#
106 |     2000 STA ]
107 |   \ Loop forever and call the frame function each frame
108 |   begin
109 |     ppu-wait-nmi
110 |     frame
111 |   0 until
112 | ;
113 | 
114 | 0 15 pal-col!
115 | 1 16 pal-col!
116 | 2 30 pal-col!
117 | 3 31 pal-col!
118 | 4 pal-bright
119 | 80 to vppu-ctrl 


--------------------------------------------------------------------------------
/lit/.gitignore:
--------------------------------------------------------------------------------
1 | node_modules/
2 | 


--------------------------------------------------------------------------------
/lit/6502.cpp:
--------------------------------------------------------------------------------
 1 | #include "6502.h"
 2 | #include "stdint.h"
 3 | #include "stdio.h"
 4 | #include "stdbool.h"
 5 | #include <string>
 6 | #include <iostream>
 7 | #include <fstream>
 8 | #include <sstream>
 9 | #include <exception>
10 | 
11 | int main(int argc, char **argv) {
12 |   trace = false;
13 | 
14 |   initOpcodes();
15 | 
16 |   FILE *bootstrap = fopen("out/bootstrap.bin", "r");
17 |   if (!fread(&m.memory, 1, sizeof(m.memory), bootstrap)) {
18 |     printf("Couldn't open bootstrap.bin");
19 |     return 1;
20 |   }
21 | 
22 |   for (int i = 1; i < argc; i++) {
23 |     if (argv[i] == std::string("-b")) {
24 |       std::string binary = argv[i+1];
25 |       int splitPoint = binary.find(":");
26 |       std::string name = binary.substr(0, splitPoint);
27 |       std::string file = binary.substr(splitPoint+1);
28 |       std::ifstream in(file.c_str());
29 |       std::string fileContents(
30 |         (std::istreambuf_iterator<char>(in)),
31 |         std::istreambuf_iterator<char>());
32 |       std::stringstream ss;
33 |       ss << " " << std::hex << fileContents.size() << " heredoc " << name << " " << fileContents << " ";
34 |       lastLineInput += ss.str();
35 |       i++;
36 |     } else {
37 |       std::ifstream in(argv[i]);
38 |       std::string fileContents(
39 |         (std::istreambuf_iterator<char>(in)),
40 |         std::istreambuf_iterator<char>());
41 |       lastLineInput.append(fileContents);
42 |     }
43 |   }
44 | 
45 |   m.ip = m.memory[0xFFFC] + (m.memory[0xFFFD] << 8) - 1;
46 | 
47 |   while(emulate()) {
48 |     lastLineInput.clear();
49 |     std::getline(std::cin, lastLineInput);
50 |     lastLineInput += "\n";
51 |     lineIndex = 0;
52 |   }
53 | 
54 |   FILE *romout = fopen("out/game.nes", "w+");
55 |   FILE *ramout = fopen("out/ram.out", "w+");
56 | 
57 |   fwrite("NES\x1A\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", 1, 16, romout);
58 |   fwrite(&m.memory[0x8000], 1, 0x8000, romout);
59 | 
60 |   fwrite(&m.memory, 1, 0x800, ramout);
61 | }
62 | 
63 | 


--------------------------------------------------------------------------------
/lit/6502.h:
--------------------------------------------------------------------------------
  1 | #include "stdint.h"
  2 | #include "stdio.h"
  3 | #include "stdbool.h"
  4 | #include <string>
  5 | 
  6 | #define IO_PORT 0x401C
  7 | #define MEMORY_SIZE (64*1024)
  8 | 
  9 | typedef struct Machine {
 10 |   uint8_t a = 0;
 11 |   uint8_t x = 0;
 12 |   uint8_t y = 0;
 13 |   uint8_t sp = 0xFF;
 14 |   uint16_t ip = 0xFFFF;
 15 |   struct {
 16 |     bool n = false;
 17 |     bool v = false;
 18 |     bool z = false;
 19 |     bool s = false;
 20 |     bool c = false;
 21 |     bool d = false;
 22 |     bool i = false;
 23 |   } status;
 24 |   uint8_t memory[MEMORY_SIZE];
 25 | } Machine;
 26 | 
 27 | static Machine m;
 28 | static bool trace;
 29 | 
 30 | 
 31 | static std::string lastLineInput;
 32 | static size_t lineIndex = 0;
 33 | 
 34 | typedef struct OutOfInputException
 35 |   : public std::exception
 36 |   {} OutOfInputException;
 37 | 
 38 | static uint8_t nextChar() {
 39 |   if (lineIndex == lastLineInput.size()) {
 40 |     throw OutOfInputException();
 41 |   }
 42 |   uint8_t result = lastLineInput[lineIndex];
 43 |   lineIndex++;
 44 |   return result;
 45 | }
 46 | 
 47 | 
 48 | static uint8_t read(uint16_t addr) {
 49 |   if (addr == IO_PORT) {
 50 |     return nextChar();
 51 |   } else {
 52 |     return m.memory[addr];
 53 |   }
 54 | }
 55 | 
 56 | static void set(uint16_t addr, uint8_t val) {
 57 |   if (addr == IO_PORT) {
 58 |     putchar(val);
 59 |   } else {
 60 |     m.memory[addr] = val;
 61 |   }
 62 | }
 63 | static uint8_t pop() {
 64 |   m.sp = m.sp + 1;
 65 |   return read(0x100 + m.sp);
 66 | }
 67 | 
 68 | static uint16_t popAddr() {
 69 |   uint8_t lo = pop();
 70 |   uint16_t hi = pop() << 8;
 71 |   return hi + lo;
 72 | }
 73 | 
 74 | static void push(uint8_t val) {
 75 |   set(0x100 + m.sp, val);
 76 |   m.sp = m.sp - 1;
 77 | }
 78 | 
 79 | static void pushAddr(uint16_t addr) {
 80 |   push(addr >> 8);
 81 |   push(addr);
 82 | }
 83 | 
 84 | static uint8_t immediate() {
 85 |   m.ip = m.ip + 1;
 86 |   return read(m.ip);
 87 | }
 88 | 
 89 | // Gets the next two bytes from the instruction stream
 90 | // and returns them as a little-endian address.
 91 | static uint16_t absolute() {
 92 |   uint8_t low = immediate();
 93 |   uint16_t hi = immediate() << 8;
 94 |   return hi + low;
 95 | }
 96 | 
 97 | static uint8_t zeroPage() { return immediate(); }
 98 | static uint8_t zeroPageX() { return zeroPage() + m.x; }
 99 | static uint8_t zeroPageY() { return zeroPage() + m.y; }
100 | static uint16_t absoluteX() { return absolute() + m.x; }
101 | static uint16_t absoluteY() { return absolute() + m.y; }
102 | 
103 | static uint16_t indirect() {
104 |   uint16_t addr = absolute();
105 |   uint16_t addrPlus1 = addr + 1;
106 |   // adjust for jmp indirect bug
107 |   if ((addrPlus1 & 0xFF) == 0) {
108 |     addrPlus1 -= 0x100;
109 |   }
110 |   uint8_t low = read(addr);
111 |   uint16_t hi = read(addrPlus1) << 8;
112 |   return hi + low;
113 | }
114 | 
115 | static uint16_t indirectX() {
116 |   uint8_t zpAddr = zeroPageX();
117 |   uint8_t addrPlus1 = zpAddr + 1;
118 |   uint8_t low = read(zpAddr);
119 |   uint16_t hi = read(addrPlus1) << 8;
120 |   return hi + low;
121 | }
122 | 
123 | static uint16_t indirectY() {
124 |   uint8_t addr = zeroPage();
125 |   uint8_t addrPlus1 = addr + 1;
126 |   uint8_t low = read(addr);
127 |   uint16_t hi = read(addrPlus1) << 8;
128 |   return hi + low + m.y;
129 | }
130 | 
131 | static uint8_t setSZ(uint8_t val) {
132 |   m.status.n = val >= 0x80;
133 |   m.status.z = val == 0;
134 |   return val;
135 | }
136 | static void BIT(uint8_t read) {
137 |   m.status.z = m.a & read;
138 |   m.status.n = read & 0x80;
139 |   m.status.v = read & 0x40;
140 | }
141 | 
142 | static void LDA(uint8_t value) { m.a = setSZ(value); }
143 | static void LDX(uint8_t value) { m.x = setSZ(value); }
144 | static void LDY(uint8_t value) { m.y = setSZ(value); }
145 | static void INC(uint16_t addr) { set(addr, setSZ(read(addr) + 1)); }
146 | static void DEC(uint16_t addr) { set(addr, setSZ(read(addr) - 1)); }
147 | static void AND(uint8_t value) { m.a = setSZ(m.a & value); }
148 | static void ORA(uint8_t value) { m.a = setSZ(m.a | value); }
149 | static void EOR(uint8_t value) { m.a = setSZ(m.a ^ value); }
150 | 
151 | static void ASL_A() {
152 |   m.status.c = m.a >= 0x80;
153 |   m.a = setSZ(m.a << 1);
154 | }
155 | 
156 | static void ASL(uint16_t addr) {
157 |   uint8_t value = read(addr);
158 |   m.status.c = value >= 0x80;
159 |   set(addr, setSZ(value << 1));
160 | }
161 | 
162 | static void ROL_A() {
163 |   uint8_t c = m.status.c;
164 |   m.status.c = m.a >= 0x80;
165 |   m.a = setSZ((m.a << 1) + c);
166 | }
167 | 
168 | static void ROL(uint16_t addr) {
169 |   uint8_t value = read(addr);
170 |   uint8_t c = m.status.c;
171 |   m.status.c = value >= 0x80;
172 |   set(addr, setSZ((value << 1) + c));
173 | }
174 | 
175 | static void LSR_A() {
176 |   m.status.c = m.a & 1;
177 |   m.a = setSZ(m.a >> 1);
178 | }
179 | 
180 | static void LSR(uint16_t addr) {
181 |   uint8_t value = read(addr);
182 |   m.status.c = value & 1;
183 |   set(addr, setSZ(value >> 1));
184 | }
185 | 
186 | static void ROR_A() {
187 |   uint8_t c = m.status.c ? 0x80 : 0;
188 |   m.status.c = m.a & 1;
189 |   m.a = setSZ((m.a >> 1) + c);
190 | }
191 | 
192 | static void ROR(uint16_t addr) {
193 |   uint8_t value = read(addr);
194 |   uint8_t c = m.status.c ? 0x80 : 0;
195 |   m.status.c = value & 1;
196 |   set(addr, setSZ((value >> 1) + c));
197 | }
198 | 
199 | static void BRANCH(uint8_t condition) {
200 |   uint8_t disp = immediate();
201 |   if (condition) {
202 |     if (disp >= 0x80) {
203 |       m.ip = m.ip - 0x100;
204 |     }
205 |     m.ip = m.ip + disp;
206 |   }
207 | }
208 | 
209 | static void JMP(uint16_t addr) {
210 |   m.ip = addr - 1;
211 | }
212 | 
213 | static void ADC(uint8_t value) {
214 |   uint16_t newValue = m.a + value + m.status.c;
215 |   m.status.c = newValue > 0xFF;
216 |   m.status.v = !((m.a ^ value) & 0x80) && ((m.a ^ newValue) & 0x80);
217 |   m.a = setSZ((uint8_t)newValue);
218 | }
219 | 
220 | static void SBC(uint8_t value) { ADC(~value); }
221 | 
222 | static void CMP(uint8_t a, uint8_t b) {
223 |   uint8_t comparison = a - b;
224 |   m.status.z = comparison == 0;
225 |   m.status.c = a >= b;
226 |   m.status.n = comparison >= 0x80;
227 | }
228 | 
229 | static void SET_P(uint8_t a) {
230 |   m.status.n = a & 0x80;
231 |   m.status.v = a & 0x40;
232 |   m.status.d = a & 0x08;
233 |   m.status.i = a & 0x04;
234 |   m.status.z = a & 0x02;
235 |   m.status.c = a & 0x01;
236 | }
237 | 
238 | static uint8_t GET_P() {
239 |   return (m.status.n ? 0x80 : 0)
240 |     | (m.status.v ? 0x40 : 0)
241 |     | 0x20
242 |     | 0x10
243 |     | (m.status.d ? 0x08 : 0)
244 |     | (m.status.i ? 0x04 : 0)
245 |     | (m.status.z ? 0x02 : 0)
246 |     | (m.status.c ? 0x01 : 0);
247 | }
248 | 
249 | typedef struct Handler {
250 |   const char *name;
251 |   void (*handler)();
252 | } Handler;
253 | 
254 | static Handler opcodes[256] = { 0 };
255 | 
256 | void initOpcodes() {
257 |   // bit
258 |   opcodes[0x24] = {"BIT ZP", []{ BIT(read(zeroPage())); }};
259 |   opcodes[0x2C] = {"BIT ABS", []{ BIT(read(absolute())); }};
260 |   // lda
261 |   opcodes[0xA9] = {"LDA IMM", []{ LDA(immediate()); }};
262 |   opcodes[0xA5] = {"LDA ZP", []{ LDA(read(zeroPage())); }};
263 |   opcodes[0xB5] = {"LDA ZPX", []{ LDA(read(zeroPageX())); }};
264 |   opcodes[0xAD] = {"LDA ABS", []{ LDA(read(absolute())); }};
265 |   opcodes[0xBD] = {"LDA ABSX", []{ LDA(read(absoluteX())); }};
266 |   opcodes[0xB9] = {"LDA ABSY", []{ LDA(read(absoluteY())); }};
267 |   opcodes[0xA1] = {"LDA INDX", []{ LDA(read(indirectX())); }};
268 |   opcodes[0xB1] = {"LDA INDY", []{ LDA(read(indirectY())); }};
269 | 
270 |   opcodes[0x8A] = {"TXA", []{ LDA(m.x); }};
271 |   opcodes[0x98] = {"TYA", []{ LDA(m.y); }};
272 | 
273 |   // sta
274 |   opcodes[0x85] = {"STA", []{ set(zeroPage(), m.a); }};
275 |   opcodes[0x95] = {"STA", []{ set(zeroPageX(), m.a); }};
276 |   opcodes[0x8D] = {"STA", []{ set(absolute(), m.a); }};
277 |   opcodes[0x9D] = {"STA", []{ set(absoluteX(), m.a); }};
278 |   opcodes[0x99] = {"STA", []{ set(absoluteY(), m.a); }};
279 |   opcodes[0x81] = {"STA", []{ set(indirectX(), m.a); }};
280 |   opcodes[0x91] = {"STA", []{ set(indirectY(), m.a); }};
281 | 
282 |   // ldx
283 |   opcodes[0xA2] = {"LDX", []{ LDX(immediate()); }};
284 |   opcodes[0xA6] = {"LDX", []{ LDX(read(zeroPage())); }};
285 |   opcodes[0xB6] = {"LDX", []{ LDX(read(zeroPageY())); }};
286 |   opcodes[0xAE] = {"LDX", []{ LDX(read(absolute())); }};
287 |   opcodes[0xBE] = {"LDX", []{ LDX(read(absoluteY())); }};
288 |   opcodes[0xAA] = {"TAX", []{ LDX(m.a); }};
289 |   opcodes[0xCA] = {"DEX", []{ LDX(m.x - 1); }};
290 |   opcodes[0xE8] = {"INX", []{ LDX(m.x + 1); }};
291 |   opcodes[0xBA] = {"TSX", []{ LDX(m.sp); }};
292 | 
293 |   // stx
294 |   opcodes[0x86] = {"STX", []{ set(zeroPage(), m.x); }};
295 |   opcodes[0x96] = {"STX", []{ set(zeroPageY(), m.x); }};
296 |   opcodes[0x8E] = {"STX", []{ set(absolute(), m.x); }};
297 |   opcodes[0x9A] = {"TXS", []{ m.sp = m.x; }};
298 | 
299 |   // ldy
300 |   opcodes[0xA0] = {"LDY", []{ LDY(immediate()); }};
301 |   opcodes[0xA4] = {"LDY", []{ LDY(read(zeroPage())); }};
302 |   opcodes[0xB4] = {"LDY", []{ LDY(read(zeroPageX())); }};
303 |   opcodes[0xAC] = {"LDY", []{ LDY(read(absolute())); }};
304 |   opcodes[0xBC] = {"LDY", []{ LDY(read(absoluteX())); }};
305 | 
306 |   opcodes[0xA8] = {"TAY", []{ LDY(m.a); }};
307 |   opcodes[0x88] = {"DEY", []{ LDY(m.y - 1); }};
308 |   opcodes[0xC8] = {"INY", []{ LDY(m.y + 1); }};
309 | 
310 |   // sty
311 |   opcodes[0x84] = {"STY", []{ set(zeroPage(), m.y); }};
312 |   opcodes[0x94] = {"STY", []{ set(zeroPageX(), m.y); }};
313 |   opcodes[0x8C] = {"STY", []{ set(absolute(), m.y); }};
314 | 
315 |   // pha/pla
316 |   opcodes[0x48] = {"PHA", []{ push(m.a); }};
317 |   opcodes[0x68] = {"PLA", []{ LDA(pop()); }};
318 | 
319 |   opcodes[0x08] = {"PHP", []{ push(GET_P()); }};
320 |   opcodes[0x28] = {"PLP", []{ SET_P(pop()); }};
321 | 
322 |   // official and unofficial nops
323 |   opcodes[0x1A] = {"NOP1A", []{ }};
324 |   opcodes[0x3A] = {"NOP3A", []{ }};
325 |   opcodes[0x5A] = {"NOP5A", []{ }};
326 |   opcodes[0x7A] = {"NOP7A", []{ }};
327 |   opcodes[0xDA] = {"NOPDA", []{ }};
328 |   opcodes[0xEA] = {"NOP", []{ }};
329 |   opcodes[0xFA] = {"NOPFA", []{ }};
330 | 
331 |   opcodes[0x80] = {"NOP80 #", []{ immediate(); }};
332 |   opcodes[0x82] = {"NOP82 #", []{ immediate(); }};
333 |   opcodes[0x89] = {"NOP89 #", []{ immediate(); }};
334 |   opcodes[0xC2] = {"NOPC2 #", []{ immediate(); }};
335 |   opcodes[0xE2] = {"NOPE2 #", []{ immediate(); }};
336 | 
337 |   // inc
338 |   opcodes[0xE6] = {"INC", []{ INC(zeroPage()); }};
339 |   opcodes[0xF6] = {"INC", []{ INC(zeroPageX()); }};
340 |   opcodes[0xEE] = {"INC", []{ INC(absolute()); }};
341 |   opcodes[0xFE] = {"INC", []{ INC(absoluteX()); }};
342 | 
343 |   // dec
344 |   opcodes[0xC6] = {"DEC", []{ DEC(zeroPage()); }};
345 |   opcodes[0xD6] = {"DEC", []{ DEC(zeroPageX()); }};
346 |   opcodes[0xCE] = {"DEC", []{ DEC(absolute()); }};
347 |   opcodes[0xDE] = {"DEC", []{ DEC(absoluteX()); }};
348 | 
349 |   // jmp
350 |   opcodes[0x4C] = {"JMP", []{ JMP(absolute()); }};
351 |   opcodes[0x6C] = {"JMPI", []{ JMP(indirect()); }};
352 | 
353 |   // flag instructions
354 |   opcodes[0x18] = {"CLC", []{ m.status.c = 0; }};
355 |   opcodes[0x38] = {"SEC", []{ m.status.c = 1; }};
356 |   opcodes[0x58] = {"CLI", []{ m.status.i = 0; }};
357 |   opcodes[0x78] = {"SEI", []{ m.status.i = 1; }};
358 |   opcodes[0xB8] = {"CLV", []{ m.status.v = 0; }};
359 |   opcodes[0xD8] = {"CLC", []{ m.status.c = 0; }};
360 |   opcodes[0xF8] = {"SEC", []{ m.status.c = 1; }};
361 | 
362 |   // and
363 |   opcodes[0x29] = {"AND", []{ AND(immediate()); }};
364 |   opcodes[0x25] = {"AND", []{ AND(read(zeroPage())); }};
365 |   opcodes[0x35] = {"AND", []{ AND(read(zeroPageX())); }};
366 |   opcodes[0x2D] = {"AND", []{ AND(read(absolute())); }};
367 |   opcodes[0x3D] = {"AND", []{ AND(read(absoluteX())); }};
368 |   opcodes[0x39] = {"AND", []{ AND(read(absoluteY())); }};
369 |   opcodes[0x21] = {"AND", []{ AND(read(indirectX())); }};
370 |   opcodes[0x31] = {"AND", []{ AND(read(indirectY())); }};
371 | 
372 |   // ora
373 |   opcodes[0x09] = {"ORA", []{ ORA(immediate()); }};
374 |   opcodes[0x05] = {"ORA", []{ ORA(read(zeroPage())); }};
375 |   opcodes[0x15] = {"ORA", []{ ORA(read(zeroPageX())); }};
376 |   opcodes[0x0D] = {"ORA", []{ ORA(read(absolute())); }};
377 |   opcodes[0x1D] = {"ORA", []{ ORA(read(absoluteX())); }};
378 |   opcodes[0x19] = {"ORA", []{ ORA(read(absoluteY())); }};
379 |   opcodes[0x01] = {"ORA", []{ ORA(read(indirectX())); }};
380 |   opcodes[0x11] = {"ORA", []{ ORA(read(indirectY())); }};
381 | 
382 |   // eor
383 |   opcodes[0x49] = {"EOR", []{ EOR(immediate()); }};
384 |   opcodes[0x45] = {"EOR", []{ EOR(read(zeroPage())); }};
385 |   opcodes[0x55] = {"EOR", []{ EOR(read(zeroPageX())); }};
386 |   opcodes[0x4D] = {"EOR", []{ EOR(read(absolute())); }};
387 |   opcodes[0x5D] = {"EOR", []{ EOR(read(absoluteX())); }};
388 |   opcodes[0x59] = {"EOR", []{ EOR(read(absoluteY())); }};
389 |   opcodes[0x41] = {"EOR", []{ EOR(read(indirectX())); }};
390 |   opcodes[0x51] = {"EOR", []{ EOR(read(indirectY())); }};
391 | 
392 |   // asl
393 |   opcodes[0x0A] = {"ASL", []{ ASL_A(); }};
394 |   opcodes[0x06] = {"ASL", []{ ASL(zeroPage()); }};
395 |   opcodes[0x16] = {"ASL", []{ ASL(zeroPageX()); }};
396 |   opcodes[0x0E] = {"ASL", []{ ASL(absolute()); }};
397 |   opcodes[0x1E] = {"ASL", []{ ASL(absoluteX()); }};
398 | 
399 |   // lsr
400 |   opcodes[0x4A] = {"LSR", []{ LSR_A(); }};
401 |   opcodes[0x46] = {"LSR", []{ LSR(zeroPage()); }};
402 |   opcodes[0x56] = {"LSR", []{ LSR(zeroPageX()); }};
403 |   opcodes[0x4E] = {"LSR", []{ LSR(absolute()); }};
404 |   opcodes[0x5E] = {"LSR", []{ LSR(absoluteX()); }};
405 | 
406 |   // rol
407 |   opcodes[0x2A] = {"ROL", []{ ROL_A(); }};
408 |   opcodes[0x26] = {"ROL", []{ ROL(zeroPage()); }};
409 |   opcodes[0x36] = {"ROL", []{ ROL(zeroPageX()); }};
410 |   opcodes[0x2E] = {"ROL", []{ ROL(absolute()); }};
411 |   opcodes[0x3E] = {"ROL", []{ ROL(absoluteX()); }};
412 | 
413 |   // ror
414 |   opcodes[0x6A] = {"ROR", []{ ROR_A(); }};
415 |   opcodes[0x66] = {"ROR", []{ ROR(zeroPage()); }};
416 |   opcodes[0x76] = {"ROR", []{ ROR(zeroPageX()); }};
417 |   opcodes[0x6E] = {"ROR", []{ ROR(absolute()); }};
418 |   opcodes[0x7E] = {"ROR", []{ ROR(absoluteX()); }};
419 | 
420 |   // jsr/rts/rti
421 |   opcodes[0x20] = {"JSR", []{ pushAddr(m.ip + 2); JMP(absolute()); }};
422 |   opcodes[0x60] = {"RTS", []{ JMP(popAddr() + 1); }};
423 |   opcodes[0x40] = {"RTI", []{ SET_P(pop()); JMP(popAddr()); }};
424 | 
425 |   // branch
426 |   opcodes[0x10] = {"BPL", []{ BRANCH(!m.status.n); }};
427 |   opcodes[0x30] = {"BMI", []{ BRANCH(m.status.n); }};
428 |   opcodes[0x50] = {"BVC", []{ BRANCH(!m.status.v); }};
429 |   opcodes[0x70] = {"BVS", []{ BRANCH(m.status.v); }};
430 |   opcodes[0x90] = {"BCC", []{ BRANCH(!m.status.c); }};
431 |   opcodes[0xB0] = {"BCS", []{ BRANCH(m.status.c); }};
432 |   opcodes[0xD0] = {"BNE", []{ BRANCH(!m.status.z); }};
433 |   opcodes[0xF0] = {"BEQ", []{ BRANCH(m.status.z); }};
434 | 
435 |   opcodes[0x69] = {"ADC", []{ ADC(immediate()); }};
436 |   opcodes[0x65] = {"ADC", []{ ADC(read(zeroPage())); }};
437 |   opcodes[0x75] = {"ADC", []{ ADC(read(zeroPageX())); }};
438 |   opcodes[0x6D] = {"ADC", []{ ADC(read(absolute())); }};
439 |   opcodes[0x7D] = {"ADC", []{ ADC(read(absoluteX())); }};
440 |   opcodes[0x79] = {"ADC", []{ ADC(read(absoluteY())); }};
441 |   opcodes[0x61] = {"ADC", []{ ADC(read(indirectX())); }};
442 |   opcodes[0x71] = {"ADC", []{ ADC(read(indirectY())); }};
443 | 
444 |   opcodes[0xE9] = {"SBC", []{ SBC(immediate()); }};
445 |   opcodes[0xE5] = {"SBC", []{ SBC(read(zeroPage())); }};
446 |   opcodes[0xF5] = {"SBC", []{ SBC(read(zeroPageX())); }};
447 |   opcodes[0xED] = {"SBC", []{ SBC(read(absolute())); }};
448 |   opcodes[0xFD] = {"SBC", []{ SBC(read(absoluteX())); }};
449 |   opcodes[0xF9] = {"SBC", []{ SBC(read(absoluteY())); }};
450 |   opcodes[0xE1] = {"SBC", []{ SBC(read(indirectX())); }};
451 |   opcodes[0xF1] = {"SBC", []{ SBC(read(indirectY())); }};
452 | 
453 |   opcodes[0xC9] = {"CMP", []{ CMP(m.a, immediate()); }};
454 |   opcodes[0xC5] = {"CMP", []{ CMP(m.a, read(zeroPage())); }};
455 |   opcodes[0xD5] = {"CMP", []{ CMP(m.a, read(zeroPageX())); }};
456 |   opcodes[0xCD] = {"CMP", []{ CMP(m.a, read(absolute())); }};
457 |   opcodes[0xDD] = {"CMP", []{ CMP(m.a, read(absoluteX())); }};
458 |   opcodes[0xD9] = {"CMP", []{ CMP(m.a, read(absoluteY())); }};
459 |   opcodes[0xC1] = {"CMP", []{ CMP(m.a, read(indirectX())); }};
460 |   opcodes[0xD1] = {"CMP", []{ CMP(m.a, read(indirectY())); }};
461 | 
462 |   opcodes[0xE0] = {"CPX", []{ CMP(m.x, immediate()); }};
463 |   opcodes[0xE4] = {"CPX", []{ CMP(m.x, read(zeroPage())); }};
464 |   opcodes[0xEC] = {"CPX", []{ CMP(m.x, read(absolute())); }};
465 | 
466 |   opcodes[0xC0] = {"CPY", []{ CMP(m.y, immediate()); }};
467 |   opcodes[0xC4] = {"CPY", []{ CMP(m.y, read(zeroPage())); }};
468 |   opcodes[0xCC] = {"CPY", []{ CMP(m.y, read(absolute())); }};
469 | 
470 |   // Debugging opcodes (not used on real processors)
471 |   opcodes[0xFF] = {"DBG_START", []{
472 |     printf("DEBUGGER STARTED");
473 |     trace = true;
474 |   }};
475 |   opcodes[0xEF] = {"DBG_END", []{
476 |     printf("DEBUGGER ENDED");
477 |     trace = false;
478 |   }};
479 |   opcodes[0xDF] = {"DBG_TRACE", []{
480 |     m.ip = m.ip + 1;
481 |     while (m.memory[m.ip]) {
482 |       putchar(m.memory[m.ip]);
483 |       m.ip = m.ip + 1;
484 |     }
485 |     printf("\n");
486 |   }};
487 | }
488 | 
489 | // Runs the emulator until it needs more input or
490 | // stops. Returns true if it needs more input, and
491 | // false if emulation is done.
492 | bool emulate() {
493 |   while (true) {
494 |     if (m.ip == 0xFFFF) { return false; }
495 | 
496 |     uint16_t ip = m.ip;
497 |     uint8_t opcode = immediate();
498 |     if (opcodes[opcode].handler == nullptr) {
499 |       printf("\n\nUnknown opcode $%02x\n", opcode);
500 |       printf("IP:\t%04x\t%02x\ta:%02x\tx:%02x\ty:%02x", m.ip, opcode, m.a, m.x, m.y);
501 |       printf("\n");
502 |       for (int i = 0; i < 256; i++) {
503 |         printf("%02x ", m.memory[0x100+i]);
504 |       }
505 |       return false;
506 |     } else {
507 |       if (trace) {
508 |         // Output some spaces to visualize the call stack depth.
509 |         for (int i = 0; i < (0xFF - m.sp)/2; i++) {
510 |           putchar(' ');
511 |         }
512 |         printf("IP:\t%04x\t%02x\t%s\ta:%02x\tx:%02x\ty:%02x\tv:%01x\n",
513 |           m.ip,
514 |           opcode,
515 |           opcodes[opcode].name,
516 |           m.a,
517 |           m.x,
518 |           m.y,
519 |           m.status.v);
520 |       }
521 |       try {
522 |         opcodes[opcode].handler();
523 |       } catch (OutOfInputException &e) {
524 |         // The instruction ran, but didn't have
525 |         // enough user input to finish. Reset the
526 |         // instruction pointer, and return a request
527 |         // for more input.
528 |         m.ip = ip;
529 |         return true;
530 |       }
531 |     }
532 |   }
533 |   return false;
534 | }
535 | 
536 | 


--------------------------------------------------------------------------------
/lit/Makefile:
--------------------------------------------------------------------------------
 1 | 
 2 | # Change these configs
 3 | CC65=../../cc65/bin
 4 | MESEN=../../emus/mesen/Mesen.exe
 5 | LIT=../../literate/lit
 6 | 
 7 | out/bootstrap.bin: bootstrap.s
 8 | 	$(CC65)/ca65 --cpu 6502x -g bootstrap.s -o out/bootstrap.o
 9 | 	$(CC65)/ld65 --dbgfile out/debug.txt -C bootstrap.conf out/bootstrap.o -o out/bootstrap.bin
10 | 
11 | out/bootstrap.bin.h: out/bootstrap.bin
12 | 	xxd -i out/bootstrap.bin out/bootstrap.bin.h
13 | 
14 | out/6502: 6502.cpp
15 | 	g++ -O2 -Wall -Wpedantic -Wsequence-point -std=c++11 6502.cpp -o out/6502
16 | 
17 | out.nes: out/bootstrap.bin bootstrap.f font.chr game.f done.f out/6502
18 | 	./out/6502 bootstrap.f -b font:font.chr game.f done.f
19 | 
20 | run: out/game.nes
21 | 	mono $(MESEN) out/game.nes
22 | 
23 | repl: out/bootstrap.bin bootstrap.f font.chr game.f out/6502
24 | 	./out/6502 bootstrap.f -b font:font.chr game.f
25 | 
26 | lit: lit/test.lit
27 | 	$(LIT) lit/test.lit
28 | 


--------------------------------------------------------------------------------
/lit/bootstrap.conf:
--------------------------------------------------------------------------------
 1 | MEMORY {
 2 |   ZEROPAGE: start = $00,   size = $100,  file = %O, fill = yes;
 3 |   STACK:    start = $200,  size = $100,  file = %O, fill = yes;
 4 |   RAM:      start = $200,  size = $600,  file = %O, fill = yes;
 5 |   PADDING:  start = $800,  size = $3820, file = %O, fill = yes;
 6 |   TMP_RAM:  start = $4020, size = $E0,   file = %O, fill = yes;
 7 |   TMP_CODE: start = $4100, size = $1700, file = %O, fill = yes;
 8 |   TMP_DICT: start = $5800, size = $800,  file = %O, fill = yes;
 9 |   RAM2:     start = $6000, size = $2000, file = %O, fill = yes;
10 |   CODE:     start = $8000, size = $7000, file = %O, fill = yes; 
11 |   DICT:     start = $F000, size = $FFA,  file = %O, fill = yes;
12 |   VECTORS:  start = $FFFA, size = $6,    file = %O, fill = yes;
13 | }
14 | SEGMENTS {
15 |   ZEROPAGE:      load = ZEROPAGE, type = ro;
16 |   STACK:         load = STACK,    type = ro, optional = true;
17 |   RAM:           load = RAM,      type = ro, optional = true, align = $100;
18 |   VARIABLES:     load = RAM,      type = ro, optional = true;
19 |   TMP_VARIABLES: load = TMP_RAM,  type = ro, optional = true;
20 |   TMP_CODE:      load = TMP_CODE, type = ro, optional = true;
21 |   TMP_DICT_CODE: load = TMP_CODE, type = ro, optional = true;
22 |   TMP_DICT:      load = TMP_DICT, type = ro, optional = true;
23 |   RAM2:          load = RAM2,     type = ro, optional = true;
24 |   CODE:          load = CODE,     type = ro;
25 |   DICT_CODE:     load = CODE,     type = ro;
26 |   DICT:          load = DICT,     type = ro, optional = true;
27 |   VECTORS:       load = VECTORS,  type = ro;
28 | }
29 | 
30 | 


--------------------------------------------------------------------------------
/lit/bootstrap.f:
--------------------------------------------------------------------------------
  1 | <tmp> definitions:
  2 | 
  3 |   \ Define addresses of the stack and tmp variables.
  4 |   : stack 8 ;
  5 |   : tmp 0 ;
  6 |   : io-port 16412 ;
  7 | 
  8 | 
  9 |   \ Macro to move the top of stack into tmp.
 10 |   : >TMP
 11 |     stack    LDA.ZX
 12 |     tmp      STA.Z
 13 |     stack 1+ LDA.ZX
 14 |     tmp 1+   STA.Z
 15 |   ;
 16 | 
 17 |   \ special case these instructions
 18 |   : TXA 138 c, ;
 19 |   : TYA 152 c, ;
 20 |   : TXS 154 c, ;
 21 | 
 22 |   : emit [
 23 |     stack LDA.ZX
 24 |     io-port STA \ $401C
 25 |     INX
 26 |     INX
 27 |   ] ;
 28 | 
 29 |   : cr
 30 |     10 emit ;
 31 | 
 32 | <perm> definitions:
 33 | 
 34 |   : and [
 35 |     stack     LDA.ZX
 36 |     stack 2 + AND.ZX
 37 |     stack 2 + STA.ZX
 38 |     
 39 |     stack 1+  LDA.ZX
 40 |     stack 3 + AND.ZX
 41 |     stack 3 + STA.ZX
 42 |     
 43 |     INX INX
 44 |   ] ;
 45 | 
 46 |   : or [
 47 |     stack     LDA.ZX
 48 |     stack 2 + ORA.ZX
 49 |     stack 2 + STA.ZX
 50 | 
 51 |     stack 1+  LDA.ZX
 52 |     stack 3 + ORA.ZX
 53 |     stack 3 + STA.ZX
 54 | 
 55 |     INX INX
 56 |   ] ;
 57 | 
 58 |   : xor [
 59 |     stack     LDA.ZX
 60 |     stack 2 + EOR.ZX
 61 |     stack 2 + STA.ZX
 62 | 
 63 |     stack 1+  LDA.ZX
 64 |     stack 3 + EOR.ZX
 65 |     stack 3 + STA.ZX
 66 | 
 67 |     INX INX
 68 |   ] ;
 69 | 
 70 |   \ a b -- a b a
 71 |   : over [
 72 |     DEX
 73 |     DEX
 74 |     stack 4 + LDA.ZX
 75 |     stack     STA.ZX
 76 |     stack 5 + LDA.ZX
 77 |     stack 1 + STA.ZX  ] ;
 78 | 
 79 |   \ ( a b c -- b c a )
 80 |   : rot [
 81 |     stack     LDA.ZX
 82 |     PHA
 83 |     stack 2 + LDY.ZX
 84 |     stack 4 + LDA.ZX
 85 |     stack     STA.ZX
 86 |     stack 4 + STY.ZX
 87 |     PLA
 88 |     stack 2 + STA.ZX
 89 |     stack 1 + LDA.ZX
 90 |     PHA
 91 |     stack 3 + LDY.ZX
 92 |     stack 5 + LDA.ZX
 93 | 
 94 |     stack 1 + STA.ZX
 95 |     stack 5 + STY.ZX
 96 |     PLA
 97 |     stack 3 + STA.ZX
 98 |   ] ;
 99 | 
100 | <tmp> definitions:
101 | 
102 |   \ Define the inline assembly language IF and THEN constructs.
103 |   \ Rather than using labeled branches, we can do structured
104 |   \ control flow. IFEQ, for example, will branch to the matching
105 |   \ THEN if the Z flag is non-zero.
106 |   : IF  chere @ ;
107 |   : IFEQ  0 BNE IF ;
108 |   : IFNE  0 BEQ IF ;
109 |   : IFCC  0 BCS IF ;
110 |   : IFCS  0 BCC IF ;
111 |   : IFVC  0 BVS IF ;
112 |   : IFVS  0 BVC IF ;
113 |   : IFPL  0 BMI IF ;
114 |   : IFMI  0 BPL IF ;
115 | 
116 |   : THEN
117 |     dup
118 |     chere @ swap -
119 |     swap 1- c! 
120 |   ;
121 | 
122 |   : ELSE
123 |     CLV
124 |     IFVS
125 |     swap
126 |     THEN
127 |   ;
128 | 
129 |   \ Define the assembly language looping constructs.
130 |   \ A BEGIN..UNTIL loop will continue looping until
131 |   \ the condition code given is set.
132 |   : BEGIN  chere @ ;
133 |   : UNTIL  chere @ - 2 - ;
134 |   : UNTILEQ  UNTIL BNE ;
135 |   : UNTILNE  UNTIL BEQ ;
136 |   : UNTILCC  UNTIL BCS ;
137 |   : UNTILCS  UNTIL BCC ;
138 |   : UNTILVC  UNTIL BVS ;
139 |   : UNTILVS  UNTIL BVC ;
140 |   : UNTILPL  UNTIL BMI ;
141 |   : UNTILMI  UNTIL BPL ;
142 | 
143 |   \ Define BEGIN..WHILE..REPEAT loops,
144 |   \ which are like while loops in C:
145 |   \ while (/* BEGIN */ cond /* WHILE */) { ... /* REPEAT */} 
146 |   : WHILE  chere @ ;
147 |   : WHILEEQ  0 BNE WHILE ;
148 |   : WHILENE  0 BEQ WHILE ;
149 |   : WHILECC  0 BCS WHILE ;
150 |   : WHILECS  0 BCC WHILE ;
151 |   : WHILEVC  0 BVS WHILE ;
152 |   : WHILEVS  0 BVC WHILE ;
153 |   : WHILEPL  0 BMI WHILE ;
154 |   : WHILEMI  0 BPL WHILE ;
155 | 
156 |   : REPEAT
157 |     CLV
158 |     swap chere @ - 2 - BVC \ bra to start of loop
159 |     dup
160 |     chere @ swap -
161 |     swap 1- c!
162 |   ;
163 | 
164 |   \ Gets the flags1 byte of the dictionary entry
165 |   : flags  dhere @ dict::len + ;
166 |   : immediate  flags @ 128 xor flags ! ;
167 |   immediate \ mark the word immediate as immediate
168 | 
169 |   : always-inline immediate
170 |     flags @ 64 xor flags ! ;
171 | 
172 |   \ Prints out the whole stack
173 |   : .s [
174 |     BEGIN
175 |       TXA
176 |       79 CMP.#
177 |     WHILENE
178 |       ] . [
179 |     REPEAT
180 |   ] ;
181 | 
182 | <perm> definitions:
183 | 
184 |   : >byte [
185 |     stack 1+ LDA.ZX
186 |     stack    STA.ZX
187 |     0        LDA.#
188 |     stack 1+ STA.ZX
189 |   ] ;
190 | 
191 |   : <byte always-inline [
192 |     0 LDA.#
193 |     stack 1+ STA.ZX
194 |   ] ;
195 | 
196 | <tmp> definitions:
197 | 
198 |   \ Pronounced tick, finds the given word
199 |   : ' word find ;
200 | 
201 |   \ Takes the next word and compiles it even if it's immediate
202 |   : [compile] immediate
203 |     ' JSR
204 |   ;
205 | 
206 |   : literal immediate
207 |     DEX DEX
208 |     dup
209 |     <byte LDA.#
210 |     stack STA.ZX
211 |     >byte LDA.#
212 |     stack 1+ STA.ZX
213 |   ;
214 | 
215 |   : ['] immediate ' [compile] literal ;
216 |  
217 | <perm> definitions:
218 | 
219 |   : = [
220 |     INX INX
221 |     stack 2 - LDA.ZX
222 |     stack     CMP.ZX
223 |     IFNE
224 |       0        LDA.#
225 |       stack    STA.ZX
226 |       stack 1+ STA.ZX
227 |       RTS
228 |     THEN
229 |     0        LDY.#
230 |     stack 1- LDA.ZX
231 |     stack 1+ CMP.ZX
232 |     IFEQ
233 |       DEY
234 |     THEN
235 |     stack    STY.ZX
236 |     stack 1+ STY.ZX
237 |   ] ;
238 | 
239 |   : <> [
240 |     INX INX
241 |     stack 2 - LDA.ZX
242 |     stack     CMP.ZX
243 |     IFNE
244 |      255      LDA.#
245 |      stack    STA.ZX
246 |      stack 1+ STA.ZX
247 |      RTS
248 |    THEN
249 |    0 LDY.#
250 |    stack 1- LDA.ZX
251 |    stack 1+ CMP.ZX
252 |    IFNE
253 |      DEY
254 |    THEN
255 |    stack    STY.ZX
256 |    stack 1+ STY.ZX
257 |    ] ;
258 | 
259 |   : 0= [
260 |     0        LDY.#
261 |     stack    LDA.ZX
262 |     stack 1+ ORA.ZX
263 |     IFEQ
264 |       DEY
265 |     THEN
266 |     stack    STY.ZX
267 |     stack 1+ STY.ZX
268 |   ] ;
269 | 
270 |   : 0> [
271 |     0        LDY.#
272 |     stack 1+ LDA.ZX
273 |     IFPL
274 |       DEY
275 |     THEN
276 |     stack    STY.ZX
277 |     stack 1+ STY.ZX
278 |   ] ;
279 | 
280 |   \ See http://www.6502.org/tutorials/compare_beyond.html#6
281 |   : > [
282 |     255 LDY.#
283 |     stack     LDA.ZX
284 |     stack 2 + CMP.ZX
285 |     stack 1+  LDA.ZX
286 |     stack 3 + SBC.ZX
287 |     IFVS
288 |       128 EOR.#
289 |     THEN
290 |     \ Now N flag contains comparison result
291 |     IFPL
292 |       INY
293 |     THEN
294 |     INX INX
295 |     stack    STY.ZX
296 |     stack 1+ STY.ZX
297 |   ] ;
298 | 
299 |   : < [
300 |     255 LDY.#
301 |     stack 2 + LDA.ZX
302 |     stack     CMP.ZX
303 |     stack 3 + LDA.ZX
304 |     stack 1+  SBC.ZX
305 |     IFVS
306 |       128 EOR.#
307 |     THEN
308 |     \ Now N flag contains comparison result
309 |     IFPL
310 |       INY
311 |     THEN
312 |     INX INX
313 |     stack    STY.ZX
314 |     stack 1+ STY.ZX
315 |   ] ;
316 | 
317 |   : u< [
318 |     \ TODO
319 |     255 LDY.#
320 |     stack 1+  LDA.ZX
321 |     stack 3 + CMP.ZX
322 |     IFCS
323 |       IFEQ
324 |         stack     LDA.ZX
325 |         stack 2 + CMP.ZX
326 |         
327 |       ELSE
328 |         
329 |       THEN
330 |     THEN
331 |   ] ;
332 | 
333 |   : u> [
334 |     \ TODO
335 |   ] ;
336 | 
337 |   \ Logical shift right
338 |   \ ( u -- u )
339 |   : lsr [
340 |     stack 1+ LSR.ZX
341 |     stack    ROR.ZX
342 |   ] ;
343 | 
344 |   \ Arithmetic shift right
345 |   \ ( i -- i )
346 |   : asr [
347 |     stack 1+ LDA.ZX
348 |     128      CMP.#
349 |     stack 1+ ROR.ZX
350 |     stack    ROR.ZX
351 |   ] ;
352 | 
353 |   \ Arithmetic shift left
354 |   : asl [
355 |     stack    ASL.ZX
356 |     stack 1+ ROL.ZX
357 |   ] ;
358 | 
359 |   : +! [
360 |     >TMP
361 | 
362 |     0         LDY.#
363 |     tmp       LDA.IY
364 |     CLC
365 |     stack 2 + ADC.ZX
366 |     tmp       STA.IY
367 | 
368 |     INY
369 |     tmp       LDA.IY
370 |     stack 3 + ADC.ZX
371 |     tmp       STA.IY
372 | 
373 |     INX INX
374 |     INX INX
375 |   ] ;
376 | 
377 |   : -! [
378 |     >TMP
379 | 
380 |     0         LDY.#
381 |     tmp       LDA.IY
382 |     SEC
383 |     stack 2 + SBC.ZX
384 |     tmp       STA.IY
385 | 
386 |     INY
387 |     tmp       LDA.IY
388 |     stack 3 + SBC.ZX
389 |     tmp       STA.IY
390 | 
391 |     INX INX
392 |     INX INX
393 |   ] ;
394 | 
395 |   : c>r always-inline [
396 |     stack LDA.ZX
397 |     PHA
398 |     INX
399 |     INX
400 |   ] ;
401 | 
402 |   : cr> always-inline [
403 |     DEX
404 |     DEX
405 |     PLA
406 |     stack    STA.ZX
407 |     0        LDA.#
408 |     stack 1+ STA.ZX
409 |   ] ;
410 | 
411 |   : >r always-inline [
412 |     stack 1+ LDA.ZX
413 |     PHA
414 |     stack    LDA.ZX
415 |     PHA
416 |     INX
417 |     INX
418 |   ] ;
419 | 
420 |   : r> always-inline [
421 |     DEX
422 |     DEX
423 |     PLA
424 |     stack    STA.ZX
425 |     PLA
426 |     stack 1+ STA.ZX
427 |   ] ;
428 | 
429 |   \ ( r: a -- )
430 |   : rdrop always-inline [
431 |     PLA
432 |     PLA
433 |   ] ;
434 | 
435 |   \ ( -- sp )
436 |   : dsp@ [
437 |     DEX
438 |     DEX
439 |     TXA
440 |     stack    STA.ZX
441 |     0        LDY.#
442 |     stack 1+ STY.ZX
443 |   ] ;
444 | 
445 |   \ ( sp -- )
446 |   : dsp! [
447 |     stack LDA.ZX
448 |     TAX
449 |   ] ;
450 | 
451 | <tmp> definitions:
452 |   : hex 16 base ! ;
453 |   : decimal 10 base ! ;
454 |   : '\n' 10 ;
455 |   : bl 32 ;
456 |   : space bl emit ;
457 | 
458 |   \ Recursively call the current word
459 |   : recurse immediate
460 |     dhere @
461 |     JSR
462 |   ;
463 | 
464 |   : recurse-tail immediate
465 |     dhere @
466 |     JMP
467 |   ;
468 | 
469 |   : POP INX INX ;
470 | 
471 | <perm> definitions:
472 |   : negate 0 swap - ;
473 |   : true 0 1 - ;
474 |   : false 0 ;
475 |   : not 0= ;
476 | 
477 |   : 2- 2 - ;
478 |   : 2+ 2 + ;
479 | 
480 |   : allot
481 |     vhere +!
482 |   ;
483 | 
484 | <tmp> definitions:
485 | 
486 |   \ Save branch instruction address
487 |   : if immediate
488 |     \ [compile] debug
489 |     POP
490 |     stack 2- LDA.ZX
491 |     stack 1- ORA.ZX
492 |     chere @
493 |     0 BEQ
494 |   ;
495 | 
496 |   : unless immediate
497 |     ['] not JSR
498 |     [compile] if
499 |   ;
500 | 
501 |   \ Write the branch target to here.
502 |   : then immediate
503 |     dup
504 |     chere @ swap - 2-
505 |     swap 1+ c! 
506 |   ;
507 | 
508 |   : else immediate
509 |     chere @ 1+
510 |     swap
511 |     CLV 0 BVC
512 |     dup
513 |     chere @ swap - 2-
514 |     swap 1+ c!
515 |   ;
516 | 
517 |   : begin immediate
518 |     \ [compile] debug
519 |     chere @
520 |   ;
521 | 
522 |   \ ( branch-target -- )
523 |   : repeat immediate
524 |     CLV
525 |     chere @ - 2- BVC
526 |   ;
527 | 
528 |   \ ( branch-target -- )
529 |   : until immediate
530 |     POP
531 |     stack 2- LDA.ZX
532 |     stack 1- ORA.ZX
533 |     chere @ - 2- BEQ
534 |   ;
535 | 
536 |   : while
537 |     POP
538 |     stack 2- LDA.ZX
539 |     stack 1- ORA.ZX
540 |     chere @ - 2- BNE
541 |   ;
542 | 
543 |   : char
544 |     word
545 |     [
546 |       INX INX \ drop word length
547 |       stack    LDA.XI
548 |       stack    STA.ZX
549 |       0        LDA.#
550 |       stack 1+ STA.ZX
551 |     ]
552 |   ;
553 | 
554 |   : '(' [ char ( ] literal ;
555 |   : ')' [ char ) ] literal ;
556 |   : '"' [ char " ] literal ;
557 | 
558 |   : ( immediate
559 |     1
560 |     begin
561 |       key
562 |       dup '(' = if
563 |         drop
564 |         1+
565 |       else
566 |         ')' = if
567 |           1-
568 |         then
569 |       then
570 |     dup 0= until
571 |     drop
572 |   ;
573 | 
574 |   ( Now I can write comments using (nested) parens )
575 | 
576 |   ( Declares a constant value. Use like `10 constant VariableName`)
577 |   : constant immediate
578 |     word
579 |     create
580 |     [compile] literal
581 |     RTS
582 |   ;
583 | 
584 |   ( Declares an uninitialized variable, giving it space
585 |     after vhere )
586 |   : variable immediate
587 |     vhere @
588 |     2 allot
589 |     [compile] constant
590 |   ;
591 | 
592 |   ( xt -- impl )
593 |   : >impl
594 |     dict::impl + @
595 |   ;
596 | 
597 |   ( Takes a dictionary entry and prints the name of the word )
598 |   : id.
599 |     dict::len +    ( Skip the pointers )
600 |     dup c@ ( get the length )
601 |     31 and ( Mask the flags )
602 |     
603 |     begin
604 |       swap 1+ ( addr len -- len addr+1 )
605 |       dup c@ ( len addr -- len addr char )
606 |       emit
607 |       swap 1- ( len addr -- addr len-1 )
608 | 
609 |       dup 0=
610 |     until 
611 |     drop
612 |     drop
613 |   ;
614 | 
615 |   ( True to hide the word from dictionary searches )
616 |   : ?hidden
617 |     dict::len +
618 |     c@
619 |     32 and
620 |   ;
621 | 
622 |   ( True if the word is the last in the dictionary )
623 |   : ?end
624 |     dict::flags +
625 |     c@
626 |     128 and
627 |   ;
628 | 
629 |   ( True if the word is a single-byte val )
630 |   : ?byte
631 |     dict::flags +
632 |     c@
633 |     64 and
634 |   ;
635 | 
636 |   ( True if the word should execute immediately in compile mode )
637 |   : ?immediate
638 |     dict::len +
639 |     c@
640 |     128 and
641 |   ;
642 | 
643 |   ( Returns the next dictionary entry. )
644 |   : next
645 |     dup ?end if
646 |       drop
647 |       0
648 |     else
649 |       dup dict::len + c@ 63 and + dict::name +
650 |     then
651 |   ;
652 | 
653 |   ( Prints all the words in the dictionary )
654 |   ( dict-start -- )
655 |   : words'
656 |     begin
657 |       dup ?hidden not if
658 |         dup id.
659 |         space
660 |       then
661 |       next
662 |       dup 0=
663 |     until
664 |     drop ( drop null pointer )
665 |     cr
666 |   ;
667 | 
668 |   ( Prints all the words in all the dictionaries )
669 |   : words
670 |     dicts
671 |     begin
672 |       words'
673 |     dup 0= until
674 |     drop
675 |   ;
676 | 
677 |   : compiling? state @ ;
678 | 
679 |   ( -- )
680 |   : ." immediate
681 |     compiling? if
682 |       ['] (.') JSR ( compile jsr (.") )
683 | 
684 |       begin
685 |         key
686 |         dup '"' <> if
687 |           c,
688 |           0
689 |         then
690 |       until
691 |       0 c,
692 |     else
693 |       begin
694 |         key
695 |         dup '"' <> if
696 |           emit
697 |           0
698 |         then
699 |       until
700 |     then
701 |   ;
702 | 
703 |   : welcome
704 |     ." Welcome to Forth!" cr
705 |   ;
706 | 
707 |   welcome
708 | 
709 |   ( A variable which, when called, pushes its value instead of its address )
710 |   : val
711 |     vhere @ ( get the variable address )
712 |     2 allot ( allot two variables )
713 |     word
714 |     create ( create a new dictionary entry )
715 |     DEX DEX
716 |     dup LDA ( load the value from the variable and push it to the stack )
717 |     stack STA.ZX
718 |     dup 1+ LDA
719 |     stack 1+ STA.ZX 
720 |     RTS
721 | 
722 |     ( initialize val )
723 |     !
724 | 
725 |     ['] always-inline execute
726 |   ;
727 | 
728 |   : c-val
729 |     vhere @ ( get the variable address )
730 |     1 allot
731 |     word
732 |     create ( create a new dictionary entry )
733 |     dhere @ c-val-tog
734 |     DEX DEX
735 |     dup LDA ( load the value and push it )
736 |     stack STA.ZX
737 |     0 LDA.#
738 |     stack 1+ STA.ZX
739 |     RTS
740 |     ( initialize )
741 |     !
742 |   ;
743 | 
744 |   ( Gets the address of a val and it's size )
745 |   : val-addr
746 |     word
747 |     find
748 |     dup 0= if
749 |       drop
750 |       drop
751 |       drop
752 |       ." Cannot get address of unknown val." cr
753 |       quit
754 |     then
755 |     dup >impl 3 + @ ( read variable address from val impl )
756 |     swap ?byte
757 |   ;
758 | 
759 |   ( Writes a value to a `val` variable )
760 |   : to immediate
761 |     val-addr
762 |     compiling? if
763 |       if ( single byte )
764 |         stack LDA.ZX
765 |         STA
766 |         INX INX
767 |       else
768 |         dup
769 |         stack LDA.ZX
770 |         STA
771 |         stack 1+ LDA.ZX
772 |         1+ STA
773 |         INX INX
774 |       then
775 |     else
776 |       if ( single byte )
777 |         c!
778 |       else
779 |         !
780 |       then
781 |     then
782 |   ;
783 | 
784 |   : heredoc immediate
785 |     word
786 |     create
787 |     chere @ 21 +
788 |     DEX
789 |     DEX
790 |     dup <byte LDA.#
791 |     stack     STA.ZX
792 |     >byte     LDA.#
793 |     stack 1+  STA.ZX
794 | 
795 |     DEX
796 |     DEX
797 |     dup <byte LDA.#
798 |     stack     STA.ZX
799 |     dup >byte LDA.#
800 |     stack 1+  STA.ZX
801 |     RTS
802 | 
803 |     begin
804 |       key c,
805 |       1-
806 |     dup 0= until
807 |     drop
808 |   ;
809 | 
810 |   hex
811 |   ( xt -- )
812 |   : set-reset! 0FFFC ! ;
813 |   ( xt -- )
814 |   : set-nmi! 0FFFA ! ;
815 |   ( xt -- )
816 |   : set-irq! 0FFFE ! ;
817 | 
818 | 
819 |   ' thaw set-reset!
820 | 
821 |   ( Ends an interrupt handler definiton )
822 |   : ;int immediate
823 |     40 c, \ append rti
824 |     dhere @ hidden \ unhide
825 |     [compile] [
826 |   ;
827 |   decimal
828 | 
829 |   : int-handle ;int
830 | 
831 |   ' int-handle set-nmi!
832 |   ' int-handle set-irq!
833 | 
834 |   ( new-xt old-xt -- )
835 |   ( Redefines old as new, so that all calls to old
836 |     will instead call new. Doesn't rePLAce inlined calls )
837 |   : monkey-patch
838 |     dict::impl + !
839 |   ;
840 | 
841 |   : inline,
842 |     1-
843 |     begin
844 |       1+ dup
845 |       c@ dup c,
846 |       96 =
847 |     until
848 |     drop
849 |     \ undo writing the rts
850 |     chere @ 1- chere !
851 |   ;
852 | 
853 |   ( a simple inline which just copies the impl until hitting an rts.
854 |     It will be confused by any 0x60 byte )
855 |   : [inline] immediate
856 |     word find >impl inline,
857 |   ;
858 | 
859 |   : disas
860 |     20
861 |     begin
862 |       swap
863 |       see
864 |       swap 1-
865 |       dup 0=
866 |     until
867 |     drop
868 |     drop
869 |   ;
870 | 
871 |   : do immediate
872 |     \ inline code to put the loop bound then 
873 |     c-sp      LDY.Z
874 |     DEY
875 |     DEY
876 |     c-sp      STY.Z
877 |     stack     LDA.ZX
878 |     cstack    STA.Y
879 |     stack  2+ LDA.ZX
880 |     cstack 1+ STA.Y
881 |     INX
882 |     INX
883 |     INX
884 |     INX \ drop the values on the stack
885 | 
886 |     \ save the address of the beginning of the loop
887 |     chere @
888 |   ;
889 | 
890 |   : loop immediate
891 |     c-sp   LDY.Z
892 |     cstack LDA.Y
893 |     CLC
894 |     1      ADC.#
895 |     cstack 1+ CMP.Y
896 |     cstack STA.Y
897 |     UNTILEQ 
898 |   ;
899 | 
900 | <perm> definitions:
901 |   : i [
902 |     DEX
903 |     DEX
904 |     0 LDA.#
905 |     stack 1+ STA.ZX
906 |     c-sp LDY.Z
907 |     cstack LDA.Y
908 |     stack STA.ZX
909 |   ] ;
910 | 
911 |   : save-for-interrupt always-inline [
912 |     DEX DEX \ make room for the red zone
913 |     PHA
914 |     TYA
915 |     PHA
916 |     tmp LDA.Z
917 |     PHA
918 |     tmp 1+  LDA.Z
919 |     PHA
920 |     tmp 2 + LDA.Z
921 |     PHA
922 |     tmp 3 + LDA.Z
923 |     PHA
924 |     tmp 4 + LDA.Z
925 |     PHA
926 |     tmp 5 + LDA.Z
927 |     PHA
928 |     tmp 6 + LDA.Z
929 |     PHA
930 |     tmp 7 + LDA.Z
931 |     PHA
932 |   ] ;
933 | 
934 |   : restore-for-interrupt always-inline [
935 |     PLA
936 |     tmp 7 + STA.Z
937 |     PLA
938 |     tmp 6 + STA.Z
939 |     PLA
940 |     tmp 5 + STA.Z
941 |     PLA
942 |     tmp 4 + STA.Z
943 |     PLA
944 |     tmp 3 + STA.Z
945 |     PLA
946 |     tmp 2 + STA.Z
947 |     PLA
948 |     tmp 1+  STA.Z
949 |     PLA
950 |     tmp     STA.Z
951 |     
952 |     PLA
953 |     TAY
954 |     PLA
955 |     INX INX \ remove the red zone
956 |   ] ;
957 | 
958 |   hex
959 |   \ Wait a few frames for the PPU to stabilize on power-on
960 |   : wait-for-ppu [
961 |     BEGIN
962 |       2002 BIT
963 |     UNTILMI
964 |     BEGIN
965 |       2002 BIT
966 |     UNTILMI
967 |     BEGIN
968 |       2002 BIT
969 |     UNTILMI
970 |     BEGIN
971 |       2002 BIT
972 |     UNTILMI
973 |   ] ;
974 | 
975 |   ' nmi set-nmi!
976 | : { immediate
977 |   CLV IFVS
978 | ;
979 | 
980 | : } immediate
981 |   RTS
982 |   dup THEN
983 |   [compile] literal
984 | ;
985 | 
986 | 


--------------------------------------------------------------------------------
/lit/css/style.css:
--------------------------------------------------------------------------------
 1 | 
 2 | th {
 3 |   text-align: left;
 4 |   border: 1px solid;
 5 | }
 6 | 
 7 | td {
 8 |   text-align: center;
 9 |   border: 1px solid;
10 | }
11 | 


--------------------------------------------------------------------------------
/lit/css/theme.css:
--------------------------------------------------------------------------------
  1 | /*! Color themes for Google Code Prettify | MIT License | github.com/jmblog/color-themes-for-google-code-prettify */
  2 | .prettyprint {
  3 |   background: #fff;
  4 |   font-family: Menlo, "Bitstream Vera Sans Mono", "DejaVu Sans Mono", Monaco, Consolas, monospace;
  5 |   border: 0 !important;
  6 | }
  7 | 
  8 | .pln {
  9 |   color: #333;
 10 | }
 11 | 
 12 | /* Specify class=linenums on a pre to get line numbering */
 13 | ol.linenums {
 14 |   margin-top: 0;
 15 |   margin-bottom: 0;
 16 |   color: #cccccc;
 17 | }
 18 | 
 19 | li.L0,
 20 | li.L1,
 21 | li.L2,
 22 | li.L3,
 23 | li.L4,
 24 | li.L5,
 25 | li.L6,
 26 | li.L7,
 27 | li.L8,
 28 | li.L9 {
 29 |   padding-left: 1em;
 30 |   background-color: #fff;
 31 |   list-style-type: decimal;
 32 | }
 33 | 
 34 | @media screen {
 35 | 
 36 |   /* string content */
 37 | 
 38 |   .str {
 39 |     color: #183691;
 40 |   }
 41 | 
 42 |   /* keyword */
 43 | 
 44 |   .kwd {
 45 |     color: #a71d5d;
 46 |   }
 47 | 
 48 |   /* comment */
 49 | 
 50 |   .com {
 51 |     color: #969896;
 52 |   }
 53 | 
 54 |   /* type name */
 55 | 
 56 |   .typ {
 57 |     color: #0086b3;
 58 |   }
 59 | 
 60 |   /* literal value */
 61 | 
 62 |   .lit {
 63 |     color: #0086b3;
 64 |   }
 65 | 
 66 |   /* punctuation */
 67 | 
 68 |   .pun {
 69 |     color: #333;
 70 |   }
 71 | 
 72 |   /* lisp open bracket */
 73 | 
 74 |   .opn {
 75 |     color: #333;
 76 |   }
 77 | 
 78 |   /* lisp close bracket */
 79 | 
 80 |   .clo {
 81 |     color: #333;
 82 |   }
 83 | 
 84 |   /* markup tag name */
 85 | 
 86 |   .tag {
 87 |     color: #000080;
 88 |   }
 89 | 
 90 |   /* markup attribute name */
 91 | 
 92 |   .atn {
 93 |     color: #795da3;
 94 |   }
 95 | 
 96 |   /* markup attribute value */
 97 | 
 98 |   .atv {
 99 |     color: #183691;
100 |   }
101 | 
102 |   /* declaration */
103 | 
104 |   .dec {
105 |     color: #333;
106 |   }
107 | 
108 |   /* variable name */
109 | 
110 |   .var {
111 |     color: #008080;
112 |   }
113 | 
114 |   /* function name */
115 | 
116 |   .fun {
117 |     color: #900;
118 |   }
119 | }
120 | 
121 | 


--------------------------------------------------------------------------------
/lit/done.f:
--------------------------------------------------------------------------------
1 | done
2 | 
3 | 


--------------------------------------------------------------------------------
/lit/editor.lit:
--------------------------------------------------------------------------------
 1 | <!DOCTYPE html>
 2 | <html>
 3 | <head>
 4 |   <meta http-equiv="X-UA-Compatible" content="IE=edge" />
 5 |   <meta http-equiv="Content-Type" content="text/html;charset=utf-8" >
 6 |   <link rel="stylesheet" data-name="vs/editor/editor.main" href="node_modules/monaco-editor/min/vs/editor/editor.main.css">
 7 | </head>
 8 | <body>
 9 | 
10 | <h2>Monaco Editor Sync Loading Sample</h2>
11 | 
12 | <pre>
13 | <code id="test" data-lang="text/javascript">
14 | var a = {};
15 | if <a href="#">(a)</a> {
16 |   console.log(a);
17 | }
18 | </code>
19 | </pre>
20 | 
21 | <div id="container" style="width:800px;height:600px;border:1px solid grey"></div>
22 | 
23 | <script>var require = { paths: { 'vs': 'node_modules/monaco-editor/min/vs' } };</script>
24 | <script src="node_modules/monaco-editor/min/vs/loader.js"></script>
25 | <script src="node_modules/monaco-editor/min/vs/editor/editor.main.nls.js"></script>
26 | <script src="node_modules/monaco-editor/min/vs/editor/editor.main.js"></script>
27 | 
28 | <script>
29 |   window.addEventListener('load', function() {
30 |     Array.from(document.querySelectorAll('pre.prettyprint')).forEach((elt) => {
31 |       const text = elt.innerText;
32 |       const height = getComputedStyle(elt).height;
33 |       elt.style.height = (+height.substring(0, height.length - 2) * 19/16) + 'px';
34 |       elt.innerHTML = "";
35 |       var editor = monaco.editor.create(elt, {
36 |         value: text,
37 |         language: 'text',
38 |         scrollBeyondLastLine: false,
39 |         readOnly: true,
40 |         lineNumbers: 'off'
41 |       });
42 |     });
43 |   });
44 | </script>
45 | 
46 | </body>
47 | </html>
48 | 


--------------------------------------------------------------------------------
/lit/font.chr:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/RussellSprouts/ice-forth/e8ee101a70bc89f81fd47eb452f0fb56685c1f8d/lit/font.chr


--------------------------------------------------------------------------------
/lit/game.f:
--------------------------------------------------------------------------------
  1 | <perm> definitions:
  2 | 
  3 | hex
  4 | 
  5 | 0 val colors
  6 | 0 val addr
  7 | 
  8 | 0 c-val spr
  9 | 80 c-val Y
 10 | 
 11 | 20 val ballvx
 12 | 20 val ballvy
 13 | 500 val ballx
 14 | 800 val bally
 15 | 
 16 | ballx val oldballx
 17 | bally val oldbally
 18 | 
 19 | ( x y -- )
 20 | : draw| 
 21 |   [ char | bl - literal ]
 22 |   0
 23 |   spr oam-spr to spr ;
 24 | 
 25 | ( x y -- )
 26 | : draw-paddle
 27 |   over over 8 +
 28 |   draw| draw|
 29 | ;
 30 | 
 31 | ( x y -- )
 32 | : draw-ball
 33 |   [ char . bl - literal ] 0 spr oam-spr to spr 
 34 | ;
 35 | 
 36 | : frame
 37 |     \ colors 1+ 7 and to colors
 38 |     0 to spr
 39 | 
 40 |     joy1 btnU and if
 41 |       Y 4 - to Y
 42 |     then
 43 |     joy1 btnD and if
 44 |       Y 4 + to Y
 45 |     then
 46 | 
 47 |     ballvx ballx + to ballx
 48 |     ballvy bally + to bally
 49 | 
 50 |     ballx asr asr asr asr
 51 |     dup 100 > if
 52 |       1000 to ballx
 53 |       ballvx negate to ballvx
 54 |     else dup 0 < if
 55 |       0 to ballx
 56 |       ballvx negate to ballvx
 57 |     then then
 58 | 
 59 |     bally asr asr asr asr
 60 |     dup E0 > if
 61 |       E00 to bally
 62 |       ballvy negate to ballvy
 63 |     else dup 0 < if
 64 |       0 to bally
 65 |       ballvy negate to ballvy
 66 |     then then
 67 |     draw-ball
 68 | 
 69 |     10 \ x
 70 |     Y \ y
 71 |     draw-paddle
 72 | 
 73 |     E0 10 draw-paddle
 74 | 
 75 |     ballx to oldballx
 76 |     bally to oldbally
 77 | 
 78 |     addr 1+ 1FFF and to addr
 79 | 
 80 |     vppu-mask 1F and
 81 |     colors asl asl asl asl asl or to vppu-mask
 82 |     
 83 |     vppu-mask
 84 |     [
 85 |       stack LDA.ZX
 86 |       FE AND.#
 87 |       2001 STA
 88 |     ]
 89 |     drop
 90 | ;
 91 | 
 92 | : init
 93 |   font 0000 mv>ppu
 94 |   font 1000 mv>ppu
 95 |   19 to vppu-mask
 96 | ;
 97 | 
 98 | : done
 99 |   freeze \ stop emulation and write NES ROM
100 |   wait-for-ppu
101 |   \ Disable rendering
102 |   [ 0 LDA.#
103 |     2000 STA ]
104 |   init
105 |   \ Enable NMIs
106 |   [ 80 LDA.#
107 |     2000 STA ]
108 |   \ Loop forever and call the frame function each frame
109 |   begin
110 |     ppu-wait-nmi
111 |     frame
112 |   0 until
113 | ;
114 | 
115 | 0 15 pal-col!
116 | 1 16 pal-col!
117 | 2 30 pal-col!
118 | 3 31 pal-col!
119 | 4 pal-bright
120 | 80 to vppu-ctrl
121 | 
122 | 


--------------------------------------------------------------------------------
/lit/package.json:
--------------------------------------------------------------------------------
 1 | {
 2 |   "name": "ice-forth",
 3 |   "version": "1.0.0",
 4 |   "description": "",
 5 |   "main": "index.js",
 6 |   "scripts": {
 7 |     "test": "echo \"Error: no test specified\" && exit 1"
 8 |   },
 9 |   "author": "",
10 |   "license": "ISC",
11 |   "dependencies": {
12 |     "monaco-editor": "^0.14.3"
13 |   }
14 | }
15 | 


--------------------------------------------------------------------------------
/lit/script/syntax.js:
--------------------------------------------------------------------------------
 1 | 
 2 | PR.registerLangHandler(
 3 |     PR.createSimpleLexer(
 4 |         [
 5 |          // Whitespace
 6 |          [PR.PR_PLAIN,       /^[\t\n\r \xA0]+/, null, '\t\n\r \xA0'],
 7 |          // A double or single quoted, possibly multi-line, string.
 8 |          [PR.PR_STRING,      /^(?:\"(?:[^\"])*(?:\"|$)|\'(?:[^\'])*(?:\'|$))/, null, '"\'']
 9 |         ],
10 |         [
11 |          // A comment is either a line comment that starts with two dashes, or
12 |          // two dashes preceding a long bracketed block.
13 |          [PR.PR_COMMENT, /^;[^\r\n]*/],
14 |          // A long bracketed block not preceded by -- is a string.
15 |          [PR.PR_KEYWORD, /^(?:ADC|AND|ASL|BCC|BCS|BEQ|BIT|BMI|BNE|BPL|BRK|BVC|BVS|CLC|CLD|CLI|CLV|CMP|CPX|CPY|DEC|DEX|DEY|EOR|INC|INX|INY|JMP|JSR|LDA|LDX|LDY|LSR|NOP|ORA|PHA|PHP|PLA|PLP|ROL|ROR|RTI|RTS|SBC|SEC|SED|SEI|STA|STX|STY|TAX|TAY|TSX|TXA|TXS|TYA|a|x|y|ADD|SUB|BGE|BLT|BGT|BLE|BNZ|BZE)\b/, null],
16 |          [PR.PR_TYPE, /^(?:\.\w+)\b/i, null],
17 |          [PR.PR_DECLARATION, /[@?]?[a-zA-Z0-9_]+\s*\:(?!\:)/],
18 |          [PR.PR_DECLARATION, /^def(word|var|const|c?val)\w*\b/],
19 |          // A number is a hex integer literal, a decimal literal, or a binary literal.
20 |          [PR.PR_LITERAL,
21 |           /^(?:(?:\%[01]+)|(?:\$[0-9a-f]+)|(?:[0-9]+))/i],
22 |          // An identifier
23 |          [PR.PR_PLAIN, /^[a-z_]\w*/i],
24 |          // A run of punctuation
25 |          [PR.PR_PUNCTUATION, /^[^\w\t\n\r \xA0][^\w\t\n\r \xA0\"\'\-\+=]*/]
26 |         ]),
27 | ['inc', 's']);
28 | 
29 | // Comments are nested with (), so fake nesting by expanding this regex
30 | // a bunch of times.
31 | var comment = "\\(\\s[^)]*\\)"
32 | for (let i = 0; i < 10; i++) {
33 |   comment = comment.replace("[^)]", "(?:[^()]|\\([^)]*\\))");
34 | }
35 | 
36 | PR.registerLangHandler(
37 |   PR.createSimpleLexer(
38 |     [],
39 |     [
40 |      [PR.PR_COMMENT, /^\s\\[^\r\n]*/, '\\'],
41 |      [PR.PR_COMMENT, new RegExp(comment)],
42 |      [PR.PR_TYPE, /^(?:\s\:\s+[^\s]+)/],
43 |      [PR.PR_TYPE, /^(?:dup|drop|c?\!|c?\@)(?=\s|$)/],
44 |      [PR.PR_KEYWORD, /^(?:to|\')\s+[^\s]+/i],
45 |      [PR.PR_KEYWORD, /^(?:(?:if|else|then|begin|until)\b)/],
46 |      // A number is a hex integer literal, a decimal literal, or a binary literal.
47 |      [PR.PR_LITERAL,
48 |       /^(?:(?:\%[01]+)|(?:[0-9a-f]+(?=\s))|(?:[0-9]+))/i],
49 |      // An identifier
50 |      [PR.PR_PLAIN, /^[a-z_]\w*/i],
51 |      // A run of punctuation
52 |      // [PR.PR_PUNCTUATION, /^[^\w\t\n\r \xA0][^\w\t\n\r \xA0\"\'\-\+=]*/]
53 |     ]),
54 |   ['f']);
55 | 
56 | window.addEventListener('load', function() {
57 |   const SCALE = 4;
58 |   const colors = ["#000000", "#333333", "#666666", "#FFFFFF"];
59 |   const elts = Array.from(document.querySelectorAll("script[type='application/russellsprouts-chr']"));
60 |   for (const elt of elts) {
61 |     fetch(elt.getAttribute('src')).then(response => {
62 |       return response.blob()
63 |     }).then(blob => {
64 |       const reader = new FileReader();
65 |       reader.onload = function() {
66 |         const buffer = reader.result;
67 |         console.log(reader.result);
68 |         const canvas = document.createElement('canvas');
69 |         const ctx = canvas.getContext('2d');
70 |         canvas.width = 16*8*SCALE;
71 |         canvas.height = Math.floor(buffer.length / 16 / 16) * 8 * SCALE;
72 |         elt.parentNode.insertBefore(canvas, elt);
73 | 
74 |         for (let tile = 0; tile < Math.floor(buffer.length / 16); tile++) {
75 |           const tileX = (tile % 16) * 8;
76 |           const tileY = Math.floor(tile / 16) * 8;
77 |           for (let y = 0; y < 8; y++) {
78 |             let plane0 = buffer.charCodeAt(tile * 16 + y);
79 |             let plane1 = buffer.charCodeAt(tile * 16 + y + 8);
80 | 
81 |             for (let x = 0; x < 8; x++) {
82 |               const color = ((plane0 & 0x80) >> 7) | ((plane1 & 0x80) >> 6);
83 |               ctx.fillStyle = colors[color];
84 |               ctx.fillRect((tileX + x) * SCALE, (tileY + y) * SCALE, SCALE, SCALE);
85 |               plane0 <<= 1;
86 |               plane1 <<= 1;
87 |             }
88 |           }
89 |         }
90 |       };
91 |       reader.readAsBinaryString(blob);
92 |     });
93 |   }
94 | });
95 | 


--------------------------------------------------------------------------------
/lit/test.f:
--------------------------------------------------------------------------------
1 | My file to test ( comment )
2 | a ( nested (1)) a
3 | a ( nested (1(2)) ) a
4 | a ( nested (1(2(3))) ) a
5 | a ( nested (1(2(3(4)))) ) a
6 | a ( nested (1(2(3(4(5))))) ) a
7 | 
8 | 


--------------------------------------------------------------------------------
/macros.inc:
--------------------------------------------------------------------------------
1 | 
2 | 
3 | 


--------------------------------------------------------------------------------
/minimizing-assembler.txt:
--------------------------------------------------------------------------------
1 | 
2 | Initial size:
3 | 2798 bytes.
4 | 


--------------------------------------------------------------------------------
/neslib.s:
--------------------------------------------------------------------------------
  1 | ;(C) 2015 Alex Semenov (Shiru)
  2 | ;(C) 2016 Lauri Kasanen
  3 | ;
  4 | ; This software is provided 'as-is', without any express or implied
  5 | ; warranty.  In no event will the authors be held liable for any damages
  6 | ; arising from the use of this software.
  7 | ;
  8 | ; Permission is granted to anyone to use this software for any purpose,
  9 | ; including commercial applications, and to alter it and redistribute it
 10 | ; freely, subject to the following restrictions:
 11 | ;
 12 | ; 1. The origin of this software must not be misrepresented; you must not
 13 | ;    claim that you wrote the original software. If you use this software
 14 | ;    in a product, an acknowledgment in the product documentation would be
 15 | ;    appreciated but is not required.
 16 | ; 2. Altered source versions must be plainly marked as such, and must not be
 17 | ;    misrepresented as being the original software.
 18 | ; 3. This notice may not be removed or altered from any source distribution. 
 19 | ;
 20 | ; ---------------------------------------------------------------------------
 21 | ; This has been ported from the original version (meant to be called from
 22 | ; CC65) to have a Forth interface.
 23 | ; ---------------------------------------------------------------------------
 24 | 
 25 | 
 26 | .include "forth.inc"
 27 | 
 28 | .macpack generic
 29 | .macpack longbranch
 30 | 
 31 | .export PPU_MASK_VAR
 32 | defcval "vppu-mask", 0, PPU_MASK_VAR
 33 | defcval "vppu-ctrl", 0, PPU_CTRL_VAR
 34 | defcval "vppu-stat", 0, PPU_STATUS_VAR
 35 | defcval "scroll-x", 0, SCROLL_X_VAR
 36 | defcval "scroll-y", 0, SCROLL_Y_VAR
 37 | 
 38 | defcval "joy1", 0, JOY1_VAR
 39 | defcval "joy2", 0, JOY2_VAR
 40 | defcval "oldjoy1", 0, OLD_JOY1
 41 | defcval "oldjoy2", 0, OLD_JOY2
 42 | 
 43 | defconst "btnA", $80, BTN_A
 44 | defconst "btnB", $40, BTN_B
 45 | defconst "btnSel", $20, BTN_SELECT
 46 | defconst "btnSt", $10, BUTTON_START
 47 | defconst "btnU", $8, BUTTON_UP
 48 | defconst "btnD", $4, BUTTON_DOWN
 49 | defconst "btnL", $2, BUTTON_LEFT
 50 | defconst "btnR", $1, BUTTON_RIGHT
 51 | 
 52 | .segment "ZEROPAGE"
 53 | ; Initialize color brightness to normal.
 54 | PAL_SPR_PTR: .word palBrightTable4
 55 | PAL_BG_PTR: .word palBrightTable4
 56 | 
 57 | .segment "RAM"
 58 | .align 256
 59 | ; Initialize OAM buffer with $FF to hide all sprites.
 60 | OAM_BUF: .res 256, $FF
 61 | PAL_BUF: .res 32, $20
 62 | FRAME_CNT1: .res 1
 63 | PAL_UPDATE: .res 1
 64 | NAME_UPD_ENABLE: .res 1
 65 | VRAM_UPDATE: .res 1
 66 | 
 67 | .segment "CODE"
 68 | 
 69 | ; NMI handler
 70 | defword "nmi", 0, NMI
 71 |   pha
 72 |   txa
 73 |   pha
 74 |   tya
 75 |   pha
 76 | 
 77 |   lda PPU_MASK_VAR_VALUE ;if rendering is disabled, do not access the VRAM at all
 78 |   and #%00011000
 79 |   jeq @skipAll
 80 | 
 81 | @doUpdate:
 82 | 
 83 |   lda #0
 84 |   sta $4013
 85 | 
 86 |   lda #>OAM_BUF   ;update OAM
 87 |   sta $4014
 88 | 
 89 |   lda PAL_UPDATE   ;update palette if needed
 90 |   bne @updPal
 91 |   jmp @updVRAM
 92 | 
 93 | @updPal:
 94 | 
 95 |   ldx #0
 96 |   stx PAL_UPDATE
 97 | 
 98 |   lda #$3f
 99 |   sta $2006
100 |   stx $2006
101 | 
102 |   ldy PAL_BUF       ;background color, remember it in X
103 |   lda (PAL_BG_PTR),y
104 |   sta $2007
105 |   tax
106 | 
107 |   .repeat 3,I
108 |   ldy PAL_BUF+1+I
109 |   lda (PAL_BG_PTR),y
110 |   sta $2007
111 |   .endrepeat
112 | 
113 |   .repeat 3,J
114 |   stx $2007      ;background color
115 |   .repeat 3,I
116 |   ldy PAL_BUF+5+(J*4)+I
117 |   lda (PAL_BG_PTR),y
118 |   sta $2007
119 |   .endrepeat
120 |   .endrepeat
121 | 
122 |   .repeat 4,J
123 |   stx $2007      ;background color
124 |   .repeat 3,I
125 |   ldy PAL_BUF+17+(J*4)+I
126 |   lda (PAL_SPR_PTR),y
127 |   sta $2007
128 |   .endrepeat
129 |   .endrepeat
130 | 
131 | @updVRAM:
132 | 
133 |   lda VRAM_UPDATE
134 |   beq @skipUpd
135 |   lda #0
136 |   sta VRAM_UPDATE
137 | 
138 |   lda NAME_UPD_ENABLE
139 |   beq @skipUpd
140 | 
141 |   jsr _flush_vram_update_nmi
142 | 
143 | @skipUpd:
144 | 
145 |   lda #0
146 |   sta $2006
147 |   sta $2006
148 | 
149 |   lda SCROLL_X_VAR_VALUE
150 |   sta $2005
151 |   lda SCROLL_Y_VAR_VALUE
152 |   sta $2005
153 | 
154 |   lda PPU_CTRL_VAR_VALUE
155 |   sta $2000
156 | 
157 | @skipAll:
158 | 
159 |   lda PPU_MASK_VAR_VALUE
160 |   sta $2001
161 | 
162 |   inc FRAME_CNT1
163 | 
164 |   jsr FamiToneUpdate
165 | 
166 |   ; Read controllers
167 |   lda JOY1_VAR_VALUE
168 |   sta OLD_JOY1_VALUE
169 |   lda JOY2_VAR_VALUE
170 |   sta OLD_JOY2_VALUE
171 | 
172 |   lda #$01
173 |   sta $4016
174 |   sta JOY2_VAR_VALUE
175 |   lsr
176 |   sta $4016
177 | @controllerLoop:
178 |   lda $4016
179 |   and #$03
180 |   cmp #$01
181 |   rol JOY1_VAR_VALUE
182 |   lda $4017
183 |   and #$03
184 |   cmp #$01
185 |   rol JOY2_VAR_VALUE
186 |   bcc @controllerLoop
187 | 
188 |   pla
189 |   tay
190 |   pla
191 |   tax
192 |   pla
193 | 
194 | irq:
195 | 
196 |   rti
197 | 
198 | FamiToneUpdate:
199 |   rts
200 | 
201 | ; Set bg and spr palettes, data is 32 bytes array
202 | ; ( palette-buffer -- )
203 | defword "pal!", 0, pal_all
204 |   toTMP1
205 |   lda #$20
206 | 
207 | ; Given a length in A, sets the palette buffer
208 | ; given the buffer address in TMP1-2
209 | pal_copy:
210 |   sta TMP3
211 | 
212 |   ldy #0
213 | 
214 | @0:
215 |   lda (TMP1), y
216 |   sta PAL_BUF, y
217 |   iny
218 |   dec TMP3
219 |   bne @0
220 | 
221 |   inc PAL_UPDATE
222 | 
223 |   pop
224 |   rts
225 | 
226 | ; Set bg palette only, data is 16 bytes array
227 | ; ( palette-buffer -- )
228 | defword "pal-bg!", 0, pal_bg
229 |   toTMP1
230 |   lda #$10
231 |   bne pal_copy ; bra
232 | 
233 | ; Set spr palette only, data is 16 bytes array
234 | ; ( palette-buffer -- )
235 | defword "pal-spr!", 0, pal_spr
236 |   toTMP1
237 |   lda #$10  
238 |   sta TMP3
239 |   ldy #0
240 | 
241 | @0:
242 |   lda (TMP1), y
243 |   sta PAL_BUF + $10, y
244 |   iny
245 |   dec TMP3
246 |   bne @0
247 | 
248 |   inc <PAL_UPDATE
249 |   pop
250 |   rts
251 | 
252 | ; Set a palette entry. index is 0..31
253 | ; ( index color -- )
254 | defword "pal-col!", 0, pal_col
255 |   ldy Stack+2, x
256 |   lda Stack, x
257 |   and #$1f
258 |   sta PAL_BUF, y
259 |   inc PAL_UPDATE
260 |   pop
261 |   pop
262 |   rts
263 | 
264 | ; reset palette to $0F
265 | ; ( -- )
266 | defword "pal-clear", 0, pal_clear
267 |   lda #$0F
268 |   ldy #0
269 | 
270 | @1:
271 |   sta PAL_BUF, y
272 |   iny
273 |   cpy #$20
274 |   bne @1
275 |   sty PAL_UPDATE
276 |   rts
277 | 
278 | ; Set virtual bright for sprites only
279 | ; ( brightness -- )
280 | defword "pal-spr-bright", 0, pal_spr_bright
281 |   ldy Stack, x
282 |   lda palBrightTableL, y
283 |   sta PAL_SPR_PTR
284 |   lda palBrightTableH, y
285 |   sta PAL_SPR_PTR+1
286 |   sta PAL_UPDATE
287 |   pop
288 |   rts
289 | 
290 | ; Set virtual bright for background only
291 | ; ( brightness -- )
292 | defword "pal-bg-bright", 0, pal_bg_bright
293 |   ldy Stack, x
294 |   lda palBrightTableL, y
295 |   sta <PAL_BG_PTR
296 |   lda palBrightTableH, y
297 |   sta <PAL_BG_PTR+1
298 |   sta <PAL_UPDATE
299 |   pop
300 |   rts
301 | 
302 | ; Set virtual bright both for sprites and background.
303 | ; 0 is black, 4 is normal, 8 is white.
304 | defword "pal-bright", 0, pal_bright
305 |   jsr DUP
306 |   jsr pal_spr_bright
307 |   jmp pal_bg_bright
308 | 
309 | ; Turn off rendering, nmi still enabled when rendering is disabled.
310 | ; ( -- )
311 | defword "ppu-off", 0, ppu_off
312 |   lda PPU_MASK_VAR
313 |   and #%11100111
314 |   sta PPU_MASK_VAR
315 |   jmp ppu_wait_nmi
316 | 
317 | ; Turn on bg, spr
318 | ; ( -- )
319 | defword "ppu-on-all", 0, ppu_on_all
320 |   lda PPU_MASK_VAR
321 |   ora #%00011000
322 | 
323 | ppu_onoff:
324 |   sta PPU_MASK_VAR
325 |   jmp ppu_wait_nmi
326 | 
327 | ; Turn on bg only
328 | ; ( -- )
329 | defword "ppu-on-bg", 0, ppu_on_bg
330 |   lda PPU_MASK_VAR
331 |   ora #%00001000
332 |   bne ppu_onoff ; bra
333 | 
334 | ; Turn on spr only
335 | ; ( -- )
336 | defword "ppu-on-spr", 0, ppu_on_spr
337 |   lda PPU_MASK_VAR
338 |   ora #%00010000
339 |   bne ppu_onoff ; bra
340 | 
341 | ; Clear OAM buffer -- all sprites are hidden
342 | ; ( -- )
343 | defword "oam-clear", 0, oam_clear
344 |   ldy #0
345 |   lda #$FF
346 | @1:
347 |   sta OAM_BUF, y
348 |   iny
349 |   iny
350 |   iny
351 |   iny
352 |   bne @1
353 |   rts
354 | 
355 | ; Set sprite display mode. False for 8x8, true for 8x16
356 | ; ( flag -- )
357 | defword "oam-size", 0, oam_size
358 |   ldy #0
359 |   lda Stack, x
360 |   ora Stack+1, x
361 |   beq :+
362 |   ldy #%00100000
363 | : sty TMP1
364 |   lda PPU_CTRL_VAR
365 |   and #%11011111
366 |   ora TMP1
367 |   sta PPU_CTRL_VAR
368 | 
369 |   rts
370 | 
371 | ; Set a sprite in the OAM buffer. chrnum is tile, attr is
372 | ; attribute, sprid is offset in OAM in bytes
373 | ; returns sprid+4 which is offset for the next sprite
374 | ; ( x y chrnum attr sprid -- new-sprite-id )
375 | defword "oam-spr", 0, oam_spr
376 |   ldy Stack, x ; get sprite ID
377 | 
378 |   lda Stack+2, x ; attribute
379 |   sta OAM_BUF+2, y
380 | 
381 |   lda Stack+4, x ; chrnum
382 |   sta OAM_BUF+1, y
383 | 
384 |   lda Stack+6, x ; y
385 |   sta OAM_BUF, y
386 | 
387 |   lda Stack+8, x
388 |   sta OAM_BUF+3, y
389 | 
390 |   pop
391 |   pop
392 |   pop
393 |   pop
394 | 
395 |   tya
396 |   clc
397 |   adc #4
398 |   sta Stack, x
399 |   lda #0
400 |   sta Stack+1, x
401 |   rts
402 | 
403 | ; Set metasprite in OAM buffer
404 | ; meta sprites is a const unsigned char array, with
405 | ; four bytes per sprite in order x, y, tile, attribute
406 | ; x=128 is the end of a metasprite
407 | ; returns sprid of next sprite
408 | ; TODO 
409 | oam_meta_spr:
410 | 
411 | ; hide all remaining sprites from given offset
412 | ; ( sprid -- )
413 | defword "oam-hide-rest", 0, oam_hide_rest
414 |   ldy Stack, x
415 |   lda #240
416 | @1:
417 |   sta OAM_BUF, y
418 |   iny
419 |   iny
420 |   iny
421 |   iny
422 |   bne @1
423 | 
424 |   pop
425 |   rts
426 | 
427 | ; Wait actual TV frame, 50hz for PAL, 60hz for NTSC
428 | ; ( -- )
429 | defword "ppu-wait-nmi", 0, ppu_wait_nmi
430 |   lda #1
431 |   sta VRAM_UPDATE
432 |   lda FRAME_CNT1
433 | 
434 | @1:
435 |   cmp FRAME_CNT1
436 |   beq @1
437 |   rts
438 | 
439 | ; Set scroll after screen split invoked by the sprite 0 hit.
440 | ; warning: all CPU time between the function call and the actual split
441 | ; point will be wasted!
442 | ; warning: only X scroll can be changed with this version.
443 | ; ( x y -- )
444 | split: ; TODO
445 | 
446 | ; Select current bank for sprites 0..1
447 | ; ( n -- )
448 | defword "bank-spr", 0, bank_spr
449 |   lda Stack, x
450 |   and #1
451 |   asl
452 |   asl
453 |   asl
454 |   sta TMP1
455 |   lda PPU_CTRL_VAR
456 |   and #%11110111
457 |   ora TMP1
458 |   sta PPU_CTRL_VAR
459 |   pop
460 | 
461 |   rts
462 | 
463 | ; Select current bank for background, 0..1
464 | ; ( n -- )
465 | defword "bank-bg", 0, bank_bg
466 |   lda Stack, x
467 |   and #1
468 |   asl
469 |   asl
470 |   asl
471 |   asl
472 |   sta TMP1
473 |   lda PPU_CTRL_VAR
474 |   and #%11101111
475 |   ora TMP1
476 |   sta PPU_CTRL_VAR
477 | 
478 |   rts
479 | 
480 | ; read a block from current address of vram, only works
481 | ; when rendering is turned off
482 | ; ( dst size -- )
483 | vram_read: ; TODO
484 | 
485 | ; write a block to current address of vram, only works
486 | ; when rendering is turned off
487 | ; ( src size -- )
488 | vram_write: ; TODO
489 | 
490 | .export delay
491 | ; delay for N frames
492 | ; ( frames -- )
493 | defword "delay", 0, delay
494 |   ldy Stack, x
495 | 
496 | @1:
497 |   jsr ppu_wait_nmi
498 |   dey
499 |   bne @1  
500 | 
501 |   pop 
502 |   rts
503 | 
504 | defword "oam", 0, OAM_BUFFER_LOC
505 |   push OAM_BUF
506 |   rts
507 | 
508 | ; Does a bulk copy of data to the PPU
509 | ; ( src len target -- )
510 | defword "mv>ppu", 0, MV_TO_PPU
511 | 
512 |   PpuAddr := Stack
513 |   ; Write to PPUADDR
514 |   bit $2002
515 |   lda PpuAddr+1, x
516 |   sta $2006
517 |   lda PpuAddr, x
518 |   sta $2006
519 |   pop
520 | 
521 |   End     := Stack
522 |   Data    := Stack+2
523 | 
524 |   lda Data, x
525 |   clc
526 |   adc End, x
527 |   sta End, x
528 |   lda Data+1, x
529 |   adc End+1, x
530 |   sta End+1, x
531 | 
532 |   lda #0
533 |   sta TMP1
534 |   lda Data+1, x
535 |   sta TMP2
536 | 
537 |   lda End, x
538 |   sta TMP3
539 | 
540 |   ldy Data, x
541 | 
542 | @loop:
543 |   lda (TMP1), y
544 |   sta $2007
545 |   iny
546 |   bne :+
547 |   inc TMP2
548 | : cpy TMP3
549 |   bne @loop
550 |   lda TMP2
551 |   cmp End+1, x
552 |   bne @loop
553 | 
554 |   pop
555 |   pop
556 |   rts
557 | 
558 | _flush_vram_update_nmi: rts
559 | 
560 | palBrightTableL:
561 | 
562 |   .byte <palBrightTable0,<palBrightTable1,<palBrightTable2
563 |   .byte <palBrightTable3,<palBrightTable4,<palBrightTable5
564 |   .byte <palBrightTable6,<palBrightTable7,<palBrightTable8
565 | 
566 | palBrightTableH:
567 | 
568 |   .byte >palBrightTable0,>palBrightTable1,>palBrightTable2
569 |   .byte >palBrightTable3,>palBrightTable4,>palBrightTable5
570 |   .byte >palBrightTable6,>palBrightTable7,>palBrightTable8
571 | 
572 | palBrightTable0:
573 |   .byte $0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f ;black
574 | palBrightTable1:
575 |   .byte $0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f
576 | palBrightTable2:
577 |   .byte $0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f
578 | palBrightTable3:
579 |   .byte $0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f
580 | palBrightTable4:
581 |   .byte $00,$01,$02,$03,$04,$05,$06,$07,$08,$09,$0a,$0b,$0c,$0f,$0f,$0f ;normal colors
582 | palBrightTable5:
583 |   .byte $10,$11,$12,$13,$14,$15,$16,$17,$18,$19,$1a,$1b,$1c,$00,$00,$00
584 | palBrightTable6:
585 |   .byte $10,$21,$22,$23,$24,$25,$26,$27,$28,$29,$2a,$2b,$2c,$10,$10,$10 ;$10 because $20 is the same as $30
586 | palBrightTable7:
587 |   .byte $30,$31,$32,$33,$34,$35,$36,$37,$38,$39,$3a,$3b,$3c,$20,$20,$20
588 | palBrightTable8:
589 |   .byte $30,$30,$30,$30,$30,$30,$30,$30,$30,$30,$30,$30,$30,$30,$30,$30 ;white
590 |   .byte $30,$30,$30,$30,$30,$30,$30,$30,$30,$30,$30,$30,$30,$30,$30,$30
591 |   .byte $30,$30,$30,$30,$30,$30,$30,$30,$30,$30,$30,$30,$30,$30,$30,$30
592 |   .byte $30,$30,$30,$30,$30,$30,$30,$30,$30,$30,$30,$30,$30,$30,$30,$30
593 | 


--------------------------------------------------------------------------------
/note.s:
--------------------------------------------------------------------------------
1 | 
2 | .byte "Trying a ROM hack? Source code available! https://github.com/RussellSprouts/ice-forth", 0
3 | 


--------------------------------------------------------------------------------
/posts/01-intro.md:
--------------------------------------------------------------------------------
  1 | 
  2 | # IceForth for the Nintendo Entertainment System
  3 | 
  4 | IceForth is a language for writing programs on the NES, hosted on a virtual NES
  5 | cartridge. A few kb of bootstrap machine code is loaded in a virtual 6502
  6 | processor, enough to bootstrap Forth, including an assembler and disassembler.
  7 | The cartridge behaves like a NES cartridge with writeable memory where there
  8 | would usually be ROM. As it reads the source code, it compiles and extends itself,
  9 | filling the cartridge with the rest of the Forth environment and the NES program.
 10 | When the source executes the word `freeze`, it freezes everything into a tidy ROM
 11 | file and stops the simulation. This ROM file contains all the information it needs
 12 | to pick up right where freeze left off, returning from `freeze` as if nothing nothing
 13 | happened and keeps going.
 14 | 
 15 | ## The simulator
 16 | 
 17 | The simulator is a very basic 6502 simulator. It loads the 64kb file bootstrap.bin,
 18 | which is the output of the assembler. It simulates the NES memory map, where
 19 | 00-$7FF is RAM, and $4020-$FFFF is under the control of the cartridge. It adds one
 20 | thing to the hardware -- an io port at an address that was part of the test mode
 21 | of the real processor. This memory address reads
 22 | 
 23 | ## The assembly bootstrap
 24 | 
 25 | 
 26 | ## Understanding Forth
 27 | 
 28 | There are many resources online explaining how the Forth
 29 | language works. (LINKS)
 30 | The most important parts of the Forth interpreter are the
 31 | stacks. These are the primary way of passing data around.
 32 | In the example,
 33 | 
 34 | ```
 35 | 1 2 +
 36 | ```
 37 | 
 38 | `1` pushes the value one onto the data stack, `2` pushes the value two
 39 | onto the data stack, and `+` takes the top two values from the data stack, adds
 40 | them, and pushes the result back onto the data stack. This notation, of
 41 | operands followed by operator is known as reverse Polish notation.
 42 | 
 43 | Forth also has a return stack. This stack is used to store the call stack,
 44 | so that words can call other words and return back to just after the call.
 45 | 
 46 | To oversimplify, here's how the Forth interpreter works:
 47 | First, read input characters until you find a space. Each space-delimited
 48 | string is known as a word. `dup`, `1+`, `'`, `2`, etc. are all valid word names.
 49 | First, the interpreter looks up the word in the dictionary. If it's not found,
 50 | then it tries to parse it as a number. If those fail, then show an error.
 51 | 
 52 | Now, the interpreter checks the value of its `state` variable. If the state
 53 | is interpreting, then it will immediately execute the word. For example, if the word is
 54 | `!` (store), then it will immediately read the address and value from the stack
 55 | and write the value to the address. Numbers are executed by pushing them onto the
 56 | stack.
 57 | 
 58 | If the state is compiling, then it will compile the word. For regular words,
 59 | this means appending `jsr CodeForWord` to the code area. For numbers, this
 60 | means appending assembly code to push the value to the code area.
 61 | 
 62 | Now this is a very simplified view. The first thing that modifies this basic loop
 63 | are the flags in the dictionary.
 64 | 
 65 | - immediate: If a word has this flag, then it will always execute immediately,
 66 |   even in compile mode. For example, the word `[` simply switches `state` to
 67 |   interpret mode. It must do this while in compile mode, otherwise there would be
 68 |   no way to switch out of compile mode, so it is marked with the
 69 |   immediate flag.
 70 | - always\_inline: Instead of compiling as `jsr CodeForWord`, when in compile mode
 71 |   these words are inlined. This saves the overhead of the call. For example, the
 72 |   word drop is implemented as:
 73 | 
 74 |   ```
 75 |   drop:
 76 |     inx
 77 |     inx
 78 |     rts
 79 |   ```
 80 | 
 81 |   Inlined, drop is 4 cycles, and 2 bytes, but with the subroutine it is 19 cycles
 82 |   and 3 bytes. It's always a good idea to inline it.
 83 | 
 84 | - hidden: A word with this flag is in the dictionary but will not be found during
 85 |   a dictionary search.
 86 | 
 87 | Besides the flags, as words are executing they can interact with the words used for
 88 | interpretation. I've already mentioned `[` which modifies the state variable (it also has 
 89 | a twin `]`). The input stream is also open. Though the interpreter only cares about
 90 | space delimited strings, a word is free to consume characters from the input stream
 91 | before returning to the interpreter. The word `."` prints a string, and is used like
 92 | this:
 93 | 
 94 | ```
 95 | ." Hello world"
 96 | ```
 97 | 
 98 | The interpreter sees the word `."`, which is marked immediate, so it executes it.
 99 | `."` then consumes characters until it sees the close quote mark, and either executes
100 | or compiles code to print the string, before returning to the interpreter. This allows
101 | new words to easily extend the interpreter.
102 | 
103 | ## Understanding the Nintendo Entertainment System
104 | 
105 | lda #0
106 | sta Stack, x
107 | lda #0
108 | sta Stack+1, x
109 | 


--------------------------------------------------------------------------------
/relocation-ideas.txt:
--------------------------------------------------------------------------------
1 | 
2 | 1. Inline - use different NOP instructions to mark code for relocation.
3 |    The dictionary defines the start and end points of each word, and
4 |    markers define places where relocation needs to happen.
5 | 


--------------------------------------------------------------------------------
/subroutines.f:
--------------------------------------------------------------------------------
 1 | 
 2 | : { immediate
 3 |   CLV IFVS
 4 | ;
 5 | 
 6 | : } immediate
 7 |   RTS
 8 |   dup THEN
 9 |   [compile] literal
10 | ;
11 | 
12 | : test 0 { 1 0 } execute ;
13 | 


--------------------------------------------------------------------------------
/visualize-ops.html:
--------------------------------------------------------------------------------
  1 | <!doctype html>
  2 | <html>
  3 | <head>
  4 | <title>Operation Visualization</title>
  5 | </head>
  6 | <body style="background-color: #fdd">
  7 |   <textarea style="float:left;width:20%;height:768px;" readonly id="text"></textarea>
  8 |   <div style="float:right;position:relative;width:768px;height:768px;">
  9 |     <canvas style="position:absolute;top:0;left:0" id="c" width=768 height=768></canvas>
 10 |     <canvas style="position:absolute;top:0;left:0;opacity:25%" id="c-overlay" width=768 height=768></canvas>
 11 | 
 12 |   </div>
 13 |   <hr style="clear:both"/>
 14 |   <label>Choose bootstrap.bin and ops.out
 15 |   <input type="file" id="files" multiple />
 16 |   </label>
 17 |   <button id="submit">Submit</button>
 18 |   <script>
 19 |     let c = document.getElementById('c');
 20 |     let ctx = c.getContext('2d');
 21 | 
 22 |     let overlay = document.getElementById('c-overlay');
 23 |     let overlay_ctx = overlay.getContext('2d');
 24 | 
 25 |     function setPixel(x, y, c) {
 26 |       ctx.fillStyle = c;
 27 |       ctx.fillRect(x*3, y*3, 3, 3);
 28 |     }
 29 | 
 30 |     overlay_ctx.fillStyle = 'red';
 31 |     overlay_ctx.fillRect(0, 0, 256*3, 0x8*3);
 32 |     overlay_ctx.fillStyle = 'gray';
 33 |     overlay_ctx.fillRect(0, 8*3, 256*3, (0x40-8) * 3);
 34 | 
 35 |     overlay_ctx.fillStyle = 'blue';
 36 |     overlay_ctx.fillRect(0, 0x40*3, 256*3, 0x20*3);
 37 | 
 38 |     overlay_ctx.fillStyle = 'red';
 39 |     overlay_ctx.fillRect(0, 0x60*3, 256*3, 0x20*3);
 40 | 
 41 |     let memoryState, ops;
 42 | 
 43 |     function byte2Color(byte) {
 44 |       const val = Math.floor(byte / 16).toString(16);
 45 |       return '#' + val + val + val;
 46 |     }
 47 |   
 48 |     let op = 0;
 49 |     let ops_per_frame = 4096;
 50 |     let chars_per_frame = 16;
 51 |     let source = "";
 52 |     let textarea = document.getElementById('text');
 53 |     function startAnimation() {
 54 |       let chars = 0;
 55 |       for (let i = 0; i < ops_per_frame && op < ops.length; i++) {
 56 |         let [opType, addr, val] = ops[op++].split('\t')
 57 |         if (opType == 'w') {
 58 |           setPixel(addr % 256, Math.floor(addr / 256), byte2Color(val % 256));
 59 |         } else if (opType == 'r') {
 60 |           chars++;
 61 |           const nextChar = String.fromCharCode(+addr);
 62 |           source = source + nextChar;
 63 |           textarea.innerHTML = source;
 64 |           textarea.scrollTop = textarea.scrollHeight;
 65 |           if (chars === chars_per_frame) break;
 66 |         }
 67 |       }
 68 | 
 69 |       requestAnimationFrame(startAnimation);
 70 |     }
 71 | 
 72 |     function redraw() {
 73 |       if (memoryState != null) {
 74 |         for (let i = 0; i < memoryState.byteLength; i++) {
 75 |           setPixel(i % 256, Math.floor(i / 256), byte2Color(memoryState[i])); 
 76 |         }
 77 |       }
 78 |   
 79 |       if (memoryState != null && ops != null) {
 80 |         requestAnimationFrame(startAnimation);
 81 |       }
 82 |     }
 83 | 
 84 |     document.getElementById("submit").onclick = function() {
 85 |       let files = document.getElementById("files").files;
 86 |       for (let f of files) {
 87 |         let reader = new FileReader();
 88 | 
 89 |         reader.onloadend = function () {
 90 |           if (reader.result.byteLength === 65536) {
 91 |             memoryState = new Uint8Array(reader.result);
 92 |             console.log(memoryState[0]);
 93 |           } else {
 94 |             ops = new TextDecoder('utf-8').decode(reader.result).split('\n');
 95 |           }
 96 |           console.log(reader.result);
 97 |           redraw();
 98 |         }
 99 | 
100 |         reader.readAsArrayBuffer(f);
101 |       }
102 |     }
103 |     
104 |   </script>
105 | </body>
106 | </html>
107 | 


--------------------------------------------------------------------------------