path: root/compiler/standardClient.ey

## regex support
# ideas taken from http://swtch.com/~rsc/regexp/regexp3.html
{
  0 ==:MATCH 1 ==:TERM 2 ==:JUMP 3 ==:SPLIT 4 ==:SAVE 5 ==:FIRST 6 ==:LAST

  { ==b ==a [
    [ SPLIT 1 a len 1 add ] # FIXME this should be "2 add"?!
    a _ len dearray
    [ JUMP b len ]
    b _ len dearray
  ] } /alternative deffst

  |cat /sequence deffd

  { ==?a [ # TODO measure separate + implementation performance impact
    [ JUMP a len 1 add ]
    a _ len dearray
    [ SPLIT 1 a len neg ]
  ] } /star deffst

  { ==?p [
    [ TERM p ]
  ] } /terminal deffst

  { ==?i ==?a [
    [ SAVE i 2 mul ]
    a _ len dearray
    [ SAVE i 2 mul 1 add ]
  ] } /capture deffst

  { [ ] } /empty deffd

  { ==?str
    str len 0 eq {
      1 neg
    } {
      0 str *
    } ? *
  } /head deffd

  { 1 -01 str .postfix } /tail deffd

  { 0 -01 * -101 head eq } "^" deffd
  { deffd }' /install deffst
  [ "(" ")" "[" "]" "-" "|" "^" "*" "+" "." "$" "\\" ] { ==?c
    { _ head 0 c * eq } "^" c cat install
  } each

  { # "(parse) re: " -101 cat dump

    seq ==?a
    ^| {
      tail parse ==?b
      a b alternative =a
    } rep
    a
  } /parse deffst

  { # "(seq) re: " -101 cat dump

    empty _ ==?a
            ==?l

    { # "(seq loop) re: " -101 cat dump
      _ head 1 neg eq -01
      ^| -01
      ^) -01
      -0321 or or not
    } {
      [ { ^* } {
        l star =l
        tail
      } { ^+ } {
        l l star sequence =l
        tail
      } { 1 } {
        a l sequence =a
        atom =l
      } ] conds
    } loop
    a l sequence
  } /seq deffst

  0 ==?currentCapture
  
  { # "(atom) re: " -101 cat dump
    empty ==?a

    [ { ^( } {
      tail parse currentCapture capture =a
      currentCapture 1 add =currentCapture
      ^) not { ") expected" die } rep
      tail
    } { ^[ } {
      tail
      ^^ {
        tail chars =*nset
        { nset not }' ==?set
        ^] not { "] expected" die } rep
        tail
      }' {
        chars ==?set
        ^] not { "] expected" die } rep
        tail
      }' ? *
      set terminal =a
    } { ^. } {
      { -- 1 }" terminal =a
      tail
    } { ^^ } {
      [ [ FIRST ] ] =a
      tail
    } { ^$ } {
      [ [ LAST ] ] =a
      tail
    } { ^\ } {
      tail
      [ { ^d } {
        { _ 0 "0" * ge -01 0 "9" * le and }" terminal =a
        tail
      } { ^\ } {
        { 0 "\\" * eq }" terminal =a
        tail
      } { ^. } {
        { 0 "." * eq }" terminal =a
        tail
      } { ^n } {
        { 0 "\n" * eq }" terminal =a
        tail
      } { 1 } {
        "invalid character '" "' after \\ in regex" -120 cat cat die
      } ] conds
    } { 1 } {
      _ head { eq }_ terminal =a
      tail
    } ] conds

    # "(atom end) re: " -101 cat dump
    a
  } /atom deffst

  { # "(chars) re: " -101 cat dump
    ^] {
      tail chars2 =*s
      { _ s -01 0 "]" * eq or }' ==?set
    }' {
      chars2 ==?set
    }' ? *
    set
  } /chars deffst

  { # "(chars2) re: " -101 cat dump
    ^- {
      tail chars2 =*s
      { _ s -01 0 "-" * eq or }' ==?set
    }' {
      charsR ==?set
    }' ? *
    set
  } /chars2 deffst

  { # "(charsR) re: " -101 cat dump
    charsN ==?set
    { ^] not } {
      set =*s1
      charsN =*s2
      { _ s1 -01 s2 or }' =set
    } loop
    set
  } /charsR deffst

  { # "(charsN) re: " -101 cat dump
    _ head ==?start
    ^\ {
      tail
      [ { ^\ } {
        0 "\\" * =start
      } { ^n } {
        0 "\n" * =start
      } { 1 } {
        "invalid character '" "' after \\ in regex" -120 cat cat die
      } ] conds
    } rep
    tail
    ^- {
      tail
      _ head ==?end
      ^\ {
        tail
        [ { ^\ } {
          0 "\\" * =end
        } { ^n } {
          0 "\n" * =end
        } { 1 } {
          "invalid character '" "' after \\ in regex" -120 cat cat die
        } ] conds
      } rep
      tail
      { _ start ge -01 end le and }' ==?set
    }' {
      { start eq }' ==?set
    }' ? *
    set
  } /charsN deffst

  { 0 -01 * }" /threadGetPC deffd
  { 1 -01 * }" /threadGetCaptures deffd

  { [
    0 # pc
    [ currentCapture { 0 0 } rep ] # captures
  ] } /newThread deff

  { #==thread ==newpc
    [ -021 threadGetCaptures ]
  }" /cloneThread deffd

  { #==thread ==newpc
    [ -0201 threadGetCaptures _ len dearray ] ]
  }" /fullCloneThread deffd

  |add /origadd deffd

  # TODO think about implementation efficiency
  { < ==maxSize
    0 ==size
    [ maxSize { 0 }" rep ] =*get
    [ maxSize { 1 }" rep ] =*pcFree

    { # ==thread
      _ threadGetPC pcFree {
        _ size |get =[]
          0 -01 threadGetPC |pcFree =[]
        size 1 origadd =size
      }" { -- }" ? *
    }' /add deffst

    {
      0 =size
      [ maxSize { 1 }" rep ] =pcFree
    }' /clear deffst
  > } /threadList deffd

  { ==prog ==string
    0 ==position
    string len ==maxPosition
    0 ==done
    0 ==matched

    prog len _ threadList ==clist
               threadList ==nlist

    newThread _ ==thread clist .add

    0 ==pc
    { } =*code

    [
      { # MATCH
        1 =matched
        clist .clear
      }" { # TERM
        position maxPosition lt {
          position string * 1 code * { pc 1 add thread cloneThread nlist .add }" rep
        }" rep
      }" { # JUMP
        pc 1 code add thread cloneThread clist .add
      }" { # SPLIT
        pc 1 code add thread cloneThread clist .add
        pc 2 code add thread cloneThread clist .add
      }" { # SAVE
        pc 1 add thread fullCloneThread
        position 1 code -2102 threadGetCaptures =[]
                              clist .add
      }" { # FIRST
        position 0 eq { pc 1 add thread cloneThread clist .add }" rep
      }" { # LAST
        position maxPosition eq { pc 1 add thread cloneThread clist .add }" rep
      }"
    ] =*codeSemantics

    0 ==i
    { position maxPosition le done not and }" {
      0 =i
      { i clist .size lt done not and }" {
        i clist .get _ =thread
                       threadGetPC _ =pc
                                     prog * =code
        0 code codeSemantics *
        i 1 add =i
      }" loop

      clist nlist =clist =nlist
      nlist .clear
      position 1 add =position
    }" loop

    matched {
      currentCapture ==i
      { i } { i 1 sub =i
        string
        i 2 mul       thread threadGetCaptures * _ ==start -01 str .postfix
        i 2 mul 1 add thread threadGetCaptures * start sub -01 str .inplacePrefix
      } loop
    } rep
    matched
  } /execute deffst

  parse ==prog --
  [
    [ SPLIT 3 1 ]
    [ TERM { -- 1 }" ]
    [ JUMP 2 neg ]
    prog _ len dearray
    [ MATCH ]
  ] =prog
  { prog execute }
} /enregex deffd

{
  quoted {
    _ sys .typed .type 1 eq {
      enregex
    } { |enregex "*" | } ? *
  } { enregex * } ? *
} /regex defq

< # sys extensions
  # TODO: handle EINTR correctly

  0 _ ==:RDONLY
  1 _ ==:WRONLY
  2 _ ==:RDWR
      bor bor ==:RWMASK

  64 ==:OCREAT
  1024 ==:OAPPEND

  1 ==:PROTREAD
  2 ==:PROTWRITE
  4 ==:PROTEXEC

  2 ==:MAPPRIVATE
  32 ==:MAPANONYMOUS
  
  0 ==:READ
  1 ==:WRITE
  2 ==:OPEN
  3 ==:CLOSE

  9 ==:MMAP
  11 ==:MUNMAP
  60 ==:EXIT

  { ==code
    code 0 0 0 0 0 EXIT sys .asm .syscall
    "exit failed" die
  } /exit sys .deff

  { < ==?mode ==?flags ==?fd <
      { flags RWMASK bnot band RDONLY bor =flags } /readonly deff
      { flags RWMASK bnot band WRONLY bor =flags } /writeonly deff
      { flags RWMASK bnot band RDWR bor =flags } /readwrite deff
      { flags OCREAT bor =flags } /creating deff
      { flags OAPPEND bor =flags } /appending deff
      { ==path
        fd 0 ge { "file already open" die } rep 
        path "\0" cat flags mode 0 0 0 OPEN sys .asm .syscall -- _ =fd
        0 lt { "cannot open " path cat die } rep
      } /open deff
      {
        fd 0 0 0 0 0 CLOSE sys .asm .syscall --
        0 lt { "bad things happened to your close call" die } rep
      } /close deff
      { ==count
        fd 0 lt { "file not open" die } rep 
        count str .alloc ==?buf
        fd buf count 0 0 0 READ sys .asm .syscall -- _
        0 lt { "read failed" die } rep
        buf str .inplacePrefix
      } /read deff
      { ==buf
        fd 0 lt { "file not open" die } rep 
        fd buf _ len 0 0 0 WRITE sys .asm .syscall -- _
        0 lt { "write failed" die } rep
      } /write deff
      { ==buf
        fd 0 lt { "file not open" die } rep 
        { buf len } {
          fd buf _ len 0 0 0 WRITE sys .asm .syscall -- _
          0 lt { "write failed" die } rep
          buf str .postfix =buf
        } loop
      } /writeall deff
      { =*f "" ==buffer
        {
          buffer 4096 read cat =buffer # FIXME interpreter API should also have .read defined as returning string
          buffer "" streq not
        } {
          {
            buffer "([^\\n]*)\\n" regex
          } {
            _ len 1 add buffer str .postfix =buffer
              f
          } loop
        } loop
      } /eachLine deff
  > > -- } /makefile deff

  |makefile /fdToFile sys .deff

  { # 0777 = 511
    1 neg RDONLY 511 makefile
  } /file sys .deff

  0 RDONLY 0 makefile /in sys .defv
  1 WRONLY 0 makefile /out sys .defv
  2 WRONLY 0 makefile /err sys .defv

  < # sys .asm extensions
    { ==reqAddr ==reqSize
      <
        reqAddr
        reqSize
        PROTEXEC PROTREAD PROTWRITE bor bor
        MAPPRIVATE MAPANONYMOUS bor
        1 neg
        0
        MMAP sys .asm .syscall -- _
        0 lt { "mmap failed" die } rep

        ==base
        reqSize ==size

        {
          base size 0 0 0 0 MUNMAP sys .asm .syscall --
          0 lt { "munmap failed" die } rep
        } =*free
      >
    } /allocAt sys .asm .deff

    {
      0 sys .asm .allocAt
    } /alloc sys .asm .deff
  > --

  < # sys .typed extensions

    # Returns an array which lists the sequence of curried arguments
    # i.e. if f: A -> B -> C -> D -> E the result will be [ A B C D ]
    { ==object
      { "unknown type in typeStack" die } ==unknown
      { "invalid type in typeStack" die } ==invalid
      { [ object 0 1 neg ] } ==literal

      object sys .typed .type [
        literal # integer
        literal # string
        literal # scope
        invalid # name table
        invalid # extension area
        { object sys .typed .inputs ==in
          in len 1 neq { "multi-input function in typeStack" die } rep
          [ 0 in * 0 1 neg ]
          object sys .typed .outputs ==out
          out len 1 neq { "multi-output function in typeStack" die } rep
          0 out * typeStackInternal
        } # function
        invalid # function code
        { [ 1 0 object len 1 sub ] 0 object * typeStackInternal } # array
        invalid # function type
        unknown
        unknown
        unknown
        unknown
        unknown
        unknown
        unknown
      ] * *
    } /typeStackInternal deff

    { [ -01 typeStackInternal ] } /typeStack deff

    { -- 0 } /isVariableType deff

    { ==t
      t len 3 neq { "complex execution type non-triple" die } rep

      2 t * 1 t * ge
    } /isIterableType deff

    { =*a =*b
      [
        { 0 a sys .typed .type 0 b sys .typed .type neq }
        { 0 }

        { 0 a sys .typed .type 0 neq }
        { "type equality only implemented for ints" die }

        { 0 b sys .typed .type 0 neq }
        { "type equality only implemented for ints" die }

        { 0 a 0 b neq } { 0 }
        { 1 } { 1 }
      ] conds
    } /typeEqual deff

    { ==earlierType ==laterType
      [
        earlierType laterType typeEqual
        { earlierType 1 }

        # TODO: maybe handle structs here one day (or move the whole affair into
        # a real compilation stage
        { 0 earlierType * sys .typed .type 0 neq }
        { 0 }

        # Who came first determines iteration range
        { 2 earlierType * 1 neg neq }
        { earlierType 1 }

        # But if only the later one defines a range, take that one
        { 2 laterType * 1 neg neq }
        { laterType 1 }

        # General integers go-iterate iff they binary and results in non-zero
        { 0 earlierType * 0 laterType * band 0 neq }
        { earlierType 1 }

        { 1 }
        { 0 }
      ] conds
    } /commonIterationType deff

    { ==arr
      0
    } /getLoopStart deff

    { ==arr
      arr len eq
    } /isLoopEnd deff

    { ==arr
      1 add
    } /doLoopStep deff

    # Executing a function f: A->B->C (i.e. B A f) on concrete arguments b a.
    # Phase 1
    #   Foreach argument:
    #     Find the function input type from top of concrete argument type stack,
    #       increase viewport from top of concrete type stack
    #         match type from bottom to top, if type cannot be found, create constant function
    #         final match is that which creates minimal number of constant function layers
    # Phase 2
    #   Foreach argument type:
    #     Identify the type stack above the match from phase 1.
    #     Run from right (stacktop) argument to left (stacklow) argument:
    #       Take topmost type, check whether it can be found in other stacks (from top)
    #         Eliminate all matching types via function or loop creation
    { _ ==?f sys .typed .inputs ==?inputs
      [ ] ==?concreteArgs
      [ ] ==?viewPortOffset

      # Phase 1
      0 inputs len range reverse {
        # print "Analyzing arg: %d"
        inputs * typeStack ==?formalTypeStack
        _ ==?c typeStack ==?concreteTypeStack
        # "Type-Stack: %d" Dumper($concreteTypeStack) die

        0 ==?bestViewPortSize
        concreteTypeStack len 1 add ==?bestViewPortMatch

        # "Formal Type Stack: @$formalTypeStack\n" print
        # "       Type Stack: @$concreteTypeStack\n" print

        1 neg concreteTypeStack * isVariableType {
          1 concreteTypeStack len 1 add range { ==?viewPortSize
            [ 0 viewPortSize range { concreteTypeStack * } each ] ==?typeViewPort # explicit each here
            # "@$formalTypeStack vs. @$concreteTypeStack\n" print

            formalTypeStack concreteTypeStack typeMismatchCount ==?viewPortMatch # FIXME this line seems fishy
            viewPortMatch bestViewPortMatch lt {
              viewPortSize =bestViewPortSize
              viewPortMatch =bestViewPortMatch
            } rep
          } each
        } {
          concreteTypeStack len =bestViewPortSize
          0 =bestViewPortMatch
        } ? *

        # convert concrete argument to exactly matching function
        # ... which calls the concrete argument using its relevant args
        bestViewPortMatch {
          # if argument is concrete, but we need are construction a function overall, then concrete
          # argument needs to be converted to a constant function in whatever domain is necessary
          "concrete argument constant functionification needs to be implemented, mismatch: $bestViewPortMatch" die
          { "magic goes here FIXME" die } =c
        } {
          # zero mismatches, can directly use concrete argument
          [ concreteTypeStack len formalTypeStack len sub ] viewPortOffset cat =viewPortOffset
        } ? *

        [ c ] concreteArgs cat =concreteArgs
      } each

      # "Viewport Offsets: @viewPortOffset\n" print

      # Phase 2,
      [
        0 viewPortOffset len range { ==?i
          i concreteArgs * typeStack ==?remaining
          [ 0 i viewPortOffset * range { remaining * } each ] # explicit each here
        } each
      ] ==?toBeAbstractedTypes

      "toBeAbstractedTypes: " dump
      toBeAbstractedTypes dump

      [ toBeAbstractedTypes { len } each ] any not {
        # no types need to be abstracted, function can be called
        concreteArgs _ dump _ len dearray f
        "attempting to call function (w.o. abstraction)" dump
        0 concreteArgs len range { ==?i
          i concreteArgs * sys .typed .type _ dump
          i inputs       * sys .typed .type _ dump
          neq { "invalid input type at argument index " dump i dump "" die } rep
        } each
        *
      } {
        [ ] ==?argTypes # the type stack of the new function
        [ ] ==?stageCalls # which functions to call in each stage
        [ ] ==?loops # undef for lambda abstraction, loop bound source for loops

        0 toBeAbstractedTypes len range reverse { ==?i
          { i toBeAbstractedTypes * len } {
            # TODO: create a decent shift
            [ i toBeAbstractedTypes * reverse _ len dearray ==?type ] reverse i toBeAbstractedTypes =[]
              [ i ] ==?stageCalls2
              1 neg ==?iterationSource
              type isIterableType { i =iterationSource } rep

              0 i range reverse { ==?j
                j toBeAbstractedTypes * len not not {
                  0 j toBeAbstractedTypes * * type commonIterationType # -> <type> <any exists>
                  { =type
                    iterationSource 0 lt type isIterableType and { j =iterationSource } rep
                    # TODO: create a decent shift
                    [ j toBeAbstractedTypes * reverse _ len dearray -- ] reverse j toBeAbstractedTypes =[]
                    [ j ] stageCalls2 cat =stageCalls2
                  } rep
                } rep
              } each

              iterationSource 0 ge {
                [ 1 neg ] argTypes cat =argTypes
                [ iterationSource ] loops cat =loops
              } {
                [ type ] argTypes cat =argTypes
                [ 1 neg ] loops cat =loops
              } ? *
            stageCalls [ stageCalls2 ] cat =stageCalls
          } loop
        } each

        "concreteArgs: " dump
        concreteArgs dump
        "stageCalls: " dump
        stageCalls dump
        "argTypes: " dump
        argTypes dump
        "loops: " dump
        loops dump
        
        { ==?loops ==?argTypes ==?stageCalls ==?concreteArgs
          stageCalls len not {
            concreteArgs _ len dearray f
            *
          } {
            [ stageCalls _ len dearray ==?stage ] =stageCalls
            [ argTypes _ len dearray ==?argType ] =argTypes
            [ loops _ len dearray ==?loopIndex ] =loops
            loopIndex 0 ge {
              [ ] ==?results
              loopIndex concreteArgs * ==?loopedOver
              loopedOver getLoopStart ==?i
              { i loopedOver isLoopEnd not } {
                [ concreteArgs _ len dearray ] ==?concreteArgsCopy
                stage { ==?j
                  # TODO: think about a single function returning multiple values
                  i j concreteArgs * * j concreteArgsCopy =[]
                } each

                [ concreteArgsCopy stageCalls argTypes loops unravel ]
                results -01 cat =results
                results dump
                # TODO: think about a single function returning multiple values
                # should be solved by producing two arrays side by side

                i loopedOver doLoopStep =i
              } loop

              results
              # push @$data, [\@results, ['array', '[]', [['range', 0, $#results]], [undef]]];
              # FIXME the undef can be determined
            } {
              { ==?v
                stage { ==?i
                  v i concreteArgs * * i concreteArgs =[]
                } each

                concreteArgs stageCalls argTypes loops unravel
              } # leave this on the stack
              # push @$data, [$abstraction, ['func', 'autoabstraction of ' . $f->[1]->[1], [grep { $_ } @argTypeCopy], undef]];
              # FIXME the undef can be determined
            } ? *
          } ? *
        } =*?unravel

        concreteArgs stageCalls argTypes loops unravel

        "execution complete" dump
      } ? *
    } /execute sys .typed .deff
  > --
> --

# global extensions
<
  [ /0 /1 /2 /3 /4 /5 /6 /7 /8 /9 /A /B /C /D /E /F ] ==:base16singleDigits
  [ base16singleDigits { ==first base16singleDigits { first -01 cat } each } each ] ==:base16digits

  {
    [ -01 8 { _ 256 mod base16digits * -01 256 div } rep -- ]
    reverse |cat fold
  } /base16encode64 deffd

  { ==indent _ ==o
    { "unknown type in dump" die } ==unknown
    { "invalid type in dump" die } ==invalid
        
    "" indent { "  " cat } rep sys .err .writeall
    sys .typed .type [
      { o base16encode64 sys .err .writeall } # integer
      { "\"" o "\"" cat cat sys .err .writeall } # string
      { "<scope: " o sys .asm .rawAddress base16encode64 cat ">" cat sys .err .writeall }
      invalid # name table
      invalid # extension area
      { "<function: " o sys .asm .rawAddress base16encode64 cat ">" cat sys .err .writeall }
      invalid # function code
      {
        "[\n" sys .err .writeall
        o { indent 1 add dumpIndented } each
        "" indent { "  " cat } rep "]" cat sys .err .writeall
      } # array
      invalid # function type
      unknown
      unknown
      unknown
      unknown
      unknown
      unknown
      unknown
    ] * *
    "\n" sys .err .writeall
  } /dumpIndented deffd

  # dump top stack element to sys .err
  { 0 dumpIndented }
> -- /dump deffd

{ ==filename # ==?f (left on the stack and executed from sys .asm .programStart)
  sys .asm .patchProgramStart ==frozenAllocationCount

  # hex decoding
  { ==strNumber
    strNumber len 2 neq { "not a valid hex-string" die } rep
    1 0 { strNumber * 48 sub [ 0 1 2 3 4 5 6 7 8 9  0 0 0 0 0 0 0  10 11 12 13 14 15 ] * } -20*10* 16 mul add
  } "%" defq

  { _ 0 ge assert 8 { _ 256 mod -01 256 div } rep -- } /uint64 deffd
  { _ 0 lt { 4294967296 add } rep 4294967295 band 4 { _ 256 mod -01 256 div } rep -- } /uint32 deffd
  { _ 0 lt { 65536 add } rep 65535 band 2 { _ 256 mod -01 256 div } rep -- } /uint16 deffd
  { _ 0 lt { 256 add } rep 255 band } /uint8 deffd

  { ==align ==value
    align value align mod sub align mod
  } /alignUpto deff

  sys .file ==out
  filename out _ .creating _ .writeonly .open

  [
    <
      ".null" ==?name
      0 ==?nameOffset { =nameOffset } /setNameOffset deff
      0 ==?dataOffset { =dataOffset } /setDataOffset deff
      0 ==?type # reserved first section
      0 ==?flags # none
      0 ==?addr # not loaded
      0 ==?link # no associated section
      0 ==?entsize # no entries
      [ ] ==?data
      0 ==?dataSize
    > <
      ".strtab" ==?name
      0 ==?nameOffset { =nameOffset } /setNameOffset deff
      0 ==?dataOffset { =dataOffset } /setDataOffset deff
      3 ==?type # string table
      0 ==?flags # none
      0 ==?addr # not loaded
      0 ==?link # no associated section
      0 ==?entsize # no entries
      [ ] ==?data # to be filled later
      0 ==?dataSize # to be filled later
      { _ =data len =dataSize } /setData deff
    > _ ==?stringTable
  ] ==metaSections

  [
    0 frozenAllocationCount range { ==i
      <
        ".-=#=-" ==?name
        0 ==?nameOffset { =nameOffset } /setNameOffset deff
        0 ==?dataOffset { =dataOffset } /setDataOffset deff
        1 ==?type # program data
        7 ==?flags # writable, allocated, executable
        0 ==?addr # FIXME
        0 ==?link # no associated section
        0 ==?entsize # no entries
        i sys .asm .globalAllocBase ==?dataBase
        i sys .asm .globalAllocSize ==?dataSize
      >
    } each
  ] ==allocSections

  4096 ==:PAGESIZE

  < 1 ==?nameOffset
    [
      %00 # initial zero byte of string table
      ### section names

      [ metaSections allocSections ] { { ==?s
        s .name ==?n
        0 n len range { n * } each %00
        nameOffset s .setNameOffset
        nameOffset n len add 1 add =nameOffset
      } each } each
    ] stringTable .setData
  > -- <
    # %40 ==? section header size, %38 == program header size
    metaSections len allocSections len add %40 mul
                     allocSections len     %38 mul add
                                           %40     add ==dataOffset
    metaSections { ==s
      dataOffset s .setDataOffset
      dataOffset s .dataSize add =dataOffset
    } each

    dataOffset _ 4096 alignUpto add =dataOffset

    allocSections { ==s
      dataOffset s .setDataOffset
      dataOffset s .dataSize add _ PAGESIZE alignUpto add =dataOffset
    } each
  > --

  [
    ### elf header
    # unsigned char e_ident[16]; /* ELF identification */
    %7F 0 1 2 "ELF" -30*20*10*  # elf identifier
    %02                         # elfclass64
    %01                         # elf version
    %01                         # little endian encoding
    %00 %00                     # Sys-V ABI
    %00 %00 %00 %00 %00 %00 %00 # padding
    # Elf64_Half    e_type;      /* Object file type */
    %02 %00                     # executable file
    # Elf64_Half    e_machine;   /* Machine type */
    %3E %00                     # whatever, /bin/ls has this
    # Elf64_Word    e_version;   /* Object file version */
    %01 %00 %00 %00             # always 1
    # Elf64_Addr    e_entry;     /* Entry point address */
    sys .asm .|programStart sys .asm .rawCodeAddress uint64
    # Elf64_Off     e_phoff;     /* Program header offset */
    metaSections len allocSections len add %40 mul
                                           %40     add uint64
    # Elf64_Off     e_shoff;     /* Section header offset */
    %40 uint64
    # Elf64_Word    e_flags;     /* Processor-specific flags */
    %00 %00 %00 %00 # taken from from /bin/ls
    # Elf64_Half    e_ehsize;    /* ELF header size */
    %40 %00
    # Elf64_Half    e_phentsize; /* Size of program header entry */
    %38 %00
    # Elf64_Half    e_phnum;     /* Number of program header entries */
    allocSections len uint16
    # Elf64_Half    e_shentsize; /* Size of section header entry */
    %40 %00
    # Elf64_Half    e_shnum;     /* Number of section header entries */
    metaSections len allocSections len add uint16
    # Elf64_Half    e_shstrndx;  /* Section name string table index */
    %01 %00 # section header name table index in section headers table

    [ metaSections allocSections ] { { ==s
      ### section header
      # Elf64_Word  sh_name;      /* Section name */
      s .nameOffset uint32
      # Elf64_Word  sh_type;      /* Section type */
      s .type uint32
      # Elf64_Xword sh_flags;     /* Section attributes */
      s .flags uint64
      # Elf64_Addr  sh_addr;      /* Virtual address in memory */
      s .addr uint64
      # Elf64_Off   sh_offset;    /* Offset in file */
      s .dataOffset uint64
      # Elf64_Xword sh_size;      /* Size of section */
      s .dataSize uint64
      # Elf64_Word  sh_link;      /* Link to other section */
      s .link uint32
      # Elf64_Word  sh_info;      /* Miscellaneous information */
      0 uint32
      # Elf64_Xword sh_addralign; /* Address alignment boundary */
      1 uint64
      # Elf64_Xword sh_entsize;   /* Size of entries, if section has table */
      0 uint64
    } each } each

    allocSections { ==s
      ### program header
      # Elf64_Word       p_type;          /* Type of segment */
      %01 %00 %00 %00 # loadable segment
      # Elf64_Word       p_flags;         /* Segment attributes */
      %07 %00 %00 %00 # read | write | execute
      # Elf64_Off        p_offset;        /* Offset in file */
      s .dataOffset uint64
      # Elf64_Addr       p_vaddr;         /* Virtual address in memory */
      s .dataBase uint64
      # Elf64_Addr       p_paddr;         /* Reserved */
      %00 %00 %00 %00 %00 %00 %00 %00
      # Elf64_Xword      p_filesz;        /* Size of segment in file */
      s .dataSize uint64
      # Elf64_Xword      p_memsz;         /* Size of segment in memory */
      s .dataSize uint64
      # Elf64_Xword      p_align;         /* Alignment of segment */
      %01 %00 %00 %00 %00 %00 %00 %00 # alignment
    } each
  ] metaSections { .data cat } each ==fileData

  fileData len str .alloc ==buffer
  0 fileData len range { ==i i fileData * i buffer =[] } each

  buffer out .writeall

  1 ==:WRITE

  buffer len ==fileOffset

  allocSections { ==section
    section .dataOffset fileOffset sub str .alloc out .writeall
    section .dataOffset section .dataSize add =fileOffset

    out .fd section .dataBase section .dataSize 0 0 0 WRITE sys .asm .syscall --
    section .dataSize neq { "write failed" die } rep
  } each

  out .close
} /freeze sys .deff

# no long-term stack use here as the executed program uses it as well
{ scope
  { ==currentScope ==input
    { .value currentScope sys .executeIdentifier =currentScope } /TOKID defvd
    { .value elymas .base10decode } /TOKINT defvd
    { .value } /TOKSTR defvd

    {
      TOKINT TOKSTR TOKID elymas .tokenize { _ .handle } each
    } input .eachLine
  } *
}" /includeFile deffd

{ # ==?filename
  sys .file -0010 .open
                  includeFile
                  .close
}" /include deffd

# vim: syn=elymas