diff --git a/apps/forth/dict.asm b/apps/forth/dict.asm index cbff0e6..de45a48 100644 --- a/apps/forth/dict.asm +++ b/apps/forth/dict.asm @@ -51,69 +51,31 @@ doesWord: push hl \ pop iy jr compiledWord -; The IF word checks the stack for zero. If it's non-zero, it does nothing and -; allow compiledWord to continue. -; If it's zero, it tracksback RS, advance it until it finds a ELSE, a THEN, or -; an EXIT (not supposed to happen unless the IF is misconstructed). Whether -; it's a ELSE or THEN, the same thing happens: we resume execution after the -; ELSE/THEN. If it's a EXIT, we simply execute it. -ifWord: +; This word is followed by a wordref to branch to. Set RS to that address. +branchWord: + ld l, (ix) + ld h, (ix+1) + call intoHL + ld (ix), l + ld (ix+1), h + jp exit + +BRANCH: + .dw branchWord + +; Conditional branch, only branch if TOS is zero +cbranchWord: pop hl ld a, h or l - jp nz, exit ; non-zero, continue - ; Zero, seek ELSE, THEN or EXIT. Continue to elseWord - -; If a ELSE word is executed, it means that the preceding IF had a non-zero -; condition and continued execution. This means that upon encountering an ELSE, -; we must search for a THEN or an EXIT. -; To simplify implementation and share code with ifWord, we also match ELSE, -; which is only possible in malformed construct. Therefore "IF ELSE ELSE" is -; valid and interpreted as "IF ELSE THEN". -elseWord: - ; to save processing, we test EXIT, ELSE and THEN in the order they - ; appear, address-wise. This way, we don't need to push/pop HL: we can - ; SUB the difference between the words and check for zeroes. - call popRS - ; We need to save that IP somewhere. Let it be BC - ld b, h - ld c, l -.loop: - ; Whether there's a match or not, we will resume the operation at IP+2, - ; which means that we have to increase BC anyways. Let's do it now. - inc bc \ inc bc - call intoHL - or a ; clear carry - ld de, EXIT - sbc hl, de - jp z, exit - ; Not EXIT, let's continue with ELSE. No carry possible because EXIT - ; is first word. No need to clear. - ld de, ELSE-EXIT - sbc hl, de - jr c, .nomatch ; A word between EXIT and ELSE. No match. - jr z, .match ; We have a ELSE - ; Let's try with THEN. Again, no carry possible, C cond was handled. - ld de, THEN-ELSE - sbc hl, de - jr z, .match ; We have a THEN -.nomatch: - ; Nothing matched, which means that we need to continue looking. - ; BC is already IP+2 - ld h, b - ld l, c - jr .loop -.match: - ; Matched a ELSE or a THEN, which means we need to continue executing - ; word from IP+2, which is already in BC. - push bc \ pop iy - jp compiledWord - -; This word does nothing. It's never going to be executed unless the wordlist -; is misconstructed. -thenWord: + jr z, branchWord + ; skip next 2 bytes + call skipRS jp exit +CBRANCH: + .dw cbranchWord + ; This is not a word, but a number literal. This works a bit differently than ; others: PF means nothing and the actual number is placed next to the ; numberWord reference in the compiled word list. What we need to do to fetch @@ -121,12 +83,14 @@ thenWord: ; it to the Parameter stack and then push an increase Interpreter Pointer back ; to RS. numberWord: - call popRS + ld l, (ix) + ld h, (ix+1) ld e, (hl) inc hl ld d, (hl) inc hl - call pushRS + ld (ix), l + ld (ix+1), h push de jp exit NUMBER: @@ -186,6 +150,8 @@ abort: ; Reinitialize PS (RS is reinitialized in forthInterpret ld sp, (INITIAL_SP) jp forthRdLine +ABORTREF: + .dw ABORT .db "BYE" .fill 5 @@ -290,7 +256,7 @@ DEFINE: jr nz, .notIMMED ; Immediate word, we'll have to call it. ; Before we make our call, let's save our current HL/DE position - ld (HERE), de + ld (CMPDST), de ld e, (hl) inc hl ld d, (hl) @@ -329,7 +295,7 @@ DEFINE: ; recall old HL / DE values ld l, (ix) ld h, (ix+1) - ld de, (HERE) + ld de, (CMPDST) ; continue! jr .loop @@ -374,18 +340,12 @@ IMMEDIATE: .dw IMMEDIATE LITERAL: .dw nativeWord - ld hl, (HERE) + ld hl, (CMPDST) ld de, NUMBER - ld (hl), e - inc hl - ld (hl), d - inc hl + call DEinHL pop de ; number from stack - ld (hl), e - inc hl - ld (hl), d - inc hl - ld (HERE), hl + call DEinHL + ld (CMPDST), hl jp exit ; ( -- c ) @@ -400,27 +360,9 @@ KEY: push hl jp exit - .db "INTERPR" - .db 0 - .dw KEY -INTERPRET: - .dw nativeWord -interpret: - ld iy, COMPBUF -.loop: - call readword - jr nz, .end - call compile - jr .loop -.end: - ld hl, QUIT - call wrCompHL - ld iy, COMPBUF - jp compiledWord - .db "CREATE" .fill 2 - .dw INTERPRET + .dw KEY CREATE: .dw nativeWord call entryhead @@ -607,22 +549,61 @@ CMP: jp exit .db "IF" - .fill 6 + .fill 5 + .db 1 ; IMMEDIATE .dw CMP IF: - .dw ifWord + .dw nativeWord + ; Spit a conditional branching atom, followed by 2 empty bytes. Then, + ; push the address of those 2 bytes on the PS. ELSE or THEN will pick + ; them up and set their own address in those 2 bytes. + ld hl, (CMPDST) + ld de, CBRANCH + call DEinHL + push hl ; address of cell to fill + ; For now, let's fill it with a reference to ABORT in case we have a + ; malformed construct + ld de, ABORTREF + call DEinHL + ld (CMPDST), hl + jp exit .db "ELSE" - .fill 4 + .fill 3 + .db 1 ; IMMEDIATE .dw IF ELSE: - .dw elseWord + .dw nativeWord + ; Set IF's branching cell to current atom address and spit our own + ; uncondition branching cell, which will then be picked up by THEN. + ; First, let's spit our 4 bytes + ld hl, (CMPDST) + ld de, BRANCH + call DEinHL + push hl ; address of cell to fill + ld de, ABORTREF + call DEinHL + ld (CMPDST), hl + ; We've spit our ELSE bytes, but we haven't updated our IF's forward + ; branching cell. That cell's address is currently at (SP-2). Let's do + ; some stack-fu to get it. + ex de, hl ; value to write now in DE + pop hl + ex (sp), hl ; IF's cell's address now in HL + call DEinHL + jp exit .db "THEN" - .fill 4 + .fill 3 + .db 1 ; IMMEDIATE .dw ELSE THEN: - .dw thenWord + .dw nativeWord + ; See comments in IF and ELSE + pop hl ; where to put our own address + ld de, (CMPDST) ; that's our branching address + call DEinHL + jp exit .db "RECURSE" .db 0 @@ -755,5 +736,3 @@ LATEST: .dw 1 .dw EQ .dw EXIT - -; diff --git a/apps/forth/main.asm b/apps/forth/main.asm index ab8cb61..42669d9 100644 --- a/apps/forth/main.asm +++ b/apps/forth/main.asm @@ -12,11 +12,35 @@ .equ INITIAL_SP FORTH_RAMSTART .equ CURRENT @+2 .equ HERE @+2 +; Pointer to where we currently are in the interpretation of the current line. .equ INPUTPOS @+2 +; Pointer to where compiling words should output. During interpret, it's a +; moving target in (COMPBUF). During DEFINE, it's (HERE). +.equ CMPDST @+2 ; Buffer where we compile the current input line. Same size as STDIO_BUFSIZE. .equ COMPBUF @+2 .equ FORTH_RAMEND @+0x40 +; EXECUTION MODEL +; After having read a line through stdioReadLine, we want to interpret it. As +; a general rule, we go like this: +; +; 1. read single word from line +; 2. compile word to atom +; 3. execute atom +; 4. goto 1 +; +; During step 3, it's possible that atom read from input, so INPUTPOS might +; have moved between 3 and 4. +; +; Because the Parameter Stack uses PS, we can't just go around calling routines: +; This messes with the PS. This is why we almost always jump (unless our call +; doesn't involve Forth words in any way). +; +; This presents a challenge for our interpret loop because step 4, "goto 1" +; isn't obvious. To be able to do that, we must push a "return routine" to the +; Return Stack before step 3. + ; *** Code *** forthMain: ; STACK OVERFLOW PROTECTION: @@ -36,10 +60,70 @@ forthRdLine: call printstr call printcrlf call stdioReadLine - ld (INPUTPOS), hl -forthInterpret: ld ix, RS_ADDR-2 ; -2 because we inc-before-push - ld iy, INTERPRET + ld (INPUTPOS), hl + ld hl, COMPBUF + ld (CMPDST), hl +forthInterpret: + call readword + jr nz, .execute + call find + jr nz, .maybeNum + ex de, hl + call HLisIMMED + jr z, .immed + ex de, hl + call .writeDE + jr forthInterpret +.maybeNum: + push hl ; --> lvl 1. save string addr + call parseLiteral + pop hl ; <-- lvl 1 + jr nz, .undef + ; a valid number in DE! + ex de, hl + ld de, NUMBER + call .writeDE + ex de, hl ; number in DE + call .writeDE + jr forthInterpret +.undef: + ; When encountering an undefined word during compilation, we spit a + ; reference to litWord, followed by the null-terminated word. + ; This way, if a preceding word expect a string literal, it will read it + ; by calling readLIT, and if it doesn't, the routine will be + ; called, triggering an abort. + ld de, LIT + call .writeDE + ld de, (CMPDST) + call strcpyM + ld (CMPDST), de + jr forthInterpret +.immed: + push hl ; --> lvl 1 + ld hl, .retRef + call pushRS + pop iy ; <-- lvl 1 jp executeCodeLink +.execute: + ld de, QUIT + call .writeDE + ld iy, COMPBUF + jp compiledWord +.writeDE: + push hl + ld hl, (CMPDST) + ld (hl), e + inc hl + ld (hl), d + inc hl + ld (CMPDST), hl + pop hl + ret + +.retRef: + .dw $+2 + .dw forthInterpret + msgOk: .db " ok", 0 diff --git a/apps/forth/stack.asm b/apps/forth/stack.asm index a17b728..2ab221c 100644 --- a/apps/forth/stack.asm +++ b/apps/forth/stack.asm @@ -25,6 +25,17 @@ popRS: dec ix ret +; Skip the next two bytes in RS' TOS +skipRS: + push hl + ld l, (ix) + ld h, (ix+1) + inc hl \ inc hl + ld (ix), l + ld (ix+1), h + pop hl + ret + ; Verifies that SP is within bounds. If it's not, call ABORT chkPS: ld hl, (INITIAL_SP) diff --git a/apps/forth/util.asm b/apps/forth/util.asm index 18c7e50..b0720d8 100644 --- a/apps/forth/util.asm +++ b/apps/forth/util.asm @@ -257,42 +257,6 @@ wrCompHL: inc iy ret -; Compile word string at (HL) and write down its compiled version in IY, -; advancing IY to the byte next to the last written byte. -compile: - call find - jr nz, .maybeNum - ex de, hl - jr wrCompHL -.maybeNum: - push hl ; --> lvl 1. save string addr - call parseLiteral - jr nz, .undef - pop hl ; <-- lvl 1 - ; a valid number! - ld hl, NUMBER - call wrCompHL - ex de, hl ; number in HL - jr wrCompHL -.undef: - ; When encountering an undefined word during compilation, we spit a - ; reference to litWord, followed by the null-terminated word. - ; This way, if a preceding word expect a string literal, it will read it - ; by calling readLIT, and if it doesn't, the routine will be - ; called, triggering an abort. - ld hl, LIT - call wrCompHL - pop hl ; <-- lvl 1. recall string addr -.writeLit: - ld a, (hl) - ld (iy), a - inc hl - inc iy - or a - jr nz, .writeLit - ret - - ; Spit name + prev in (HERE) and adjust (HERE) and (CURRENT) ; HL points to new (HERE) entryhead: @@ -315,10 +279,8 @@ entryhead: xor a ; set Z ret -; Sets Z if wordref at (HL) is of the IMMEDIATE type -HLPointsIMMED: - push hl - call intoHL +; Sets Z if wordref at HL is of the IMMEDIATE type +HLisIMMED: dec hl dec hl dec hl @@ -329,6 +291,13 @@ HLPointsIMMED: inc hl inc hl inc hl + ret + +; Sets Z if wordref at (HL) is of the IMMEDIATE type +HLPointsIMMED: + push hl + call intoHL + call HLisIMMED pop hl ret @@ -343,3 +312,10 @@ flagsToBC: dec bc ret +; Write DE in (HL), advancing HL by 2. +DEinHL: + ld (hl), e + inc hl + ld (hl), d + inc hl + ret