a comprehensive label system is now implemented

it doesn't actually resolve their real values yet though

Change-Id: Ib8fa0f73dfa37ec9e593f5cf17adc825a42ba53b
Force-Push: yes

1 files changed, 96 insertions, 19 deletions

diff --git a/make-hello.e b/make-hello.e
index 797c228..bf0b076 100644
--- a/make-hello.e
+++ b/make-hello.e
@@ -4,25 +4,100 @@
 
 : origin 0x08000000 ;
 
+~ Status is a bit field:
+~    bit zero is whether it's been used
+~    bit one is whether it's been defined
+~    bit two is whether it was used before being defined
+~    bit three is whether the guessed value wound up equaling the actual value
+
 : init-labels
-  heap hexdump
-  latest @ dup word-heading hexdump
-  ~ s" labels" create
   8 allocate s" labels" variable
   0 s" labels" find entry-to-execution-token execute !
   ;
+~ This needs to happen now because otherwise the word "labels" won't exist.
 init-labels
-latest @ dup word-heading hexdump
-labels @ .hex newline
 
-: new-label
-  s" frobboz" labels create-in
+~ (entry pointer --)
+: label-heading
+  dup entry-to-name dup emitstring space
+  stringlen 1+ 54 swap - 0 max indent
+  entry-to-execution-token dup 8 + @ .hex64 space @ .hex8
+  newline ;
+
+~ (dictionary handle)
+: oldest-entry-in
+  dup
+  dup { { dup @ } { @ } while } if
+  dup 3roll = { drop 0 } if
+  ;
+
+~ (entry pointer, dictionary handle)
+: next-newer-entry-in
+  @
+  2dup = { 2drop 0 exit } if
+  { dup { 2dup @ != } if }
+  { @ } while swap drop ;
+
+: list-labels
+  labels oldest-entry-in { dup }
+  { dup label-heading labels next-newer-entry-in } while drop ;
+
+~ (name string pointer -- )
+: new-label labels create-in 0 , 0 , ;
+
+: label-status entry-to-execution-token ;
+: label-value entry-to-execution-token 8 + ;
+
+: intern-label
+  dup labels swap find-in
+  dup { swap drop }
+      { drop dup new-label labels swap find-in } if-else ;
+
+: L'
+  word value@
+  interpreter-flags @ 0x01 &
+  { ' litstring entry-to-execution-token ,
+    here @ swap packstring 0 pack8 8 packalign here !
+    ' intern-label entry-to-execution-token ,
+    dropstring }
+  { intern-label dropstring-with-result } if-else
+  ; make-immediate
+
+~ (label entry pointer -- label value)
+: use-label
+  ~ If it hasn't been defined yet, mark it used-before-set.
+  dup label-status dup @ dup 0x01 & not { 0x02 | swap ! } { drop drop } if-else
+
+  ~ Mark it used. It's faster to just do this than to check if it's needed.
+  dup label-status dup @ 0x01 | swap !
+
+  ~ Return the guessed value.
+  label-value @ ;
   ;
-here @
-new-label
-latest @ dup word-heading hexdump
-labels @ .hex newline
-hexdump
+
+~ (new label value, label entry pointer --)
+: set-label
+  ~ We always set the defined bit to true. We leave the other status bits
+  ~ as-is, except that we check whether it's unused up to now, and whether
+  ~ the previous value equals the new value. If either of those holds, we set
+  ~ the guessed-equals-actual bit to true.
+  dup label-status @ 0x02 |
+  ~ (new value, entry, updated status)
+  3unroll dup 4 unroll label-value @ swap dup 3unroll =
+  ~ (entry, updated status, new value, equality)
+  3roll dup 4 unroll 0x01 & not
+  ~ (entry, updated status, new value, equality, unused)
+  || { swap 0x08 | swap } if
+  ~ (entry, updated status, new value)
+  3roll dup 3unroll
+  ~ (updated status, entry, new value, entry)
+  label-value ! label-status !
+  ;
+
+~ (output memory start, current output point
+~  -- output memory start, current output point, offset)
+: current-offset 2dup swap - ;
+
 
 ~ ~~
 ~ ~~ ELF header
@@ -74,22 +149,24 @@ hexdump
     ~ required, but can be anything, subject to alignment
   0 pack64                                  ~ physical address (ignored)
 
-  ~ Fill in 0 as the file size for now, to avoid uninitialized memory.
-  0 pack64                                  ~ size in file
-    ~ TODO call use-label here
-  0 pack64                                  ~ size in memory
-    ~ TODO call use-label here
+  L' total-size use-label pack64            ~ size in file
+  L' total-size use-label pack64            ~ size in memory
 
   0 pack64                                  ~ segment alignment
     ~ for relocation, but this doesn't apply to us
   ;
 
 : output-start-routine
-  ~ lit 1 :rax mov-reg64-imm32
+  1 :rax mov-reg64-imm32
+  1 :rdi mov-reg64-imm32
   ;
 
+~ (output memory start, current output point
+~  -- output memory start, current output point)
+~
+~ Everything directly called by all-contents has this same interface.
+~
 : all-contents
-  ~ current output point
   elf-file-header
   elf-program-header
   output-start-routine