#include "user.inc" ; *** Consts *** ARGSPEC_SINGLE_CNT .equ 7 ARGSPEC_TBL_CNT .equ 12 INSTR_TBL_PRIMARYC_CNT .equ 25 ; *** Code *** .org USER_CODE call parseLine ld b, 0 ld c, a ; written bytes ret ; Sets Z is A is ';', CR, LF, or null. isLineEnd: cp ';' ret z cp 0 ret z cp 0x0d ret z cp 0x0a ret ; Sets Z is A is ' ' or ',' isSep: cp ' ' ret z cp ',' ret ; Sets Z is A is ' ', ',', ';', CR, LF, or null. isSepOrLineEnd: call isSep ret z call isLineEnd ret ; read word in (HL) and put it in (DE), null terminated. A is the read ; length. HL is advanced to the next separator char. readWord: push bc ld b, 4 .loop: ld a, (hl) call isSepOrLineEnd jr z, .success call JUMP_UPCASE ld (de), a inc hl inc de djnz .loop .success: xor a ld (de), a ld a, 4 sub a, b jr .end .error: xor a ld (de), a .end: pop bc ret ; (HL) being a string, advance it to the next non-sep character. ; Set Z if we could do it before the line ended, reset Z if we couldn't. toWord: .loop: ld a, (hl) call isLineEnd jr z, .error call isSep jr nz, .success inc hl jr .loop .error: ; we need the Z flag to be unset and it is set now. Let's CP with ; something it can't be equal to, something not a line end. cp 'a' ; Z flag unset ret .success: ; We need the Z flag to be set and it is unset. Let's compare it with ; itself to return a set Z cp a ret ; Read arg from (HL) into argspec at (DE) ; HL is advanced to the next word. Z is set if there's a next word. readArg: push de ld de, tmpVal call readWord push hl ld hl, tmpVal call matchArg pop hl pop de ld (de), a call toWord ret ; Read line from (HL) into (curWord), (curArg1) and (curArg2) readLine: push de xor a ld (curWord), a ld (curArg1), a ld (curArg2), a ld de, curWord call readWord call toWord jr nz, .end ld de, curArg1 call readArg jr nz, .end ld de, curArg2 call readArg .end: pop de ret ; Returns length of string at (HL) in A. strlen: push bc push hl ld bc, 0 ld a, 0 ; look for null char .loop: cpi jp z, .found jr .loop .found: ; How many char do we have? the (NEG BC)-1, which started at 0 and ; decreased at each CPI call. In this routine, we stay in the 8-bit ; realm, so C only. ld a, c neg dec a pop hl pop bc ret ; find argspec for string at (HL). Returns matching argspec in A. ; Return value 1 holds a special meaning: arg is not empty, but doesn't match ; any argspec (A == 0 means arg is empty). A return value of 1 means an error. matchArg: call strlen cp 0 ret z ; empty string? A already has our result: 0 push bc push de push hl cp 1 jr z, .matchsingle ; Arg is one char? We have a "single" type. ; Not a "single" arg. Do the real thing then. ld de, argspecTbl ; DE now points the the "argspec char" part of the entry, but what ; we're comparing in the loop is the string next to it. Let's offset ; DE by one so that the loop goes through strings. inc de ld b, ARGSPEC_TBL_CNT .loop1: ld a, 4 call JUMP_STRNCMP jr z, .found ; got it! ld a, 5 call JUMP_ADDDE djnz .loop1 ; exhausted? we have a problem os specifying a wrong argspec. This is ; an internal consistency error. ld a, 1 jr .end .found: ; found the matching argspec row. Our result is one byte left of DE. dec de ld a, (de) jr .end .matchsingle: ld a, (hl) ld hl, argspecsSingle ld bc, ARGSPEC_SINGLE_CNT .loop2: cpi jr z, .end ; found! our result is already in A. go straight ; to end. jp po, .loop2notfound jr .loop2 .loop2notfound: ; something's wrong. error ld a, 1 jr .end .end: pop hl pop de pop bc ret ; Compare primary row at (DE) with string at curWord. Sets Z flag if there's a ; match, reset if not. matchPrimaryRow: push hl push ix ld hl, curWord ld a, 4 call JUMP_STRNCMP jr nz, .end ; name matches, let's see the rest ld ixh, d ld ixl, e ld a, (curArg1) cp (ix+4) jr nz, .end ld a, (curArg2) cp (ix+5) .end: pop ix pop hl ret ; Parse line at (HL) and write resulting opcode(s) in (DE). Returns the number ; of bytes written in A. parseLine: call readLine push de ld de, instrTBlPrimaryC ld b, INSTR_TBL_PRIMARYC_CNT .loop: ld a, (de) call matchPrimaryRow jr z, .match ld a, 7 call JUMP_ADDDE djnz .loop ; no match xor a pop de ret .match: ld a, 6 ; upcode is on 7th byte call JUMP_ADDDE ld a, (de) pop de ld (de), a ld a, 1 ret ; In instruction metadata below, argument types arge indicated with a single ; char mnemonic that is called "argspec". This is the table of correspondance. ; Single letters are represented by themselves, so we don't need as much ; metadata. argspecsSingle: .db "ABCDEHL" ; Format: 1 byte argspec + 4 chars string argspecTbl: .db 'h', "HL", 0, 0 .db 'l', "(HL)" .db 'd', "DE", 0, 0 .db 'e', "(DE)" .db 'b', "BC", 0, 0 .db 'c', "(BC)" .db 'a', "AF", 0, 0 .db 'f', "AF'", 0 .db 'x', "(IX)" .db 'y', "(IY)" .db 's', "SP", 0, 0 .db 'p', "(SP)" ; This is a list of primary instructions (single upcode) that lead to a ; constant (no group code to insert). Format: ; ; 4 bytes for the name (fill with zero) ; 1 byte for arg constant ; 1 byte for 2nd arg constant ; 1 byte for upcode instrTBlPrimaryC: .db "ADD", 0, 'A', 'h', 0x86 ; ADD A, HL .db "CCF", 0, 0, 0, 0x3f ; CCF .db "CPL", 0, 0, 0, 0x2f ; CPL .db "DAA", 0, 0, 0, 0x27 ; DAA .db "DI",0,0, 0, 0, 0xf3 ; DI .db "EI",0,0, 0, 0, 0xfb ; EI .db "EX",0,0, 'p', 'h', 0xe3 ; EX (SP), HL .db "EX",0,0, 'a', 'f', 0x08 ; EX AF, AF' .db "EX",0,0, 'd', 'h', 0xeb ; EX DE, HL .db "EXX", 0, 0, 0, 0xd9 ; EXX .db "HALT", 0, 0, 0x76 ; HALT .db "INC", 0, 'l', 0, 0x34 ; INC (HL) .db "JP",0,0, 'l', 0, 0xe9 ; JP (HL) .db "LD",0,0, 'c', 'A', 0x02 ; LD (BC), A .db "LD",0,0, 'e', 'A', 0x12 ; LD (DE), A .db "LD",0,0, 'A', 'c', 0x0a ; LD A, (BC) .db "LD",0,0, 'A', 'e', 0x0a ; LD A, (DE) .db "LD",0,0, 's', 'h', 0x0a ; LD SP, HL .db "NOP", 0, 0, 0, 0x00 ; NOP .db "RET", 0, 0, 0, 0xc9 ; RET .db "RLA", 0, 0, 0, 0x17 ; RLA .db "RLCA", 0, 0, 0x07 ; RLCA .db "RRA", 0, 0, 0, 0x1f ; RRA .db "RRCA", 0, 0, 0x0f ; RRCA .db "SCF", 0, 0, 0, 0x37 ; SCF ; *** Variables *** ; enough space for 4 chars and a null curWord: .db 0, 0, 0, 0, 0 ; Args are 3 bytes: argspec, then values of numerical constants (when that's ; appropriate) curArg1: .db 0, 0, 0 curArg2: .db 0, 0, 0 ; space for tmp stuff tmpVal: .db 0, 0, 0, 0, 0