guix_mirror_bot pushed a commit to branch add-compress-debug-symbols-phase in repository guix.
commit be5b70598b0a19db274d89901046d7b7f6c0382c Author: Maxim Cournoyer <[email protected]> AuthorDate: Tue Oct 28 21:50:34 2025 +0900 elf: Remove bundled Guile source. This module has been included in Guile as (system vm elf) since around version 2.1. * guix/elf.scm: Delete file. * CODEOWNERS: De-register module. * Makefile.am (MODULES): Likewise. * etc/teams.scm (core): Likewise. * gnu/build/linux-modules.scm: Adjust imports. * gnu/packages/gnuzilla.scm (icecat-minimal) [modules]: Likewise. * gnu/packages/librewolf.scm (librewolf): Likewise. * gnu/packages/sequoia.scm (sequoia): Likewise. * gnu/packages/tor-browsers.scm (make-torbrowser): Likewise. * gnu/packages/version-control.scm (hg-commitsigs): Likewise. * guix/build-system/gnu.scm (%default-gnu-imported-modules): Likewise. * guix/build/debug-link.scm: Likewise. * guix/build/gnu-build-system.scm: Likewise. * guix/build/gremlin.scm: Likewise. * guix/build/meson-build-system.scm: Likewise. * guix/grafts.scm (graft-derivation/shallow): Likewise. * guix/scripts/pack.scm (wrapped-package): Likewise. * tests/debug-link.scm: ("elf-debuglink", "set-debuglink-crc"): Likewise. * tests/gremlin.scm: Likewise. Change-Id: I86ac4237fdd820a6b54dc0fe7a7d10403a290ef9 --- CODEOWNERS | 1 - Makefile.am | 1 - etc/teams.scm | 1 - gnu/build/linux-modules.scm | 2 +- gnu/packages/gnuzilla.scm | 2 +- gnu/packages/librewolf.scm | 2 +- gnu/packages/sequoia.scm | 2 +- gnu/packages/tor-browsers.scm | 2 +- gnu/packages/version-control.scm | 2 +- guix/build-system/gnu.scm | 2 +- guix/build/debug-link.scm | 2 +- guix/build/gnu-build-system.scm | 2 +- guix/build/gremlin.scm | 2 +- guix/build/meson-build-system.scm | 2 +- guix/elf.scm | 1046 ------------------------------------- guix/grafts.scm | 6 +- guix/scripts/pack.scm | 7 +- tests/debug-link.scm | 12 +- tests/gremlin.scm | 2 +- 19 files changed, 23 insertions(+), 1075 deletions(-) diff --git a/CODEOWNERS b/CODEOWNERS index 1de80c8e25..1bb14eeb54 100644 --- a/CODEOWNERS +++ b/CODEOWNERS @@ -45,7 +45,6 @@ guix/diagnostics\.scm @guix/core guix/discovery\.scm @guix/core guix/docker\.scm @guix/core guix/download\.scm @guix/core -guix/elf\.scm @guix/core guix/ftp-client\.scm @guix/core guix/gexp\.scm @guix/core guix/git-authenticate\.scm @guix/core diff --git a/Makefile.am b/Makefile.am index a6c2e73388..54479f5ae7 100644 --- a/Makefile.am +++ b/Makefile.am @@ -201,7 +201,6 @@ MODULES = \ guix/ftp-client.scm \ guix/http-client.scm \ guix/gnupg.scm \ - guix/elf.scm \ guix/profiling.scm \ guix/store.scm \ guix/cvs-download.scm \ diff --git a/etc/teams.scm b/etc/teams.scm index 403aa52f24..3821ed57d4 100755 --- a/etc/teams.scm +++ b/etc/teams.scm @@ -510,7 +510,6 @@ already exists. Lookup team IDs among CURRENT-TEAMS." "guix/discovery.scm" "guix/docker.scm" "guix/download.scm" - "guix/elf.scm" "guix/ftp-client.scm" "guix/gexp.scm" "guix/git-authenticate.scm" diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm index 6bf71100e4..5ff5198e8a 100644 --- a/gnu/build/linux-modules.scm +++ b/gnu/build/linux-modules.scm @@ -21,7 +21,6 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (gnu build linux-modules) - #:use-module (guix elf) #:use-module (guix glob) #:use-module (guix build syscalls) #:use-module ((guix build utils) #:select (find-files invoke)) @@ -39,6 +38,7 @@ #:use-module (ice-9 match) #:use-module (ice-9 rdelim) #:autoload (ice-9 pretty-print) (pretty-print) + #:use-module (system vm elf) #:export (dot-ko ensure-dot-ko module-formal-name diff --git a/gnu/packages/gnuzilla.scm b/gnu/packages/gnuzilla.scm index d24797b85a..7e883ce291 100644 --- a/gnu/packages/gnuzilla.scm +++ b/gnu/packages/gnuzilla.scm @@ -927,7 +927,7 @@ preferences/advanced-scripts.dtd" (srfi srfi-26) (rnrs bytevectors) (rnrs io ports) - (guix elf) + (system vm elf) (guix build gremlin) ,@%default-gnu-modules) #:phases diff --git a/gnu/packages/librewolf.scm b/gnu/packages/librewolf.scm index 6c852d7f1c..586e29a962 100644 --- a/gnu/packages/librewolf.scm +++ b/gnu/packages/librewolf.scm @@ -282,7 +282,7 @@ (srfi srfi-26) (rnrs bytevectors) (rnrs io ports) - (guix elf) + (system vm elf) (guix build gremlin) ,@%default-gnu-imported-modules) #:phases diff --git a/gnu/packages/sequoia.scm b/gnu/packages/sequoia.scm index 4dfa48bca3..1eb047e84e 100644 --- a/gnu/packages/sequoia.scm +++ b/gnu/packages/sequoia.scm @@ -318,7 +318,7 @@ This Guix package is built to use the nettle cryptographic library.") (guix build union) (guix build gnu-build-system) (guix build gremlin) - (guix elf)) + (system vm elf)) #:builder #~(begin (use-modules (guix build utils) diff --git a/gnu/packages/tor-browsers.scm b/gnu/packages/tor-browsers.scm index 2a5645272e..ef2d7432d4 100644 --- a/gnu/packages/tor-browsers.scm +++ b/gnu/packages/tor-browsers.scm @@ -362,7 +362,7 @@ Browser.") (srfi srfi-26) (rnrs bytevectors) (rnrs io ports) - (guix elf) + (system vm elf) (guix build gremlin) ,@%default-gnu-imported-modules) #:phases diff --git a/gnu/packages/version-control.scm b/gnu/packages/version-control.scm index 918ef96786..fc272afbb1 100644 --- a/gnu/packages/version-control.scm +++ b/gnu/packages/version-control.scm @@ -2948,7 +2948,7 @@ history. It implements the changeset evolution concept for Mercurial.") (guix build utils) (guix build gremlin) (ice-9 ftw) - (guix elf)) + (system vm elf)) #:phases (modify-phases %standard-phases (add-after 'unpack 'patch-paths diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm index 8f0883956e..2a2566f2ee 100644 --- a/guix/build-system/gnu.scm +++ b/guix/build-system/gnu.scm @@ -56,7 +56,7 @@ '((guix build gnu-build-system) (guix build utils) (guix build gremlin) - (guix elf))) + (system vm elf))) (define-deprecated/public-alias %gnu-build-system-modules %default-gnu-imported-modules) diff --git a/guix/build/debug-link.scm b/guix/build/debug-link.scm index 7a74e6001b..a147c254d7 100644 --- a/guix/build/debug-link.scm +++ b/guix/build/debug-link.scm @@ -18,7 +18,6 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (guix build debug-link) - #:use-module (guix elf) #:use-module (guix build io) #:use-module ((guix build utils) #:select (find-files elf-file? make-file-writable)) @@ -26,6 +25,7 @@ #:use-module (rnrs io ports) #:use-module (srfi srfi-1) #:use-module (system foreign) + #:use-module (system vm elf) #:use-module (ice-9 match) #:export (debuglink-crc32 elf-debuglink diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm index 8183762ce1..15cb17cabc 100644 --- a/guix/build/gnu-build-system.scm +++ b/guix/build/gnu-build-system.scm @@ -22,7 +22,6 @@ (define-module (guix build gnu-build-system) #:use-module (guix build utils) #:use-module (guix build gremlin) - #:use-module (guix elf) #:use-module (ice-9 ftw) #:use-module (ice-9 match) #:use-module (ice-9 regex) @@ -35,6 +34,7 @@ #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) #:use-module (srfi srfi-26) + #:use-module (system vm elf) #:use-module (rnrs io ports) #:export (%standard-phases %license-file-regexp diff --git a/guix/build/gremlin.scm b/guix/build/gremlin.scm index 2392a74a35..eb4e0af2e7 100644 --- a/guix/build/gremlin.scm +++ b/guix/build/gremlin.scm @@ -18,7 +18,6 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (guix build gremlin) - #:use-module (guix elf) #:use-module (guix build io) #:use-module ((guix build utils) #:select (store-file-name?)) #:use-module (ice-9 match) @@ -28,6 +27,7 @@ #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) #:use-module (system foreign) + #:use-module (system vm elf) #:use-module (rnrs bytevectors) #:use-module (rnrs io ports) #:export (elf-error? diff --git a/guix/build/meson-build-system.scm b/guix/build/meson-build-system.scm index d8be1f3faa..7a85772759 100644 --- a/guix/build/meson-build-system.scm +++ b/guix/build/meson-build-system.scm @@ -24,10 +24,10 @@ #:use-module ((guix build glib-or-gtk-build-system) #:prefix glib-or-gtk:) #:use-module (guix build utils) #:use-module (guix build gremlin) - #:use-module (guix elf) #:use-module (ice-9 match) #:use-module (rnrs io ports) #:use-module (srfi srfi-1) + #:use-module (system vm elf) #:export (%standard-phases meson-build)) diff --git a/guix/elf.scm b/guix/elf.scm deleted file mode 100644 index 4283dbd2e4..0000000000 --- a/guix/elf.scm +++ /dev/null @@ -1,1046 +0,0 @@ -;;; Guile ELF reader and writer - -;; Copyright (C) 2011, 2012, 2013, 2014, 2015 Free Software Foundation, Inc. - -;;;; This library is free software; you can redistribute it and/or -;;;; modify it under the terms of the GNU Lesser General Public -;;;; License as published by the Free Software Foundation; either -;;;; version 3 of the License, or (at your option) any later version. -;;;; -;;;; This library is distributed in the hope that it will be useful, -;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;;;; Lesser General Public License for more details. -;;;; -;;;; You should have received a copy of the GNU Lesser General Public -;;;; License along with this library; if not, write to the Free Software -;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA - -;;; Commentary: -;;; -;;; This file was taken from the Guile 2.1 branch, where it is known as -;;; (system vm elf), and renamed to (guix elf). It will be unneeded when Guix -;;; switches to Guile 2.1/2.2. -;;; -;;; A module to read and write Executable and Linking Format (ELF) -;;; files. -;;; -;;; This module exports a number of record types that represent the -;;; various parts that make up ELF files. Fundamentally this is the -;;; main header, the segment headers (program headers), and the section -;;; headers. It also exports bindings for symbolic constants and -;;; utilities to parse and write special kinds of ELF sections. -;;; -;;; See elf(5) for more information on ELF. -;;; -;;; Code: - -(define-module (guix elf) - #:use-module (rnrs bytevectors) - #:use-module (system foreign) - #:use-module (system base target) - #:use-module (srfi srfi-9) - #:use-module (ice-9 receive) - #:use-module (ice-9 vlist) - #:export (has-elf-header? - - (make-elf* . make-elf) - elf? - elf-bytes elf-word-size elf-byte-order - elf-abi elf-type elf-machine-type - elf-entry elf-phoff elf-shoff elf-flags elf-ehsize - elf-phentsize elf-phnum elf-shentsize elf-shnum elf-shstrndx - - ELFOSABI_NONE ELFOSABI_HPUX ELFOSABI_NETBSD ELFOSABI_GNU - ELFOSABI_SOLARIS ELFOSABI_AIX ELFOSABI_IRIX ELFOSABI_FREEBSD - ELFOSABI_TRU64 ELFOSABI_MODESTO ELFOSABI_OPENBSD - ELFOSABI_ARM_AEABI ELFOSABI_ARM ELFOSABI_STANDALONE - - ET_NONE ET_REL ET_EXEC ET_DYN ET_CORE - - EM_NONE EM_SPARC EM_386 EM_MIPS EM_PPC EM_PPC64 EM_ARM EM_SH - EM_SPARCV9 EM_IA_64 EM_X86_64 - - elf-header-len elf-header-shoff-offset - write-elf-header - - (make-elf-segment* . make-elf-segment) - elf-segment? - elf-segment-index - elf-segment-type elf-segment-offset elf-segment-vaddr - elf-segment-paddr elf-segment-filesz elf-segment-memsz - elf-segment-flags elf-segment-align - - elf-program-header-len write-elf-program-header - - PT_NULL PT_LOAD PT_DYNAMIC PT_INTERP PT_NOTE PT_SHLIB - PT_PHDR PT_TLS PT_NUM PT_LOOS PT_GNU_EH_FRAME PT_GNU_STACK - PT_GNU_RELRO - - PF_R PF_W PF_X - - (make-elf-section* . make-elf-section) - elf-section? - elf-section-index - elf-section-name elf-section-type elf-section-flags - elf-section-addr elf-section-offset elf-section-size - elf-section-link elf-section-info elf-section-addralign - elf-section-entsize - - elf-section-header-len elf-section-header-addr-offset - elf-section-header-offset-offset - write-elf-section-header - - (make-elf-symbol* . make-elf-symbol) - elf-symbol? - elf-symbol-name elf-symbol-value elf-symbol-size - elf-symbol-info elf-symbol-other elf-symbol-shndx - elf-symbol-binding elf-symbol-type elf-symbol-visibility - - elf-symbol-len elf-symbol-value-offset write-elf-symbol - - SHN_UNDEF - - SHT_NULL SHT_PROGBITS SHT_SYMTAB SHT_STRTAB SHT_RELA - SHT_HASH SHT_DYNAMIC SHT_NOTE SHT_NOBITS SHT_REL SHT_SHLIB - SHT_DYNSYM SHT_INIT_ARRAY SHT_FINI_ARRAY SHT_PREINIT_ARRAY - SHT_GROUP SHT_SYMTAB_SHNDX SHT_NUM SHT_LOOS SHT_HIOS - SHT_LOPROC SHT_HIPROC SHT_LOUSER SHT_HIUSER - - SHF_WRITE SHF_ALLOC SHF_EXECINSTR SHF_MERGE SHF_STRINGS - SHF_INFO_LINK SHF_LINK_ORDER SHF_OS_NONCONFORMING SHF_GROUP - SHF_TLS - - DT_NULL DT_NEEDED DT_PLTRELSZ DT_PLTGOT DT_HASH DT_STRTAB - DT_SYMTAB DT_RELA DT_RELASZ DT_RELAENT DT_STRSZ DT_SYMENT - DT_INIT DT_FINI DT_SONAME DT_RPATH DT_SYMBOLIC DT_REL - DT_RELSZ DT_RELENT DT_PLTREL DT_DEBUG DT_TEXTREL DT_JMPREL - DT_BIND_NOW DT_INIT_ARRAY DT_FINI_ARRAY DT_INIT_ARRAYSZ - DT_FINI_ARRAYSZ DT_RUNPATH DT_FLAGS DT_ENCODING - DT_PREINIT_ARRAY DT_PREINIT_ARRAYSZ DT_NUM DT_LOGUILE - DT_GUILE_GC_ROOT DT_GUILE_GC_ROOT_SZ DT_GUILE_ENTRY - DT_GUILE_VM_VERSION DT_GUILE_FRAME_MAPS DT_HIGUILE - DT_LOOS DT_HIOS DT_LOPROC DT_HIPROC - - string-table-ref - - STB_LOCAL STB_GLOBAL STB_WEAK STB_NUM STB_LOOS STB_GNU - STB_HIOS STB_LOPROC STB_HIPROC - - STT_NOTYPE STT_OBJECT STT_FUNC STT_SECTION STT_FILE - STT_COMMON STT_TLS STT_NUM STT_LOOS STT_GNU STT_HIOS - STT_LOPROC STT_HIPROC - - STV_DEFAULT STV_INTERNAL STV_HIDDEN STV_PROTECTED - - NT_GNU_ABI_TAG NT_GNU_HWCAP NT_GNU_BUILD_ID NT_GNU_GOLD_VERSION - - parse-elf - elf-segment elf-segments - elf-section elf-sections elf-section-by-name elf-sections-by-name - elf-symbol-table-len elf-symbol-table-ref - - parse-elf-note - elf-note-name elf-note-desc elf-note-type)) - -;; #define EI_NIDENT 16 - -;; typedef struct { -;; unsigned char e_ident[EI_NIDENT]; -;; uint16_t e_type; -;; uint16_t e_machine; -;; uint32_t e_version; -;; ElfN_Addr e_entry; -;; ElfN_Off e_phoff; -;; ElfN_Off e_shoff; -;; uint32_t e_flags; -;; uint16_t e_ehsize; -;; uint16_t e_phentsize; -;; uint16_t e_phnum; -;; uint16_t e_shentsize; -;; uint16_t e_shnum; -;; uint16_t e_shstrndx; -;; } ElfN_Ehdr; - -(define elf32-header-len 52) -(define elf64-header-len 64) -(define (elf-header-len word-size) - (case word-size - ((4) elf32-header-len) - ((8) elf64-header-len) - (else (error "invalid word size" word-size)))) -(define (elf-header-shoff-offset word-size) - (case word-size - ((4) 32) - ((8) 40) - (else (error "bad word size" word-size)))) - -(define ELFCLASS32 1) ; 32-bit objects -(define ELFCLASS64 2) ; 64-bit objects - -(define ELFDATA2LSB 1) ; 2's complement, little endian -(define ELFDATA2MSB 2) ; 2's complement, big endian - -(define EV_CURRENT 1) ; Current version - -(define ELFOSABI_NONE 0) ; UNIX System V ABI */ -(define ELFOSABI_HPUX 1) ; HP-UX -(define ELFOSABI_NETBSD 2) ; NetBSD. -(define ELFOSABI_GNU 3) ; Object uses GNU ELF extensions. -(define ELFOSABI_SOLARIS 6) ; Sun Solaris. -(define ELFOSABI_AIX 7) ; IBM AIX. -(define ELFOSABI_IRIX 8) ; SGI Irix. -(define ELFOSABI_FREEBSD 9) ; FreeBSD. -(define ELFOSABI_TRU64 10) ; Compaq TRU64 UNIX. -(define ELFOSABI_MODESTO 11) ; Novell Modesto. -(define ELFOSABI_OPENBSD 12) ; OpenBSD. -(define ELFOSABI_ARM_AEABI 64) ; ARM EABI -(define ELFOSABI_ARM 97) ; ARM -(define ELFOSABI_STANDALONE 255) ; Standalone (embedded) application - -(define ET_NONE 0) ; No file type -(define ET_REL 1) ; Relocatable file -(define ET_EXEC 2) ; Executable file -(define ET_DYN 3) ; Shared object file -(define ET_CORE 4) ; Core file - -;; -;; Machine types -;; -;; Just a sampling of these values. We could include more, but the -;; important thing is to recognize architectures for which we have a -;; native compiler. Recognizing more common machine types is icing on -;; the cake. -;; -(define EM_NONE 0) ; No machine -(define EM_SPARC 2) ; SUN SPARC -(define EM_386 3) ; Intel 80386 -(define EM_MIPS 8) ; MIPS R3000 big-endian -(define EM_PPC 20) ; PowerPC -(define EM_PPC64 21) ; PowerPC 64-bit -(define EM_ARM 40) ; ARM -(define EM_SH 42) ; Hitachi SH -(define EM_SPARCV9 43) ; SPARC v9 64-bit -(define EM_IA_64 50) ; Intel Merced -(define EM_X86_64 62) ; AMD x86-64 architecture - -(define cpu-mapping (make-hash-table)) -(for-each (lambda (pair) - (hashq-set! cpu-mapping (car pair) (cdr pair))) - `((none . ,EM_NONE) - (sparc . ,EM_SPARC) ; FIXME: map 64-bit to SPARCV9 ? - (i386 . ,EM_386) - (mips . ,EM_MIPS) - (ppc . ,EM_PPC) - (ppc64 . ,EM_PPC64) - (arm . ,EM_ARM) ; FIXME: there are more arm cpu variants - (sh . ,EM_SH) ; FIXME: there are more sh cpu variants - (ia64 . ,EM_IA_64) - (x86_64 . ,EM_X86_64))) - -(define SHN_UNDEF 0) - -(define host-machine-type - (hashq-ref cpu-mapping - (string->symbol (car (string-split %host-type #\-))) - EM_NONE)) - -(define host-word-size - (sizeof '*)) - -(define host-byte-order - (native-endianness)) - -(define (has-elf-header? bv) - (and - ;; e_ident - (>= (bytevector-length bv) 16) - (= (bytevector-u8-ref bv 0) #x7f) - (= (bytevector-u8-ref bv 1) (char->integer #\E)) - (= (bytevector-u8-ref bv 2) (char->integer #\L)) - (= (bytevector-u8-ref bv 3) (char->integer #\F)) - (cond - ((= (bytevector-u8-ref bv 4) ELFCLASS32) - (>= (bytevector-length bv) elf32-header-len)) - ((= (bytevector-u8-ref bv 4) ELFCLASS64) - (>= (bytevector-length bv) elf64-header-len)) - (else #f)) - (or (= (bytevector-u8-ref bv 5) ELFDATA2LSB) - (= (bytevector-u8-ref bv 5) ELFDATA2MSB)) - (= (bytevector-u8-ref bv 6) EV_CURRENT) - ;; Look at ABI later. - (= (bytevector-u8-ref bv 8) 0) ; ABI version - ;; The rest of the e_ident is padding. - - ;; e_version - (let ((byte-order (if (= (bytevector-u8-ref bv 5) ELFDATA2LSB) - (endianness little) - (endianness big)))) - (= (bytevector-u32-ref bv 20 byte-order) EV_CURRENT)))) - -(define-record-type <elf> - (make-elf bytes word-size byte-order abi type machine-type - entry phoff shoff flags ehsize - phentsize phnum shentsize shnum shstrndx) - elf? - (bytes elf-bytes) - (word-size elf-word-size) - (byte-order elf-byte-order) - (abi elf-abi) - (type elf-type) - (machine-type elf-machine-type) - (entry elf-entry) - (phoff elf-phoff) - (shoff elf-shoff) - (flags elf-flags) - (ehsize elf-ehsize) - (phentsize elf-phentsize) - (phnum elf-phnum) - (shentsize elf-shentsize) - (shnum elf-shnum) - (shstrndx elf-shstrndx)) - -(define* (make-elf* #:key (bytes #f) - (byte-order (target-endianness)) - (word-size (target-word-size)) - (abi ELFOSABI_STANDALONE) - (type ET_DYN) - (machine-type EM_NONE) - (entry 0) - (phoff (elf-header-len word-size)) - (shoff -1) - (flags 0) - (ehsize (elf-header-len word-size)) - (phentsize (elf-program-header-len word-size)) - (phnum 0) - (shentsize (elf-section-header-len word-size)) - (shnum 0) - (shstrndx SHN_UNDEF)) - (make-elf bytes word-size byte-order abi type machine-type - entry phoff shoff flags ehsize - phentsize phnum shentsize shnum shstrndx)) - -(define (parse-elf32 bv byte-order) - (make-elf bv 4 byte-order - (bytevector-u8-ref bv 7) - (bytevector-u16-ref bv 16 byte-order) - (bytevector-u16-ref bv 18 byte-order) - (bytevector-u32-ref bv 24 byte-order) - (bytevector-u32-ref bv 28 byte-order) - (bytevector-u32-ref bv 32 byte-order) - (bytevector-u32-ref bv 36 byte-order) - (bytevector-u16-ref bv 40 byte-order) - (bytevector-u16-ref bv 42 byte-order) - (bytevector-u16-ref bv 44 byte-order) - (bytevector-u16-ref bv 46 byte-order) - (bytevector-u16-ref bv 48 byte-order) - (bytevector-u16-ref bv 50 byte-order))) - -(define (write-elf-ident bv class data abi) - (bytevector-u8-set! bv 0 #x7f) - (bytevector-u8-set! bv 1 (char->integer #\E)) - (bytevector-u8-set! bv 2 (char->integer #\L)) - (bytevector-u8-set! bv 3 (char->integer #\F)) - (bytevector-u8-set! bv 4 class) - (bytevector-u8-set! bv 5 data) - (bytevector-u8-set! bv 6 EV_CURRENT) - (bytevector-u8-set! bv 7 abi) - (bytevector-u8-set! bv 8 0) ; ABI version - (bytevector-u8-set! bv 9 0) ; Pad to 16 bytes. - (bytevector-u8-set! bv 10 0) - (bytevector-u8-set! bv 11 0) - (bytevector-u8-set! bv 12 0) - (bytevector-u8-set! bv 13 0) - (bytevector-u8-set! bv 14 0) - (bytevector-u8-set! bv 15 0)) - -(define (write-elf32-header bv elf) - (let ((byte-order (elf-byte-order elf))) - (write-elf-ident bv ELFCLASS32 - (case byte-order - ((little) ELFDATA2LSB) - ((big) ELFDATA2MSB) - (else (error "unknown endianness" byte-order))) - (elf-abi elf)) - (bytevector-u16-set! bv 16 (elf-type elf) byte-order) - (bytevector-u16-set! bv 18 (elf-machine-type elf) byte-order) - (bytevector-u32-set! bv 20 EV_CURRENT byte-order) - (bytevector-u32-set! bv 24 (elf-entry elf) byte-order) - (bytevector-u32-set! bv 28 (elf-phoff elf) byte-order) - (bytevector-u32-set! bv 32 (elf-shoff elf) byte-order) - (bytevector-u32-set! bv 36 (elf-flags elf) byte-order) - (bytevector-u16-set! bv 40 (elf-ehsize elf) byte-order) - (bytevector-u16-set! bv 42 (elf-phentsize elf) byte-order) - (bytevector-u16-set! bv 44 (elf-phnum elf) byte-order) - (bytevector-u16-set! bv 46 (elf-shentsize elf) byte-order) - (bytevector-u16-set! bv 48 (elf-shnum elf) byte-order) - (bytevector-u16-set! bv 50 (elf-shstrndx elf) byte-order))) - -(define (parse-elf64 bv byte-order) - (make-elf bv 8 byte-order - (bytevector-u8-ref bv 7) - (bytevector-u16-ref bv 16 byte-order) - (bytevector-u16-ref bv 18 byte-order) - (bytevector-u64-ref bv 24 byte-order) - (bytevector-u64-ref bv 32 byte-order) - (bytevector-u64-ref bv 40 byte-order) - (bytevector-u32-ref bv 48 byte-order) - (bytevector-u16-ref bv 52 byte-order) - (bytevector-u16-ref bv 54 byte-order) - (bytevector-u16-ref bv 56 byte-order) - (bytevector-u16-ref bv 58 byte-order) - (bytevector-u16-ref bv 60 byte-order) - (bytevector-u16-ref bv 62 byte-order))) - -(define (write-elf64-header bv elf) - (let ((byte-order (elf-byte-order elf))) - (write-elf-ident bv ELFCLASS64 - (case byte-order - ((little) ELFDATA2LSB) - ((big) ELFDATA2MSB) - (else (error "unknown endianness" byte-order))) - (elf-abi elf)) - (bytevector-u16-set! bv 16 (elf-type elf) byte-order) - (bytevector-u16-set! bv 18 (elf-machine-type elf) byte-order) - (bytevector-u32-set! bv 20 EV_CURRENT byte-order) - (bytevector-u64-set! bv 24 (elf-entry elf) byte-order) - (bytevector-u64-set! bv 32 (elf-phoff elf) byte-order) - (bytevector-u64-set! bv 40 (elf-shoff elf) byte-order) - (bytevector-u32-set! bv 48 (elf-flags elf) byte-order) - (bytevector-u16-set! bv 52 (elf-ehsize elf) byte-order) - (bytevector-u16-set! bv 54 (elf-phentsize elf) byte-order) - (bytevector-u16-set! bv 56 (elf-phnum elf) byte-order) - (bytevector-u16-set! bv 58 (elf-shentsize elf) byte-order) - (bytevector-u16-set! bv 60 (elf-shnum elf) byte-order) - (bytevector-u16-set! bv 62 (elf-shstrndx elf) byte-order))) - -(define (parse-elf bv) - (cond - ((has-elf-header? bv) - (let ((class (bytevector-u8-ref bv 4)) - (byte-order (let ((data (bytevector-u8-ref bv 5))) - (cond - ((= data ELFDATA2LSB) (endianness little)) - ((= data ELFDATA2MSB) (endianness big)) - (else (error "unhandled byte order" data)))))) - (cond - ((= class ELFCLASS32) (parse-elf32 bv byte-order)) - ((= class ELFCLASS64) (parse-elf64 bv byte-order)) - (else (error "unhandled class" class))))) - (else - (error "Invalid ELF" bv)))) - -(define* (write-elf-header bv elf) - ((case (elf-word-size elf) - ((4) write-elf32-header) - ((8) write-elf64-header) - (else (error "unknown word size" (elf-word-size elf)))) - bv elf)) - -;; -;; Segment types -;; -(define PT_NULL 0) ; Program header table entry unused -(define PT_LOAD 1) ; Loadable program segment -(define PT_DYNAMIC 2) ; Dynamic linking information -(define PT_INTERP 3) ; Program interpreter -(define PT_NOTE 4) ; Auxiliary information -(define PT_SHLIB 5) ; Reserved -(define PT_PHDR 6) ; Entry for header table itself -(define PT_TLS 7) ; Thread-local storage segment -(define PT_NUM 8) ; Number of defined types -(define PT_LOOS #x60000000) ; Start of OS-specific -(define PT_GNU_EH_FRAME #x6474e550) ; GCC .eh_frame_hdr segment -(define PT_GNU_STACK #x6474e551) ; Indicates stack executability -(define PT_GNU_RELRO #x6474e552) ; Read-only after relocation - -;; -;; Segment flags -;; -(define PF_X (ash 1 0)) ; Segment is executable -(define PF_W (ash 1 1)) ; Segment is writable -(define PF_R (ash 1 2)) ; Segment is readable - -(define-record-type <elf-segment> - (make-elf-segment index type offset vaddr paddr filesz memsz flags align) - elf-segment? - (index elf-segment-index) - (type elf-segment-type) - (offset elf-segment-offset) - (vaddr elf-segment-vaddr) - (paddr elf-segment-paddr) - (filesz elf-segment-filesz) - (memsz elf-segment-memsz) - (flags elf-segment-flags) - (align elf-segment-align)) - -(define* (make-elf-segment* #:key (index -1) (type PT_LOAD) (offset 0) (vaddr 0) - (paddr 0) (filesz 0) (memsz filesz) - (flags (logior PF_W PF_R)) - (align 8)) - (make-elf-segment index type offset vaddr paddr filesz memsz flags align)) - -;; typedef struct { -;; uint32_t p_type; -;; Elf32_Off p_offset; -;; Elf32_Addr p_vaddr; -;; Elf32_Addr p_paddr; -;; uint32_t p_filesz; -;; uint32_t p_memsz; -;; uint32_t p_flags; -;; uint32_t p_align; -;; } Elf32_Phdr; - -(define (parse-elf32-program-header index bv offset byte-order) - (if (<= (+ offset 32) (bytevector-length bv)) - (make-elf-segment index - (bytevector-u32-ref bv offset byte-order) - (bytevector-u32-ref bv (+ offset 4) byte-order) - (bytevector-u32-ref bv (+ offset 8) byte-order) - (bytevector-u32-ref bv (+ offset 12) byte-order) - (bytevector-u32-ref bv (+ offset 16) byte-order) - (bytevector-u32-ref bv (+ offset 20) byte-order) - (bytevector-u32-ref bv (+ offset 24) byte-order) - (bytevector-u32-ref bv (+ offset 28) byte-order)) - (error "corrupt ELF (offset out of range)" offset))) - -(define (write-elf32-program-header bv offset byte-order seg) - (bytevector-u32-set! bv offset (elf-segment-type seg) byte-order) - (bytevector-u32-set! bv (+ offset 4) (elf-segment-offset seg) byte-order) - (bytevector-u32-set! bv (+ offset 8) (elf-segment-vaddr seg) byte-order) - (bytevector-u32-set! bv (+ offset 12) (elf-segment-paddr seg) byte-order) - (bytevector-u32-set! bv (+ offset 16) (elf-segment-filesz seg) byte-order) - (bytevector-u32-set! bv (+ offset 20) (elf-segment-memsz seg) byte-order) - (bytevector-u32-set! bv (+ offset 24) (elf-segment-flags seg) byte-order) - (bytevector-u32-set! bv (+ offset 28) (elf-segment-align seg) byte-order)) - - -;; typedef struct { -;; uint32_t p_type; -;; uint32_t p_flags; -;; Elf64_Off p_offset; -;; Elf64_Addr p_vaddr; -;; Elf64_Addr p_paddr; -;; uint64_t p_filesz; -;; uint64_t p_memsz; -;; uint64_t p_align; -;; } Elf64_Phdr; - -;; NB: position of `flags' is different! - -(define (parse-elf64-program-header index bv offset byte-order) - (if (<= (+ offset 56) (bytevector-length bv)) - (make-elf-segment index - (bytevector-u32-ref bv offset byte-order) - (bytevector-u64-ref bv (+ offset 8) byte-order) - (bytevector-u64-ref bv (+ offset 16) byte-order) - (bytevector-u64-ref bv (+ offset 24) byte-order) - (bytevector-u64-ref bv (+ offset 32) byte-order) - (bytevector-u64-ref bv (+ offset 40) byte-order) - (bytevector-u32-ref bv (+ offset 4) byte-order) - (bytevector-u64-ref bv (+ offset 48) byte-order)) - (error "corrupt ELF (offset out of range)" offset))) - -(define (write-elf64-program-header bv offset byte-order seg) - (bytevector-u32-set! bv offset (elf-segment-type seg) byte-order) - (bytevector-u64-set! bv (+ offset 8) (elf-segment-offset seg) byte-order) - (bytevector-u64-set! bv (+ offset 16) (elf-segment-vaddr seg) byte-order) - (bytevector-u64-set! bv (+ offset 24) (elf-segment-paddr seg) byte-order) - (bytevector-u64-set! bv (+ offset 32) (elf-segment-filesz seg) byte-order) - (bytevector-u64-set! bv (+ offset 40) (elf-segment-memsz seg) byte-order) - (bytevector-u32-set! bv (+ offset 4) (elf-segment-flags seg) byte-order) - (bytevector-u64-set! bv (+ offset 48) (elf-segment-align seg) byte-order)) - -(define (write-elf-program-header bv offset byte-order word-size seg) - ((case word-size - ((4) write-elf32-program-header) - ((8) write-elf64-program-header) - (else (error "invalid word size" word-size))) - bv offset byte-order seg)) - -(define (elf-program-header-len word-size) - (case word-size - ((4) 32) - ((8) 56) - (else (error "bad word size" word-size)))) - -(define (elf-segment elf n) - (if (not (< -1 n (elf-phnum elf))) - (error "bad segment number" n)) - ((case (elf-word-size elf) - ((4) parse-elf32-program-header) - ((8) parse-elf64-program-header) - (else (error "unhandled pointer size"))) - n - (elf-bytes elf) - (+ (elf-phoff elf) (* n (elf-phentsize elf))) - (elf-byte-order elf))) - -(define (elf-segments elf) - (let lp ((n (elf-phnum elf)) (out '())) - (if (zero? n) - out - (lp (1- n) (cons (elf-segment elf (1- n)) out))))) - -(define-record-type <elf-section> - (make-elf-section index name type flags - addr offset size link info addralign entsize) - elf-section? - (index elf-section-index) - (name elf-section-name) - (type elf-section-type) - (flags elf-section-flags) - (addr elf-section-addr) - (offset elf-section-offset) - (size elf-section-size) - (link elf-section-link) - (info elf-section-info) - (addralign elf-section-addralign) - (entsize elf-section-entsize)) - -(define* (make-elf-section* #:key (index SHN_UNDEF) (name 0) (type SHT_PROGBITS) - (flags SHF_ALLOC) (addr 0) (offset 0) (size 0) - (link 0) (info 0) (addralign 8) (entsize 0)) - (make-elf-section index name type flags addr offset size link info addralign - entsize)) - -;; typedef struct { -;; uint32_t sh_name; -;; uint32_t sh_type; -;; uint32_t sh_flags; -;; Elf32_Addr sh_addr; -;; Elf32_Off sh_offset; -;; uint32_t sh_size; -;; uint32_t sh_link; -;; uint32_t sh_info; -;; uint32_t sh_addralign; -;; uint32_t sh_entsize; -;; } Elf32_Shdr; - -(define (parse-elf32-section-header index bv offset byte-order) - (if (<= (+ offset 40) (bytevector-length bv)) - (make-elf-section index - (bytevector-u32-ref bv offset byte-order) - (bytevector-u32-ref bv (+ offset 4) byte-order) - (bytevector-u32-ref bv (+ offset 8) byte-order) - (bytevector-u32-ref bv (+ offset 12) byte-order) - (bytevector-u32-ref bv (+ offset 16) byte-order) - (bytevector-u32-ref bv (+ offset 20) byte-order) - (bytevector-u32-ref bv (+ offset 24) byte-order) - (bytevector-u32-ref bv (+ offset 28) byte-order) - (bytevector-u32-ref bv (+ offset 32) byte-order) - (bytevector-u32-ref bv (+ offset 36) byte-order)) - (error "corrupt ELF (offset out of range)" offset))) - -(define (write-elf32-section-header bv offset byte-order sec) - (bytevector-u32-set! bv offset (elf-section-name sec) byte-order) - (bytevector-u32-set! bv (+ offset 4) (elf-section-type sec) byte-order) - (bytevector-u32-set! bv (+ offset 8) (elf-section-flags sec) byte-order) - (bytevector-u32-set! bv (+ offset 12) (elf-section-addr sec) byte-order) - (bytevector-u32-set! bv (+ offset 16) (elf-section-offset sec) byte-order) - (bytevector-u32-set! bv (+ offset 20) (elf-section-size sec) byte-order) - (bytevector-u32-set! bv (+ offset 24) (elf-section-link sec) byte-order) - (bytevector-u32-set! bv (+ offset 28) (elf-section-info sec) byte-order) - (bytevector-u32-set! bv (+ offset 32) (elf-section-addralign sec) byte-order) - (bytevector-u32-set! bv (+ offset 36) (elf-section-entsize sec) byte-order)) - - -;; typedef struct { -;; uint32_t sh_name; -;; uint32_t sh_type; -;; uint64_t sh_flags; -;; Elf64_Addr sh_addr; -;; Elf64_Off sh_offset; -;; uint64_t sh_size; -;; uint32_t sh_link; -;; uint32_t sh_info; -;; uint64_t sh_addralign; -;; uint64_t sh_entsize; -;; } Elf64_Shdr; - -(define (elf-section-header-len word-size) - (case word-size - ((4) 40) - ((8) 64) - (else (error "bad word size" word-size)))) - -(define (elf-section-header-addr-offset word-size) - (case word-size - ((4) 12) - ((8) 16) - (else (error "bad word size" word-size)))) - -(define (elf-section-header-offset-offset word-size) - (case word-size - ((4) 16) - ((8) 24) - (else (error "bad word size" word-size)))) - -(define (parse-elf64-section-header index bv offset byte-order) - (if (<= (+ offset 64) (bytevector-length bv)) - (make-elf-section index - (bytevector-u32-ref bv offset byte-order) - (bytevector-u32-ref bv (+ offset 4) byte-order) - (bytevector-u64-ref bv (+ offset 8) byte-order) - (bytevector-u64-ref bv (+ offset 16) byte-order) - (bytevector-u64-ref bv (+ offset 24) byte-order) - (bytevector-u64-ref bv (+ offset 32) byte-order) - (bytevector-u32-ref bv (+ offset 40) byte-order) - (bytevector-u32-ref bv (+ offset 44) byte-order) - (bytevector-u64-ref bv (+ offset 48) byte-order) - (bytevector-u64-ref bv (+ offset 56) byte-order)) - (error "corrupt ELF (offset out of range)" offset))) - -(define (write-elf64-section-header bv offset byte-order sec) - (bytevector-u32-set! bv offset (elf-section-name sec) byte-order) - (bytevector-u32-set! bv (+ offset 4) (elf-section-type sec) byte-order) - (bytevector-u64-set! bv (+ offset 8) (elf-section-flags sec) byte-order) - (bytevector-u64-set! bv (+ offset 16) (elf-section-addr sec) byte-order) - (bytevector-u64-set! bv (+ offset 24) (elf-section-offset sec) byte-order) - (bytevector-u64-set! bv (+ offset 32) (elf-section-size sec) byte-order) - (bytevector-u32-set! bv (+ offset 40) (elf-section-link sec) byte-order) - (bytevector-u32-set! bv (+ offset 44) (elf-section-info sec) byte-order) - (bytevector-u64-set! bv (+ offset 48) (elf-section-addralign sec) byte-order) - (bytevector-u64-set! bv (+ offset 56) (elf-section-entsize sec) byte-order)) - -(define (elf-section elf n) - (if (not (< -1 n (elf-shnum elf))) - (error "bad section number" n)) - ((case (elf-word-size elf) - ((4) parse-elf32-section-header) - ((8) parse-elf64-section-header) - (else (error "unhandled pointer size"))) - n - (elf-bytes elf) - (+ (elf-shoff elf) (* n (elf-shentsize elf))) - (elf-byte-order elf))) - -(define (write-elf-section-header bv offset byte-order word-size sec) - ((case word-size - ((4) write-elf32-section-header) - ((8) write-elf64-section-header) - (else (error "invalid word size" word-size))) - bv offset byte-order sec)) - -(define (elf-sections elf) - (let lp ((n (elf-shnum elf)) (out '())) - (if (zero? n) - out - (lp (1- n) (cons (elf-section elf (1- n)) out))))) - -;; -;; Section Types -;; -(define SHT_NULL 0) ; Section header table entry unused -(define SHT_PROGBITS 1) ; Program data -(define SHT_SYMTAB 2) ; Symbol table -(define SHT_STRTAB 3) ; String table -(define SHT_RELA 4) ; Relocation entries with addends -(define SHT_HASH 5) ; Symbol hash table -(define SHT_DYNAMIC 6) ; Dynamic linking information -(define SHT_NOTE 7) ; Notes -(define SHT_NOBITS 8) ; Program space with no data (bss) -(define SHT_REL 9) ; Relocation entries, no addends -(define SHT_SHLIB 10) ; Reserved -(define SHT_DYNSYM 11) ; Dynamic linker symbol table -(define SHT_INIT_ARRAY 14) ; Array of constructors -(define SHT_FINI_ARRAY 15) ; Array of destructors -(define SHT_PREINIT_ARRAY 16) ; Array of pre-constructors -(define SHT_GROUP 17) ; Section group -(define SHT_SYMTAB_SHNDX 18) ; Extended section indeces -(define SHT_NUM 19) ; Number of defined types. -(define SHT_LOOS #x60000000) ; Start OS-specific. -(define SHT_HIOS #x6fffffff) ; End OS-specific type -(define SHT_LOPROC #x70000000) ; Start of processor-specific -(define SHT_HIPROC #x7fffffff) ; End of processor-specific -(define SHT_LOUSER #x80000000) ; Start of application-specific -(define SHT_HIUSER #x8fffffff) ; End of application-specific - -;; -;; Section Flags -;; -(define SHF_WRITE (ash 1 0)) ; Writable -(define SHF_ALLOC (ash 1 1)) ; Occupies memory during execution -(define SHF_EXECINSTR (ash 1 2)) ; Executable -(define SHF_MERGE (ash 1 4)) ; Might be merged -(define SHF_STRINGS (ash 1 5)) ; Contains nul-terminated strings -(define SHF_INFO_LINK (ash 1 6)) ; `sh_info' contains SHT index -(define SHF_LINK_ORDER (ash 1 7)) ; Preserve order after combining -(define SHF_OS_NONCONFORMING (ash 1 8)) ; Non-standard OS specific handling required -(define SHF_GROUP (ash 1 9)) ; Section is member of a group. -(define SHF_TLS (ash 1 10)) ; Section hold thread-local data. - -;; -;; Dynamic entry types. The DT_GUILE types are non-standard. -;; -(define DT_NULL 0) ; Marks end of dynamic section -(define DT_NEEDED 1) ; Name of needed library -(define DT_PLTRELSZ 2) ; Size in bytes of PLT relocs -(define DT_PLTGOT 3) ; Processor defined value -(define DT_HASH 4) ; Address of symbol hash table -(define DT_STRTAB 5) ; Address of string table -(define DT_SYMTAB 6) ; Address of symbol table -(define DT_RELA 7) ; Address of Rela relocs -(define DT_RELASZ 8) ; Total size of Rela relocs -(define DT_RELAENT 9) ; Size of one Rela reloc -(define DT_STRSZ 10) ; Size of string table -(define DT_SYMENT 11) ; Size of one symbol table entry -(define DT_INIT 12) ; Address of init function -(define DT_FINI 13) ; Address of termination function -(define DT_SONAME 14) ; Name of shared object -(define DT_RPATH 15) ; Library search path (deprecated) -(define DT_SYMBOLIC 16) ; Start symbol search here -(define DT_REL 17) ; Address of Rel relocs -(define DT_RELSZ 18) ; Total size of Rel relocs -(define DT_RELENT 19) ; Size of one Rel reloc -(define DT_PLTREL 20) ; Type of reloc in PLT -(define DT_DEBUG 21) ; For debugging ; unspecified -(define DT_TEXTREL 22) ; Reloc might modify .text -(define DT_JMPREL 23) ; Address of PLT relocs -(define DT_BIND_NOW 24) ; Process relocations of object -(define DT_INIT_ARRAY 25) ; Array with addresses of init fct -(define DT_FINI_ARRAY 26) ; Array with addresses of fini fct -(define DT_INIT_ARRAYSZ 27) ; Size in bytes of DT_INIT_ARRAY -(define DT_FINI_ARRAYSZ 28) ; Size in bytes of DT_FINI_ARRAY -(define DT_RUNPATH 29) ; Library search path -(define DT_FLAGS 30) ; Flags for the object being loaded -(define DT_ENCODING 32) ; Start of encoded range -(define DT_PREINIT_ARRAY 32) ; Array with addresses of preinit fc -(define DT_PREINIT_ARRAYSZ 33) ; size in bytes of DT_PREINIT_ARRAY -(define DT_NUM 34) ; Number used -(define DT_LOGUILE #x37146000) ; Start of Guile-specific -(define DT_GUILE_GC_ROOT #x37146000) ; Offset of GC roots -(define DT_GUILE_GC_ROOT_SZ #x37146001) ; Size in machine words of GC roots -(define DT_GUILE_ENTRY #x37146002) ; Address of entry thunk -(define DT_GUILE_VM_VERSION #x37146003) ; Bytecode version -(define DT_GUILE_FRAME_MAPS #x37146004) ; Offset of .guile.frame-maps -(define DT_HIGUILE #x37146fff) ; End of Guile-specific -(define DT_LOOS #x6000000d) ; Start of OS-specific -(define DT_HIOS #x6ffff000) ; End of OS-specific -(define DT_LOPROC #x70000000) ; Start of processor-specific -(define DT_HIPROC #x7fffffff) ; End of processor-specific - - -(define (string-table-ref bv offset) - (let lp ((end offset)) - (if (zero? (bytevector-u8-ref bv end)) - (let ((out (make-bytevector (- end offset)))) - (bytevector-copy! bv offset out 0 (- end offset)) - (utf8->string out)) - (lp (1+ end))))) - -(define (elf-section-by-name elf name) - (let ((off (elf-section-offset (elf-section elf (elf-shstrndx elf))))) - (let lp ((n (elf-shnum elf))) - (and (> n 0) - (let ((section (elf-section elf (1- n)))) - (if (equal? (string-table-ref (elf-bytes elf) - (+ off (elf-section-name section))) - name) - section - (lp (1- n)))))))) - -(define (elf-sections-by-name elf) - (let* ((sections (elf-sections elf)) - (off (elf-section-offset (list-ref sections (elf-shstrndx elf))))) - (map (lambda (section) - (cons (string-table-ref (elf-bytes elf) - (+ off (elf-section-name section))) - section)) - sections))) - -(define-record-type <elf-symbol> - (make-elf-symbol name value size info other shndx) - elf-symbol? - (name elf-symbol-name) - (value elf-symbol-value) - (size elf-symbol-size) - (info elf-symbol-info) - (other elf-symbol-other) - (shndx elf-symbol-shndx)) - -(define* (make-elf-symbol* #:key (name 0) (value 0) (size 0) - (binding STB_LOCAL) (type STT_NOTYPE) - (info (logior (ash binding 4) type)) - (visibility STV_DEFAULT) (other visibility) - (shndx SHN_UNDEF)) - (make-elf-symbol name value size info other shndx)) - -;; typedef struct { -;; uint32_t st_name; -;; Elf32_Addr st_value; -;; uint32_t st_size; -;; unsigned char st_info; -;; unsigned char st_other; -;; uint16_t st_shndx; -;; } Elf32_Sym; - -(define (elf-symbol-len word-size) - (case word-size - ((4) 16) - ((8) 24) - (else (error "bad word size" word-size)))) - -(define (elf-symbol-value-offset word-size) - (case word-size - ((4) 4) - ((8) 8) - (else (error "bad word size" word-size)))) - -(define (parse-elf32-symbol bv offset stroff byte-order) - (if (<= (+ offset 16) (bytevector-length bv)) - (make-elf-symbol (let ((name (bytevector-u32-ref bv offset byte-order))) - (if stroff - (string-table-ref bv (+ stroff name)) - name)) - (bytevector-u32-ref bv (+ offset 4) byte-order) - (bytevector-u32-ref bv (+ offset 8) byte-order) - (bytevector-u8-ref bv (+ offset 12)) - (bytevector-u8-ref bv (+ offset 13)) - (bytevector-u16-ref bv (+ offset 14) byte-order)) - (error "corrupt ELF (offset out of range)" offset))) - -(define (write-elf32-symbol bv offset byte-order sym) - (bytevector-u32-set! bv offset (elf-symbol-name sym) byte-order) - (bytevector-u32-set! bv (+ offset 4) (elf-symbol-value sym) byte-order) - (bytevector-u32-set! bv (+ offset 8) (elf-symbol-size sym) byte-order) - (bytevector-u8-set! bv (+ offset 12) (elf-symbol-info sym)) - (bytevector-u8-set! bv (+ offset 13) (elf-symbol-other sym)) - (bytevector-u16-set! bv (+ offset 14) (elf-symbol-shndx sym) byte-order)) - -;; typedef struct { -;; uint32_t st_name; -;; unsigned char st_info; -;; unsigned char st_other; -;; uint16_t st_shndx; -;; Elf64_Addr st_value; -;; uint64_t st_size; -;; } Elf64_Sym; - -(define (parse-elf64-symbol bv offset stroff byte-order) - (if (<= (+ offset 24) (bytevector-length bv)) - (make-elf-symbol (let ((name (bytevector-u32-ref bv offset byte-order))) - (if stroff - (string-table-ref bv (+ stroff name)) - name)) - (bytevector-u64-ref bv (+ offset 8) byte-order) - (bytevector-u64-ref bv (+ offset 16) byte-order) - (bytevector-u8-ref bv (+ offset 4)) - (bytevector-u8-ref bv (+ offset 5)) - (bytevector-u16-ref bv (+ offset 6) byte-order)) - (error "corrupt ELF (offset out of range)" offset))) - -(define (write-elf64-symbol bv offset byte-order sym) - (bytevector-u32-set! bv offset (elf-symbol-name sym) byte-order) - (bytevector-u8-set! bv (+ offset 4) (elf-symbol-info sym)) - (bytevector-u8-set! bv (+ offset 5) (elf-symbol-other sym)) - (bytevector-u16-set! bv (+ offset 6) (elf-symbol-shndx sym) byte-order) - (bytevector-u64-set! bv (+ offset 8) (elf-symbol-value sym) byte-order) - (bytevector-u64-set! bv (+ offset 16) (elf-symbol-size sym) byte-order)) - -(define (write-elf-symbol bv offset byte-order word-size sym) - ((case word-size - ((4) write-elf32-symbol) - ((8) write-elf64-symbol) - (else (error "invalid word size" word-size))) - bv offset byte-order sym)) - -(define (elf-symbol-table-len section) - (let ((len (elf-section-size section)) - (entsize (elf-section-entsize section))) - (unless (and (not (zero? entsize)) (zero? (modulo len entsize))) - (error "bad symbol table" section)) - (/ len entsize))) - -(define* (elf-symbol-table-ref elf section n #:optional strtab) - (let ((bv (elf-bytes elf)) - (byte-order (elf-byte-order elf)) - (stroff (and strtab (elf-section-offset strtab))) - (base (elf-section-offset section)) - (len (elf-section-size section)) - (entsize (elf-section-entsize section))) - (unless (<= (* (1+ n) entsize) len) - (error "out of range symbol table access" section n)) - (case (elf-word-size elf) - ((4) - (unless (<= 16 entsize) - (error "bad entsize for symbol table" section)) - (parse-elf32-symbol bv (+ base (* n entsize)) stroff byte-order)) - ((8) - (unless (<= 24 entsize) - (error "bad entsize for symbol table" section)) - (parse-elf64-symbol bv (+ base (* n entsize)) stroff byte-order)) - (else (error "bad word size" elf))))) - -;; Legal values for ST_BIND subfield of st_info (symbol binding). - -(define STB_LOCAL 0) ; Local symbol -(define STB_GLOBAL 1) ; Global symbol -(define STB_WEAK 2) ; Weak symbol -(define STB_NUM 3) ; Number of defined types. -(define STB_LOOS 10) ; Start of OS-specific -(define STB_GNU_UNIQUE 10) ; Unique symbol. -(define STB_HIOS 12) ; End of OS-specific -(define STB_LOPROC 13) ; Start of processor-specific -(define STB_HIPROC 15) ; End of processor-specific - -;; Legal values for ST_TYPE subfield of st_info (symbol type). - -(define STT_NOTYPE 0) ; Symbol type is unspecified -(define STT_OBJECT 1) ; Symbol is a data object -(define STT_FUNC 2) ; Symbol is a code object -(define STT_SECTION 3) ; Symbol associated with a section -(define STT_FILE 4) ; Symbol's name is file name -(define STT_COMMON 5) ; Symbol is a common data object -(define STT_TLS 6) ; Symbol is thread-local data objec -(define STT_NUM 7) ; Number of defined types. -(define STT_LOOS 10) ; Start of OS-specific -(define STT_GNU_IFUNC 10) ; Symbol is indirect code object -(define STT_HIOS 12) ; End of OS-specific -(define STT_LOPROC 13) ; Start of processor-specific -(define STT_HIPROC 15) ; End of processor-specific - -;; Symbol visibility specification encoded in the st_other field. - -(define STV_DEFAULT 0) ; Default symbol visibility rules -(define STV_INTERNAL 1) ; Processor specific hidden class -(define STV_HIDDEN 2) ; Sym unavailable in other modules -(define STV_PROTECTED 3) ; Not preemptible, not exported - -(define (elf-symbol-binding sym) - (ash (elf-symbol-info sym) -4)) - -(define (elf-symbol-type sym) - (logand (elf-symbol-info sym) #xf)) - -(define (elf-symbol-visibility sym) - (logand (elf-symbol-other sym) #x3)) - -(define NT_GNU_ABI_TAG 1) -(define NT_GNU_HWCAP 2) -(define NT_GNU_BUILD_ID 3) -(define NT_GNU_GOLD_VERSION 4) - -(define-record-type <elf-note> - (make-elf-note name desc type) - elf-note? - (name elf-note-name) - (desc elf-note-desc) - (type elf-note-type)) - -(define (parse-elf-note elf section) - (let ((bv (elf-bytes elf)) - (byte-order (elf-byte-order elf)) - (offset (elf-section-offset section))) - (unless (<= (+ offset 12) (bytevector-length bv)) - (error "corrupt ELF (offset out of range)" offset)) - (let ((namesz (bytevector-u32-ref bv offset byte-order)) - (descsz (bytevector-u32-ref bv (+ offset 4) byte-order)) - (type (bytevector-u32-ref bv (+ offset 8) byte-order))) - (unless (<= (+ offset 12 namesz descsz) (bytevector-length bv)) - (error "corrupt ELF (offset out of range)" offset)) - (let ((name (make-bytevector (1- namesz))) - (desc (make-bytevector descsz))) - (bytevector-copy! bv (+ offset 12) name 0 (1- namesz)) - (bytevector-copy! bv (+ offset 12 namesz) desc 0 descsz) - (make-elf-note (utf8->string name) desc type))))) diff --git a/guix/grafts.scm b/guix/grafts.scm index 77297fe07e..b3abbca25f 100644 --- a/guix/grafts.scm +++ b/guix/grafts.scm @@ -118,12 +118,12 @@ are not recursively applied to dependencies of DRV." (define build (with-imported-modules '((guix build graft) (guix build utils) - (guix build debug-link) - (guix elf)) + (guix build debug-link)) #~(begin (use-modules (guix build graft) (guix build utils) - (ice-9 match)) + (ice-9 match) + (system vm elf)) (define %outputs (ungexp (outputs->gexp outputs))) diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index 432e846bf4..f738be2ddd 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -1224,20 +1224,19 @@ libfakechroot.so and related ld.so machinery as a fallback." '((guix build io) (guix build utils) (guix build union) - (guix build gremlin) - (guix elf))) + (guix build gremlin))) #~(begin (use-modules (guix build io) (guix build utils) ((guix build union) #:select (symlink-relative)) - (guix elf) (guix build gremlin) (ice-9 binary-ports) (ice-9 ftw) (ice-9 match) (ice-9 receive) (srfi srfi-1) - (rnrs bytevectors)) + (rnrs bytevectors) + (system vm elf)) (define input ;; The OUTPUT* output of PACKAGE. diff --git a/tests/debug-link.scm b/tests/debug-link.scm index 7ccc054a5d..1ba40cdd4f 100644 --- a/tests/debug-link.scm +++ b/tests/debug-link.scm @@ -18,7 +18,6 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (test-debug-link) - #:use-module (guix elf) #:use-module (guix build utils) #:use-module (guix build debug-link) #:use-module (guix build io) @@ -33,6 +32,7 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-64) + #:use-module (system vm elf) #:use-module (rnrs io ports) #:use-module (ice-9 match)) @@ -69,13 +69,12 @@ (exp (with-imported-modules (source-module-closure '((guix build io) (guix build utils) - (guix build debug-link) - (guix elf))) + (guix build debug-link))) #~(begin (use-modules (guix build io) (guix build utils) (guix build debug-link) - (guix elf) + (system vm elf) (rnrs io ports)) (define read-elf @@ -115,13 +114,12 @@ (exp (with-imported-modules (source-module-closure '((guix build io) (guix build utils) - (guix build debug-link) - (guix elf))) + (guix build debug-link))) #~(begin (use-modules (guix build io) (guix build utils) (guix build debug-link) - (guix elf) + (system vm elf) (rnrs io ports)) (define read-elf diff --git a/tests/gremlin.scm b/tests/gremlin.scm index 44237e2ad3..34cab5e567 100644 --- a/tests/gremlin.scm +++ b/tests/gremlin.scm @@ -19,7 +19,6 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (test-gremlin) - #:use-module (guix elf) #:use-module (guix tests) #:use-module ((guix utils) #:select (call-with-temporary-directory target-aarch64?)) @@ -31,6 +30,7 @@ #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-64) + #:use-module (system vm elf) #:use-module (rnrs io ports) #:use-module (ice-9 popen) #:use-module (ice-9 rdelim)
