commit 42230a2df7f4833a976403a58a1d5a5285a45b6c
parent 3425240dfd5e9ae9c9d218c306ff984f39ce6506
Author: Henry Wilson <m3henry@googlemail.com>
Date: Wed, 2 Aug 2017 17:53:22 +0100
single LEAVE
Diffstat:
| M | compiler.s | | | 107 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++---------- |
| M | macros.i | | | 8 | ++++++++ |
2 files changed, 102 insertions(+), 13 deletions(-)
diff --git a/compiler.s b/compiler.s
@@ -4,12 +4,6 @@ verb forth HERE
variable
endword
-.macro hereflg flags:req
- get HERE
- const \flags
- do SETFLAGS
-.endm
-
verb forth modeI "[" immediate
set MODE 0
endword
@@ -100,17 +94,79 @@ verb forth DO "DO" immediate
compile pushret # # Loop End
endword # #
+verb forth LEAVE "LEAVE" immediate
+ compile popret # #
+ compile popret #
+ compile dogoto
+ get HERE
+ do SIFTDO
+ do store
+ compile 0
+ endword
+
+verb forth loopI "I" immediate # ( -- uint )
+ compile popret # #
+ compile popret #
+ compile DUP
+ compile pushret # Loop Counter
+ compile SWAP #
+ compile pushret # # Loop End
+ endword
+
verb forth LOOP "LOOP" immediate
compile popret # #
compile popret #
compile inc
compile dup2
compile nequal
- compile dobranch
+0: compile dobranch
+ do DUP
compile
- compile drop2
+ do DUP
+ do fetch
+ test equal pushret 1f
+ const thing
+ do linksapply
+ const pushret
+ do SWAP
+ do store
+ goto 2f
+1: do drop2
+2: compile drop2
endword
+noverb forth linksapply # ( ptr func -- )
+ do OVER
+ if 1f
+ do drop2
+ endword
+1: do OVER
+ do fetch
+ do OVER
+ do linksapply
+ do EXECUTE
+ endword
+
+noverb forth thing
+ get HERE
+ do SWAP
+ do store
+ endword
+
+noverb forth resolveleaves
+ do DUP
+ do fetch
+ do DUP
+ if 1f
+ do DROP
+ endword
+1: do resolveleaves
+ get HERE
+ do SWAP
+ do store
+ endword
+
+
verb forth plusloop "+LOOP" immediate
compile popret # #
compile SWAP #
@@ -127,9 +183,20 @@ verb forth plusloop "+LOOP" immediate
compile greater #
compile popret #
compile XOR
- compile dobranch
- compile
- compile drop2
+ goto 0b # Can use LOOP logic
+
+verb forth SIFTDO # ( {sys} -- {sys} sys )
+ do DUP
+ do fetch
+ const pushret
+ do equal
+ if 1f
+ do pushret # Unrelated stack item
+ do SIFTDO #
+ do popret #
+ do SWAP
+ endword
+1: do DUP
endword
# Conditionals
@@ -137,13 +204,11 @@ verb forth plusloop "+LOOP" immediate
verb forth IF "IF" immediate
compile iszero
compile dobranch
- hereflg 'I'
compile 0
endword
verb forth ELSE "ELSE" immediate
compile dogoto
- hereflg 'I'
compile 0
do SWAP
get HERE
@@ -173,3 +238,19 @@ verb forth SETFLAGS
do OR
endword
+verb forth SIFTFLAGS
+ do OVER
+ do GETFLAGS
+ do OVER
+ do equal
+ if 1f
+ do SWAP
+ do pushret # Unrelated stack item
+ do SIFTFLAGS #
+ do popret #
+ do SWAP
+ endword
+1: do DROP
+ do DUP
+ do STRIPFLAGS
+ endword
diff --git a/macros.i b/macros.i
@@ -120,6 +120,14 @@
.endif
.endm
+.macro noverb type:req name:req immediate
+.ifnb \immediate
+\name\(): \type\()word \immediate
+.else
+\name\(): \type\()word
+.endif
+.endm
+
# Codeword macros
.macro codeword immediate
