summary refs log tree commit diff
path: root/amd64.e
diff options
context:
space:
mode:
authorIrene Knapp <ireneista@irenes.space>2026-05-22 05:32:50 -0700
committerIrene Knapp <ireneista@irenes.space>2026-05-22 05:34:11 -0700
commit02a165b1e5ce2960207976e0c27b568ab2d33f8d (patch)
tree008c533f786953c99d9a3e0700c4dd5430dd34b3 /amd64.e
parent3f3bda4692b4017c7ad6ed1c434313b9dcc62cfb (diff)
de-branch'd all the internals
so it's all just high-level flow control now, which makes it load in itself

the output isn't identical on the first self-compilation, but it converges on the second

with this, it is officially self-hosting. WOW.

Force-Push: yes
Change-Id: Ic14de1dae209b200cada269b07c3826c86fa494f
Diffstat (limited to 'amd64.e')
-rw-r--r--amd64.e156
1 files changed, 78 insertions, 78 deletions
diff --git a/amd64.e b/amd64.e
index 4d3c734..8e53822 100644
--- a/amd64.e
+++ b/amd64.e
@@ -145,64 +145,62 @@ s" :cc-greater" keyword
 
 ~ (register -- 3-bit encoded value for register)
 : reg64
-  ~   In counting the words for the branches, notice that each integer literal
-  ~ is two words.
-  dup :rax = 0branch [ 5 8 * , ] drop 0 exit
-  dup :rcx = 0branch [ 5 8 * , ] drop 1 exit
-  dup :rdx = 0branch [ 5 8 * , ] drop 2 exit
-  dup :rbx = 0branch [ 5 8 * , ] drop 3 exit
-  dup :rsp = 0branch [ 5 8 * , ] drop 4 exit
-  dup :rbp = 0branch [ 5 8 * , ] drop 5 exit
-  dup :rsi = 0branch [ 5 8 * , ] drop 6 exit
-  dup :rdi = 0branch [ 5 8 * , ] drop 7 exit
+  dup :rax = { drop 0 exit } if
+  dup :rcx = { drop 1 exit } if
+  dup :rdx = { drop 2 exit } if
+  dup :rbx = { drop 3 exit } if
+  dup :rsp = { drop 4 exit } if
+  dup :rbp = { drop 5 exit } if
+  dup :rsi = { drop 6 exit } if
+  dup :rdi = { drop 7 exit } if
   ." Parameter to reg64 is not a reg64." 1 sys-exit ;
 
 ~ (register -- 3-bit encoded value for register)
 : extrareg64
-  dup :r8 = 0branch [ 5 8 * , ] drop 0 exit
-  dup :r9 = 0branch [ 5 8 * , ] drop 1 exit
-  dup :r10 = 0branch [ 5 8 * , ] drop 2 exit
-  dup :r11 = 0branch [ 5 8 * , ] drop 3 exit
-  dup :r12 = 0branch [ 5 8 * , ] drop 4 exit
-  dup :r13 = 0branch [ 5 8 * , ] drop 5 exit
-  dup :r14 = 0branch [ 5 8 * , ] drop 6 exit
-  dup :r15 = 0branch [ 5 8 * , ] drop 7 exit
+  dup :r8 = { drop 0 exit } if
+  dup :r9 = { drop 1 exit } if
+  dup :r10 = { drop 2 exit } if
+  dup :r11 = { drop 3 exit } if
+  dup :r12 = { drop 4 exit } if
+  dup :r13 = { drop 5 exit } if
+  dup :r14 = { drop 6 exit } if
+  dup :r15 = { drop 7 exit } if
   ." Parameter to extrareg64 is not an extrareg64." 1 sys-exit ;
 
 ~ (register -- 3-bit encoded value for register)
 : reg32
-  dup :eax = 0branch [ 5 8 * , ] drop 0 exit
-  dup :ecx = 0branch [ 5 8 * , ] drop 0 exit
-  dup :edx = 0branch [ 5 8 * , ] drop 0 exit
-  dup :ebx = 0branch [ 5 8 * , ] drop 0 exit
-  dup :esp = 0branch [ 5 8 * , ] drop 0 exit
-  dup :ebp = 0branch [ 5 8 * , ] drop 0 exit
-  dup :esi = 0branch [ 5 8 * , ] drop 0 exit
-  dup :edi = 0branch [ 5 8 * , ] drop 0 exit
+  dup :eax = { drop 0 exit } if
+  dup :ecx = { drop 0 exit } if
+  dup :edx = { drop 0 exit } if
+  dup :ebx = { drop 0 exit } if
+  dup :esp = { drop 0 exit } if
+  dup :ebp = { drop 0 exit } if
+  dup :esi = { drop 0 exit } if
+  dup :edi = { drop 0 exit } if
   ." Parameter to reg32 is not a reg32." 1 sys-exit ;
 
 ~ (register -- 3-bit encoded value for register)
 : reg16
-  dup :ax = 0branch [ 5 8 * , ] drop 0 exit
-  dup :cx = 0branch [ 5 8 * , ] drop 1 exit
-  dup :dx = 0branch [ 5 8 * , ] drop 2 exit
-  dup :bx = 0branch [ 5 8 * , ] drop 3 exit
-  dup :sp = 0branch [ 5 8 * , ] drop 4 exit
-  dup :bp = 0branch [ 5 8 * , ] drop 5 exit
-  dup :si = 0branch [ 5 8 * , ] drop 6 exit
-  dup :di = 0branch [ 5 8 * , ] drop 7 exit
+  dup :ax = { drop 0 exit } if
+  dup :cx = { drop 1 exit } if
+  dup :dx = { drop 2 exit } if
+  dup :bx = { drop 3 exit } if
+  dup :sp = { drop 4 exit } if
+  dup :bp = { drop 5 exit } if
+  dup :si = { drop 6 exit } if
+  dup :di = { drop 7 exit } if
   ." Parameter to reg16 is not a reg16." 1 sys-exit ;
 
 ~ (register -- 3-bit encoded value for register)
 : reg8
-  dup :al = 0branch [ 5 8 * , ] drop 0 exit
-  dup :cl = 0branch [ 5 8 * , ] drop 1 exit
-  dup :dl = 0branch [ 5 8 * , ] drop 2 exit
-  dup :bl = 0branch [ 5 8 * , ] drop 3 exit
-  dup :ah = 0branch [ 5 8 * , ] drop 4 exit
-  dup :ch = 0branch [ 5 8 * , ] drop 5 exit
-  dup :dh = 0branch [ 5 8 * , ] drop 6 exit
-  dup :bh = 0branch [ 5 8 * , ] drop 7 exit
+  dup :al = { drop 0 exit } if
+  dup :cl = { drop 1 exit } if
+  dup :dl = { drop 2 exit } if
+  dup :bl = { drop 3 exit } if
+  dup :ah = { drop 4 exit } if
+  dup :ch = { drop 5 exit } if
+  dup :dh = { drop 6 exit } if
+  dup :bh = { drop 7 exit } if
   ." Parameter to reg8 is not a reg8." 1 sys-exit ;
 
 
@@ -215,10 +213,10 @@ s" :cc-greater" keyword
 ~
 ~ (scale factor -- 2-bit encoded value)
 : scalefield
-  dup 1 = 0branch [ 5 8 * , ] drop 0 exit
-  dup 2 = 0branch [ 5 8 * , ] drop 1 exit
-  dup 5 = 0branch [ 5 8 * , ] drop 2 exit
-  dup 8 = 0branch [ 5 8 * , ] drop 3 exit
+  dup 1 = { drop 0 exit } if
+  dup 2 = { drop 1 exit } if
+  dup 5 = { drop 2 exit } if
+  dup 8 = { drop 3 exit } if
   ." Parameter to scalefield is not 1, 2, 4, or 8." 1 sys-exit ;
 
 
@@ -238,22 +236,22 @@ s" :cc-greater" keyword
 ~
 ~ (condition -- 4-bit encoded value)
 : condition-code
-  dup :cc-overflow = 0branch [ 5 8 * , ] drop 0 exit
-  dup :cc-no-overflow = 0branch [ 5 8 * , ] drop 1 exit
-  dup :cc-below = 0branch [ 5 8 * , ] drop 2 exit
-  dup :cc-above-equal = 0branch [ 5 8 * , ] drop 3 exit
-  dup :cc-equal = 0branch [ 5 8 * , ] drop 4 exit
-  dup :cc-not-equal = 0branch [ 5 8 * , ] drop 5 exit
-  dup :cc-below-equal = 0branch [ 5 8 * , ] drop 6 exit
-  dup :cc-above = 0branch [ 5 8 * , ] drop 7 exit
-  dup :cc-sign = 0branch [ 5 8 * , ] drop 8 exit
-  dup :cc-not-sign = 0branch [ 5 8 * , ] drop 9 exit
-  dup :cc-even = 0branch [ 5 8 * , ] drop 10 exit
-  dup :cc-odd = 0branch [ 5 8 * , ] drop 11 exit
-  dup :cc-less = 0branch [ 5 8 * , ] drop 12 exit
-  dup :cc-greater-equal = 0branch [ 5 8 * , ] drop 13 exit
-  dup :cc-less-equal = 0branch [ 5 8 * , ] drop 14 exit
-  dup :cc-greater = 0branch [ 5 8 * , ] drop 15 exit
+  dup :cc-overflow = { drop 0 exit } if
+  dup :cc-no-overflow = { drop 1 exit } if
+  dup :cc-below = { drop 2 exit } if
+  dup :cc-above-equal = { drop 3 exit } if
+  dup :cc-equal = { drop 4 exit } if
+  dup :cc-not-equal = { drop 5 exit } if
+  dup :cc-below-equal = { drop 6 exit } if
+  dup :cc-above = { drop 7 exit } if
+  dup :cc-sign = { drop 8 exit } if
+  dup :cc-not-sign = { drop 9 exit } if
+  dup :cc-even = { drop 10 exit } if
+  dup :cc-odd = { drop 11 exit } if
+  dup :cc-less = { drop 12 exit } if
+  dup :cc-greater-equal = { drop 13 exit } if
+  dup :cc-less-equal = { drop 14 exit } if
+  dup :cc-greater = { drop 15 exit } if
   ." Parameter to condition-code is not a condition code." 1 sys-exit ;
 
 
@@ -399,15 +397,16 @@ s" :cc-greater" keyword
 ~  -- output point)
 : addressing-indirect-reg64
   ~ Exit with an error if the R/M register is :rbp.
-  dup :rbp != 0branch [ 23 8 * , ]
-  ~ Check whether the R/M register is :rsp. Save the test result for later.
-  dup :rsp = 4 unroll
-  ~ (equality result, output point, reg/op value, reg/mem name)
-  reg64 0 3unroll modrm
-  ~ (equality result, output point)
-  ~ If the R/M register was rsp, we need an SIB byte; otherwise, skip it.
-  swap 0branch [ 8 8 * , ] 0 4 :rsp reg64 sib
-  exit
+  dup :rbp != {
+    ~ Check whether the R/M register is :rsp. Save the test result for later.
+    dup :rsp = 4 unroll
+    ~ (equality result, output point, reg/op value, reg/mem name)
+    reg64 0 3unroll modrm
+    ~ (equality result, output point)
+    ~ If the R/M register was rsp, we need an SIB byte; otherwise, skip it.
+    swap { 0 4 :rsp reg64 sib } if
+    exit
+  } if
   ." R/M parameter to addressing-indirect-reg64 is :rbp." 1 sys-exit ;
 
 ~ (output point, reg/op field value, reg/mem field register,
@@ -420,7 +419,7 @@ s" :cc-greater" keyword
   4 unroll
   reg64 1 3unroll modrm
   ~ If the R/M register was rsp, we need an SIB byte; otherwise, skip it.
-  3roll 0branch [ 8 8 * , ] 0 4 :rsp reg64 sib
+  3roll { 0 4 :rsp reg64 sib } if
   ~ The displacement byte.
   swap pack8 ;
 
@@ -434,7 +433,7 @@ s" :cc-greater" keyword
   4 unroll
   reg64 2 3unroll modrm
   ~ If the R/M register was rsp, we need an SIB byte; otherwise, skip it.
-  3roll 0branch [ 8 8 * , ] 0 4 :rsp reg64 sib
+  3roll { 0 4 :rsp reg64 sib } if
   ~ The displacement value.
   swap pack32 ;
 
@@ -443,11 +442,12 @@ s" :cc-greater" keyword
 ~  -- output point)
 : addressing-indexed-reg64
   ~ Exit with an error if the base register is :rbp.
-  dup :rbp != 0branch [ 23 8 * , ]
-  ~ Reg/mem value 4 means to use an SIB byte (at least, with this mode).
-  5 roll 0 6 roll 4 modrm 4 unroll
-  reg64 3unroll reg64 3unroll scalefield 3unroll sib
-  exit
+  dup :rbp != {
+    ~ Reg/mem value 4 means to use an SIB byte (at least, with this mode).
+    5 roll 0 6 roll 4 modrm 4 unroll
+    reg64 3unroll reg64 3unroll scalefield 3unroll sib
+    exit
+  } if
   ." Base parameter to addressing-indexed-reg64 is :rbp." 1 sys-exit ;
 
 ~ (output point, reg/op field value,