diff --git a/bin/Makefile b/bin/Makefile index 13b51f6..4c882d3 100644 --- a/bin/Makefile +++ b/bin/Makefile @@ -1,7 +1,7 @@ CFLAGS = -I/opt/local/include -Wall -DNDEBUG -O3 #-fomit-frame-pointer #CFLAGS = -I/opt/local/include -Wall -g -LDFLAGS = -L/opt/local/lib -g -ldl -lgmp #-rdynamic +LDFLAGS = -L/opt/local/lib -g -ldl -lgmp -lz #-rdynamic CC = gcc all: ikarus diff --git a/bin/ikarus b/bin/ikarus index dc50a29..269d988 100755 Binary files a/bin/ikarus and b/bin/ikarus differ diff --git a/bin/ikarus-fasl.c b/bin/ikarus-fasl.c index 0256805..ece3513 100644 --- a/bin/ikarus-fasl.c +++ b/bin/ikarus-fasl.c @@ -13,27 +13,62 @@ #include #include +#include + #ifndef RTLD_DEFAULT #define RTLD_DEFAULT 0 #endif +#define USE_ZLIB 1 + typedef struct { +#if USE_ZLIB + gzFile fh; +#else char* membase; char* memp; char* memq; +#endif ikp* marks; int marks_size; } fasl_port; static ikp ik_fasl_read(ikpcb* pcb, fasl_port* p); +#if USE_ZLIB +void ik_fasl_load(ikpcb* pcb, char* fasl_file){ + gzFile fh = gzopen(fasl_file, "rb"); + if(fh == NULL){ + fprintf(stderr, "cannot open %s\n", fasl_file); + exit(-1); + } + fasl_port p; + p.fh = fh; + p.marks = NULL; + p.marks_size = 0; + ikp v = ik_fasl_read(pcb, &p); + while(v){ + if(p.marks){ + bzero(p.marks, p.marks_size * sizeof(ikp*)); + } + ikp val = ik_exec_code(pcb, v); + val = void_object; + if(val != void_object){ + ik_print(val); + } + v = ik_fasl_read(pcb, &p); + }; + + fprintf(stderr, "here\n"); + exit(-1); +} +#else void ik_fasl_load(ikpcb* pcb, char* fasl_file){ int fd = open(fasl_file, O_RDONLY); if(fd == -1){ fprintf(stderr, "failed to open %s: %s\n", fasl_file, strerror(errno)); exit(-1); } - int filesize; { struct stat buf; @@ -45,7 +80,6 @@ void ik_fasl_load(ikpcb* pcb, char* fasl_file){ filesize = buf.st_size; } int mapsize = ((filesize + pagesize - 1) / pagesize) * pagesize; - char* mem = mmap( 0, mapsize, @@ -53,20 +87,16 @@ void ik_fasl_load(ikpcb* pcb, char* fasl_file){ MAP_PRIVATE, fd, 0); - if(mem == MAP_FAILED){ fprintf(stderr, "Mapping failed for %s: %s\n", fasl_file, strerror(errno)); exit(-1); } - fasl_port p; p.membase = mem; p.memp = mem; p.memq = mem + filesize; p.marks = NULL; p.marks_size = 0; - - while(p.memp < p.memq){ ikp v = ik_fasl_read(pcb, &p); if(p.marks){ @@ -78,7 +108,6 @@ void ik_fasl_load(ikpcb* pcb, char* fasl_file){ ik_print(val); } } - if(p.memp != p.memq){ fprintf(stderr, "fasl-read did not reach eof!\n"); exit(-10); @@ -95,7 +124,7 @@ void ik_fasl_load(ikpcb* pcb, char* fasl_file){ } close(fd); } - +#endif static ikp @@ -121,9 +150,6 @@ ik_relocate_code(ikp code){ } int tag = r & 3; int code_off = r >> 2; -// fprintf(stderr, "data=0x%08x, off=0x%08x, data+off=0x%08x, r=0x%08x\n", -// (int)data, code_off, (int)data+code_off, r); -// fprintf(stderr, "setting 0x%08x from r=0x%08x\n", (int)(data+code_off), r); if(tag == 0){ /* vanilla object */ ref(data, code_off) = ref(p, wordsize); @@ -174,10 +200,16 @@ ik_relocate_code(ikp code){ static char fasl_read_byte(fasl_port* p){ +#if USE_ZLIB + int c = gzgetc(p->fh); + if(c != -1){ + return (char)c; +#else if(p->memp < p->memq){ char c = *(p->memp); p->memp++; return c; +#endif } else { fprintf(stderr, "fasl_read_byte: read beyond eof\n"); exit(-1); @@ -185,9 +217,15 @@ static char fasl_read_byte(fasl_port* p){ } static void fasl_read_buf(fasl_port* p, void* buf, int n){ +#if USE_ZLIB + int bytes = gzread(p->fh, buf, n); + if(bytes == n){ + return; +#else if((p->memp+n) <= p->memq){ memcpy(buf, p->memp, n); p->memp += n; +#endif } else { fprintf(stderr, "fasl_read_buf: read beyond eof\n"); exit(-1); @@ -220,9 +258,7 @@ static ikp do_read(ikpcb* pcb, fasl_port* p){ } if(idx < p->marks_size){ if(p->marks[idx] != 0){ - fprintf(stderr, "mark %d already set (fileoff=%d)\n", - idx, - (int)p->memp - (int)p->membase - 6); + fprintf(stderr, "mark %d already set\n", idx); ik_print(p->marks[idx]); exit(-1); } @@ -438,10 +474,7 @@ static ikp do_read(ikpcb* pcb, fasl_port* p){ return x; } else { - fprintf(stderr, - "invalid type '%c' (0x%02x) found in fasl file at byte 0x%08x\n", - c, c, - (int) p->memp - (int) p->membase - 1); + fprintf(stderr, "invalid type '%c' (0x%02x) found in fasl file\n", c, c); exit(-1); } } @@ -450,11 +483,17 @@ static ikp do_read(ikpcb* pcb, fasl_port* p){ static ikp ik_fasl_read(ikpcb* pcb, fasl_port* p){ /* first check the header */ char buf[IK_FASL_HEADER_LEN]; +#if USE_ZLIB + int bytes = gzread(p->fh, buf, IK_FASL_HEADER_LEN); + if(bytes == 0){ + return 0; + } +#else fasl_read_buf(p, buf, IK_FASL_HEADER_LEN); +#endif if(strncmp(buf, IK_FASL_HEADER, IK_FASL_HEADER_LEN) != 0){ fprintf(stderr, "invalid fasl header\n"); exit(-1); } return do_read(pcb, p); } - diff --git a/bin/ikarus-runtime.c b/bin/ikarus-runtime.c index ebd0187..000c8b3 100644 --- a/bin/ikarus-runtime.c +++ b/bin/ikarus-runtime.c @@ -686,7 +686,7 @@ mtname(unsigned int n){ if(n == mainheap_type) { return "HEAP_T"; } if(n == mainstack_type) { return "STAK_T"; } if(n == pointers_type) { return "PTER_T"; } - if(n == data_type) { return "DATA_T"; } + if(n == dat_type) { return "DATA_T"; } if(n == code_type) { return "CODE_T"; } if(n == hole_type) { return " "; } return "WHAT_T"; diff --git a/bin/ikarus.h b/bin/ikarus.h index 806c13e..78a4c4e 100644 --- a/bin/ikarus.h +++ b/bin/ikarus.h @@ -28,7 +28,7 @@ extern int hash_table_count; #define mainheap_type 0x00000100 #define mainstack_type 0x00000200 #define pointers_type 0x00000300 -#define data_type 0x00000400 +#define dat_type 0x00000400 #define code_type 0x00000500 #define weak_pairs_type 0x00000600 #define symbols_type 0x00000700 @@ -44,7 +44,7 @@ extern int hash_table_count; #define mainstack_mt (mainstack_type | unscannable_tag | retain_tag) #define pointers_mt (pointers_type | scannable_tag | dealloc_tag) #define symbols_mt (symbols_type | scannable_tag | dealloc_tag) -#define data_mt (data_type | unscannable_tag | dealloc_tag) +#define data_mt (dat_type | unscannable_tag | dealloc_tag) #define code_mt (code_type | scannable_tag | dealloc_tag) #define weak_pairs_mt (weak_pairs_type | scannable_tag | dealloc_tag) diff --git a/bin/verify-integrity.c b/bin/verify-integrity.c index 32669a1..af42b51 100644 --- a/bin/verify-integrity.c +++ b/bin/verify-integrity.c @@ -155,7 +155,7 @@ verify_page(unsigned char* p, unsigned char* base, unsigned int* svec, unsigned else if(type == symbols_type){ return verify_pointers_page(p,s,d,base,svec,dvec); } - else if(type == data_type){ + else if(type == dat_type){ /* nothing to do for data */ return p+pagesize; } diff --git a/src/ikarus.boot b/src/ikarus.boot index 1ae32e2..871d276 100644 Binary files a/src/ikarus.boot and b/src/ikarus.boot differ diff --git a/src/ikarus.intel-assembler.ss b/src/ikarus.intel-assembler.ss index 62d0cfa..5b9103a 100644 --- a/src/ikarus.intel-assembler.ss +++ b/src/ikarus.intel-assembler.ss @@ -838,6 +838,19 @@ 0 ls))) +(define foreign-string->bytevector + (let ([mem '()]) + (lambda (x) + (let f ([ls mem]) + (cond + [(null? ls) + (let ([bv (string->utf8-bytevector x)]) + (set! mem (cons (cons x bv) mem)) + bv)] + [(string=? x (caar ls)) (cdar ls)] + [else (f (cdr ls))]))))) + + (define whack-reloc (lambda (thunk?-label code vec) (define reloc-idx 0) @@ -872,7 +885,7 @@ ;;; wait for equal? hash tables. (let ([name (if (string? v) - (string->utf8-bytevector v) + (foreign-string->bytevector v) (error 'whack-reloc "not a string ~s" v))]) (vector-set! vec reloc-idx (fxlogor 1 (fxsll idx 2))) (vector-set! vec (fx+ reloc-idx 1) name) diff --git a/src/makefile.ss b/src/makefile.ss index 132dffc..38151d9 100755 --- a/src/makefile.ss +++ b/src/makefile.ss @@ -843,12 +843,15 @@ [(assq x locs) => cdr] [else (error 'bootstrap "no location for ~s" x)]))) - (let ([p (open-output-file "ikarus.boot" 'replace)]) + (let ([p (open-output-file "ikarus.tmp" 'replace)]) (for-each (lambda (x) (compile-core-expr-to-port x p)) core*) (close-output-port p))))) +(system "gzip -f ikarus.tmp") +(system "mv ikarus.tmp.gz ikarus.boot") + (printf "Happy Happy Joy Joy\n")