Data stack based control flow stack. PLOOPEX: (almost) ANS94 update m…

…echanism. New words: :NONAME and AHEAD. PE
frenchie68 · Oct 18, 2022 · c973d5d · c973d5d
1 parent c37b68b
commit c973d5d
Show file tree

Hide file tree

Showing 12 changed files with 6,030 additions and 6,077 deletions.
diff --git a/SW/doc/79-STANDARD-subset.txt b/SW/doc/79-STANDARD-subset.txt
@@ -168,8 +168,8 @@ the 79-STANDARD specification.
 
 5 1994 ANSI draft 6 Words
 -------------------------
-['] .S ACCEPT CELLS CHAR [CHAR] COMPILE, INVERT KEY? NIP POSTPONE S>D S"
-SOURCE U> TUCK UNLOOP WITHIN
+['] .S ACCEPT AHEAD CELLS CHAR [CHAR] COMPILE, INVERT KEY? NIP POSTPONE S>D S"
+SOURCE U> TUCK UNLOOP WITHIN :NONAME
 
 Note: KEY? U> and WITHIN return the 79-STANDARD version of true, i.e. 1.
 When porting code originally designed for an ANSI environment, the ANSI true
@@ -241,7 +241,7 @@ UNLESS	Perl inspired. Functionally equivalent to:
 UNMONITOR ( -- ) If the running EEPROM image was compiled with a non-zero
 	RELFEAT (see constants.asm), newly created CONSTANTs will automatically
 	be monitored (see MONITOR above). However, ANSI VALUEs are nothing
-	than CONSTANTs which value can be altered. Invoking UNMONITOR
+	other than CONSTANTs which value can be altered. Invoking UNMONITOR
 	immediately after having created a CONSTANT (or any : definition) will
 	cause that object's payload not to be included for integrity check.
 

diff --git a/SW/doc/PORTING-ANSI-code.txt b/SW/doc/PORTING-ANSI-code.txt
@@ -53,7 +53,7 @@ TO. For instance:
 
 This can be achieved (in a very implementation specific way) in Z79Forth with:
 
-: VALUE CONSTANT ;
+: VALUE CONSTANT UNMONITOR ;
 : TO ( inputstream: <symbol> -- ) ( execution: nn -- )
   >IN @                       \ symSrcStartAddress
   FIND  ?DUP  IF              \ symSrcStartAddress\xt
@@ -66,9 +66,9 @@ This can be achieved (in a very implementation specific way) in Z79Forth with:
     >IN !                     \ Symbol not found
   THEN ; IMMEDIATE
 
-However, if the reliability feature is configured, ICHECK will report a code
-integrity check failure, should the original value of the constant ever be
-altered.
+Please note the reference to UNMONITOR in the definition of VALUE. This will
+cause the reliability feature to ignore changes to the constant's value after
+its original definition.
 
 See https://forth-standard.org/standard/testsuite#test:core:VALUE for test
 patterns. This particular implementation passes the test patterns but the

diff --git a/SW/examples/bernd-oof.4th b/SW/examples/bernd-oof.4th
@@ -16,25 +16,6 @@
   SWAP                     \ addr1 addr2 u addr2-addr1 u
   U< IF CMOVE> ELSE CMOVE THEN ;
 
-\ :NONAME support. WARNING: because this is an application
-\ level implementation, any error in a :NONAME definition
-\ will cause the last named word to be forgotten!
-\ Nested anonymous definitions are not supported.
-VARIABLE anonep            \ xt returned by :NONAME
-VARIABLE isanon   0 isanon !
-
-: :NONAME HERE anonep !
-  1 DUP STATE ! isanon ! ;
-
-: ; isanon @ UNLESS        \ UNLESS is a shortcut for 0= IF
-    ['] ; EXECUTE
-    EXIT
-  THEN
-  0 DUP isanon ! STATE !
-  $39 C,                   \ Emit an RTS instruction
-  anonep @                 \ Return the execution token
-; IMMEDIATE RESTRICT
-
 \ end Z79Forth glue code.
 
 \ ------------------------------------------------------------

diff --git a/SW/examples/hanoi.4th b/SW/examples/hanoi.4th
@@ -40,18 +40,18 @@ CREATE RING  N 2+  ALLOT               ( array[1..N] of bytes )
 
 : PRESENCE ( tower ring -- flag )
   RING +  C@  = ;
-: LINE ( tower line -- display_line_of_top )
+: HLINE ( tower line -- display_line_of_top )
   4 SWAP  N 0 DO
     DUP I PRESENCE 0= ( ABS ) ROT + SWAP
   LOOP DROP ;
 
 : RAISE ( size tower -- )
-  DUP  POS  SWAP  LINE  2  SWAP  DO
+  DUP  POS  SWAP  HLINE  2  SWAP  DO
     2DUP I BL DISPLAY  2DUP  I 1- COLOR DISPLAY
   -1 +LOOP  2DROP ;
 
 : LOWER ( size tower -- )
-  DUP  POS  SWAP  LINE 1+ 2 DO
+  DUP  POS  SWAP  HLINE 1+ 2 DO
     2DUP  I 1-  BL DISPLAY
     2DUP I COLOR DISPLAY
   LOOP 2DROP ;  

diff --git a/SW/examples/meta2/meta2.4th b/SW/examples/meta2/meta2.4th
@@ -19,37 +19,6 @@
   THEN
 ; IMMEDIATE
 
-\ This is extremely useful for debugging call stacks.
-\ It may not work properly if bytes are on the system
-\ stack of the 6309 though!
-\ : sysstkdump S
-\   BEGIN
-\     DUP $8000 U<
-\   WHILE  
-\     CR DUP @ .'  
-\     1 CELLS + 
-\   REPEAT
-\   DROP ;
-
-\ :NONAME support. WARNING: because this is an application
-\ level implementation, any error in a :NONAME definition
-\ will cause the last named word to be forgotten!
-\ Nested anonymous definitions are not supported.
-VARIABLE isanon   0 isanon !
-VARIABLE anonep         \ Execution token returned by :NONAME
-
-: :NONAME HERE anonep !
-  1 DUP STATE ! isanon ! ;
-
-: ; isanon @ UNLESS     \ UNLESS is a shortcut for 0= IF
-    ['] ; EXECUTE
-    EXIT
-  THEN
-  0 DUP isanon ! STATE !
-  $39 C,                \ Emit an RTS instruction
-  anonep @              \ Return the execution token
-; IMMEDIATE RESTRICT
-
 VARIABLE curblk  \ Init'ed by reset-input, updated by advance
 -1 CONSTANT true
 0 CONSTANT false

diff --git a/SW/examples/sapin.4th b/SW/examples/sapin.4th
@@ -4,8 +4,8 @@
   LOOP [CHAR] | DUP 2 0 DO
   12 0 DO [CHAR] ~ EMIT LOOP
   I 1 <> IF 2 0 DO EMIT LOOP THEN
-  LOOP CR 12 SPACES 2 0 DO [CHAR] | EMIT
-  LOOP 12 SPACES ;
+  LOOP CR 12 SPACES ." ||"
+  12 SPACES ;
 SAPIN
-\ FORGET SAPIN
+FORGET SAPIN
 
diff --git a/SW/src/constants.asm b/SW/src/constants.asm
@@ -25,6 +25,10 @@ RELFEAT	set	0		HVNMI and HVNMI2 disable RELFEAT
 	ENDC			HVNMI
 	ENDC			RTCFEAT
 
+* Control flow stack implemented on the top of the data stack.
+CSPUSH	EQU	NPUSH  
+CSPOP	EQU	NPOP
+
 * Memory map.
 RAMSTRT	equ	$0000
 RAMSIZE	equ	$8000