diff --git a/apps/forth/dict.asm b/apps/forth/dict.asm index 14cf533..0015a31 100644 --- a/apps/forth/dict.asm +++ b/apps/forth/dict.asm @@ -1,5 +1,6 @@ ; A dictionary entry has this structure: -; - 8b name (zero-padded) +; - 7b name (zero-padded) +; - 1b flags (bit 0: IMMEDIATE) ; - 2b prev pointer ; - 2b code pointer ; - Parameter field (PF) @@ -168,14 +169,16 @@ exit: jp compiledWord ; ( R:I -- ) - .db "QUIT", 0, 0, 0, 0 + .db "QUIT" + .fill 4 .dw EXIT QUIT: .dw nativeWord quit: jp forthRdLine - .db "ABORT", 0, 0, 0 + .db "ABORT" + .fill 3 .dw QUIT ABORT: .dw nativeWord @@ -198,7 +201,8 @@ BYE: ret ; ( c -- ) - .db "EMIT", 0, 0, 0, 0 + .db "EMIT" + .fill 4 .dw BYE EMIT: .dw nativeWord @@ -208,7 +212,8 @@ EMIT: jp exit ; ( addr -- ) - .db "EXECUTE", 0 + .db "EXECUTE" + .db 0 .dw EMIT EXECUTE: .dw nativeWord @@ -239,19 +244,18 @@ DEFINE: ; All we need to do is to know how many bytes to copy. To do so, we ; skip compwords until EXIT is reached. ld (HERE), hl ; where we write compwords. - ; Let's save old RS TOS - ld e, (ix) - ld d, (ix+1) + ld l, (ix) + ld h, (ix+1) .loop: - call RSIsEXIT + call HLPointsEXIT jr z, .loopend call compSkip jr .loop .loopend: - ; At this point, RS' TOS points to EXIT compword. We'll copy it too. + ; At this point, HL points to EXIT compword. We'll copy it too. ; We'll use LDIR. BC will be RSTOP-OLDRSTOP+2 - ld l, (ix) - ld h, (ix+1) + ld e, (ix) + ld d, (ix+1) inc hl \ inc hl ; our +2 or a ; clear carry sbc hl, de @@ -267,7 +271,8 @@ DEFINE: ld (HERE), de ; update HERE jp exit - .db "DOES>", 0, 0, 0 + .db "DOES>" + .fill 3 .dw DEFINE DOES: .dw nativeWord @@ -300,7 +305,8 @@ KEY: push hl jp exit - .db "INTERPRE" + .db "INTERPR" + .db 0 .dw KEY INTERPRET: .dw nativeWord @@ -317,7 +323,8 @@ interpret: ld iy, COMPBUF jp compiledWord - .db "CREATE", 0, 0 + .db "CREATE" + .fill 2 .dw INTERPRET CREATE: .dw nativeWord @@ -338,7 +345,8 @@ HERE_: ; Caution: conflicts with actual variable name .dw sysvarWord .dw HERE - .db "CURRENT", 0 + .db "CURRENT" + .db 0 .dw HERE_ CURRENT_: .dw sysvarWord @@ -514,7 +522,8 @@ STOREINC: ; ( n -- ) ; HERE +! - .db "ALLOT", 0, 0, 0 + .db "ALLOT" + .fill 3 .dw STOREINC ALLOT: .dw compiledWord @@ -523,7 +532,8 @@ ALLOT: .dw EXIT ; CREATE 2 ALLOT - .db "VARIABLE" + .db "VARIABL" + .db 0 .dw ALLOT VARIABLE: .dw compiledWord @@ -535,7 +545,8 @@ VARIABLE: ; ( n -- ) ; CREATE HERE @ ! DOES> @ - .db "CONSTANT" + .db "CONSTAN" + .db 0 .dw VARIABLE CONSTANT: .dw compiledWord diff --git a/apps/forth/main.asm b/apps/forth/main.asm index cd25199..3042579 100644 --- a/apps/forth/main.asm +++ b/apps/forth/main.asm @@ -4,9 +4,9 @@ ; Number of bytes we keep as a padding between HERE and the scratchpad .equ PADDING 0x20 ; Max length of dict entry names -.equ NAMELEN 8 +.equ NAMELEN 7 ; Offset of the code link relative to the beginning of the word -.equ CODELINK_OFFSET NAMELEN+2 +.equ CODELINK_OFFSET NAMELEN+3 ; *** Variables *** .equ INITIAL_SP FORTH_RAMSTART diff --git a/apps/forth/util.asm b/apps/forth/util.asm index 80f42be..03433cd 100644 --- a/apps/forth/util.asm +++ b/apps/forth/util.asm @@ -43,78 +43,78 @@ readword: inc a ; unset Z ret -RSIsDE: - push hl - ld l, (ix) - ld h, (ix+1) +; Sets Z if (HL) == E and (HL+1) == D +HLPointsDE: ld a, (hl) cp e - jr nz, .end ; no + ret nz ; no inc hl ld a, (hl) + dec hl cp d ; Z has our answer -.end: - pop hl ret -; Is RS' TOS pointing to a NUMBER word? -; Z if yes, NZ if no. -RSIsNUMBER: +HLPointsNUMBER: push de ld de, NUMBER - call RSIsDE + call HLPointsDE pop de ret -; Is RS' TOS pointing to a LIT word? -; Z if yes, NZ if no. -RSIsLIT: +HLPointsLIT: push de ld de, LIT - call RSIsDE + call HLPointsDE pop de ret -; Is RS' TOS pointing to EXIT? -; Z if yes, NZ if no. -RSIsEXIT: +HLPointsEXIT: push de ld de, EXIT - call RSIsDE + call HLPointsDE pop de ret -; Skip the compword where RS' TOS is currently pointing. If it's a regular word, +; Skip the compword where HL is currently pointing. If it's a regular word, ; it's easy: we inc by 2. If it's a NUMBER, we inc by 4. If it's a LIT, we skip ; to after null-termination. compSkip: - push hl - ld l, (ix) - ld h, (ix+1) - ; At the minimum, we skip by 2 - inc hl \ inc hl - call RSIsNUMBER + call HLPointsNUMBER jr z, .isNum - call RSIsLIT - jr nz, .end ; A word + call HLPointsLIT + jr nz, .isWord ; We have a literal + inc hl \ inc hl call strskip inc hl ; byte after word termination - jr .end + ret .isNum: ; skip by 4 inc hl \ inc hl -.end: - ; HL is good, write it to RS - ld (ix), l - ld (ix+1), h - pop hl + ; continue to isWord +.isWord: + ; skip by 2 + inc hl \ inc hl ret -; Checks RS' TOS and, if it points to a string literal (LIT), makes HL point -; to it and advance IP to byte following null-termination. -; If it doesn't, things get interesting: If it's a word reference, then it's +; The goal of this routine is to read a string literal following the currently +; executed words. For example, CREATE and DEFINE need this. Things are a little +; twisted, so bear with me while I explain how it works. +; +; When we call this routine, everything has been compiled. We're on an atom and +; we're executing it. Now, we're looking for a string literal or a word-with-a +; name that follows our readCompWord caller. We could think that this word is +; right there on RS' TOS, but no! You have to account for words wrapping the +; caller. For example, "VARIABLE" calls "CREATE". If you call "VARIABLE foo", +; if CREATE looks at what follows in RS' TOS, it will only find the "2" in +; "CREATE 2 ALLOT". +; +; Therefore, we actually need to check in RS' *bottom of stack* for our answer. +; If that atom is a LIT, we're good. We make HL point to it and advance IP to +; byte following null-termination. +; +; If it isn't, things get interesting: If it's a word reference, then it's ; not an invalid literal. For example, one could want to redefine an existing ; word. So in that case, we'll copy the word's name on the pad (it might not be ; null-terminated) and set HL to point to it. @@ -124,18 +124,22 @@ compSkip: ; word. Yeah, it means that ";" can't be overridden... ; If name can't be read, we abort readCompWord: - ; In all cases, we want RS' TOS in HL. Let's get it now. - ld l, (ix) - ld h, (ix+1) - call RSIsLIT + ; In all cases, we want RS' BOS in HL. Let's get it now. + ld hl, (RS_ADDR) + call HLPointsLIT jr nz, .notLIT - ; RS TOS is a LIT, make HL point to string, then skip this RS compword. + ; RS BOS is a LIT, make HL point to string, then skip this RS compword. inc hl \ inc hl ; HL now points to string itself - jr compSkip + push hl ; --> lvl 1, our result + call strskip + inc hl ; byte after word termination + ld (RS_ADDR), hl + pop hl ; <-- lvl 1, our result + ret .notLIT: ; Alright, not a literal, but is it a word? If it's not a number, then ; it's a word. - call RSIsNUMBER + call HLPointsNUMBER jr z, .notWord ; Not a number, then it's a word. Copy word to pad and point to it. call intoHL @@ -153,7 +157,9 @@ readCompWord: ; null-terminate xor a ld (de), a - call compSkip + ; Advance RS' BOS by 2 + ld hl, RS_ADDR + inc (hl) \ inc (hl) pop hl ; <-- lvl 1 ret .notWord: @@ -251,13 +257,15 @@ compile: ; HL points to new (HERE) entryhead: call readCompWord - call printstr ld de, (HERE) call strcpy ex de, hl ; (HERE) now in HL ld de, (CURRENT) ld a, NAMELEN call addHL + xor a ; IMMED + ld (hl), a + inc hl ld (hl), e inc hl ld (hl), d