├── .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 7 | #include 8 | #include 9 | #include 10 | #include 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(in)), 34 | std::istreambuf_iterator()); 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(in)), 43 | std::istreambuf_iterator()); 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 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 ` definitions:` and ` 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 | 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 | 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 | 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 | definitions: 184 | 185 | : >byte [ 186 | stack 1+ LDA.ZX 187 | stack STA.ZX 188 | 0 LDA.# 189 | stack 1+ STA.ZX 190 | ] ; 191 | 192 | : 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.# 213 | stack 1+ STA.ZX 214 | ; 215 | 216 | : ['] immediate ' [compile] literal ; 217 | 218 | 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 | 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 | 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 | 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.# 784 | stack 1+ STA.ZX 785 | 786 | DEX 787 | DEX 788 | 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 | 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 #", HERE_PERM, PERM_LATEST 653 | defconst "", 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 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 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 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 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 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 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) | 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 6 | #include 7 | #include 8 | #include 9 | #include 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(in)), 31 | std::istreambuf_iterator()); 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(in)), 40 | std::istreambuf_iterator()); 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 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 | 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 | 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 | 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 | definitions: 183 | 184 | : >byte [ 185 | stack 1+ LDA.ZX 186 | stack STA.ZX 187 | 0 LDA.# 188 | stack 1+ STA.ZX 189 | ] ; 190 | 191 | : 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.# 212 | stack 1+ STA.ZX 213 | ; 214 | 215 | : ['] immediate ' [compile] literal ; 216 | 217 | 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 | 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 | 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 | 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.# 793 | stack 1+ STA.ZX 794 | 795 | DEX 796 | DEX 797 | 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 | 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 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 |

Monaco Editor Sync Loading Sample

11 | 12 |
13 | 
14 | var a = {};
15 | if (a) {
16 |   console.log(a);
17 | }
18 | 
19 | 
20 | 21 |
22 | 23 | 24 | 25 | 26 | 27 | 28 | 45 | 46 | 47 | 48 | -------------------------------------------------------------------------------- /lit/font.chr: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/RussellSprouts/ice-forth/e8ee101a70bc89f81fd47eb452f0fb56685c1f8d/lit/font.chr -------------------------------------------------------------------------------- /lit/game.f: -------------------------------------------------------------------------------- 1 | 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