level0/meta/meta-elf.f

   1 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;; Native x86 GNU/Linux Forth System
   3 ;; metacompiler
   4 ;;
   5 ;; Copyright (C) 2020 Ketmar Dark // Invisible Vector
   6 ;;
   7 ;; This program is free software: you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation, version 3 of the License ONLY.
  10 ;;
  11 ;; This program is distributed in the hope that it will be useful,
  12 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;; GNU General Public License for more details.
  15 ;;
  16 ;; You should have received a copy of the GNU General Public License
  17 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  18 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  19 ;; simple elf header creation, and writing binary elf file
  20 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  21
  22 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  23 : (put-b)  ( addr value -- addr+1 )
  24   over c! 1+
  25 ;
  26
  27 : (put-w)  ( addr value -- addr+2 )
  28   over w! 2+
  29 ;
  30
  31 : (put-dw)  ( addr value -- addr+4 )
  32   over ! cell+
  33 ;
  34
  35 : (put-strz)  ( addr count -- addr+count+1 )
  36   dup 0> if
  37     over + swap do i c@ (put-b) loop
  38     0 (put-b)
  39   else
  40     drop
  41   endif
  42 ;
  43
  44
  45 0 constant DT_NULL
  46 1 constant DT_NEEDED
  47 4 constant DT_HASH
  48 5 constant DT_STRTAB
  49 6 constant DT_SYMTAB
  50 10 constant DT_STRSZ
  51 11 constant DT_SYMENT
  52 17 constant DT_REL
  53 18 constant DT_RELSZ
  54 19 constant DT_RELENT
  55
  56 4 4 + 4 + 1 + 1 + 2 + constant ELF32_SYM_SIZE
  57 4 4 + constant ELF32_REL_SIZE
  58
  59 : build-elf-header  ( addr -- eaddr )
  60   ;; signature
  61   $7F (put-b)
  62   [char] E (put-b)
  63   [char] L (put-b)
  64   [char] F (put-b)
  65
  66   1 (put-b)     ;; bitness
  67   1 (put-b)     ;; endianness
  68   1 (put-b)     ;; header version
  69   3 (put-b)     ;; abi
  70
  71   8 0 do 0 (put-b) loop
  72
  73   2 (put-w)     ;; e_type
  74   3 (put-w)     ;; e_machine
  75
  76   1 (put-dw)    ;; e_version
  77   dup to elf-entry-point-addr
  78   0 (put-dw)    ;; e_entry
  79   $34 (put-dw)  ;; e_phoff
  80   0 (put-dw)    ;; e_shoff
  81   0 (put-dw)    ;; e_flags
  82
  83   $34 (put-w)   ;; e_ehsize
  84   32 (put-w)    ;; e_phentsize
  85   3 (put-w)     ;; e_phnum
  86   40 (put-w)    ;; e_shentsize
  87   0 (put-w)     ;; e_shnum
  88   0 (put-w)     ;; e_shstrndx
  89
  90   ;; first segment: interpreter
  91   3 (put-dw)          ;; type
  92   $00000094 (put-dw)  ;; foffset
  93   $08048094 (put-dw)  ;; vaddr
  94   $08048094 (put-dw)  ;; shit
  95   $00000013 (put-dw)  ;; fsize
  96   $00000013 (put-dw)  ;; msize
  97   $00000004 (put-dw)  ;; flags
  98   $00000001 (put-dw)  ;; align
  99
 100   ;; second segment: dynamic imports
 101   2 (put-dw)          ;; type
 102   $000000A7 (put-dw)  ;; foffset
 103   $080480A7 (put-dw)  ;; vaddr
 104   $080480A7 (put-dw)  ;; shit
 105   $00000050 (put-dw)  ;; fsize
 106   $00000050 (put-dw)  ;; msize
 107   $00000004 (put-dw)  ;; flags
 108   $00000001 (put-dw)  ;; align
 109
 110   ;; thirds segment: executable code
 111   1 (put-dw)          ;; type
 112   $00000000 (put-dw)  ;; foffset
 113   $08048000 (put-dw)  ;; vaddr
 114   $08048000 (put-dw)  ;; shit
 115   dup to elf-code-size-addr
 116   $0000D3C5 (put-dw)  ;; fsize
 117   $0000D3C5 (put-dw)  ;; msize
 118   $00000007 (put-dw)  ;; flags
 119   $00001000 (put-dw)  ;; align
 120
 121   ;; first segment data: write interpreter string
 122   " /lib/ld-linux.so.2" (put-strz)
 123
 124   ;; second segment data: write import table
 125   ;; the only thing we need is .so management functions, so we'll create
 126   ;; a very simple import table for "libdl.so", with 3 imports:
 127   ;; "dlopen", "dlclose", "dlsym"
 128   DT_NEEDED (put-dw)  1 (put-dw) ;; elfhead_str_libdl-elfhead_strtab
 129   DT_STRTAB (put-dw)  $08048137 (put-dw)  ;; elfhead_strtab
 130   DT_STRSZ (put-dw)   $0000001F (put-dw)  ;; elfhead_strsz
 131   DT_SYMTAB (put-dw)  $080480F7 (put-dw)  ;; elfhead_symtab
 132   DT_SYMENT (put-dw)  ELF32_SYM_SIZE (put-dw)
 133   DT_REL (put-dw)     $08048156 (put-dw)  ;; elfhead_rel
 134   DT_RELSZ (put-dw)   $00000018 (put-dw)  ;; elfhead_relsz (put-dw)
 135   DT_RELENT (put-dw)  ELF32_REL_SIZE (put-dw)
 136   DT_HASH (put-dw)    $0804816E (put-dw)  ;; elfhead_hash (put-dw)
 137   DT_NULL (put-dw)    0 (put-dw)
 138
 139   ;; here starts executable segment
 140   ;; we're putting rest of import table into it; this is prolly not right, but it works
 141
 142   ;; import symbol table
 143   ;; NULL import, should always be here
 144     0 (put-dw)  ;; name
 145     0 (put-dw)  ;; value
 146     0 (put-dw)  ;; size
 147   $12 (put-b)   ;; (STB_GLOBAL<<4)|STT_FUNC
 148     0 (put-b)   ;; other
 149     0 (put-w)   ;; shndx
 150   ;; import "dlopen"
 151    10 (put-dw)  ;; name
 152     0 (put-dw)  ;; value
 153     0 (put-dw)  ;; size
 154   $12 (put-b)   ;; (STB_GLOBAL<<4)|STT_FUNC
 155     0 (put-b)   ;; other
 156     0 (put-w)   ;; shndx
 157   ;; import "dlclose"
 158    17 (put-dw)  ;; name
 159     0 (put-dw)  ;; value
 160     0 (put-dw)  ;; size
 161   $12 (put-b)   ;; (STB_GLOBAL<<4)|STT_FUNC
 162     0 (put-b)   ;; other
 163     0 (put-w)   ;; shndx
 164   ;; import "dlsym"
 165    25 (put-dw)  ;; name
 166     0 (put-dw)  ;; value
 167     0 (put-dw)  ;; size
 168   $12 (put-b)   ;; (STB_GLOBAL<<4)|STT_FUNC
 169     0 (put-b)   ;; other
 170     0 (put-w)   ;; shndx
 171
 172   ;; string table
 173   0 (put-b)
 174   " libdl.so" (put-strz)
 175   " dlopen" (put-strz)
 176   " dlclose" (put-strz)
 177   " dlsym" (put-strz)
 178
 179   ;; importer will use this to fix relocations
 180   ;; dlopen
 181   $0804818A (put-dw)  ;; offset to elfimp_dlopen
 182   $0101     (put-dw)  ;; high bit is symbol index, low bit is R_386_32
 183   ;; dlclose
 184   $0804818E (put-dw)  ;; offset to elfimp_dlclose
 185   $0201     (put-dw)  ;; high bit is symbol index, low bit is R_386_32
 186   ;; dlsym
 187   $08048192 (put-dw)  ;; offset to elfimp_dlsym
 188   $0301     (put-dw)  ;; high bit is symbol index, low bit is R_386_32
 189
 190   ;; fake import hash table with one bucket
 191   1 (put-dw)  ;; bucket size
 192   4 (put-dw)  ;; chain size (including NULL import)
 193   0 (put-dw)  ;; fake bucket, just one hash value
 194   ;; hashtable bucket
 195   1 (put-dw)
 196   2 (put-dw)
 197   3 (put-dw)
 198   4 (put-dw)
 199
 200   ;; loadef will add symbol offets to the following three dwords
 201   dup real->tc to elf-import-table-rva
 202   0 (put-dw)  ;; dlopen
 203   0 (put-dw)  ;; dlclose
 204   0 (put-dw)  ;; dlsym
 205   dup real->tc elf-import-table-rva - to elf-import-table-size
 206 ;
 207
 208
 209 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 210 : create-elf-tc-constants  ( -- )
 211   ;; create some assembler constants
 212   " urforth_code_base_addr" elf-base-rva asmx86:asm-Make-Constant
 213
 214   " elfhead_codesize_addr" elf-code-size-addr real->tc asmx86:asm-Make-Constant
 215   " elfhead_impstart" elf-import-table-rva asmx86:asm-Make-Constant
 216   " elfhead_implen" elf-import-table-size asmx86:asm-Make-Constant
 217
 218   " elfimp_dlopen" elf-import-table-rva 0 +cells asmx86:asm-Make-Constant
 219   " elfimp_dlclose" elf-import-table-rva 1 +cells asmx86:asm-Make-Constant
 220   " elfimp_dlsym" elf-import-table-rva 2 +cells asmx86:asm-Make-Constant
 221 ;
 222
 223
 224 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 225 : save-elf-binary  ( addr count -- )
 226   endcr ." code size: " curr-code-size . ." bytes\n"
 227
 228   curr-code-size elf-code-size-addr !
 229   curr-code-size elf-code-size-addr cell+ !
 230
 231   ;; create output file
 232   o-wronly o-creat or o-trunc or  ;; flags
 233   s-irwxu s-irgrp or s-ixgrp or s-iroth or s-ixoth or  ;; mode
 234   (fopen)
 235   ;; check success
 236   dup 0< ?abort" cannot create output file"
 237   >r
 238   elf-target-memory curr-code-size r@ (fwrite)
 239   curr-code-size <> ?abort" error writing file"
 240   r> (fclose) ?abort" error closing file"
 241 ;