conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

64-bit fasl files can now be produced and read.

This commit is contained in:
Abdulaziz Ghuloum 2008-01-03 02:07:17 -05:00
parent 3c99e7d393
commit 341e53a36d
10 changed files with 79 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
configure vendored
View File

@ -5536,6 +5536,7 @@ cat >>confdefs.h <<_ACEOF
_ACEOF _ACEOF
# remember to enable before release.
# if (test $ac_cv_sizeof_void_p != 4); then # if (test $ac_cv_sizeof_void_p != 4); then
# AC_MSG_ERROR([Ikarus can only run in 32-bit mode.]) # AC_MSG_ERROR([Ikarus can only run in 32-bit mode.])
# fi # fi

1
configure.ac
View File

@ -29,6 +29,7 @@ case "$target_os" in
AC_CHECK_SIZEOF(void *) AC_CHECK_SIZEOF(void *)
# remember to enable before release.
# if (test $ac_cv_sizeof_void_p != 4); then # if (test $ac_cv_sizeof_void_p != 4); then
# AC_MSG_ERROR([Ikarus can only run in 32-bit mode.]) # AC_MSG_ERROR([Ikarus can only run in 32-bit mode.])
# fi # fi

6
scheme/ikarus.compiler.ss
View File

@ -2059,7 +2059,11 @@
;;; refer to the picture in src/ikarus-collect.c for details ;;; refer to the picture in src/ikarus-collect.c for details
;;; on how call-frames are laid out. (search for livemask) ;;; on how call-frames are laid out. (search for livemask)
(define call-instruction-size 5) (define call-instruction-size
(case wordsize
[(4) 5]
[(8) 10]
[else (die 'call-instruction-size "invalid" wordsize)]))
(define disp-frame-size (- (+ call-instruction-size (* 3 wordsize)))) (define disp-frame-size (- (+ call-instruction-size (* 3 wordsize))))
(define disp-frame-offset (- (+ call-instruction-size (* 2 wordsize)))) (define disp-frame-offset (- (+ call-instruction-size (* 2 wordsize))))
(define disp-multivalue-rp (- (+ call-instruction-size (* 1 wordsize)))) (define disp-multivalue-rp (- (+ call-instruction-size (* 1 wordsize))))

23
scheme/ikarus.fasl.write.ss
View File

@ -64,18 +64,19 @@
(define (put-tag c p) (define (put-tag c p)
(write-byte (char->integer c) p)) (write-byte (char->integer c) p))
(define write-int (define write-int32
(lambda (x p) (lambda (x p)
(unless (int? x) (die 'write-int "not a int" x))
(write-byte (bitwise-and x #xFF) p) (write-byte (bitwise-and x #xFF) p)
(write-byte (bitwise-and (sra x 8) #xFF) p) (write-byte (bitwise-and (sra x 8) #xFF) p)
(write-byte (bitwise-and (sra x 16) #xFF) p) (write-byte (bitwise-and (sra x 16) #xFF) p)
(write-byte (bitwise-and (sra x 24) #xFF) p) (write-byte (bitwise-and (sra x 24) #xFF) p)))
(define write-int
(lambda (x p)
(unless (int? x) (die 'write-int "not a int" x))
(write-int32 x p)
(when (eqv? wordsize 8) (when (eqv? wordsize 8)
(write-byte (bitwise-and (sra x 32) #xFF) p) (write-int32 (sra x 32) p))))
(write-byte (bitwise-and (sra x 40) #xFF) p)
(write-byte (bitwise-and (sra x 48) #xFF) p)
(write-byte (bitwise-and (sra x 56) #xFF) p))))
(define fasl-write-immediate (define fasl-write-immediate
(lambda (x p) (lambda (x p)
@ -92,7 +93,7 @@
(write-byte n p)) (write-byte n p))
(begin (begin
(put-tag #\C p) (put-tag #\C p)
(write-int n p))))] (write-int32 n p))))]
[(boolean? x) [(boolean? x)
(put-tag (if x #\T #\F) p)] (put-tag (if x #\T #\F) p)]
[(eof-object? x) (put-tag #\E p)] [(eof-object? x) (put-tag #\E p)]
@ -164,7 +165,7 @@
(write-int (string-length x) p) (write-int (string-length x) p)
(let f ([x x] [i 0] [n (string-length x)]) (let f ([x x] [i 0] [n (string-length x)])
(unless (= i n) (unless (= i n)
(write-int (char->integer (string-ref x i)) p) (write-int32 (char->integer (string-ref x i)) p)
(f x (fxadd1 i) n)))]) (f x (fxadd1 i) n)))])
m] m]
[(gensym? x) [(gensym? x)
@ -269,11 +270,11 @@
[(fx> mark 0) ; marked but not written [(fx> mark 0) ; marked but not written
(hashtable-set! h x (fx- 0 m)) (hashtable-set! h x (fx- 0 m))
(put-tag #\> p) (put-tag #\> p)
(write-int m p) (write-int32 m p)
(do-write x p h (fxadd1 m))] (do-write x p h (fxadd1 m))]
[else [else
(put-tag #\< p) (put-tag #\< p)
(write-int (fx- 0 mark) p) (write-int32 (fx- 0 mark) p)
m]))] m]))]
[else (die 'fasl-write "BUG: not in hash table" x)]))) [else (die 'fasl-write "BUG: not in hash table" x)])))
(define make-graph (define make-graph

17
scheme/ikarus.intel-assembler.ss
View File

@ -23,6 +23,10 @@
(except (ikarus code-objects) procedure-annotation) (except (ikarus code-objects) procedure-annotation)
(ikarus system $pairs)) (ikarus system $pairs))
(module (wordsize)
(include "ikarus.config.ss"))
(define fold (define fold
(lambda (f init ls) (lambda (f init ls)
(cond (cond
@ -710,9 +714,10 @@
(case (car x) (case (car x)
[(byte) (fx+ ac 1)] [(byte) (fx+ ac 1)]
[(word reloc-word reloc-word+ label-addr foreign-label [(word reloc-word reloc-word+ label-addr foreign-label
relative local-relative current-frame-offset) local-relative)
(fx+ ac 4)] (fx+ ac 4)]
[(label) ac] [(label) ac]
[(relative current-frame-offset) (+ ac wordsize)]
[else (die 'compute-code-size "unknown instr" x)]))) [else (die 'compute-code-size "unknown instr" x)])))
0 0
ls))) ls)))
@ -784,15 +789,17 @@
(f (cdr ls) (fx+ idx 1) reloc)] (f (cdr ls) (fx+ idx 1) reloc)]
[(reloc-word reloc-word+) [(reloc-word reloc-word+)
(f (cdr ls) (fx+ idx 4) (cons (cons idx a) reloc))] (f (cdr ls) (fx+ idx 4) (cons (cons idx a) reloc))]
[(local-relative relative label-addr foreign-label) [(local-relative label-addr foreign-label)
(f (cdr ls) (fx+ idx 4) (cons (cons idx a) reloc))] (f (cdr ls) (fx+ idx 4) (cons (cons idx a) reloc))]
[(relative)
(f (cdr ls) (fx+ idx wordsize) (cons (cons idx a) reloc))]
[(word) [(word)
(let ([v (cdr a)]) (let ([v (cdr a)])
(set-code-word! x idx v) (set-code-word! x idx v)
(f (cdr ls) (fx+ idx 4) reloc))] (f (cdr ls) (fx+ idx 4) reloc))]
[(current-frame-offset) [(current-frame-offset)
(set-code-word! x idx idx) (set-code-word! x idx idx) ;;; FIXME 64bit
(f (cdr ls) (fx+ idx 4) reloc)] (f (cdr ls) (fx+ idx wordsize) reloc)]
[(label) [(label)
(set-label-loc! (cdr a) (list x idx)) (set-label-loc! (cdr a) (list x idx))
(f (cdr ls) idx reloc)] (f (cdr ls) idx reloc)]
@ -800,8 +807,6 @@
(die 'whack-instructions "unknown instr" a)])))]))) (die 'whack-instructions "unknown instr" a)])))])))
(f ls 0 '()))) (f ls 0 '())))
(define wordsize 4)
(define compute-reloc-size (define compute-reloc-size
(lambda (ls) (lambda (ls)

2
scheme/last-revision
View File

@ -1 +1 @@
1315 1316

2
scheme/makefile.ss
View File

@ -1,4 +1,4 @@
#!/usr/bin/env ikarus -b ikarus.boot --r6rs-script #!../src/ikarus -b ikarus.boot --r6rs-script
;;; Ikarus Scheme -- A compiler for R6RS Scheme. ;;; Ikarus Scheme -- A compiler for R6RS Scheme.
;;; Copyright (C) 2006,2007 Abdulaziz Ghuloum ;;; Copyright (C) 2006,2007 Abdulaziz Ghuloum
;;; ;;;

6
src/ikarus-data.h
View File

@ -219,7 +219,8 @@ ikptr ik_safe_alloc(ikpcb* pcb, int size);
#define align(n) \ #define align(n) \
((((n) + align_size - 1) >> align_shift) << align_shift) ((((n) + align_size - 1) >> align_shift) << align_shift)
#define IK_FASL_HEADER "#@IK01" #define IK_FASL_HEADER \
((sizeof(ikptr) == 4) ? "#@IK01" : "#@IK02")
#define IK_FASL_HEADER_LEN (strlen(IK_FASL_HEADER)) #define IK_FASL_HEADER_LEN (strlen(IK_FASL_HEADER))
#define code_pri_tag vector_tag #define code_pri_tag vector_tag
@ -351,7 +352,8 @@ ikptr ik_safe_alloc(ikpcb* pcb, int size);
#define align_to_prev_page(x) \ #define align_to_prev_page(x) \
((((unsigned long int)(x)) >> pageshift) << pageshift) ((((unsigned long int)(x)) >> pageshift) << pageshift)
#define call_instruction_size 5 #define call_instruction_size \
((wordsize == 4) ? 5 : 10)
#define disp_frame_size (- (call_instruction_size + 3 * wordsize)) #define disp_frame_size (- (call_instruction_size + 3 * wordsize))
#define disp_frame_offset (- (call_instruction_size + 2 * wordsize)) #define disp_frame_offset (- (call_instruction_size + 2 * wordsize))
#define disp_multivale_rp (- (call_instruction_size + 1 * wordsize)) #define disp_multivale_rp (- (call_instruction_size + 1 * wordsize))

71
src/ikarus-fasl.c
View File

@ -110,8 +110,12 @@ void ik_fasl_load(ikpcb* pcb, char* fasl_file){
} }
close(fd); close(fd);
} }
ikptr val = ik_exec_code(pcb, v); ikptr val = void_object;
val = void_object; if(wordsize == 4){
ik_exec_code(pcb, v);
} else {
fprintf(stderr, "NOT EXECING YET\n");
}
if(val != void_object){ if(val != void_object){
/* this is from revision 1 /* this is from revision 1
and is no longer needed and is no longer needed
@ -123,6 +127,10 @@ void ik_fasl_load(ikpcb* pcb, char* fasl_file){
fprintf(stderr, "fasl-read did not reach eof!\n"); fprintf(stderr, "fasl-read did not reach eof!\n");
exit(-10); exit(-10);
} }
if(wordsize == 8){
fprintf(stderr, "DONE READING FASL, EXITING ...\n");
exit(-1);
}
} }
static ikptr static ikptr
@ -279,9 +287,9 @@ static ikptr do_read(ikpcb* pcb, fasl_port* p){
} }
} }
if(c == 'x'){ if(c == 'x'){
int code_size; long int code_size;
ikptr freevars; ikptr freevars;
fasl_read_buf(p, &code_size, sizeof(int)); fasl_read_buf(p, &code_size, sizeof(long int));
fasl_read_buf(p, &freevars, sizeof(ikptr)); fasl_read_buf(p, &freevars, sizeof(ikptr));
ikptr annotation = do_read(pcb, p); ikptr annotation = do_read(pcb, p);
ikptr code = alloc_code(align(code_size+disp_code_data), pcb, p); ikptr code = alloc_code(align(code_size+disp_code_data), pcb, p);
@ -317,16 +325,16 @@ static ikptr do_read(ikpcb* pcb, fasl_port* p){
} }
else if(c == 's'){ else if(c == 's'){
/* ascii string */ /* ascii string */
int len; long int len;
fasl_read_buf(p, &len, sizeof(int)); fasl_read_buf(p, &len, sizeof(long int));
int size = align(len*string_char_size + disp_string_data); long int size = align(len*string_char_size + disp_string_data);
ikptr str = ik_unsafe_alloc(pcb, size) + string_tag; ikptr str = ik_unsafe_alloc(pcb, size) + string_tag;
ref(str, off_string_length) = fix(len); ref(str, off_string_length) = fix(len);
fasl_read_buf(p, (char*)(long)str+off_string_data, len); fasl_read_buf(p, (char*)(long)str+off_string_data, len);
{ {
unsigned char* pi = (unsigned char*)(long)(str+off_string_data); unsigned char* pi = (unsigned char*)(long)(str+off_string_data);
ikchar* pj = (ikchar*)(long)(str+off_string_data); ikchar* pj = (ikchar*)(long)(str+off_string_data);
int i = len-1; long int i = len-1;
for(i=len-1; i >= 0; i--){ for(i=len-1; i >= 0; i--){
pj[i] = integer_to_char(pi[i]); pj[i] = integer_to_char(pi[i]);
} }
@ -339,9 +347,9 @@ static ikptr do_read(ikpcb* pcb, fasl_port* p){
} }
else if(c == 'S'){ else if(c == 'S'){
/* string */ /* string */
int len; long int len;
fasl_read_buf(p, &len, sizeof(int)); fasl_read_buf(p, &len, sizeof(long int));
int size = align(len*string_char_size + disp_string_data); long int size = align(len*string_char_size + disp_string_data);
ikptr str = ik_unsafe_alloc(pcb, size) + string_tag; ikptr str = ik_unsafe_alloc(pcb, size) + string_tag;
ref(str, off_string_length) = fix(len); ref(str, off_string_length) = fix(len);
long int i; long int i;
@ -356,17 +364,16 @@ static ikptr do_read(ikpcb* pcb, fasl_port* p){
} }
return str; return str;
} }
else if(c == 'V'){ else if(c == 'V'){
int len; long int len;
fasl_read_buf(p, &len, sizeof(int)); fasl_read_buf(p, &len, sizeof(long int));
int size = align(len * wordsize + disp_vector_data); long int size = align(len * wordsize + disp_vector_data);
ikptr vec = ik_unsafe_alloc(pcb, size) + vector_tag; ikptr vec = ik_unsafe_alloc(pcb, size) + vector_tag;
if(put_mark_index){ if(put_mark_index){
p->marks[put_mark_index] = vec; p->marks[put_mark_index] = vec;
} }
ref(vec, off_vector_length) = fix(len); ref(vec, off_vector_length) = fix(len);
int i; long int i;
for(i=0; i<len; i++){ for(i=0; i<len; i++){
ref(vec, off_vector_data + i*wordsize) = do_read(pcb, p); ref(vec, off_vector_data + i*wordsize) = do_read(pcb, p);
} }
@ -374,7 +381,7 @@ static ikptr do_read(ikpcb* pcb, fasl_port* p){
} }
else if(c == 'I'){ else if(c == 'I'){
ikptr fixn; ikptr fixn;
fasl_read_buf(p, &fixn, sizeof(int)); fasl_read_buf(p, &fixn, sizeof(ikptr));
return fixn; return fixn;
} }
else if(c == 'F'){ else if(c == 'F'){
@ -404,8 +411,8 @@ static ikptr do_read(ikpcb* pcb, fasl_port* p){
else if(c == 'R'){ /* R is for RTD */ else if(c == 'R'){ /* R is for RTD */
ikptr name = do_read(pcb, p); ikptr name = do_read(pcb, p);
ikptr symb = do_read(pcb, p); ikptr symb = do_read(pcb, p);
int i, n; long int i, n;
fasl_read_buf(p, &n, sizeof(int)); fasl_read_buf(p, &n, sizeof(long int));
ikptr fields; ikptr fields;
if(n == 0){ if(n == 0){
fields = null_object; fields = null_object;
@ -471,9 +478,9 @@ static ikptr do_read(ikpcb* pcb, fasl_port* p){
} }
else if(c == 'v'){ else if(c == 'v'){
/* bytevector */ /* bytevector */
int len; long int len;
fasl_read_buf(p, &len, sizeof(int)); fasl_read_buf(p, &len, sizeof(long int));
int size = align(len + disp_bytevector_data + 1); long int size = align(len + disp_bytevector_data + 1);
ikptr x = ik_unsafe_alloc(pcb, size) + bytevector_tag; ikptr x = ik_unsafe_alloc(pcb, size) + bytevector_tag;
ref(x, off_bytevector_length) = fix(len); ref(x, off_bytevector_length) = fix(len);
fasl_read_buf(p, (void*)(long)(x+off_bytevector_data), len); fasl_read_buf(p, (void*)(long)(x+off_bytevector_data), len);
@ -485,10 +492,6 @@ static ikptr do_read(ikpcb* pcb, fasl_port* p){
} }
else if(c == 'l'){ else if(c == 'l'){
int len = (unsigned char) fasl_read_byte(p); int len = (unsigned char) fasl_read_byte(p);
if(len < 0){
fprintf(stderr, "invalid len=%d\n", len);
exit(-1);
}
ikptr pair = ik_unsafe_alloc(pcb, pair_size * (len+1)) + pair_tag; ikptr pair = ik_unsafe_alloc(pcb, pair_size * (len+1)) + pair_tag;
if(put_mark_index){ if(put_mark_index){
p->marks[put_mark_index] = pair; p->marks[put_mark_index] = pair;
@ -504,17 +507,17 @@ static ikptr do_read(ikpcb* pcb, fasl_port* p){
return pair; return pair;
} }
else if(c == 'L'){ else if(c == 'L'){
int len; long int len;
fasl_read_buf(p, &len, sizeof(int)); fasl_read_buf(p, &len, sizeof(long int));
if(len < 0){ if(len < 0){
fprintf(stderr, "invalid len=%d\n", len); fprintf(stderr, "invalid len=%ld\n", len);
exit(-1); exit(-1);
} }
ikptr pair = ik_unsafe_alloc(pcb, pair_size * (len+1)) + pair_tag; ikptr pair = ik_unsafe_alloc(pcb, pair_size * (len+1)) + pair_tag;
if(put_mark_index){ if(put_mark_index){
p->marks[put_mark_index] = pair; p->marks[put_mark_index] = pair;
} }
int i; ikptr pt = pair; long int i; ikptr pt = pair;
for(i=0; i<len; i++){ for(i=0; i<len; i++){
ref(pt, off_car) = do_read(pcb, p); ref(pt, off_car) = do_read(pcb, p);
ref(pt, off_cdr) = pt + pair_size; ref(pt, off_cdr) = pt + pair_size;
@ -539,15 +542,15 @@ static ikptr do_read(ikpcb* pcb, fasl_port* p){
return int_to_scheme_char(n); return int_to_scheme_char(n);
} }
else if(c == 'b'){ else if(c == 'b'){
int len; long int len;
int sign = 0; long int sign = 0;
fasl_read_buf(p, &len, sizeof(int)); fasl_read_buf(p, &len, sizeof(long int));
if(len < 0) { if(len < 0) {
sign = 1; sign = 1;
len = -len; len = -len;
} }
if(len & 3){ if(len & 3){
fprintf(stderr, "Error in fasl-read: invalid bignum length %d\n", len); fprintf(stderr, "Error in fasl-read: invalid bignum length %ld\n", len);
exit(-1); exit(-1);
} }
unsigned long int tag = bignum_tag | (sign << bignum_sign_shift) | unsigned long int tag = bignum_tag | (sign << bignum_sign_shift) |

10
src/ikarus-runtime.c
View File

@ -42,8 +42,8 @@ int total_allocated_pages = 0;
extern char **environ; extern char **environ;
#define segment_size (pagesize*pagesize/wordsize) #define segment_size (pagesize*pagesize/4)
#define segment_shift (pageshift+pageshift-wordshift) #define segment_shift (pageshift+pageshift-2)
#define segment_index(x) (((unsigned long int)(x)) >> segment_shift) #define segment_index(x) (((unsigned long int)(x)) >> segment_shift)
ikptr ik_mmap(int size); ikptr ik_mmap(int size);
@ -328,9 +328,9 @@ ikpcb* ik_make_pcb(){
hi_mem = pcb->heap_base + pcb->heap_size + pagesize; hi_mem = pcb->heap_base + pcb->heap_size + pagesize;
} }
long int lo_seg = segment_index(lo_mem); unsigned long int lo_seg = segment_index(lo_mem);
long int hi_seg = segment_index(hi_mem+segment_size-1); unsigned long int hi_seg = segment_index(hi_mem+segment_size-1);
long int vec_size = (hi_seg - lo_seg) * pagesize; unsigned long int vec_size = (hi_seg - lo_seg) * pagesize;
ikptr dvec = ik_mmap(vec_size); ikptr dvec = ik_mmap(vec_size);
bzero((char*)(long)dvec, vec_size); bzero((char*)(long)dvec, vec_size);
pcb->dirty_vector_base = (unsigned int*)(long) dvec; pcb->dirty_vector_base = (unsigned int*)(long) dvec;