From d0d92a45599aeb6cef7ceec1cbf73c3772260009 Mon Sep 17 00:00:00 2001
From: Virgil Dupras <hsoft@hardcoded.net>
Date: Thu, 12 Mar 2020 21:49:10 -0400
Subject: [PATCH] forth: Forth-ify IF and ELSE

Now, I really need comments...
---
 apps/forth/core.fth       | 12 ++++++----
 apps/forth/dict.asm       | 47 +--------------------------------------
 apps/forth/dictionary.txt |  2 ++
 3 files changed, 11 insertions(+), 50 deletions(-)

diff --git a/apps/forth/core.fth b/apps/forth/core.fth
index 748913b..91dc88a 100644
--- a/apps/forth/core.fth
+++ b/apps/forth/core.fth
@@ -1,11 +1,15 @@
+: H HERE @ ;
+: -^ SWAP - ;
 : ? @ . ;
 : +! SWAP OVER @ + SWAP ! ;
 : ALLOT HERE +! ;
 : VARIABLE CREATE 2 ALLOT ;
-: CONSTANT CREATE HERE @ ! DOES> @ ;
-: , HERE @ ! 2 ALLOT ;
-: C, HERE @ C! 1 ALLOT ;
-: THEN DUP HERE @ SWAP - SWAP C! ; IMMEDIATE
+: CONSTANT CREATE H ! DOES> @ ;
+: , H ! 2 ALLOT ;
+: C, H C! 1 ALLOT ;
+: IF ['] (fbr?) , H 0 C, ; IMMEDIATE
+: THEN DUP H -^ SWAP C! ; IMMEDIATE
+: ELSE ['] (fbr) , 0 C, DUP H -^ SWAP C! H 1 - ; IMMEDIATE
 : NOT IF 0 ELSE 1 THEN ;
 : = CMP NOT ;
 : < CMP 0 1 - = ;
diff --git a/apps/forth/dict.asm b/apps/forth/dict.asm
index 3f8de77..a4066f0 100644
--- a/apps/forth/dict.asm
+++ b/apps/forth/dict.asm
@@ -676,53 +676,8 @@ FBRC:
 	jp	exit
 
 
-; : IF ' (fbr?) , HERE @ 0 C, ; IMMEDIATE
-	.db "IF"
-	.fill 5
-	.dw FBRC
-	.db 1		; IMMEDIATE
-IF:
-	.dw nativeWord
-	; Spit a conditional branching atom, followed by an empty 1b cell. Then,
-	; push the address of that cell on the PS. ELSE or THEN will pick
-	; them up and set the offset.
-	ld	hl, (HERE)
-	ld	de, FBRC
-	call	DEinHL
-	push	hl		; address of cell to fill
-	inc	hl		; empty 1b cell
-	ld	(HERE), hl
-	jp	exit
-
-	.db "ELSE"
-	.fill 3
-	.dw IF
-	.db 1		; IMMEDIATE
-ELSE:
-	.dw nativeWord
-	; First, let's set IF's branching cell.
-	pop	de		; cell's address
-	ld	hl, (HERE)
-	; also skip ELSE word.
-	inc	hl \ inc hl \ inc hl
-	or	a		; clear carry
-	sbc	hl, de		; HL now has relative offset
-	ld	a, l
-	ld	(de), a
-	; 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, (HERE)
-	ld	de, FBR
-	call	DEinHL
-	push	hl		; address of cell to fill
-	inc	hl		; empty 1b cell
-	ld	(HERE), hl
-	jp	exit
-
-
 	.db "RECURSE"
-	.dw ELSE
+	.dw FBRC
 	.db 0
 RECURSE:
 	.dw nativeWord
diff --git a/apps/forth/dictionary.txt b/apps/forth/dictionary.txt
index 55130ca..e877579 100644
--- a/apps/forth/dictionary.txt
+++ b/apps/forth/dictionary.txt
@@ -77,11 +77,13 @@ C@          a -- c          Set c to byte at address a
 C!          c a --          Store byte c in address a
 CURRENT     -- n            Set n to wordref of last added entry.
 HERE        -- a            Push HERE's address
+H           -- a            HERE @
 
 *** Arithmetic ***
 
 +           a b -- c        a + b -> c
 -           a b -- c        a - b -> c
+-^          a b -- c        b - a -> c
 *           a b -- c        a * b -> c
 /           a b -- c        a / b -> c