shithub: femtolisp

--- a/boot2h.sh

+++ b/boot2h.sh

@@ -1,5 +1,3 @@

 #!/bin/sh

 set -e

-sed -E 's#^[ 	]+##g' $* | tr '

-' ' ' | sed 's#\\#\\\\#g;s#"#\\"#g;s#^#"#g;s#$#\\n"#g'

-echo

+od -t x1 -v -A n $* | sed -E 's/^[^ ]* / /g;s/ (..)/0x\1,/g'

--- a/bootstrap.sh

+++ b/bootstrap.sh

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

 $F gen.lsp && \

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

 $F mkboot0.lsp builtins.lsp instructions.lsp system.lsp compiler.lsp > flisp.boot && \

+cp flisp.boot flisp.boot.builtin && \

 ninja -C build && \

 $F mkboot1.lsp && \

 ninja -C build || { cp flisp.boot.bak flisp.boot; exit 1; }

--- a/flisp.boot

+++ b/flisp.boot

@@ -297,17 +297,17 @@

   #fn("=000n120r20i2O52\x8d\x8a68621A085F86>5_486<^19261:" #(#fn(vector-alloc)

 							     #fn(":000n10B3p070051r2A<85F52i29286G3;093<FKM61:928685p49286KM71051p494<0=61:92:" #(caar

   cdar)))) #fn(length)) make-perfect-hash-table)

-	    make-system-image #fn("<000n120071727354247576Dw54Dw64278788>2288685>22989>1{89504:" #(#fn(file)

-  :write :create :truncate (*linefeed* *directory-separator* *argv* that *print-pretty*

-				       *print-width* *print-readably* *print-level* *print-length*

-				       *os-name* *interactive* *prompt*) *print-pretty*

+	    make-system-image #fn("@000n120071727354202402552717273542650277879Dw84Dw942:898:>22;88878586>42<8;>1{8;504:" #(#fn(file)

+  :write :create :truncate #fn(string) ".builtin" #fn(buffer)

+  (*linefeed* *directory-separator* *argv* that *print-pretty* *print-width* *print-readably*

+	      *print-level* *print-length* *os-name* *interactive* *prompt*) *print-pretty*

   *print-readably* #fn("5000n0Aw04Fw1:" #(*print-pretty* *print-readably*))

-  #fn("=000n07021A>1722350515224752677842678845253f2F52429F7:52^142;F61:" #(filter #fn("8000n10Z;3u0420051S;3j0421051[S;IC0422051222105151dS;3I04230A52S;3=04242105151S:" #(#fn(constant?)

-  #fn(top-level-value) #fn(string) #fn(memq) #fn(iostream?))) simple-sort #fn(environment)

-									    #fn(write) nconc #fn(map)

-									    list top-level-value #fn(io-write)

-									    *linefeed* #fn(io-close)))

-  #fn("6000n1A50420061:" #(#fn(raise)))) make-system-image)

+  #fn("?000n07021A>17223505152742576842577845253f22885F52429F7:52428859252429927:52^1^142;F512<2=F51r:522>2?E2@2A84522B84r(522B84r 522B84r\x18525629938652429938552^1^1^142C925142C9361:" #(filter

+  #fn("8000n10Z;3u0420051S;3j0421051[S;IC0422051222105151dS;3I04230A52S;3=04242105151S:" #(#fn(constant?)

+  #fn(top-level-value) #fn(string) #fn(memq) #fn(iostream?))) simple-sort #fn(environment) nconc #fn(map)

+  list top-level-value #fn(write) #fn(io-write) *linefeed* #fn(sizeof)

+  #fn(lz-pack) #fn(iostream->string) #fn(array) byte #fn(logand) 255 #fn(ash)

+  #fn(io-close))) #fn("6000n1A50420061:" #(#fn(raise)))) make-system-image)

 	    map! #fn("8000n21\x8d1B3B04101<51_41=?1@\x1d/4:" #() map!) map-int

 	    #fn(";000n2701E52340q:0E51qPq\x8a78786_4K7115122870>2|486:" #(<= 1- #fn("7000n1A<F051qPN4AA<=_:" #())) map-int)

 	    mark-label #fn("8000n270021163:" #(emit label) mark-label) max

--- a/flmain.c

+++ b/flmain.c

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

 #include "iostream.h"

 #include "ieee754.h"

 #include "random.h"

+#include "brieflz.h"

 double D_PNAN, D_NNAN, D_PINF, D_NINF;

 float F_PNAN, F_NNAN, F_PINF, F_NINF;

@@ -43,11 +44,29 @@

 	value_t f = cvalue(FL(iostreamtype), (int)sizeof(ios_t));

 	ios_t *s = value2c(ios_t*, f);

+	uint8_t *unpacked = nil;

+	if(boot[0] == 0){

+		uint32_t unpackedsz =

+			boot[1]<<0 |

+			boot[2]<<8 |

+			boot[3]<<16|

+			boot[4]<<24;

+		unpacked = MEM_ALLOC(unpackedsz);

+		unsigned long n = blz_depack_safe(boot+5, bootsz-5, unpacked, unpackedsz);

+		if(n == BLZ_ERROR){

+			ios_puts(ios_stderr, "failed to unpack boot image\n");

+			fl_exit(1);

+		}

+		boot = unpacked;

+		bootsz = n;

+	}

 	ios_static_buffer(s, boot, bootsz);

 	int r = 1;

 	FL_TRY_EXTERN{

 		if(fl_load_system_image(f) == 0){

+			if(unpacked != nil)

+				MEM_FREE(unpacked);

 			ios_close(s);

 			fl_applyn(1, symbol_value(symbol("__start", false)), argv_list(argc, argv));

 			r = 0;

--- a/main_posix.c

+++ b/main_posix.c

@@ -1,9 +1,9 @@

 #include "flisp.h"

 #include "ieee754.h"

-static const uint8_t boot[] =

+static const uint8_t boot[] = {

 #include "flisp.boot.h"

-;

+};

int

 main(int argc, char **argv)

--- a/meson.build

+++ b/meson.build

@@ -92,7 +92,7 @@

 	'boot',

 	capture: true,

 	input: [

-		'flisp.boot',

+		'flisp.boot.builtin',

],

 	output: [

 		'flisp.boot.h',

--- a/mkfile

+++ b/mkfile

@@ -58,8 +58,8 @@

 cvalues.$O: fl_arith_any.inc

 flisp.$O: maxstack.inc vm.inc

-plan9/flisp.boot.s:D: flisp.boot

-	aux/data2s boot <flisp.boot >$target

+plan9/flisp.boot.s:D: flisp.boot.builtin

+	aux/data2s boot <flisp.boot.builtin >$target

 flisp.boot.$O: plan9/flisp.boot.s

 	$AS -o $target plan9/flisp.boot.s

@@ -72,9 +72,12 @@

 bootstrap:V: $O.out

     ./$O.out gen.lsp && \

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

-	./$O.out mkboot0.lsp system.lsp compiler.lsp > flisp.boot.new && \

+	./$O.out mkboot0.lsp builtins.lsp instructions.lsp system.lsp compiler.lsp > flisp.boot.new && \

 	mv flisp.boot.new flisp.boot && \

-	./$O.out mkboot1.lsp

+	cp flisp.boot flisp.boot.builtin && \

+	mk && \

+	./$O.out mkboot1.lsp && \

+	mk

 nuke:V:

 	rm -f *.[$OS] */*.[$OS] [$OS].out *.acid $TARG $CLEANFILES

--- a/system.lsp

+++ b/system.lsp

@@ -1051,6 +1051,8 @@

 (define (make-system-image fname)

   (let ((f (file fname :write :create :truncate))

+        (z (file (string fname ".builtin") :write :create :truncate))

+        (b (buffer))

         (excludes '(*linefeed* *directory-separator* *argv* that

                     *print-pretty* *print-width* *print-readably*

                     *print-level* *print-length* *os-name* *interactive*

@@ -1057,19 +1059,32 @@

                     *prompt*)))

     (with-bindings ((*print-pretty* #t)

                     (*print-readably* #t))

-      (let ((syms

-             (filter (λ (s)

-                       (and (bound? s)

-                            (not (constant? s))

-                            (or (not (builtin? (top-level-value s)))

-                                (not (equal? (string s) ; alias of builtin

-                                             (string (top-level-value s)))))

-                            (not (memq s excludes))

-                            (not (iostream? (top-level-value s)))))

-                     (simple-sort (environment)))))

-        (write (apply nconc (map list syms (map top-level-value syms))) f)

+      (let* ((syms

+              (filter (λ (s)

+                        (and (bound? s)

+                             (not (constant? s))

+                             (or (not (builtin? (top-level-value s)))

+                                 (not (equal? (string s) ; alias of builtin

+                                              (string (top-level-value s)))))

+                             (not (memq s excludes))

+                             (not (iostream? (top-level-value s)))))

+                      (simple-sort (environment))))

+             (data (apply nconc (map list syms (map top-level-value syms)))))

+        (write data b)

+        (io-write b *linefeed*)

+        (write data f)

         (io-write f *linefeed*))

-      (io-close f))))

+      (let* ((size (sizeof b))

+             (packed (lz-pack (iostream->string b) 10))

+             (hdr (array 'byte 0

+                               (logand 0xff size)

+                               (ash size -8)

+                               (ash size -16)

+                               (ash size -24))))

+        (io-write z hdr)

+        (io-write z packed))

+      (io-close f)

+      (io-close z))))

 ; initialize globals that need to be set at load time

 (define (__init_globals)