diff options
| -rw-r--r-- | core-plus.e | 33 | ||||
| -rw-r--r-- | core.e | 61 | ||||
| -rw-r--r-- | evoke.e | 5 | ||||
| -rw-r--r-- | transform.e | 6 |
4 files changed, 65 insertions, 40 deletions
diff --git a/core-plus.e b/core-plus.e deleted file mode 100644 index d323816..0000000 --- a/core-plus.e +++ /dev/null @@ -1,33 +0,0 @@ -~ This is a temporary holding place for stuff that probably should be in -~ core someday, but only after carefully considering whether to rewrite it in -~ assembly. Most of it originally came from boot_source in quine.asm. - - -~ Now some fancier stack combinators. -~ -~ While it might be nice, for performance reasons, to do these in -~ assembler, for now it's more important to have them at all. -: 1- 1 - ; -: 1+ 1 + ; -: max 2dup >= { swap drop } { drop } if-else ; -: min 2dup <= { swap drop } { drop } if-else ; - -: over swap dup 3unroll ; -: pick 2 + dup roll dup 3roll unroll ; - -~ Standard Forth doesn't have equivalents of our ndrop and ndup. The HP -~ calls them DROPN and DUPN but that doesn't go well with ie. 2dup or 3roll, -~ so we do it like this. -: ndrop { dup } { swap drop 1- } while drop ; -: ndup dup 1+ swap { dup } - { swap dup pick 3unroll swap 1- } while 2drop ; -: 3drop drop drop drop ; -: 3dup 2 pick 2 pick 2 pick ; - -: && 0 != swap 0 != * ; -: || | 0 != ; -: not 0 = ; -: negate -1 * ; - -: align-floor dup 3unroll /% swap drop * ; - diff --git a/core.e b/core.e index 1bc73e1..491b73c 100644 --- a/core.e +++ b/core.e @@ -356,6 +356,22 @@ here ! :rax push-reg64 ~ quotient here ! ] ;asm +~ We define a pair of words that increment and decrement a single item. +~ These were inspired by Common Lisp, where they're constantly useful. +: 1+ + [ here @ + :rax pop-reg64 + :rax inc-reg64 + :rax push-reg64 + here ! ] ;asm + +: 1- + [ here @ + :rax pop-reg64 + :rax dec-reg64 + :rax push-reg64 + here ! ] ;asm + ~ Comparison routines ~ ~~~~~~~~~~~~~~~~~~~ @@ -1236,3 +1252,48 @@ here ! hlt here ! ] ;asm + +~ Additional conveniences +~ ~~~~~~~~~~~~~~~~~~~~~~~ +~ +~ Please feel free to find an organizing principle for these and put them +~ where they go. It would be kind of nice to re-write these either in +~ assembly, or with high-level flow control, but it doesn't seem urgent... + +: max + 2dup >= + 0branch [ 2 8 * , ] swap + drop ; + +: min + 2dup <= + 0branch [ 2 8 * , ] swap + drop ; + +: over swap dup 3unroll ; +: pick 2 + dup roll dup 3roll unroll ; + +~ Standard Forth doesn't have equivalents of our ndrop and ndup. The HP +~ calls them DROPN and DUPN but that doesn't go well with ie. 2dup or 3roll, +~ so we do it like this. +: ndrop + dup 0branch [ 6 8 * , ] swap drop 1- + branch [ -7 8 * , ] + drop ; + +: ndup + dup 1+ swap + dup 0branch [ 9 8 * , ] swap dup pick 3unroll swap 1- + branch [ -10 8 * , ] + 2drop ; + +: 3drop drop drop drop ; +: 3dup 2 pick 2 pick 2 pick ; + +: && 0 != swap 0 != * ; +: || | 0 != ; +: not 0 = ; +: negate -1 * ; + +: align-floor dup 3unroll /% swap drop * ; + diff --git a/evoke.e b/evoke.e index fa9ccb0..b405ab2 100644 --- a/evoke.e +++ b/evoke.e @@ -1,9 +1,8 @@ ~ (cat labels.e elf.e transform.e execution.e \ ~ echo 262144 read-to-buffer; \ -~ cat core.e core-plus.e linux.e output.e \ -~ amd64.e execution-support.e log-load.e; \ +~ cat core.e linux.e output.e amd64.e execution-support.e log-load.e; \ ~ echo pyrzqxgl 262144 read-to-buffer; \ -~ cat core.e; \ +~ cat core.e linux.e output.e; \ ~ echo 0 sys-exit pyrzqxgl; \ ~ cat evoke.e) \ ~ | ./quine > evoke && chmod 755 evoke && ./evoke diff --git a/transform.e b/transform.e index 2d75f9f..22c4ecf 100644 --- a/transform.e +++ b/transform.e @@ -385,6 +385,8 @@ allocate-transform-state s" transform-state" variable dup s" -" stringcmp 0 = { drop -1 exit } if dup s" *" stringcmp 0 = { drop -1 exit } if dup s" /%" stringcmp 0 = { drop 0 exit } if + dup s" 1+" stringcmp 0 = { drop 0 exit } if + dup s" 1-" stringcmp 0 = { drop 0 exit } if dup s" =" stringcmp 0 = { drop -1 exit } if dup s" !=" stringcmp 0 = { drop -1 exit } if dup s" >" stringcmp 0 = { drop -1 exit } if @@ -443,10 +445,6 @@ allocate-transform-state s" transform-state" variable dup s" align-size" stringcmp 0 = { drop -1 exit } if dup s" unpackalign" stringcmp 0 = { drop -1 exit } if dup s" crash" stringcmp 0 = { drop 0 exit } if - - ~ From core-plus.e. - dup s" 1-" stringcmp 0 = { drop 0 exit } if - dup s" 1+" stringcmp 0 = { drop 0 exit } if dup s" max" stringcmp 0 = { drop -1 exit } if dup s" min" stringcmp 0 = { drop -1 exit } if dup s" over" stringcmp 0 = { drop 1 exit } if |