~ current output point, string pointer
: pack-raw-string
  { unpack8 dup } { 3roll swap pack8 swap } while drop drop ;

: 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
  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

~ (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 @ ;
  ;

~ (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
~ ~~
~ ~~   This is the top-level ELF header, for the entire file. An ELF always
~ ~~ has exactly one of this header, which is always at the start of the file.
~ ~~
: elf-file-header
  0x7f pack8 s" ELF" pack-raw-string        ~ magic number
  2 pack8                                   ~ 64-bit
  1 pack8                                   ~ little-endian
  1 pack8                                   ~ ELF header format v1
  0 pack8                                   ~ System-V ABI
  0 pack64                                  ~ (padding)

  2 pack16                                  ~ executable
  0x3e pack16                               ~ Intel x86-64
  1 pack32                                  ~ ELF format version

  ~ Compute the entry pointer.
  origin 0x78 + pack64                      ~ entry point
    ~ This includes the origin, intentionally.

  0 pack64                                  ~ program header offset
    ~ We place the program header immediately after the ELF header. This
    ~ offset is from the start of the file.
  0 pack64                                  ~ section header offset
  0 pack32                                  ~ processor flags
  64 pack16                                 ~ ELF header size
  56 pack16                                 ~ program header entry size
  1 pack16                                  ~ number of program header entries
  0 pack16                                  ~ section header entry size
  0 pack16                                  ~ number of section header entries
  0 pack16                                  ~ section name string table index
  ;

~ ~~
~ ~~ Program header
~ ~~
~ ~~   An ELF program header consists of any number of these entries; they are
~ ~~ always consecutive, but may be anywhere in the file. We always have
~ ~~ exactly one, and it's always right after the ELF file header.
~ ~~
: elf-program-header
  1 pack32                                  ~ "loadable" segment type
  0x05 pack32                               ~ read+execute permission
  0 pack64                                  ~ offset in file
  origin pack64                             ~ virtual address
    ~ required, but can be anything, subject to alignment
  0 pack64                                  ~ physical address (ignored)

  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
  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
  elf-file-header
  elf-program-header
  output-start-routine
  ;

0x1000 allocate dup
~ output memory start, current output point

all-contents

~ output memory start, current output point
over - swap sys-write bye