guix/elf.scm

   1 ;;; Guile ELF reader and writer
   2
   3 ;; Copyright (C)  2011, 2012, 2013, 2014, 2015 Free Software Foundation, Inc.
   4
   5 ;;;; This library is free software; you can redistribute it and/or
   6 ;;;; modify it under the terms of the GNU Lesser General Public
   7 ;;;; License as published by the Free Software Foundation; either
   8 ;;;; version 3 of the License, or (at your option) any later version.
   9 ;;;;
  10 ;;;; This library is distributed in the hope that it will be useful,
  11 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 ;;;; Lesser General Public License for more details.
  14 ;;;;
  15 ;;;; You should have received a copy of the GNU Lesser General Public
  16 ;;;; License along with this library; if not, write to the Free Software
  17 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  18
  19 ;;; Commentary:
  20 ;;;
  21 ;;; This file was taken from the Guile 2.1 branch, where it is known as
  22 ;;; (system vm elf), and renamed to (guix elf).  It will be unneeded when Guix
  23 ;;; switches to Guile 2.1/2.2.
  24 ;;;
  25 ;;; A module to read and write Executable and Linking Format (ELF)
  26 ;;; files.
  27 ;;;
  28 ;;; This module exports a number of record types that represent the
  29 ;;; various parts that make up ELF files.  Fundamentally this is the
  30 ;;; main header, the segment headers (program headers), and the section
  31 ;;; headers.  It also exports bindings for symbolic constants and
  32 ;;; utilities to parse and write special kinds of ELF sections.
  33 ;;;
  34 ;;; See elf(5) for more information on ELF.
  35 ;;;
  36 ;;; Code:
  37
  38 (define-module (guix elf)
  39   #:use-module (rnrs bytevectors)
  40   #:use-module (system foreign)
  41   #:use-module (system base target)
  42   #:use-module (srfi srfi-9)
  43   #:use-module (ice-9 receive)
  44   #:use-module (ice-9 vlist)
  45   #:export (has-elf-header?
  46
  47             (make-elf* . make-elf)
  48             elf?
  49             elf-bytes elf-word-size elf-byte-order
  50             elf-abi elf-type elf-machine-type
  51             elf-entry elf-phoff elf-shoff elf-flags elf-ehsize
  52             elf-phentsize elf-phnum elf-shentsize elf-shnum elf-shstrndx
  53
  54             ELFOSABI_NONE ELFOSABI_HPUX ELFOSABI_NETBSD ELFOSABI_GNU
  55             ELFOSABI_SOLARIS ELFOSABI_AIX ELFOSABI_IRIX ELFOSABI_FREEBSD
  56             ELFOSABI_TRU64 ELFOSABI_MODESTO ELFOSABI_OPENBSD
  57             ELFOSABI_ARM_AEABI ELFOSABI_ARM ELFOSABI_STANDALONE
  58
  59             ET_NONE ET_REL ET_EXEC ET_DYN ET_CORE
  60
  61             EM_NONE EM_SPARC EM_386 EM_MIPS EM_PPC EM_PPC64 EM_ARM EM_SH
  62             EM_SPARCV9 EM_IA_64 EM_X86_64
  63
  64             elf-header-len elf-header-shoff-offset
  65             write-elf-header
  66
  67             (make-elf-segment* . make-elf-segment)
  68             elf-segment?
  69             elf-segment-index
  70             elf-segment-type elf-segment-offset elf-segment-vaddr
  71             elf-segment-paddr elf-segment-filesz elf-segment-memsz
  72             elf-segment-flags elf-segment-align
  73
  74             elf-program-header-len write-elf-program-header
  75
  76             PT_NULL PT_LOAD PT_DYNAMIC PT_INTERP PT_NOTE PT_SHLIB
  77             PT_PHDR PT_TLS PT_NUM PT_LOOS PT_GNU_EH_FRAME PT_GNU_STACK
  78             PT_GNU_RELRO
  79
  80             PF_R PF_W PF_X
  81
  82             (make-elf-section* . make-elf-section)
  83             elf-section?
  84             elf-section-index
  85             elf-section-name elf-section-type elf-section-flags
  86             elf-section-addr elf-section-offset elf-section-size
  87             elf-section-link elf-section-info elf-section-addralign
  88             elf-section-entsize
  89
  90             elf-section-header-len elf-section-header-addr-offset
  91             elf-section-header-offset-offset
  92             write-elf-section-header
  93
  94             (make-elf-symbol* . make-elf-symbol)
  95             elf-symbol?
  96             elf-symbol-name elf-symbol-value elf-symbol-size
  97             elf-symbol-info elf-symbol-other elf-symbol-shndx
  98             elf-symbol-binding elf-symbol-type elf-symbol-visibility
  99
 100             elf-symbol-len elf-symbol-value-offset write-elf-symbol
 101
 102             SHN_UNDEF
 103
 104             SHT_NULL SHT_PROGBITS SHT_SYMTAB SHT_STRTAB SHT_RELA
 105             SHT_HASH SHT_DYNAMIC SHT_NOTE SHT_NOBITS SHT_REL SHT_SHLIB
 106             SHT_DYNSYM SHT_INIT_ARRAY SHT_FINI_ARRAY SHT_PREINIT_ARRAY
 107             SHT_GROUP SHT_SYMTAB_SHNDX SHT_NUM SHT_LOOS SHT_HIOS
 108             SHT_LOPROC SHT_HIPROC SHT_LOUSER SHT_HIUSER
 109
 110             SHF_WRITE SHF_ALLOC SHF_EXECINSTR SHF_MERGE SHF_STRINGS
 111             SHF_INFO_LINK SHF_LINK_ORDER SHF_OS_NONCONFORMING SHF_GROUP
 112             SHF_TLS
 113
 114             DT_NULL DT_NEEDED DT_PLTRELSZ DT_PLTGOT DT_HASH DT_STRTAB
 115             DT_SYMTAB DT_RELA DT_RELASZ DT_RELAENT DT_STRSZ DT_SYMENT
 116             DT_INIT DT_FINI DT_SONAME DT_RPATH DT_SYMBOLIC DT_REL
 117             DT_RELSZ DT_RELENT DT_PLTREL DT_DEBUG DT_TEXTREL DT_JMPREL
 118             DT_BIND_NOW DT_INIT_ARRAY DT_FINI_ARRAY DT_INIT_ARRAYSZ
 119             DT_FINI_ARRAYSZ DT_RUNPATH DT_FLAGS DT_ENCODING
 120             DT_PREINIT_ARRAY DT_PREINIT_ARRAYSZ DT_NUM DT_LOGUILE
 121             DT_GUILE_GC_ROOT DT_GUILE_GC_ROOT_SZ DT_GUILE_ENTRY
 122             DT_GUILE_VM_VERSION DT_GUILE_FRAME_MAPS DT_HIGUILE
 123             DT_LOOS DT_HIOS DT_LOPROC DT_HIPROC
 124
 125             string-table-ref
 126
 127             STB_LOCAL STB_GLOBAL STB_WEAK STB_NUM STB_LOOS STB_GNU
 128             STB_HIOS STB_LOPROC STB_HIPROC
 129
 130             STT_NOTYPE STT_OBJECT STT_FUNC STT_SECTION STT_FILE
 131             STT_COMMON STT_TLS STT_NUM STT_LOOS STT_GNU STT_HIOS
 132             STT_LOPROC STT_HIPROC
 133
 134             STV_DEFAULT STV_INTERNAL STV_HIDDEN STV_PROTECTED
 135
 136             NT_GNU_ABI_TAG NT_GNU_HWCAP NT_GNU_BUILD_ID NT_GNU_GOLD_VERSION
 137
 138             parse-elf
 139             elf-segment elf-segments
 140             elf-section elf-sections elf-section-by-name elf-sections-by-name
 141             elf-symbol-table-len elf-symbol-table-ref
 142
 143             parse-elf-note
 144             elf-note-name elf-note-desc elf-note-type))
 145
 146 ;; #define EI_NIDENT 16
 147
 148 ;; typedef struct {
 149 ;;     unsigned char e_ident[EI_NIDENT];
 150 ;;     uint16_t      e_type;
 151 ;;     uint16_t      e_machine;
 152 ;;     uint32_t      e_version;
 153 ;;     ElfN_Addr     e_entry;
 154 ;;     ElfN_Off      e_phoff;
 155 ;;     ElfN_Off      e_shoff;
 156 ;;     uint32_t      e_flags;
 157 ;;     uint16_t      e_ehsize;
 158 ;;     uint16_t      e_phentsize;
 159 ;;     uint16_t      e_phnum;
 160 ;;     uint16_t      e_shentsize;
 161 ;;     uint16_t      e_shnum;
 162 ;;     uint16_t      e_shstrndx;
 163 ;; } ElfN_Ehdr;
 164
 165 (define elf32-header-len 52)
 166 (define elf64-header-len 64)
 167 (define (elf-header-len word-size)
 168   (case word-size
 169     ((4) elf32-header-len)
 170     ((8) elf64-header-len)
 171     (else (error "invalid word size" word-size))))
 172 (define (elf-header-shoff-offset word-size)
 173   (case word-size
 174     ((4) 32)
 175     ((8) 40)
 176     (else (error "bad word size" word-size))))
 177
 178 (define ELFCLASS32      1)              ; 32-bit objects
 179 (define ELFCLASS64      2)              ; 64-bit objects
 180
 181 (define ELFDATA2LSB     1)              ; 2's complement, little endian
 182 (define ELFDATA2MSB     2)              ; 2's complement, big endian
 183
 184 (define EV_CURRENT      1)              ; Current version
 185
 186 (define ELFOSABI_NONE           0)      ; UNIX System V ABI */
 187 (define ELFOSABI_HPUX           1)      ; HP-UX
 188 (define ELFOSABI_NETBSD         2)      ; NetBSD.
 189 (define ELFOSABI_GNU            3)      ; Object uses GNU ELF extensions.
 190 (define ELFOSABI_SOLARIS        6)      ; Sun Solaris.
 191 (define ELFOSABI_AIX            7)      ; IBM AIX.
 192 (define ELFOSABI_IRIX           8)      ; SGI Irix.
 193 (define ELFOSABI_FREEBSD        9)      ; FreeBSD.
 194 (define ELFOSABI_TRU64          10)     ; Compaq TRU64 UNIX.
 195 (define ELFOSABI_MODESTO        11)     ; Novell Modesto.
 196 (define ELFOSABI_OPENBSD        12)     ; OpenBSD.
 197 (define ELFOSABI_ARM_AEABI      64)     ; ARM EABI
 198 (define ELFOSABI_ARM            97)     ; ARM
 199 (define ELFOSABI_STANDALONE     255)    ; Standalone (embedded) application
 200
 201 (define ET_NONE         0)              ; No file type
 202 (define ET_REL          1)              ; Relocatable file
 203 (define ET_EXEC         2)              ; Executable file
 204 (define ET_DYN          3)              ; Shared object file
 205 (define ET_CORE         4)              ; Core file
 206
 207 ;;
 208 ;; Machine types
 209 ;;
 210 ;; Just a sampling of these values.  We could include more, but the
 211 ;; important thing is to recognize architectures for which we have a
 212 ;; native compiler.  Recognizing more common machine types is icing on
 213 ;; the cake.
 214 ;;
 215 (define EM_NONE          0)             ; No machine
 216 (define EM_SPARC         2)             ; SUN SPARC
 217 (define EM_386           3)             ; Intel 80386
 218 (define EM_MIPS          8)             ; MIPS R3000 big-endian
 219 (define EM_PPC          20)             ; PowerPC
 220 (define EM_PPC64        21)             ; PowerPC 64-bit
 221 (define EM_ARM          40)             ; ARM
 222 (define EM_SH           42)             ; Hitachi SH
 223 (define EM_SPARCV9      43)             ; SPARC v9 64-bit
 224 (define EM_IA_64        50)             ; Intel Merced
 225 (define EM_X86_64       62)             ; AMD x86-64 architecture
 226
 227 (define cpu-mapping (make-hash-table))
 228 (for-each (lambda (pair)
 229             (hashq-set! cpu-mapping (car pair) (cdr pair)))
 230           `((none . ,EM_NONE)
 231             (sparc . ,EM_SPARC) ; FIXME: map 64-bit to SPARCV9 ?
 232             (i386 . ,EM_386)
 233             (mips . ,EM_MIPS)
 234             (ppc . ,EM_PPC)
 235             (ppc64 . ,EM_PPC64)
 236             (arm . ,EM_ARM) ; FIXME: there are more arm cpu variants
 237             (sh . ,EM_SH) ; FIXME: there are more sh cpu variants
 238             (ia64 . ,EM_IA_64)
 239             (x86_64 . ,EM_X86_64)))
 240
 241 (define SHN_UNDEF 0)
 242
 243 (define host-machine-type
 244   (hashq-ref cpu-mapping
 245              (string->symbol (car (string-split %host-type #\-)))
 246              EM_NONE))
 247
 248 (define host-word-size
 249   (sizeof '*))
 250
 251 (define host-byte-order
 252   (native-endianness))
 253
 254 (define (has-elf-header? bv)
 255   (and
 256    ;; e_ident
 257    (>= (bytevector-length bv) 16)
 258    (= (bytevector-u8-ref bv 0) #x7f)
 259    (= (bytevector-u8-ref bv 1) (char->integer #\E))
 260    (= (bytevector-u8-ref bv 2) (char->integer #\L))
 261    (= (bytevector-u8-ref bv 3) (char->integer #\F))
 262    (cond
 263     ((= (bytevector-u8-ref bv 4) ELFCLASS32)
 264      (>= (bytevector-length bv) elf32-header-len))
 265     ((= (bytevector-u8-ref bv 4) ELFCLASS64)
 266      (>= (bytevector-length bv) elf64-header-len))
 267     (else #f))
 268    (or (= (bytevector-u8-ref bv 5) ELFDATA2LSB)
 269        (= (bytevector-u8-ref bv 5) ELFDATA2MSB))
 270    (= (bytevector-u8-ref bv 6) EV_CURRENT)
 271    ;; Look at ABI later.
 272    (= (bytevector-u8-ref bv 8) 0)       ; ABI version
 273    ;; The rest of the e_ident is padding.
 274
 275    ;; e_version
 276    (let ((byte-order (if (= (bytevector-u8-ref bv 5) ELFDATA2LSB)
 277                          (endianness little)
 278                          (endianness big))))
 279      (= (bytevector-u32-ref bv 20 byte-order) EV_CURRENT))))
 280
 281 (define-record-type <elf>
 282   (make-elf bytes word-size byte-order abi type machine-type
 283             entry phoff shoff flags ehsize
 284             phentsize phnum shentsize shnum shstrndx)
 285   elf?
 286   (bytes elf-bytes)
 287   (word-size elf-word-size)
 288   (byte-order elf-byte-order)
 289   (abi elf-abi)
 290   (type elf-type)
 291   (machine-type elf-machine-type)
 292   (entry elf-entry)
 293   (phoff elf-phoff)
 294   (shoff elf-shoff)
 295   (flags elf-flags)
 296   (ehsize elf-ehsize)
 297   (phentsize elf-phentsize)
 298   (phnum elf-phnum)
 299   (shentsize elf-shentsize)
 300   (shnum elf-shnum)
 301   (shstrndx elf-shstrndx))
 302
 303 (define* (make-elf* #:key (bytes #f)
 304                     (byte-order (target-endianness))
 305                     (word-size (target-word-size))
 306                     (abi ELFOSABI_STANDALONE)
 307                     (type ET_DYN)
 308                     (machine-type EM_NONE)
 309                     (entry 0)
 310                     (phoff (elf-header-len word-size))
 311                     (shoff -1)
 312                     (flags 0)
 313                     (ehsize (elf-header-len word-size))
 314                     (phentsize (elf-program-header-len word-size))
 315                     (phnum 0)
 316                     (shentsize (elf-section-header-len word-size))
 317                     (shnum 0)
 318                     (shstrndx SHN_UNDEF))
 319   (make-elf bytes word-size byte-order abi type machine-type
 320             entry phoff shoff flags ehsize
 321             phentsize phnum shentsize shnum shstrndx))
 322
 323 (define (parse-elf32 bv byte-order)
 324   (make-elf bv 4 byte-order
 325             (bytevector-u8-ref bv 7)
 326             (bytevector-u16-ref bv 16 byte-order)
 327             (bytevector-u16-ref bv 18 byte-order)
 328             (bytevector-u32-ref bv 24 byte-order)
 329             (bytevector-u32-ref bv 28 byte-order)
 330             (bytevector-u32-ref bv 32 byte-order)
 331             (bytevector-u32-ref bv 36 byte-order)
 332             (bytevector-u16-ref bv 40 byte-order)
 333             (bytevector-u16-ref bv 42 byte-order)
 334             (bytevector-u16-ref bv 44 byte-order)
 335             (bytevector-u16-ref bv 46 byte-order)
 336             (bytevector-u16-ref bv 48 byte-order)
 337             (bytevector-u16-ref bv 50 byte-order)))
 338
 339 (define (write-elf-ident bv class data abi)
 340   (bytevector-u8-set! bv 0 #x7f)
 341   (bytevector-u8-set! bv 1 (char->integer #\E))
 342   (bytevector-u8-set! bv 2 (char->integer #\L))
 343   (bytevector-u8-set! bv 3 (char->integer #\F))
 344   (bytevector-u8-set! bv 4 class)
 345   (bytevector-u8-set! bv 5 data)
 346   (bytevector-u8-set! bv 6 EV_CURRENT)
 347   (bytevector-u8-set! bv 7 abi)
 348   (bytevector-u8-set! bv 8 0) ; ABI version
 349   (bytevector-u8-set! bv 9 0) ; Pad to 16 bytes.
 350   (bytevector-u8-set! bv 10 0)
 351   (bytevector-u8-set! bv 11 0)
 352   (bytevector-u8-set! bv 12 0)
 353   (bytevector-u8-set! bv 13 0)
 354   (bytevector-u8-set! bv 14 0)
 355   (bytevector-u8-set! bv 15 0))
 356
 357 (define (write-elf32-header bv elf)
 358   (let ((byte-order (elf-byte-order elf)))
 359     (write-elf-ident bv ELFCLASS32
 360                      (case byte-order
 361                        ((little) ELFDATA2LSB)
 362                        ((big) ELFDATA2MSB)
 363                        (else (error "unknown endianness" byte-order)))
 364                      (elf-abi elf))
 365     (bytevector-u16-set! bv 16 (elf-type elf) byte-order)
 366     (bytevector-u16-set! bv 18 (elf-machine-type elf) byte-order)
 367     (bytevector-u32-set! bv 20 EV_CURRENT byte-order)
 368     (bytevector-u32-set! bv 24 (elf-entry elf) byte-order)
 369     (bytevector-u32-set! bv 28 (elf-phoff elf) byte-order)
 370     (bytevector-u32-set! bv 32 (elf-shoff elf) byte-order)
 371     (bytevector-u32-set! bv 36 (elf-flags elf) byte-order)
 372     (bytevector-u16-set! bv 40 (elf-ehsize elf) byte-order)
 373     (bytevector-u16-set! bv 42 (elf-phentsize elf) byte-order)
 374     (bytevector-u16-set! bv 44 (elf-phnum elf) byte-order)
 375     (bytevector-u16-set! bv 46 (elf-shentsize elf) byte-order)
 376     (bytevector-u16-set! bv 48 (elf-shnum elf) byte-order)
 377     (bytevector-u16-set! bv 50 (elf-shstrndx elf) byte-order)))
 378
 379 (define (parse-elf64 bv byte-order)
 380   (make-elf bv 8 byte-order
 381             (bytevector-u8-ref bv 7)
 382             (bytevector-u16-ref bv 16 byte-order)
 383             (bytevector-u16-ref bv 18 byte-order)
 384             (bytevector-u64-ref bv 24 byte-order)
 385             (bytevector-u64-ref bv 32 byte-order)
 386             (bytevector-u64-ref bv 40 byte-order)
 387             (bytevector-u32-ref bv 48 byte-order)
 388             (bytevector-u16-ref bv 52 byte-order)
 389             (bytevector-u16-ref bv 54 byte-order)
 390             (bytevector-u16-ref bv 56 byte-order)
 391             (bytevector-u16-ref bv 58 byte-order)
 392             (bytevector-u16-ref bv 60 byte-order)
 393             (bytevector-u16-ref bv 62 byte-order)))
 394
 395 (define (write-elf64-header bv elf)
 396   (let ((byte-order (elf-byte-order elf)))
 397     (write-elf-ident bv ELFCLASS64
 398                      (case byte-order
 399                        ((little) ELFDATA2LSB)
 400                        ((big) ELFDATA2MSB)
 401                        (else (error "unknown endianness" byte-order)))
 402                      (elf-abi elf))
 403     (bytevector-u16-set! bv 16 (elf-type elf) byte-order)
 404     (bytevector-u16-set! bv 18 (elf-machine-type elf) byte-order)
 405     (bytevector-u32-set! bv 20 EV_CURRENT byte-order)
 406     (bytevector-u64-set! bv 24 (elf-entry elf) byte-order)
 407     (bytevector-u64-set! bv 32 (elf-phoff elf) byte-order)
 408     (bytevector-u64-set! bv 40 (elf-shoff elf) byte-order)
 409     (bytevector-u32-set! bv 48 (elf-flags elf) byte-order)
 410     (bytevector-u16-set! bv 52 (elf-ehsize elf) byte-order)
 411     (bytevector-u16-set! bv 54 (elf-phentsize elf) byte-order)
 412     (bytevector-u16-set! bv 56 (elf-phnum elf) byte-order)
 413     (bytevector-u16-set! bv 58 (elf-shentsize elf) byte-order)
 414     (bytevector-u16-set! bv 60 (elf-shnum elf) byte-order)
 415     (bytevector-u16-set! bv 62 (elf-shstrndx elf) byte-order)))
 416
 417 (define (parse-elf bv)
 418   (cond
 419    ((has-elf-header? bv)
 420     (let ((class (bytevector-u8-ref bv 4))
 421           (byte-order (let ((data (bytevector-u8-ref bv 5)))
 422                         (cond
 423                          ((= data ELFDATA2LSB) (endianness little))
 424                          ((= data ELFDATA2MSB) (endianness big))
 425                          (else (error "unhandled byte order" data))))))
 426       (cond
 427        ((= class ELFCLASS32) (parse-elf32 bv byte-order))
 428        ((= class ELFCLASS64) (parse-elf64 bv byte-order))
 429        (else (error "unhandled class" class)))))
 430    (else
 431     (error "Invalid ELF" bv))))
 432
 433 (define* (write-elf-header bv elf)
 434   ((case (elf-word-size elf)
 435      ((4) write-elf32-header)
 436      ((8) write-elf64-header)
 437      (else (error "unknown word size" (elf-word-size elf))))
 438    bv elf))
 439
 440 ;;
 441 ;; Segment types
 442 ;;
 443 (define PT_NULL         0)              ; Program header table entry unused
 444 (define PT_LOAD         1)              ; Loadable program segment
 445 (define PT_DYNAMIC      2)              ; Dynamic linking information
 446 (define PT_INTERP       3)              ; Program interpreter
 447 (define PT_NOTE         4)              ; Auxiliary information
 448 (define PT_SHLIB        5)              ; Reserved
 449 (define PT_PHDR         6)              ; Entry for header table itself
 450 (define PT_TLS          7)              ; Thread-local storage segment
 451 (define PT_NUM          8)              ; Number of defined types
 452 (define PT_LOOS         #x60000000)     ; Start of OS-specific
 453 (define PT_GNU_EH_FRAME #x6474e550)     ; GCC .eh_frame_hdr segment
 454 (define PT_GNU_STACK    #x6474e551)     ; Indicates stack executability
 455 (define PT_GNU_RELRO    #x6474e552)     ; Read-only after relocation
 456
 457 ;;
 458 ;; Segment flags
 459 ;;
 460 (define PF_X            (ash 1 0))      ; Segment is executable
 461 (define PF_W            (ash 1 1))      ; Segment is writable
 462 (define PF_R            (ash 1 2))      ; Segment is readable
 463
 464 (define-record-type <elf-segment>
 465   (make-elf-segment index type offset vaddr paddr filesz memsz flags align)
 466   elf-segment?
 467   (index elf-segment-index)
 468   (type elf-segment-type)
 469   (offset elf-segment-offset)
 470   (vaddr elf-segment-vaddr)
 471   (paddr elf-segment-paddr)
 472   (filesz elf-segment-filesz)
 473   (memsz elf-segment-memsz)
 474   (flags elf-segment-flags)
 475   (align elf-segment-align))
 476
 477 (define* (make-elf-segment* #:key (index -1) (type PT_LOAD) (offset 0) (vaddr 0)
 478                             (paddr 0) (filesz 0) (memsz filesz)
 479                             (flags (logior PF_W PF_R))
 480                             (align 8))
 481   (make-elf-segment index type offset vaddr paddr filesz memsz flags align))
 482
 483 ;; typedef struct {
 484 ;;     uint32_t   p_type;
 485 ;;     Elf32_Off  p_offset;
 486 ;;     Elf32_Addr p_vaddr;
 487 ;;     Elf32_Addr p_paddr;
 488 ;;     uint32_t   p_filesz;
 489 ;;     uint32_t   p_memsz;
 490 ;;     uint32_t   p_flags;
 491 ;;     uint32_t   p_align;
 492 ;; } Elf32_Phdr;
 493
 494 (define (parse-elf32-program-header index bv offset byte-order)
 495   (if (<= (+ offset 32) (bytevector-length bv))
 496       (make-elf-segment index
 497                         (bytevector-u32-ref bv offset byte-order)
 498                         (bytevector-u32-ref bv (+ offset 4) byte-order)
 499                         (bytevector-u32-ref bv (+ offset 8) byte-order)
 500                         (bytevector-u32-ref bv (+ offset 12) byte-order)
 501                         (bytevector-u32-ref bv (+ offset 16) byte-order)
 502                         (bytevector-u32-ref bv (+ offset 20) byte-order)
 503                         (bytevector-u32-ref bv (+ offset 24) byte-order)
 504                         (bytevector-u32-ref bv (+ offset 28) byte-order))
 505       (error "corrupt ELF (offset out of range)" offset)))
 506
 507 (define (write-elf32-program-header bv offset byte-order seg)
 508   (bytevector-u32-set! bv offset (elf-segment-type seg) byte-order)
 509   (bytevector-u32-set! bv (+ offset 4) (elf-segment-offset seg) byte-order)
 510   (bytevector-u32-set! bv (+ offset 8) (elf-segment-vaddr seg) byte-order)
 511   (bytevector-u32-set! bv (+ offset 12) (elf-segment-paddr seg) byte-order)
 512   (bytevector-u32-set! bv (+ offset 16) (elf-segment-filesz seg) byte-order)
 513   (bytevector-u32-set! bv (+ offset 20) (elf-segment-memsz seg) byte-order)
 514   (bytevector-u32-set! bv (+ offset 24) (elf-segment-flags seg) byte-order)
 515   (bytevector-u32-set! bv (+ offset 28) (elf-segment-align seg) byte-order))
 516
 517
 518 ;; typedef struct {
 519 ;;     uint32_t   p_type;
 520 ;;     uint32_t   p_flags;
 521 ;;     Elf64_Off  p_offset;
 522 ;;     Elf64_Addr p_vaddr;
 523 ;;     Elf64_Addr p_paddr;
 524 ;;     uint64_t   p_filesz;
 525 ;;     uint64_t   p_memsz;
 526 ;;     uint64_t   p_align;
 527 ;; } Elf64_Phdr;
 528
 529 ;; NB: position of `flags' is different!
 530
 531 (define (parse-elf64-program-header index bv offset byte-order)
 532   (if (<= (+ offset 56) (bytevector-length bv))
 533       (make-elf-segment index
 534                         (bytevector-u32-ref bv offset byte-order)
 535                         (bytevector-u64-ref bv (+ offset 8) byte-order)
 536                         (bytevector-u64-ref bv (+ offset 16) byte-order)
 537                         (bytevector-u64-ref bv (+ offset 24) byte-order)
 538                         (bytevector-u64-ref bv (+ offset 32) byte-order)
 539                         (bytevector-u64-ref bv (+ offset 40) byte-order)
 540                         (bytevector-u32-ref bv (+ offset 4) byte-order)
 541                         (bytevector-u64-ref bv (+ offset 48) byte-order))
 542       (error "corrupt ELF (offset out of range)" offset)))
 543
 544 (define (write-elf64-program-header bv offset byte-order seg)
 545   (bytevector-u32-set! bv offset (elf-segment-type seg) byte-order)
 546   (bytevector-u64-set! bv (+ offset 8) (elf-segment-offset seg) byte-order)
 547   (bytevector-u64-set! bv (+ offset 16) (elf-segment-vaddr seg) byte-order)
 548   (bytevector-u64-set! bv (+ offset 24) (elf-segment-paddr seg) byte-order)
 549   (bytevector-u64-set! bv (+ offset 32) (elf-segment-filesz seg) byte-order)
 550   (bytevector-u64-set! bv (+ offset 40) (elf-segment-memsz seg) byte-order)
 551   (bytevector-u32-set! bv (+ offset 4) (elf-segment-flags seg) byte-order)
 552   (bytevector-u64-set! bv (+ offset 48) (elf-segment-align seg) byte-order))
 553
 554 (define (write-elf-program-header bv offset byte-order word-size seg)
 555   ((case word-size
 556      ((4) write-elf32-program-header)
 557      ((8) write-elf64-program-header)
 558      (else (error "invalid word size" word-size)))
 559    bv offset byte-order seg))
 560
 561 (define (elf-program-header-len word-size)
 562   (case word-size
 563     ((4) 32)
 564     ((8) 56)
 565     (else (error "bad word size" word-size))))
 566
 567 (define (elf-segment elf n)
 568   (if (not (< -1 n (elf-phnum elf)))
 569       (error "bad segment number" n))
 570   ((case (elf-word-size elf)
 571      ((4) parse-elf32-program-header)
 572      ((8) parse-elf64-program-header)
 573      (else (error "unhandled pointer size")))
 574    n
 575    (elf-bytes elf)
 576    (+ (elf-phoff elf) (* n (elf-phentsize elf)))
 577    (elf-byte-order elf)))
 578
 579 (define (elf-segments elf)
 580   (let lp ((n (elf-phnum elf)) (out '()))
 581     (if (zero? n)
 582         out
 583         (lp (1- n) (cons (elf-segment elf (1- n)) out)))))
 584
 585 (define-record-type <elf-section>
 586   (make-elf-section index name type flags
 587                     addr offset size link info addralign entsize)
 588   elf-section?
 589   (index elf-section-index)
 590   (name elf-section-name)
 591   (type elf-section-type)
 592   (flags elf-section-flags)
 593   (addr elf-section-addr)
 594   (offset elf-section-offset)
 595   (size elf-section-size)
 596   (link elf-section-link)
 597   (info elf-section-info)
 598   (addralign elf-section-addralign)
 599   (entsize elf-section-entsize))
 600
 601 (define* (make-elf-section* #:key (index SHN_UNDEF) (name 0) (type SHT_PROGBITS)
 602                             (flags SHF_ALLOC) (addr 0) (offset 0) (size 0)
 603                             (link 0) (info 0) (addralign 8) (entsize 0))
 604   (make-elf-section index name type flags addr offset size link info addralign
 605                     entsize))
 606
 607 ;; typedef struct {
 608 ;;     uint32_t   sh_name;
 609 ;;     uint32_t   sh_type;
 610 ;;     uint32_t   sh_flags;
 611 ;;     Elf32_Addr sh_addr;
 612 ;;     Elf32_Off  sh_offset;
 613 ;;     uint32_t   sh_size;
 614 ;;     uint32_t   sh_link;
 615 ;;     uint32_t   sh_info;
 616 ;;     uint32_t   sh_addralign;
 617 ;;     uint32_t   sh_entsize;
 618 ;; } Elf32_Shdr;
 619
 620 (define (parse-elf32-section-header index bv offset byte-order)
 621   (if (<= (+ offset 40) (bytevector-length bv))
 622       (make-elf-section index
 623                         (bytevector-u32-ref bv offset byte-order)
 624                         (bytevector-u32-ref bv (+ offset 4) byte-order)
 625                         (bytevector-u32-ref bv (+ offset 8) byte-order)
 626                         (bytevector-u32-ref bv (+ offset 12) byte-order)
 627                         (bytevector-u32-ref bv (+ offset 16) byte-order)
 628                         (bytevector-u32-ref bv (+ offset 20) byte-order)
 629                         (bytevector-u32-ref bv (+ offset 24) byte-order)
 630                         (bytevector-u32-ref bv (+ offset 28) byte-order)
 631                         (bytevector-u32-ref bv (+ offset 32) byte-order)
 632                         (bytevector-u32-ref bv (+ offset 36) byte-order))
 633       (error "corrupt ELF (offset out of range)" offset)))
 634
 635 (define (write-elf32-section-header bv offset byte-order sec)
 636   (bytevector-u32-set! bv offset (elf-section-name sec) byte-order)
 637   (bytevector-u32-set! bv (+ offset 4) (elf-section-type sec) byte-order)
 638   (bytevector-u32-set! bv (+ offset 8) (elf-section-flags sec) byte-order)
 639   (bytevector-u32-set! bv (+ offset 12) (elf-section-addr sec) byte-order)
 640   (bytevector-u32-set! bv (+ offset 16) (elf-section-offset sec) byte-order)
 641   (bytevector-u32-set! bv (+ offset 20) (elf-section-size sec) byte-order)
 642   (bytevector-u32-set! bv (+ offset 24) (elf-section-link sec) byte-order)
 643   (bytevector-u32-set! bv (+ offset 28) (elf-section-info sec) byte-order)
 644   (bytevector-u32-set! bv (+ offset 32) (elf-section-addralign sec) byte-order)
 645   (bytevector-u32-set! bv (+ offset 36) (elf-section-entsize sec) byte-order))
 646
 647
 648 ;; typedef struct {
 649 ;;     uint32_t   sh_name;
 650 ;;     uint32_t   sh_type;
 651 ;;     uint64_t   sh_flags;
 652 ;;     Elf64_Addr sh_addr;
 653 ;;     Elf64_Off  sh_offset;
 654 ;;     uint64_t   sh_size;
 655 ;;     uint32_t   sh_link;
 656 ;;     uint32_t   sh_info;
 657 ;;     uint64_t   sh_addralign;
 658 ;;     uint64_t   sh_entsize;
 659 ;; } Elf64_Shdr;
 660
 661 (define (elf-section-header-len word-size)
 662   (case word-size
 663     ((4) 40)
 664     ((8) 64)
 665     (else (error "bad word size" word-size))))
 666
 667 (define (elf-section-header-addr-offset word-size)
 668   (case word-size
 669     ((4) 12)
 670     ((8) 16)
 671     (else (error "bad word size" word-size))))
 672
 673 (define (elf-section-header-offset-offset word-size)
 674   (case word-size
 675     ((4) 16)
 676     ((8) 24)
 677     (else (error "bad word size" word-size))))
 678
 679 (define (parse-elf64-section-header index bv offset byte-order)
 680   (if (<= (+ offset 64) (bytevector-length bv))
 681       (make-elf-section index
 682                         (bytevector-u32-ref bv offset byte-order)
 683                         (bytevector-u32-ref bv (+ offset 4) byte-order)
 684                         (bytevector-u64-ref bv (+ offset 8) byte-order)
 685                         (bytevector-u64-ref bv (+ offset 16) byte-order)
 686                         (bytevector-u64-ref bv (+ offset 24) byte-order)
 687                         (bytevector-u64-ref bv (+ offset 32) byte-order)
 688                         (bytevector-u32-ref bv (+ offset 40) byte-order)
 689                         (bytevector-u32-ref bv (+ offset 44) byte-order)
 690                         (bytevector-u64-ref bv (+ offset 48) byte-order)
 691                         (bytevector-u64-ref bv (+ offset 56) byte-order))
 692       (error "corrupt ELF (offset out of range)" offset)))
 693
 694 (define (write-elf64-section-header bv offset byte-order sec)
 695   (bytevector-u32-set! bv offset (elf-section-name sec) byte-order)
 696   (bytevector-u32-set! bv (+ offset 4) (elf-section-type sec) byte-order)
 697   (bytevector-u64-set! bv (+ offset 8) (elf-section-flags sec) byte-order)
 698   (bytevector-u64-set! bv (+ offset 16) (elf-section-addr sec) byte-order)
 699   (bytevector-u64-set! bv (+ offset 24) (elf-section-offset sec) byte-order)
 700   (bytevector-u64-set! bv (+ offset 32) (elf-section-size sec) byte-order)
 701   (bytevector-u32-set! bv (+ offset 40) (elf-section-link sec) byte-order)
 702   (bytevector-u32-set! bv (+ offset 44) (elf-section-info sec) byte-order)
 703   (bytevector-u64-set! bv (+ offset 48) (elf-section-addralign sec) byte-order)
 704   (bytevector-u64-set! bv (+ offset 56) (elf-section-entsize sec) byte-order))
 705
 706 (define (elf-section elf n)
 707   (if (not (< -1 n (elf-shnum elf)))
 708       (error "bad section number" n))
 709   ((case (elf-word-size elf)
 710      ((4) parse-elf32-section-header)
 711      ((8) parse-elf64-section-header)
 712      (else (error "unhandled pointer size")))
 713    n
 714    (elf-bytes elf)
 715    (+ (elf-shoff elf) (* n (elf-shentsize elf)))
 716    (elf-byte-order elf)))
 717
 718 (define (write-elf-section-header bv offset byte-order word-size sec)
 719   ((case word-size
 720      ((4) write-elf32-section-header)
 721      ((8) write-elf64-section-header)
 722      (else (error "invalid word size" word-size)))
 723    bv offset byte-order sec))
 724
 725 (define (elf-sections elf)
 726   (let lp ((n (elf-shnum elf)) (out '()))
 727     (if (zero? n)
 728         out
 729         (lp (1- n) (cons (elf-section elf (1- n)) out)))))
 730
 731 ;;
 732 ;; Section Types
 733 ;;
 734 (define SHT_NULL          0)            ; Section header table entry unused
 735 (define SHT_PROGBITS      1)            ; Program data
 736 (define SHT_SYMTAB        2)            ; Symbol table
 737 (define SHT_STRTAB        3)            ; String table
 738 (define SHT_RELA          4)            ; Relocation entries with addends
 739 (define SHT_HASH          5)            ; Symbol hash table
 740 (define SHT_DYNAMIC       6)            ; Dynamic linking information
 741 (define SHT_NOTE          7)            ; Notes
 742 (define SHT_NOBITS        8)            ; Program space with no data (bss)
 743 (define SHT_REL           9)            ; Relocation entries, no addends
 744 (define SHT_SHLIB         10)           ; Reserved
 745 (define SHT_DYNSYM        11)           ; Dynamic linker symbol table
 746 (define SHT_INIT_ARRAY    14)           ; Array of constructors
 747 (define SHT_FINI_ARRAY    15)           ; Array of destructors
 748 (define SHT_PREINIT_ARRAY 16)           ; Array of pre-constructors
 749 (define SHT_GROUP         17)           ; Section group
 750 (define SHT_SYMTAB_SHNDX  18)           ; Extended section indeces
 751 (define SHT_NUM           19)           ; Number of defined types.
 752 (define SHT_LOOS          #x60000000)   ; Start OS-specific.
 753 (define SHT_HIOS          #x6fffffff)   ; End OS-specific type
 754 (define SHT_LOPROC        #x70000000)   ; Start of processor-specific
 755 (define SHT_HIPROC        #x7fffffff)   ; End of processor-specific
 756 (define SHT_LOUSER        #x80000000)   ; Start of application-specific
 757 (define SHT_HIUSER        #x8fffffff)   ; End of application-specific
 758
 759 ;;
 760 ;; Section Flags
 761 ;;
 762 (define SHF_WRITE            (ash 1 0)) ; Writable
 763 (define SHF_ALLOC            (ash 1 1)) ; Occupies memory during execution
 764 (define SHF_EXECINSTR        (ash 1 2)) ; Executable
 765 (define SHF_MERGE            (ash 1 4)) ; Might be merged
 766 (define SHF_STRINGS          (ash 1 5)) ; Contains nul-terminated strings
 767 (define SHF_INFO_LINK        (ash 1 6)) ; `sh_info' contains SHT index
 768 (define SHF_LINK_ORDER       (ash 1 7)) ; Preserve order after combining
 769 (define SHF_OS_NONCONFORMING (ash 1 8)) ; Non-standard OS specific handling required
 770 (define SHF_GROUP            (ash 1 9)) ; Section is member of a group.
 771 (define SHF_TLS              (ash 1 10)) ; Section hold thread-local data.
 772
 773 ;;
 774 ;; Dynamic entry types.  The DT_GUILE types are non-standard.
 775 ;;
 776 (define DT_NULL         0)              ; Marks end of dynamic section
 777 (define DT_NEEDED       1)              ; Name of needed library
 778 (define DT_PLTRELSZ     2)              ; Size in bytes of PLT relocs
 779 (define DT_PLTGOT       3)              ; Processor defined value
 780 (define DT_HASH         4)              ; Address of symbol hash table
 781 (define DT_STRTAB       5)              ; Address of string table
 782 (define DT_SYMTAB       6)              ; Address of symbol table
 783 (define DT_RELA         7)              ; Address of Rela relocs
 784 (define DT_RELASZ       8)              ; Total size of Rela relocs
 785 (define DT_RELAENT      9)              ; Size of one Rela reloc
 786 (define DT_STRSZ        10)             ; Size of string table
 787 (define DT_SYMENT       11)             ; Size of one symbol table entry
 788 (define DT_INIT         12)             ; Address of init function
 789 (define DT_FINI         13)             ; Address of termination function
 790 (define DT_SONAME       14)             ; Name of shared object
 791 (define DT_RPATH        15)             ; Library search path (deprecated)
 792 (define DT_SYMBOLIC     16)             ; Start symbol search here
 793 (define DT_REL          17)             ; Address of Rel relocs
 794 (define DT_RELSZ        18)             ; Total size of Rel relocs
 795 (define DT_RELENT       19)             ; Size of one Rel reloc
 796 (define DT_PLTREL       20)             ; Type of reloc in PLT
 797 (define DT_DEBUG        21)             ; For debugging ; unspecified
 798 (define DT_TEXTREL      22)             ; Reloc might modify .text
 799 (define DT_JMPREL       23)             ; Address of PLT relocs
 800 (define DT_BIND_NOW     24)             ; Process relocations of object
 801 (define DT_INIT_ARRAY   25)             ; Array with addresses of init fct
 802 (define DT_FINI_ARRAY   26)             ; Array with addresses of fini fct
 803 (define DT_INIT_ARRAYSZ 27)             ; Size in bytes of DT_INIT_ARRAY
 804 (define DT_FINI_ARRAYSZ 28)             ; Size in bytes of DT_FINI_ARRAY
 805 (define DT_RUNPATH      29)             ; Library search path
 806 (define DT_FLAGS        30)             ; Flags for the object being loaded
 807 (define DT_ENCODING     32)             ; Start of encoded range
 808 (define DT_PREINIT_ARRAY 32)            ; Array with addresses of preinit fc
 809 (define DT_PREINIT_ARRAYSZ 33)          ; size in bytes of DT_PREINIT_ARRAY
 810 (define DT_NUM          34)             ; Number used
 811 (define DT_LOGUILE      #x37146000)     ; Start of Guile-specific
 812 (define DT_GUILE_GC_ROOT    #x37146000) ; Offset of GC roots
 813 (define DT_GUILE_GC_ROOT_SZ #x37146001) ; Size in machine words of GC roots
 814 (define DT_GUILE_ENTRY      #x37146002) ; Address of entry thunk
 815 (define DT_GUILE_VM_VERSION #x37146003) ; Bytecode version
 816 (define DT_GUILE_FRAME_MAPS #x37146004) ; Offset of .guile.frame-maps
 817 (define DT_HIGUILE      #x37146fff)     ; End of Guile-specific
 818 (define DT_LOOS         #x6000000d)     ; Start of OS-specific
 819 (define DT_HIOS         #x6ffff000)     ; End of OS-specific
 820 (define DT_LOPROC       #x70000000)     ; Start of processor-specific
 821 (define DT_HIPROC       #x7fffffff)     ; End of processor-specific
 822
 823
 824 (define (string-table-ref bv offset)
 825   (let lp ((end offset))
 826     (if (zero? (bytevector-u8-ref bv end))
 827         (let ((out (make-bytevector (- end offset))))
 828           (bytevector-copy! bv offset out 0 (- end offset))
 829           (utf8->string out))
 830         (lp (1+ end)))))
 831
 832 (define (elf-section-by-name elf name)
 833   (let ((off (elf-section-offset (elf-section elf (elf-shstrndx elf)))))
 834     (let lp ((n (elf-shnum elf)))
 835       (and (> n 0)
 836            (let ((section (elf-section elf (1- n))))
 837              (if (equal? (string-table-ref (elf-bytes elf)
 838                                            (+ off (elf-section-name section)))
 839                          name)
 840                  section
 841                  (lp (1- n))))))))
 842
 843 (define (elf-sections-by-name elf)
 844   (let* ((sections (elf-sections elf))
 845          (off (elf-section-offset (list-ref sections (elf-shstrndx elf)))))
 846     (map (lambda (section)
 847            (cons (string-table-ref (elf-bytes elf)
 848                                    (+ off (elf-section-name section)))
 849                  section))
 850          sections)))
 851
 852 (define-record-type <elf-symbol>
 853   (make-elf-symbol name value size info other shndx)
 854   elf-symbol?
 855   (name elf-symbol-name)
 856   (value elf-symbol-value)
 857   (size elf-symbol-size)
 858   (info elf-symbol-info)
 859   (other elf-symbol-other)
 860   (shndx elf-symbol-shndx))
 861
 862 (define* (make-elf-symbol* #:key (name 0) (value 0) (size 0)
 863                            (binding STB_LOCAL) (type STT_NOTYPE)
 864                            (info (logior (ash binding 4) type))
 865                            (visibility STV_DEFAULT) (other visibility)
 866                            (shndx SHN_UNDEF))
 867   (make-elf-symbol name value size info other shndx))
 868
 869 ;; typedef struct {
 870 ;;     uint32_t      st_name;
 871 ;;     Elf32_Addr    st_value;
 872 ;;     uint32_t      st_size;
 873 ;;     unsigned char st_info;
 874 ;;     unsigned char st_other;
 875 ;;     uint16_t      st_shndx;
 876 ;; } Elf32_Sym;
 877
 878 (define (elf-symbol-len word-size)
 879   (case word-size
 880     ((4) 16)
 881     ((8) 24)
 882     (else (error "bad word size" word-size))))
 883
 884 (define (elf-symbol-value-offset word-size)
 885   (case word-size
 886     ((4) 4)
 887     ((8) 8)
 888     (else (error "bad word size" word-size))))
 889
 890 (define (parse-elf32-symbol bv offset stroff byte-order)
 891   (if (<= (+ offset 16) (bytevector-length bv))
 892       (make-elf-symbol (let ((name (bytevector-u32-ref bv offset byte-order)))
 893                          (if stroff
 894                              (string-table-ref bv (+ stroff name))
 895                              name))
 896                        (bytevector-u32-ref bv (+ offset 4) byte-order)
 897                        (bytevector-u32-ref bv (+ offset 8) byte-order)
 898                        (bytevector-u8-ref bv (+ offset 12))
 899                        (bytevector-u8-ref bv (+ offset 13))
 900                        (bytevector-u16-ref bv (+ offset 14) byte-order))
 901       (error "corrupt ELF (offset out of range)" offset)))
 902
 903 (define (write-elf32-symbol bv offset byte-order sym)
 904   (bytevector-u32-set! bv offset (elf-symbol-name sym) byte-order)
 905   (bytevector-u32-set! bv (+ offset 4) (elf-symbol-value sym) byte-order)
 906   (bytevector-u32-set! bv (+ offset 8) (elf-symbol-size sym) byte-order)
 907   (bytevector-u8-set! bv (+ offset 12) (elf-symbol-info sym))
 908   (bytevector-u8-set! bv (+ offset 13) (elf-symbol-other sym))
 909   (bytevector-u16-set! bv (+ offset 14) (elf-symbol-shndx sym) byte-order))
 910
 911 ;; typedef struct {
 912 ;;     uint32_t      st_name;
 913 ;;     unsigned char st_info;
 914 ;;     unsigned char st_other;
 915 ;;     uint16_t      st_shndx;
 916 ;;     Elf64_Addr    st_value;
 917 ;;     uint64_t      st_size;
 918 ;; } Elf64_Sym;
 919
 920 (define (parse-elf64-symbol bv offset stroff byte-order)
 921   (if (<= (+ offset 24) (bytevector-length bv))
 922       (make-elf-symbol (let ((name (bytevector-u32-ref bv offset byte-order)))
 923                          (if stroff
 924                              (string-table-ref bv (+ stroff name))
 925                              name))
 926                        (bytevector-u64-ref bv (+ offset 8) byte-order)
 927                        (bytevector-u64-ref bv (+ offset 16) byte-order)
 928                        (bytevector-u8-ref bv (+ offset 4))
 929                        (bytevector-u8-ref bv (+ offset 5))
 930                        (bytevector-u16-ref bv (+ offset 6) byte-order))
 931       (error "corrupt ELF (offset out of range)" offset)))
 932
 933 (define (write-elf64-symbol bv offset byte-order sym)
 934   (bytevector-u32-set! bv offset (elf-symbol-name sym) byte-order)
 935   (bytevector-u8-set! bv (+ offset 4) (elf-symbol-info sym))
 936   (bytevector-u8-set! bv (+ offset 5) (elf-symbol-other sym))
 937   (bytevector-u16-set! bv (+ offset 6) (elf-symbol-shndx sym) byte-order)
 938   (bytevector-u64-set! bv (+ offset 8) (elf-symbol-value sym) byte-order)
 939   (bytevector-u64-set! bv (+ offset 16) (elf-symbol-size sym) byte-order))
 940
 941 (define (write-elf-symbol bv offset byte-order word-size sym)
 942   ((case word-size
 943      ((4) write-elf32-symbol)
 944      ((8) write-elf64-symbol)
 945      (else (error "invalid word size" word-size)))
 946    bv offset byte-order sym))
 947
 948 (define (elf-symbol-table-len section)
 949   (let ((len (elf-section-size section))
 950         (entsize (elf-section-entsize section)))
 951     (unless (and (not (zero? entsize)) (zero? (modulo len entsize)))
 952       (error "bad symbol table" section))
 953     (/ len entsize)))
 954
 955 (define* (elf-symbol-table-ref elf section n #:optional strtab)
 956   (let ((bv (elf-bytes elf))
 957         (byte-order (elf-byte-order elf))
 958         (stroff (and strtab (elf-section-offset strtab)))
 959         (base (elf-section-offset section))
 960         (len (elf-section-size section))
 961         (entsize (elf-section-entsize section)))
 962     (unless (<= (* (1+ n) entsize) len)
 963       (error "out of range symbol table access" section n))
 964     (case (elf-word-size elf)
 965       ((4)
 966        (unless (<= 16 entsize)
 967          (error "bad entsize for symbol table" section))
 968        (parse-elf32-symbol bv (+ base (* n entsize)) stroff byte-order))
 969       ((8)
 970        (unless (<= 24 entsize)
 971          (error "bad entsize for symbol table" section))
 972        (parse-elf64-symbol bv (+ base (* n entsize)) stroff byte-order))
 973       (else (error "bad word size" elf)))))
 974
 975 ;; Legal values for ST_BIND subfield of st_info (symbol binding).
 976
 977 (define STB_LOCAL       0)              ; Local symbol
 978 (define STB_GLOBAL      1)              ; Global symbol
 979 (define STB_WEAK        2)              ; Weak symbol
 980 (define STB_NUM         3)              ; Number of defined types.
 981 (define STB_LOOS        10)             ; Start of OS-specific
 982 (define STB_GNU_UNIQUE  10)             ; Unique symbol.
 983 (define STB_HIOS        12)             ; End of OS-specific
 984 (define STB_LOPROC      13)             ; Start of processor-specific
 985 (define STB_HIPROC      15)             ; End of processor-specific
 986
 987 ;; Legal values for ST_TYPE subfield of st_info (symbol type).
 988
 989 (define STT_NOTYPE      0)              ; Symbol type is unspecified
 990 (define STT_OBJECT      1)              ; Symbol is a data object
 991 (define STT_FUNC        2)              ; Symbol is a code object
 992 (define STT_SECTION     3)              ; Symbol associated with a section
 993 (define STT_FILE        4)              ; Symbol's name is file name
 994 (define STT_COMMON      5)              ; Symbol is a common data object
 995 (define STT_TLS         6)              ; Symbol is thread-local data objec
 996 (define STT_NUM         7)              ; Number of defined types.
 997 (define STT_LOOS        10)             ; Start of OS-specific
 998 (define STT_GNU_IFUNC   10)             ; Symbol is indirect code object
 999 (define STT_HIOS        12)             ; End of OS-specific
1000 (define STT_LOPROC      13)             ; Start of processor-specific
1001 (define STT_HIPROC      15)             ; End of processor-specific
1002
1003 ;; Symbol visibility specification encoded in the st_other field.
1004
1005 (define STV_DEFAULT     0)              ; Default symbol visibility rules
1006 (define STV_INTERNAL    1)              ; Processor specific hidden class
1007 (define STV_HIDDEN      2)              ; Sym unavailable in other modules
1008 (define STV_PROTECTED   3)              ; Not preemptible, not exported
1009
1010 (define (elf-symbol-binding sym)
1011   (ash (elf-symbol-info sym) -4))
1012
1013 (define (elf-symbol-type sym)
1014   (logand (elf-symbol-info sym) #xf))
1015
1016 (define (elf-symbol-visibility sym)
1017   (logand (elf-symbol-other sym) #x3))
1018
1019 (define NT_GNU_ABI_TAG 1)
1020 (define NT_GNU_HWCAP 2)
1021 (define NT_GNU_BUILD_ID 3)
1022 (define NT_GNU_GOLD_VERSION 4)
1023
1024 (define-record-type <elf-note>
1025   (make-elf-note name desc type)
1026   elf-note?
1027   (name elf-note-name)
1028   (desc elf-note-desc)
1029   (type elf-note-type))
1030
1031 (define (parse-elf-note elf section)
1032   (let ((bv (elf-bytes elf))
1033         (byte-order (elf-byte-order elf))
1034         (offset (elf-section-offset section)))
1035     (unless (<= (+ offset 12) (bytevector-length bv))
1036       (error "corrupt ELF (offset out of range)" offset))
1037     (let ((namesz (bytevector-u32-ref bv offset byte-order))
1038           (descsz (bytevector-u32-ref bv (+ offset 4) byte-order))
1039           (type (bytevector-u32-ref bv (+ offset 8) byte-order)))
1040       (unless (<= (+ offset 12 namesz descsz) (bytevector-length bv))
1041         (error "corrupt ELF (offset out of range)" offset))
1042       (let ((name (make-bytevector (1- namesz)))
1043             (desc (make-bytevector descsz)))
1044         (bytevector-copy! bv (+ offset 12) name 0 (1- namesz))
1045         (bytevector-copy! bv (+ offset 12 namesz) desc 0 descsz)
1046         (make-elf-note (utf8->string name) desc type)))))