From 4627e1c9772cac9a2650b2eb22f4a0c66ca14b69 Mon Sep 17 00:00:00 2001
From: Virgil Dupras <hsoft@hardcoded.net>
Date: Sat, 21 Mar 2020 16:17:51 -0400
Subject: [PATCH] forth: Forth-ify "ABORT""

---
 forth/core.fs        |  3 +-
 forth/dictionary.txt |  3 +-
 forth/fmt.fs         |  2 ++
 forth/forth.asm      | 81 ++++++++++++++++++--------------------------
 4 files changed, 39 insertions(+), 50 deletions(-)

diff --git a/forth/core.fs b/forth/core.fs
index ebee6fa..252acb1 100644
--- a/forth/core.fs
+++ b/forth/core.fs
@@ -1,6 +1,7 @@
 : H HERE @ ;
 : -^ SWAP - ;
 : COMPILE ' LITN ['] , , ; IMMEDIATE
+: [COMPILE] ' , ; IMMEDIATE
 : BEGIN H ; IMMEDIATE
 : AGAIN COMPILE (bbr) H -^ C, ; IMMEDIATE
 : UNTIL COMPILE SKIP? COMPILE (bbr) H -^ C, ; IMMEDIATE
@@ -36,7 +37,6 @@
     H 1 -           ( push a. -1 for allot offset )
 ; IMMEDIATE
 
-: ? @ . ;
 : VARIABLE CREATE 2 ALLOT ;
 : CONSTANT CREATE H ! DOES> @ ;
 : = CMP NOT ;
@@ -44,6 +44,7 @@
 : > CMP 1 = ;
 : / /MOD SWAP DROP ;
 : MOD /MOD DROP ;
+: ABORT" [COMPILE] ." COMPILE ABORT ; IMMEDIATE
 
 ( In addition to pushing H this compiles 2 >R so that loop variables are sent
   to PS at runtime )
diff --git a/forth/dictionary.txt b/forth/dictionary.txt
index 9f32c4e..700e06b 100644
--- a/forth/dictionary.txt
+++ b/forth/dictionary.txt
@@ -44,7 +44,8 @@ directly, but as part of another word.
 ALLOT       n --            Move HERE by n bytes
 C,          b --            Write byte b in HERE and advance it.
 CREATE x    --              Create cell named x. Doesn't allocate a PF.
-[COMPILE] x --              Compile word x and write it to HERE
+[COMPILE] x --              Compile word x and write it to HERE. IMMEDIATE
+                            words are *not* executed.
 COMPILE x   --              Meta compiles. Kind of blows the mind. See below.
 CONSTANT x  n --            Creates cell x that when called pushes its value
 DOES>       --              See description at top of file
diff --git a/forth/fmt.fs b/forth/fmt.fs
index 406c0f5..98963bb 100644
--- a/forth/fmt.fs
+++ b/forth/fmt.fs
@@ -23,6 +23,8 @@
     AGAIN
 ;
 
+: ? @ . ;
+
 : PUSHDGTS
     999 SWAP        ( stop indicator )
     DUP 0 = IF '0' EXIT THEN    ( 0 is a special case )
diff --git a/forth/forth.asm b/forth/forth.asm
index 28b0a37..6fb5a87 100644
--- a/forth/forth.asm
+++ b/forth/forth.asm
@@ -712,21 +712,9 @@ abortUnderflow:
 	.dw	PRINT
 	.dw	ABORT
 
-	.db	"ABORT", '"'
-	.fill	1
-	.dw	ABORT
-	.db	1		; IMMEDIATE
-ABORTI:
-	.dw	compiledWord
-	.dw	PRINTI
-	.dw	NUMBER
-	.dw	ABORT
-	.dw	WR
-	.dw	EXIT
-
 	.db "BYE"
 	.fill 4
-	.dw ABORTI
+	.dw ABORT
 	.db 0
 BYE:
 	.dw nativeWord
@@ -871,42 +859,9 @@ EXECUTE:
 	jp	(hl)	; go!
 
 
-	.db	"[COMPIL"
-	.dw	EXECUTE
-	.db	1		; IMMEDIATE
-COMPILE:
-	.dw	compiledWord
-	.dw	WORD
-	.dw	FIND_
-	.dw	CSKIP
-	.dw	.maybeNum
-	.dw	DUP
-	.dw	ISIMMED
-	.dw	CSKIP
-	.dw	.word
-	; is immediate. just execute.
-	.dw	EXECUTE
-	.dw	EXIT
-
-.word:
-	.dw	compiledWord
-	.dw	WR
-	.dw	R2P		; exit COMPILE
-	.dw	DROP
-	.dw	EXIT
-
-.maybeNum:
-	.dw	compiledWord
-	.dw	PARSEI
-	.dw	LITN
-	.dw	R2P		; exit COMPILE
-	.dw	DROP
-	.dw	EXIT
-
-
 	.db	";"
 	.fill	6
-	.dw	COMPILE
+	.dw	EXECUTE
 	.db	1		; IMMEDIATE
 ENDDEF:
 	.dw	compiledWord
@@ -931,11 +886,41 @@ DEFINE:
 	.dw	compiledWord
 	.dw	WR
 	; BBR branch mark
-	.dw	COMPILE
+	.dw	.compile
 	.dw	BBR
 	.db	4
 	; no need for EXIT, ENDDEF takes care of taking us out
 
+.compile:
+	.dw	compiledWord
+	.dw	WORD
+	.dw	FIND_
+	.dw	CSKIP
+	.dw	.maybeNum
+	.dw	DUP
+	.dw	ISIMMED
+	.dw	CSKIP
+	.dw	.word
+	; is immediate. just execute.
+	.dw	EXECUTE
+	.dw	EXIT
+
+.word:
+	.dw	compiledWord
+	.dw	WR
+	.dw	R2P		; exit .compile
+	.dw	DROP
+	.dw	EXIT
+
+.maybeNum:
+	.dw	compiledWord
+	.dw	PARSEI
+	.dw	LITN
+	.dw	R2P		; exit .compile
+	.dw	DROP
+	.dw	EXIT
+
+
 
 	.db "DOES>"
 	.fill 2