shithub: femtolisp

--- a/.gitignore

+++ b/.gitignore

@@ -9,3 +9,4 @@

 /llt/*.a

 /flisp.boot.bak

 /flisp.boot.new

+boot.h

--- a/Makefile

+++ b/Makefile

@@ -35,7 +35,10 @@

 	${CC} -o $@ -c $< ${CFLAGS} -Iposix -Illt

 flisp.o:  flisp.c cvalues.c operators.c types.c flisp.h print.c read.c equal.c

-flmain.o: flmain.c flisp.h

+flmain.o: flmain.c boot.h flisp.h

+boot.h: flisp.boot

+	sed 's,\\,\\\\,g;s,",\\",g;s,^,",g;s,$$,\\n",g' flisp.boot >$@

 ${LLT}:

 	${MAKE} -C llt CFLAGS="${CFLAGS} -I../posix" CC="${CC}"

--- a/builtins.c

+++ b/builtins.c

@@ -336,11 +336,11 @@

         argcount("path.cwd", nargs, 1);

     if (nargs == 0) {

         char buf[1024];

-        get_cwd(buf, sizeof(buf));

+        getcwd(buf, sizeof(buf));

         return string_from_cstr(buf);

     char *ptr = tostring(args[0], "path.cwd");

-    if (set_cwd(ptr))

+    if (chdir(ptr))

         lerrorf(IOError, "path.cwd: could not cd to %s", ptr);

     return FL_T;

--- a/flisp.c

+++ b/flisp.c

@@ -2281,27 +2281,6 @@

     cvalues_init();

-#if defined(__plan9__)

-    char *s, *e;

-    if ((s = strstr(argv0, ".out")) != nil && s[4] == 0){

-        if((e = strrchr(argv0, '/')) != nil)

-            *e = 0;

-        s = strdup(argv0);

-        if(e != nil)

-            *e = '/';

-    }else{

-        s = "/sys/lib/flisp";

-    }

-    setc(symbol("*install-dir*"), cvalue_static_cstring(s));

-#else

-    char buf[1024];

-    char *exename = get_exename(buf, sizeof(buf));

-    if (exename != NULL) {

-        path_to_dirname(exename);

-        setc(symbol("*install-dir*"), cvalue_static_cstring(strdup(exename)));

-    }

-#endif

     memory_exception_value = fl_list2(MemoryError,

                                       cvalue_static_cstring("out of memory"));

--- a/flmain.c

+++ b/flmain.c

@@ -15,13 +15,16 @@

     return lst;

-extern value_t fl_file(value_t *args, uint32_t nargs);

+extern fltype_t *iostreamtype;

int

 main(int argc, char **argv)

-    char fname_buf[1024];

-    value_t args[2];

+    static char bootraw[] = {

+#include "boot.h"

+    };

+    value_t f;

+    ios_t *s;

     int r;

 #if defined(__plan9__)

@@ -32,20 +35,12 @@

     fl_init(512*1024);

-    value_t str = symbol_value(symbol("*install-dir*"));

-    char *exedir = (str == UNBOUND ? NULL : cvalue_data(str));

-    snprintf(fname_buf, sizeof(fname_buf), "%s%sflisp.boot",

-        exedir ? exedir : "",

-        exedir ? PATHSEPSTRING : "");

+    f = cvalue(iostreamtype, sizeof(ios_t));

+    s = value2c(ios_t*, f);

+    ios_static_buffer(s, bootraw, sizeof(bootraw));

-    fl_gc_handle(&args[0]);

-    fl_gc_handle(&args[1]);

     r = 1;

     FL_TRY_EXTERN {

-        args[0] = cvalue_static_cstring(fname_buf);

-        args[1] = symbol(":read");

-        value_t f = fl_file(&args[0], 2);

-        fl_free_gc_handles(2);

         if (fl_load_system_image(f) == 0){

             fl_applyn(1, symbol_value(symbol("__start")),

                       argv_list(argc, argv));

--- a/llt/Makefile

+++ b/llt/Makefile

@@ -4,7 +4,6 @@

 OBJS=\

 	bitvector-ops.o\

 	bitvector.o\

-	dirpath.o\

 	dump.o\

 	hashing.o\

 	htable.o\

--- a/llt/dirpath.c

+++ /dev/null

@@ -1,184 +1,0 @@

-#include "platform.h"

-void get_cwd(char *buf, size_t size)

-{

-    getcwd(buf, size);

-}

-int set_cwd(char *buf)

-{

-    return chdir(buf);

-}

-// destructively convert path to directory part

-void path_to_dirname(char *path)

-{

-    char *sep = strrchr(path, PATHSEP);

-    if (sep != NULL) {

-        *sep = '\0';

-    }

-    else {

-        path[0] = '\0';

-    }

-}

-#ifdef __plan9__

-char *get_exename(char *buf, size_t size)

-{

-    snprint(buf, size, argv0);

-    return buf;

-}

-#elif defined(__linux__)

-char *get_exename(char *buf, size_t size)

-{

-    char linkname[64]; /* /proc/<pid>/exe */

-    pid_t pid;

-    ssize_t ret;

-    /* Get our PID and build the name of the link in /proc */

-    pid = getpid();

-    if (snprintf(linkname, sizeof(linkname), "/proc/%i/exe", pid) < 0)

-        return NULL;

-    /* Now read the symbolic link */

-    ret = readlink(linkname, buf, size);

-    /* In case of an error, leave the handling up to the caller */

-    if (ret == -1)

-        return NULL;

-    /* Report insufficient buffer size */

-    if ((size_t)ret >= size)

-        return NULL;

-    /* Ensure proper NUL termination */

-    buf[ret] = 0;

-    return buf;

-}

-#elif defined(__OpenBSD__)

-#include <sys/param.h>

-#include <sys/sysctl.h>

-char *get_exename(char *buf, size_t size)

-{

-    int mib[4];

-    pid_t pid;

-    size_t len, plen;

-    char  **argv, **argv2;

-    char *p, *path, *pathcpy, filename[PATH_MAX];

-    struct stat sbuf;

-    pid = getpid();

-    mib[0] = CTL_KERN;

-    mib[1] = KERN_PROC_ARGS;

-    mib[2] = pid;

-    mib[3] = KERN_PROC_ARGV;

-    USED(size);

-    buf = NULL;

-    argv = NULL;

-    len = 128;

-    // Now, play The Guessing Game with sysctl(3) as to how big argv

-    // is supposed to be. (It's loads of fun for the whole family!)

-    while (len < SIZE_MAX / 2) {

-        len *= 2;

-        if ((argv2 = realloc(argv, len)) == NULL)

-            break;

-        argv = argv2;

-        if (sysctl(mib, 4, argv, &len, NULL, 0) == -1) {

-            if (errno == ENOMEM)

-                continue; // Go back and realloc more memory.

-            break; // Bail for some other error in sysctl(3).

-        }

-        // If you made it here, congrats! You guessed right!

-        if (*argv != NULL)

-            buf = strdup(*argv);

-        break;

-    }

-    free(argv);

-    // If no error occurred in the sysctl(3) KERN_PROC_ARGV call

-    // above, then buf at this point contains some kind of pathname.

-    if (buf != NULL) {

-	if (strchr(buf, '/') == NULL) {

-	    // buf contains a `basename`-style pathname (i.e. "foo",

-	    // as opposed to "../foo" or "/usr/bin/foo"); search the

-	    // PATH for its location. (BTW the setgid(2), setuid(2)

-	    // calls are a pre-condition for the access(2) call

-	    // later.)

-	    if ( (path = getenv("PATH")) != NULL &&

-		 !setgid(getegid()) && !setuid(geteuid()) ) {

-		// The strdup(3) call below, if successful, will

-		// allocate memory for the PATH string returned by

-		// getenv(3) above.  This is necessary because the man

-		// page of getenv(3) says that its return value

-		// "should be considered read-only"; however, the

-		// strsep(3) call below is going to be destructively

-		// modifying that value. ("Hulk smash!")

-		if ((path = strdup(path)) != NULL) {

-		    pathcpy = path;

-		    len = strlen(buf);

-		    while ((p = strsep(&pathcpy, ":")) != NULL) {

-			if (*p == '\0') p = ".";

-			plen = strlen(p);

-			// strip trailing '/'

-			while (p[plen-1] == '/') p[--plen] = '\0';

-			if (plen + 1 + len < sizeof(filename)) {

-			    snprintf(filename, sizeof(filename), "%s/%s", p, buf);

-			    if ( (stat(filename, &sbuf) == 0) &&

-				 S_ISREG(sbuf.st_mode) &&

-				 access(filename, X_OK) == 0 ) {

-				buf = strdup(filename);

-				break;

-			    }

-			}

-		    }

-		    free(path); // free the strdup(3) memory allocation.

-		}

-	    }

-	    else buf = NULL; // call to getenv(3) or [sg]ete?[ug]id(2) failed.

-	}

-	if ( buf != NULL && *buf != '/' ) {

-	    // buf contains a relative pathname (e.g. "../foo");

-	    // resolve this to an absolute pathname.

-	    if ( strlcpy(filename, buf, sizeof(filename)) >= sizeof(filename) ||

-		 realpath(filename, buf) == NULL )

-		buf = NULL;

-	}

-    }

-    return buf;

-}

-#elif defined(__FreeBSD__) || defined(__NetBSD__)

-#include <sys/types.h>

-#include <sys/sysctl.h>

-char *get_exename(char *buf, size_t size)

-{

-  int mib[4];

-  mib[0] = CTL_KERN;

-#if defined(__FreeBSD__)

-  mib[1] = KERN_PROC;

-  mib[2] = KERN_PROC_PATHNAME;

-  mib[3] = -1;

-#else

-  mib[1] = KERN_PROC_ARGS;

-  mib[2] = -1;

-  mib[3] = KERN_PROC_PATHNAME;

-#endif

-  sysctl(mib, 4, buf, &size, NULL, 0);

-  return buf;

-}

-#endif

--- a/llt/llt.h

+++ b/llt/llt.h

@@ -82,12 +82,6 @@

 uint64_t memhash(const char* buf, size_t n);

 uint32_t memhash32(const char* buf, size_t n);

-/* dirpath.c */

-void get_cwd(char *buf, size_t size);

-int set_cwd(char *buf);

-char *get_exename(char *buf, size_t size);

-void path_to_dirname(char *path);

 /* random.c */

 #define random() genrand_int32()

 #define srandom(n) init_genrand(n)

--- a/llt/mkfile

+++ b/llt/mkfile

@@ -6,7 +6,6 @@

 OFILES=\

 	bitvector-ops.$O\

 	bitvector.$O\

-	dirpath.$O\

 	dump.$O\

 	hashing.$O\

 	htable.$O\

--- a/mkfile

+++ b/mkfile

@@ -3,6 +3,7 @@

 BIN=/$objtype/bin

 TARG=flisp

 CFLAGS=$CFLAGS -p -D__plan9__ -D__${objtype}__ -Iplan9 -Illt

+CLEANFILES=boot.h

 HFILES=\

 	cvalues.c\

@@ -26,12 +27,6 @@

 default:V: all

-install:V: /sys/lib/flisp/flisp.boot

-/sys/lib/flisp/%: %

-	mkdir -p /sys/lib/flisp/

-	cp $prereq $target

 </sys/src/cmd/mkone

 $O.out: llt/libllt.$O.a

@@ -38,6 +33,11 @@

 llt/libllt.$O.a:

 	cd llt && mk

+boot.h: flisp.boot

+	sed 's,\\,\\\\,g;s,",\\",g;s,^,",g;s,$,\\n",g' $prereq >$target

+flmain.$O: boot.h

 bootstrap:V: $O.out

 	cp flisp.boot flisp.boot.bak && \