diff --git a/apps/forth/dict.asm b/apps/forth/dict.asm index 99fdea3..cbff0e6 100644 --- a/apps/forth/dict.asm +++ b/apps/forth/dict.asm @@ -282,9 +282,7 @@ DEFINE: ; is lit ldi ldi - inc hl \ inc hl call strcpyM - inc hl ; byte after word termination jr .loop .notLIT: ; it's a word @@ -309,7 +307,7 @@ DEFINE: ; 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 + call HLPointsEXITQUIT ldi ldi jr nz, .loop @@ -487,10 +485,20 @@ FETCH: push hl jp exit +; ( -- a ) + .db "LIT@" + .fill 4 + .dw FETCH +LITFETCH: + .dw nativeWord + call readLITTOS + push hl + jp exit + ; ( a b -- b a ) .db "SWAP" .fill 4 - .dw FETCH + .dw LITFETCH SWAP: .dw nativeWord pop hl @@ -571,9 +579,36 @@ DIV: push bc jp exit +; ( a1 a2 -- b ) + .db "SCMP" + .fill 4 + .dw DIV +SCMP: + .dw nativeWord + pop de + pop hl + call strcmp + call flagsToBC + push bc + jp exit + +; ( n1 n2 -- f ) + .db "CMP" + .fill 5 + .dw SCMP +CMP: + .dw nativeWord + pop hl + pop de + or a ; clear carry + sbc hl, de + call flagsToBC + push bc + jp exit + .db "IF" .fill 6 - .dw DIV + .dw CMP IF: .dw ifWord @@ -589,13 +624,25 @@ ELSE: THEN: .dw thenWord + .db "RECURSE" + .db 0 + .dw THEN +RECURSE: + .dw nativeWord + call popRS + ld l, (ix) + ld h, (ix+1) + dec hl \ dec hl + push hl \ pop iy + jp compiledWord + ; End of native words ; ( a -- ) ; @ . .db "?" .fill 7 - .dw THEN + .dw RECURSE FETCHDOT: .dw compiledWord .dw FETCH @@ -654,3 +701,59 @@ CONSTANT: .dw DOES .dw FETCH .dw EXIT + +; ( f -- f ) +; IF 0 ELSE 1 THEN + .db "NOT" + .fill 5 + .dw CONSTANT +NOT: + .dw compiledWord + .dw IF + .dw NUMBER + .dw 0 + .dw ELSE + .dw NUMBER + .dw 1 + .dw THEN + .dw EXIT + +; ( n1 n2 -- f ) +; CMP NOT + .db "=" + .fill 7 + .dw NOT +EQ: + .dw compiledWord + .dw CMP + .dw NOT + .dw EXIT + +; ( n1 n2 -- f ) +; CMP -1 = + .db "<" + .fill 7 + .dw EQ +LT: + .dw compiledWord + .dw CMP + .dw NUMBER + .dw -1 + .dw EQ + .dw EXIT + +; ( n1 n2 -- f ) +; CMP 1 = + .db ">" + .fill 7 + .dw LT +GT: +LATEST: + .dw compiledWord + .dw CMP + .dw NUMBER + .dw 1 + .dw EQ + .dw EXIT + +; diff --git a/apps/forth/dictionary.txt b/apps/forth/dictionary.txt index c2562fb..1f38a65 100644 --- a/apps/forth/dictionary.txt +++ b/apps/forth/dictionary.txt @@ -43,6 +43,7 @@ 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 +RECURSE R:I -- R:I-2 Run the current word again. THEN -- Does nothing. Serves as a branching merker for IF and ELSE. @@ -66,6 +67,18 @@ HERE -- a Push HERE's address * a b -- c a * b -> c / a b -- c a / b -> c +*** Logic *** += n1 n2 -- f Push true if n1 == n2 +< n1 n2 -- f Push true if n1 < n2 +> n1 n2 -- f Push true if n1 > n2 +CMP n1 n2 -- n Compare n1 and n2 and set n to -1, 0, or 1. + n=0: a1=a2. n=1: a1>a2. n=-1: a1 lvl 1, our result + ; HL has our its final value + ld d, h + ld e, l call strskip inc hl ; byte after word termination - ld (RS_ADDR), hl - pop hl ; <-- lvl 1, our result + ex de, hl ret .notLIT: ; Alright, not a literal, but is it a word? If it's not a number, then ; it's a word. call HLPointsNUMBER jr z, .notWord + call HLPointsEXITQUIT + jr z, .notWord ; Not a number, then it's a word. Copy word to pad and point to it. + push hl ; --> lvl 1. we need it to set DE later call intoHL or a ; clear carry ld de, CODELINK_OFFSET sbc hl, de ; That's our return value - push hl ; --> lvl 1 + push hl ; --> lvl 2 ; HL now points to word offset, let'd copy it to pad ex de, hl call pad @@ -157,10 +179,10 @@ readCompWord: ; null-terminate xor a ld (de), a - ; Advance RS' BOS by 2 - ld hl, RS_ADDR - inc (hl) \ inc (hl) - pop hl ; <-- lvl 1 + pop hl ; <-- lvl 2 + pop de ; <-- lvl 1 + ; Advance IP by 2 + inc de \ inc de ret .notWord: ld hl, .msg @@ -169,6 +191,24 @@ readCompWord: .msg: .db "word expected", 0 +readLITBOS: + push de + ld hl, (RS_ADDR) + call readLIT + ld (RS_ADDR), de + pop de + ret + +readLITTOS: + push de + ld l, (ix) + ld h, (ix+1) + call readLIT + ld (ix), e + ld (ix+1), d + pop de + ret + ; For DE being a wordref, move DE to the previous wordref. ; Z is set if DE point to 0 (no entry). NZ if not. prev: @@ -238,7 +278,7 @@ compile: ; 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 readCompWord, and if it doesn't, the routine will be + ; by calling readLIT, and if it doesn't, the routine will be ; called, triggering an abort. ld hl, LIT call wrCompHL @@ -256,7 +296,7 @@ compile: ; Spit name + prev in (HERE) and adjust (HERE) and (CURRENT) ; HL points to new (HERE) entryhead: - call readCompWord + call readLITBOS ld de, (HERE) call strcpy ex de, hl ; (HERE) now in HL @@ -291,3 +331,15 @@ HLPointsIMMED: inc hl pop hl ret + +; Checks flags Z and C and sets BC to 0 if Z, 1 if C and -1 otherwise +flagsToBC: + ld bc, 0 + ret z ; equal + inc bc + ret c ; > + ; < + dec bc + dec bc + ret + diff --git a/apps/lib/util.asm b/apps/lib/util.asm index 386f990..613b860 100644 --- a/apps/lib/util.asm +++ b/apps/lib/util.asm @@ -52,7 +52,7 @@ strcpy: ret ; Compares strings pointed to by HL and DE until one of them hits its null char. -; If equal, Z is set. If not equal, Z is reset. +; If equal, Z is set. If not equal, Z is reset. C is set if HL > DE strcmp: push hl push de