apps/forth/dict.asm

@@ -211,33 +211,10 @@ EMIT:
 	call	stdioPutC
 	jp	exit
 
-; ( c port -- )
-	.db "PC!"
-	.fill 5
-	.dw EMIT
-PSTORE:
-	.dw nativeWord
-	pop	bc
-	pop	hl
-	out	(c), l
-	jp	exit
-
-; ( port -- c )
-	.db "PC@"
-	.fill 5
-	.dw PSTORE
-PFETCH:
-	.dw nativeWord
-	pop	bc
-	ld	h, 0
-	in	l, (c)
-	push	hl
-	jp	exit
-
 ; ( addr -- )
 	.db "EXECUTE"
 	.db 0
-	.dw PFETCH
+	.dw EMIT
 EXECUTE:
 	.dw nativeWord
 	pop	iy	; is a wordref
@@ -282,7 +259,9 @@ DEFINE:
 	; is lit
 	ldi
 	ldi
+	inc	hl \ inc hl
 	call	strcpyM
+	inc	hl		; byte after word termination
 	jr	.loop
 .notLIT:
 	; it's a word
@@ -307,7 +286,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	HLPointsEXITQUIT
+	call	HLPointsEXIT
 	ldi
 	ldi
 	jr	nz, .loop
@@ -485,20 +464,10 @@ 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 LITFETCH
+	.dw FETCH
 SWAP:
 	.dw nativeWord
 	pop	hl
@@ -579,36 +548,9 @@ 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 CMP
+	.dw DIV
 IF:
 	.dw ifWord
 
@@ -624,25 +566,13 @@ 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 RECURSE
+	.dw THEN
 FETCHDOT:
 	.dw compiledWord
 	.dw FETCH
@@ -701,59 +631,3 @@ 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
-
-;

apps/forth/dictionary.txt

@@ -43,7 +43,6 @@ 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.
 
@@ -67,22 +66,8 @@ 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<a2.
-NOT         f -- f          Push the logical opposite of f
-
-*** Strings ***
-LIT@ x      -- a            Read folloing LIT and push its addr to a
-S=          a1 a2 -- n      Compare strings a1 and a2. See CMP
-
 *** I/O ***
 .           n --            Print n in its decimal form
 EMIT        c --            Spit char c to stdout
 KEY         -- c            Get char c from stdin
-PC!         c a --          Spit c to port a
-PC@         a -- c          Fetch c from port a
 

apps/forth/main.asm

@@ -27,7 +27,7 @@ forthMain:
 	; we check for stack underflow.
 	push	af \ push af \ push af
 	ld	(INITIAL_SP), sp
-	ld	hl, LATEST
+	ld	hl, CONSTANT		; last entry in hardcoded dict
 	ld	(CURRENT), hl
 	ld	hl, FORTH_RAMEND
 	ld	(HERE), hl

apps/forth/util.asm

@@ -69,14 +69,10 @@ HLPointsLIT:
 	pop	de
 	ret
 
-HLPointsEXITQUIT:
+HLPointsEXIT:
 	push	de
 	ld	de, EXIT
 	call	HLPointsDE
-	jr	z, .end
-	ld	de, QUIT
-	call	HLPointsDE
-.end:
 	pop	de
 	ret
 
@@ -102,22 +98,21 @@ compSkip:
 	inc	hl \ inc hl
 	ret
 
-; ***readLIT***
 ; 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 readLIT caller. We could think that this word is
+; name that follows our readCompWord caller. We could think that this word is
-; right there on RS' TOS, but not always! You have to account for words wrapping
+; right there on RS' TOS, but no! You have to account for words wrapping the
-; the caller. For example, "VARIABLE" calls "CREATE". If you call
+; caller. For example, "VARIABLE" calls "CREATE". If you call "VARIABLE foo",
-; "VARIABLE foo", if CREATE looks at what follows in RS' TOS, it will only find
+; if CREATE looks at what follows in RS' TOS, it will only find the "2" in
-; the "2" in "CREATE 2 ALLOT".
+; "CREATE 2 ALLOT".
 ;
-; In this case, we actually need to check in RS' *bottom of stack* for our
+; Therefore, we actually need to check in RS' *bottom of stack* for our answer.
-; answer. If that atom is a LIT, we're good. We make HL point to it and advance
+; If that atom is a LIT, we're good. We make HL point to it and advance IP to
-; IP to byte following null-termination.
+; 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
@@ -128,48 +123,31 @@ compSkip:
 ; second word in our dict. We don't accept EXIT because it's the termination
 ; word. Yeah, it means that ";" can't be overridden...
 ; If name can't be read, we abort
-;
+readCompWord:
-; BOS vs TOS: What we cover so far is the "CREATE" and friends cases, where we
+	; In all cases, we want RS' BOS in HL. Let's get it now.
-; want to read BOS. There are, however, cases where we want to read TOS, that is
+	ld	hl, (RS_ADDR)
-; that we want to read the LIT right next to our atom. Example: "(". When
-; processing comments, we are at compile time and want to read words from BOS,
-; yes), however, in "("'s definition, there's "LIT@ )", which means "fetch LIT
-; next to me and push this to stack". This LIT we want to fetch is *not* from
-; BOS, it's from TOS.
-;
-; This is why we have readLITBOS and readLITTOS. readLIT uses HL and DE and is
-; not used directly.
-
-; Given a RS stack pointer HL, read LIT next to it (or abort) and set HL to
-; point to its associated string. Set DE to there the RS stack pointer should
-; point next.
-readLIT:
 	call	HLPointsLIT
 	jr	nz, .notLIT
 	; 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
-	; HL has our its final value
+	push	hl		; --> lvl 1, our result
-	ld	d, h
-	ld	e, l
 	call	strskip
 	inc	hl		; byte after word termination
-	ex	de, hl
+	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	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 2
+	push	hl		; --> lvl 1
 	; HL now points to word offset, let'd copy it to pad
 	ex	de, hl
 	call	pad
@@ -179,10 +157,10 @@ readLIT:
 	; null-terminate
 	xor	a
 	ld	(de), a
-	pop	hl		; <-- lvl 2
+	; Advance RS' BOS by 2
-	pop	de		; <-- lvl 1
+	ld	hl, RS_ADDR
-	; Advance IP by 2
+	inc	(hl) \ inc (hl)
-	inc	de \ inc de
+	pop	hl		; <-- lvl 1
 	ret
 .notWord:
 	ld	hl, .msg
@@ -191,24 +169,6 @@ readLIT:
 .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:
@@ -278,7 +238,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 readLIT, and if it doesn't, the routine will be
+	; by calling readCompWord, and if it doesn't, the routine will be
 	; called, triggering an abort.
 	ld	hl, LIT
 	call	wrCompHL
@@ -296,7 +256,7 @@ compile:
 ; Spit name + prev in (HERE) and adjust (HERE) and (CURRENT)
 ; HL points to new (HERE)
 entryhead:
-	call	readLITBOS
+	call	readCompWord
 	ld	de, (HERE)
 	call	strcpy
 	ex	de, hl		; (HERE) now in HL
@@ -331,15 +291,3 @@ 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
-

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. C is set if HL > DE
+; If equal, Z is set. If not equal, Z is reset.
 strcmp:
 	push	hl
 	push	de