From d24c44edbea7f775be65d5739e8b416faded063d Mon Sep 17 00:00:00 2001
From: gerd <gerd>
Date: Thu, 21 Aug 2003 15:26:36 +0000
Subject: [PATCH] Lisp executable support.  From Fred Gilham.

---
 lisp/Config.FreeBSD_gencgc |   2 +-
 lisp/Config.linux_gencgc   |   2 +-
 lisp/elf.c                 | 153 +++++++++++++++++++++++++++++++++++++
 lisp/lisp.c                |  37 +++++----
 lisp/validate.c            |  14 ++--
 5 files changed, 185 insertions(+), 23 deletions(-)
 create mode 100644 lisp/elf.c

diff --git a/lisp/Config.FreeBSD_gencgc b/lisp/Config.FreeBSD_gencgc
index 80ba7eb13..01ca672d8 100644
--- a/lisp/Config.FreeBSD_gencgc
+++ b/lisp/Config.FreeBSD_gencgc
@@ -13,7 +13,7 @@ NM = nm -gp
 UNDEFSYMPATTERN = -Xlinker -u -Xlinker &
 ASSEM_SRC = x86-assem.S
 ARCH_SRC = x86-arch.c
-OS_SRC = FreeBSD-os.c os-common.c
+OS_SRC = FreeBSD-os.c os-common.c elf.c
 OS_LINK_FLAGS = -dynamic -export-dynamic
 OS_LIBS =
 GC_SRC = gencgc.c
diff --git a/lisp/Config.linux_gencgc b/lisp/Config.linux_gencgc
index 2d6df1aed..dd5253de0 100644
--- a/lisp/Config.linux_gencgc
+++ b/lisp/Config.linux_gencgc
@@ -13,7 +13,7 @@ NM = $(PATH1)/linux-nm
 UNDEFSYMPATTERN = -Xlinker -u -Xlinker &
 ASSEM_SRC = x86-assem.S linux-stubs.S
 ARCH_SRC = x86-arch.c
-OS_SRC = Linux-os.c os-common.c
+OS_SRC = Linux-os.c os-common.c elf.c
 OS_LINK_FLAGS = -rdynamic -Xlinker --export-dynamic -Xlinker -Map -Xlinker foo
 OS_LIBS = -ldl
 GC_SRC = gencgc.c
diff --git a/lisp/elf.c b/lisp/elf.c
new file mode 100644
index 000000000..823acdacd
--- /dev/null
+++ b/lisp/elf.c
@@ -0,0 +1,153 @@
+/*
+
+ This code was written by Fred Gilham, and has been placed in the
+ public domain.  It is provided "as-is" and without warantee of any
+ kind.
+
+*/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <fcntl.h>
+#include <sys/stat.h>
+#include <sys/types.h>
+#include <sys/uio.h>
+#include <unistd.h>
+#include <sys/mman.h>
+#include <elf.h>
+
+#include "os.h"
+
+
+static char elf_magic_string[] = {ELFMAG0, ELFMAG1, ELFMAG2, ELFMAG3};
+
+/* Note: FreeBSD has nice macros that let you use Elf_Ehdr
+   etc. declarations; unfortunately Linux doesn't have this so you
+   have to do Elf32_Ehdr etc.  Bad for moving to 64 bits.... */
+#ifdef __linux__
+typedef Elf32_Ehdr Elf_Ehdr;
+typedef Elf32_Shdr Elf_Shdr;
+#endif
+
+static Elf_Ehdr eh;
+
+/* Names of the Lisp image ELF sections.  These names must be the same
+   as the corresponding names found in the linker script and the
+   process-core utility. */
+static char *core_section_names[] = {"CORDYN", "CORSTA", "CORRO"};
+
+
+static void
+eread(int d, void *buf, size_t nbytes, const char *func)
+{
+  int res = read(d, buf, nbytes);
+
+  if (res == -1) {
+    perror(func);
+    exit(-1);
+  }
+
+  if (res < nbytes) {
+    fprintf(stderr, "Short read in %s!\n", func);
+    exit(-1);
+  }
+}
+
+static void
+elseek(int d, off_t o, const char *func)
+{
+  if (lseek(d, o, SEEK_SET) == -1) {
+    perror(func);
+    exit(-1);
+  }
+}
+
+
+/* Read the ELF header from a file descriptor and stuff it into a
+   structure.  Make sure it is really an elf header etc. */
+static void
+read_elf_header(int fd, Elf_Ehdr *ehp)
+{
+  eread(fd, ehp, sizeof(Elf_Ehdr), __FUNCTION__);
+
+  if (strncmp(ehp->e_ident, elf_magic_string, 4)) {
+    fprintf(stderr, "Bad ELF magic number --- not an elf file.  Exiting in %s.\n", __FUNCTION__);
+    exit(-1);
+  }
+}
+
+
+static void
+read_section_header_entry(int fd, Elf_Shdr *shp)
+{
+  eread(fd, shp, eh.e_shentsize, __FUNCTION__);
+}
+
+
+/*
+  Map the built-in lisp core sections. 
+
+  NOTE!  We need to do this without using malloc because the memory
+  layout is not set until some time after this is done.
+*/
+void
+map_core_sections(char *exec_name)
+{
+  int exec_fd;
+  Elf_Shdr sh;        /* A section header entry. */
+  Elf_Shdr strsecent;
+  char nambuf[10];
+  int soff;
+  int strsecoff;      /* File offset to string table section. */
+  int sections_remaining = 3;
+  int i, j;
+
+  if (!(exec_fd = open(exec_name, O_RDONLY))) {
+    perror("Can't open executable!");
+    exit(-1);
+  }
+
+  read_elf_header(exec_fd, &eh);
+
+  /* Find the section name string section.  Save its file offset. */
+  soff = eh.e_shoff + eh.e_shstrndx * eh.e_shentsize;
+  elseek(exec_fd, soff, __FUNCTION__);
+  read_section_header_entry(exec_fd, &strsecent);
+  strsecoff = strsecent.sh_offset;
+
+  for (i = 0; i < eh.e_shnum && sections_remaining > 0; i++) {
+
+    /* Read an entry from the section header table. */
+    elseek(exec_fd, eh.e_shoff + i * eh.e_shentsize, __FUNCTION__);
+    read_section_header_entry(exec_fd, &sh);
+
+    /* Read the name from the string section. */
+    elseek(exec_fd, strsecoff + sh.sh_name, __FUNCTION__);
+    eread(exec_fd, nambuf, 6, __FUNCTION__);
+
+    if (sh.sh_type == SHT_PROGBITS) {
+      /* See if this section is one of the lisp core sections. */
+      for (j = 0; j < 3; j++) {
+	if (!strncmp(nambuf, core_section_names[j], 6)) {
+	  /* Found a core section. Map it! */
+	  if (os_map(exec_fd, sh.sh_offset, (os_vm_address_t)sh.sh_addr, sh.sh_size) == -1) {
+	    fprintf("Can't map section %s\n", core_section_names[j]);
+	    exit(-1);
+	  }
+	  sections_remaining--;
+	  /* Found a core section, don't check the other core section names. */
+	  break;
+	}
+      }
+    }
+  }
+
+  close(exec_fd);
+
+  if (sections_remaining != 0) {
+    fprintf(stderr, "Couldn't map all core sections!  Exiting!\n");
+    exit(-1);
+  }
+}
+
diff --git a/lisp/lisp.c b/lisp/lisp.c
index e3df333a5..af05379ba 100644
--- a/lisp/lisp.c
+++ b/lisp/lisp.c
@@ -1,7 +1,7 @@
 /*
  * main() entry point for a stand alone lisp image.
  *
- * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/lisp.c,v 1.35 2003/08/18 20:48:38 toy Exp $
+ * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/lisp.c,v 1.36 2003/08/21 15:26:36 gerd Exp $
  *
  */
 
@@ -356,15 +356,22 @@ prepend_core_path(char* lib, char* corefile)
 }
 
 
-/* The symbol initial_function_addr is used globally as a flag to
-   indicate whether the executable contains the lisp image.  The
-   reason for this is that we use the linker to set the value of the
-   symbol.  But the symbol is an address, not a variable value.  So
-   for this to work as a flag, it must end up pointing to a valid
-   place in memory or we'll get a bus error or segmentation violation
-   when we check it.  The initial function address will be a valid
-   place in memory (or else we have worse problems).  FMG */
-
+/*
+  The symbol builtin_image_flag is used globally as a flag to indicate
+  whether the executable contains the lisp image.  Note that we use
+  the linker to set the value of the symbol.  But the symbol is an
+  address, not a variable value.  So for this to work as a flag, it
+  must end up pointing to a valid place in memory or we'll get a bus
+  error or segmentation violation when we check it.  If the lisp image
+  is built in, we'll set this symbol to point to the beginning of the
+  process.
+
+  We also use the linker to set initial_function_addr so that if the
+  lisp core is built in, taking the address of initial_function_addr
+  will give the address of the initial function.
+*/
+
+int builtin_image_flag = 0;
 int initial_function_addr = 0;
 
 /* And here be main. */
@@ -380,7 +387,7 @@ int main(int argc, char *argv[], char *envp[])
     boolean monitor;
     lispobj initial_function = 0;
 
-    if (initial_function_addr != 0)
+    if (builtin_image_flag != 0)
       initial_function = &initial_function_addr;
 
 #if defined(SVR4) || defined(__linux__)
@@ -402,7 +409,7 @@ int main(int argc, char *argv[], char *envp[])
       {
         if (strcmp(arg, "-core") == 0)
 	  {
-	    if (initial_function_addr) {
+	    if (builtin_image_flag) {
 	      fprintf(stderr, "Cannot specify core file in executable image --- sorry about that.\n");
 	      exit(1);
 	    }	      
@@ -454,6 +461,8 @@ int main(int argc, char *argv[], char *envp[])
 	default_core = "lisp.core";
 
     os_init();
+    if (builtin_image_flag != 0)
+      map_core_sections(argv[0]);
     validate();
     gc_init();
 
@@ -526,7 +535,7 @@ int main(int argc, char *argv[], char *envp[])
 
 
     /* Only look for a core file if we're not using a built-in image.*/
-    if (initial_function_addr == 0) {
+    if (builtin_image_flag == 0) {
       /*
        * If no core file specified, search for it in CMUCLLIB
        */
@@ -562,7 +571,7 @@ int main(int argc, char *argv[], char *envp[])
 
     globals_init();
 
-    if(initial_function_addr != 0) {
+    if(builtin_image_flag != 0) {
       extern int image_dynamic_space_size;
       int allocation_pointer = dynamic_0_space + (int)&image_dynamic_space_size;
 #ifdef i386
diff --git a/lisp/validate.c b/lisp/validate.c
index 28d6e026b..6e31f8dbd 100644
--- a/lisp/validate.c
+++ b/lisp/validate.c
@@ -1,5 +1,5 @@
 /*
- * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/validate.c,v 1.14 2003/08/12 16:41:40 gerd Exp $
+ * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/validate.c,v 1.15 2003/08/21 15:26:36 gerd Exp $
  *
  * Memory Validation
  */
@@ -27,9 +27,9 @@ ensure_space(lispobj *start, size_t size)
 
 /* We use the linker symbol redefinition trick here to get the dynamic
    space size when the core is built in to the executable.  Note that
-   initial_function_addr is used as a flag indicating that the lisp image
+   builtin_image_flag is used as a flag indicating that the lisp image
    is built into the executable.  FMG */
-extern int initial_function_addr;
+extern int builtin_image_flag;
 int image_dynamic_space_size = 0;
 
 void
@@ -40,26 +40,26 @@ validate(void)
     /* Note: XXX use alloca here because it's not malloc.  I'm assuming
      that anyone who wants to make this scheme work this will be using
      GCC.  FMG */
-    if (initial_function_addr != 0)
+    if (builtin_image_flag != 0)
       dynamic_space_data = alloca((int)(&image_dynamic_space_size));
 
     /* Read-Only Space */
     read_only_space = (lispobj *) READ_ONLY_SPACE_START;
     /* Don't try to map this space if the executable contains the
        image. */
-    if (initial_function_addr == 0)
+    if (builtin_image_flag == 0)
       ensure_space(read_only_space, READ_ONLY_SPACE_SIZE);
 
     /* Static Space */
     static_space = (lispobj *) STATIC_SPACE_START;
     /* Don't try to map this space if the executable contains the
        image. */
-    if (initial_function_addr == 0)
+    if (builtin_image_flag == 0)
       ensure_space(static_space, STATIC_SPACE_SIZE);
 
     /* Dynamic-0 Space */
     dynamic_0_space = (lispobj *) DYNAMIC_0_SPACE_START;
-    if (initial_function_addr != 0) {
+    if (builtin_image_flag != 0) {
       /* If the executable contains the lisp image, we want to copy the
 	 data in the dynamic space out of its segment, then map the
 	 dynamic space (which has the side effect of unmapping the
-- 
GitLab