From 0b3f6253e4e22aee6e94353324b639c4fece7517 Mon Sep 17 00:00:00 2001 From: Virgil Dupras Date: Mon, 9 Mar 2020 22:13:11 -0400 Subject: [PATCH] forth: add support for IMMEDIATE words --- apps/forth/dict.asm | 112 ++++++++++++++++++++++++++++++++++++++-------- apps/forth/dictionary.txt | 60 ++++++++++++++----------- apps/forth/util.asm | 17 +++++++ 3 files changed, 145 insertions(+), 44 deletions(-) diff --git a/apps/forth/dict.asm b/apps/forth/dict.asm index 0015a31..d8b33fa 100644 --- a/apps/forth/dict.asm +++ b/apps/forth/dict.asm @@ -243,34 +243,75 @@ DEFINE: ; been compiled by INTERPRET*. All those bytes will be copied as-is. ; 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. + ex de, hl ; DE is our dest ld l, (ix) ld h, (ix+1) .loop: - call HLPointsEXIT - jr z, .loopend - call compSkip + call HLPointsNUMBER + jr nz, .notNUMBER + ; is number + ld bc, 4 + ldir jr .loop -.loopend: - ; At this point, HL points to EXIT compword. We'll copy it too. - ; We'll use LDIR. BC will be RSTOP-OLDRSTOP+2 - ld e, (ix) - ld d, (ix+1) - inc hl \ inc hl ; our +2 - or a ; clear carry - sbc hl, de - ld b, h - ld c, l - ; BC has proper count - ex de, hl ; HL is our source (old RS' TOS) - ld de, (HERE) ; and DE is our dest - ldir ; go! +.notNUMBER: + call HLPointsLIT + jr nz, .notLIT + ; is lit + ldi + ldi + inc hl \ inc hl + call strcpyM + inc hl ; byte after word termination + jr .loop +.notLIT: + ; it's a word + call HLPointsIMMED + 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 e, (hl) + inc hl + ld d, (hl) + inc hl ; point to next word + push de \ pop iy ; prepare for executeCodeLink + ld (ix), l + ld (ix+1), h + ; Push return address + ld hl, .retList + call pushRS + ; Ready! + jp executeCodeLink +.notIMMED: + ; a good old regular word. We have 2 bytes to copy. But before we do, + ; let's check whether it's an EXIT. LDI doesn't affect Z, so we can + ; make our jump later. + call HLPointsEXIT + ldi + ldi + jr nz, .loop ; HL has our new RS' TOS ld (ix), l ld (ix+1), h ld (HERE), de ; update HERE jp exit +; This label is pushed to RS when an IMMED word is called. When that word calls +; exit, this is where it returns. When we return, RS will need to be popped so +; that we stay on the proper RS level. +.retList: + .dw .retWord +.retWord: + .dw .retEntry +.retEntry: + call popRS ; unwind stack + ; recall old HL / DE values + ld l, (ix) + ld h, (ix+1) + ld de, (HERE) + ; continue! + jr .loop + .db "DOES>" .fill 3 .dw DEFINE @@ -293,10 +334,43 @@ DOES: ld (HERE), iy jp exit + + .db "IMMEDIA" + .db 0 + .dw DOES +IMMEDIATE: + .dw nativeWord + ld hl, (CURRENT) + dec hl + dec hl + dec hl + inc (hl) + jp exit + +; ( n -- ) + .db "LITERAL" + .db 1 ; IMMEDIATE + .dw IMMEDIATE +LITERAL: + .dw nativeWord + ld hl, (HERE) + ld de, NUMBER + ld (hl), e + inc hl + ld (hl), d + inc hl + pop de ; number from stack + ld (hl), e + inc hl + ld (hl), d + inc hl + ld (HERE), hl + jp exit + ; ( -- c ) .db "KEY" .fill 5 - .dw DOES + .dw LITERAL KEY: .dw nativeWord call stdioGetC diff --git a/apps/forth/dictionary.txt b/apps/forth/dictionary.txt index 0efc49e..b02e2b9 100644 --- a/apps/forth/dictionary.txt +++ b/apps/forth/dictionary.txt @@ -25,39 +25,49 @@ Atom: A word of the type compiledWord contains, in its PF, a list of what we call "atoms". Those atoms are most of the time word references, but they can also be references to NUMBER and LIT. -*** Native Words *** - +*** Defining words *** : x ... -- Define a new word ; R:I -- Exit a colon definition -. n -- Print n in its decimal form +ALLOT n -- Move HERE by n bytes +CREATE x -- Create cell named x. Doesn't allocate a PF. +CONSTANT x n -- Creates cell x that when called pushes its value +DOES> -- See description at top of file +IMMEDIATE -- Flag the latest defined word as immediate. +LITERAL n -- Inserts number from TOS as a literal +VARIABLE c -- Creates cell x with 2 bytes allocation. + +*** Flow *** +ELSE -- Branch to THEN +EXECUTE a -- Execute wordref at addr a +IF n -- Branch to ELSE or THEN if n is zero +INTERPRET -- Get a line from stdin, compile it in tmp memory, + then execute the compiled contents. +QUIT R:drop -- Return to interpreter promp immediately +THEN -- Does nothing. Serves as a branching merker for IF + and ELSE. + +*** Stack *** +DUP a -- a a +OVER a b -- a b a +SWAP a b -- b a + +*** Memory *** @ a -- n Set n to value at address a ! n a -- Store n in address a +? a -- Print value of addr a ++! n a -- Increase value of addr a by n +CURRENT -- n Set n to wordref of last added entry. +HERE -- a Push HERE's address + +*** Arithmetic *** + + a b -- c a + b -> c - a b -- c a - b -> c * a b -- c a * b -> c / a b -- c a / b -> c -CREATE x -- Create cell named x. Doesn't allocate a PF. -CURRENT -- n Set n to wordref of last added entry. -DOES> -- See description at top of file -DUP a -- a a -ELSE -- Branch to THEN + +*** I/O *** +. n -- Print n in its decimal form EMIT c -- Spit char c to stdout -EXECUTE a -- Execute wordref at addr a -HERE -- a Push HERE's address -IF n -- Branch to ELSE or THEN if n is zero -QUIT R:drop -- Return to interpreter promp immediately KEY -- c Get char c from stdin -INTERPRET -- Get a line from stdin, compile it in tmp memory, - then execute the compiled contents. -OVER a b -- a b a -SWAP a b -- b a -THEN -- Does nothing. Serves as a branching merker for IF - and ELSE. -*** Core-but-Forth Words *** - -? a -- Print value of addr a -+! n a -- Increase value of addr a by n -ALLOT n -- Move HERE by n bytes -CONSTANT x n -- Creates cell x that when called pushes its value -VARIABLE c -- Creates cell x with 2 bytes allocation. diff --git a/apps/forth/util.asm b/apps/forth/util.asm index 03433cd..03282e9 100644 --- a/apps/forth/util.asm +++ b/apps/forth/util.asm @@ -274,3 +274,20 @@ entryhead: ld (HERE), hl xor a ; set Z ret + +; Sets Z if wordref at (HL) is of the IMMEDIATE type +HLPointsIMMED: + push hl + call intoHL + dec hl + dec hl + dec hl + ; We need an invert flag. We want to Z to be set when flag is non-zero. + ld a, 1 + and (hl) + dec a ; if A was 1, Z is set. Otherwise, Z is unset + inc hl + inc hl + inc hl + pop hl + ret