64-bit fasl files can now be produced and read.
This commit is contained in:
parent
3c99e7d393
commit
341e53a36d
|
@ -5536,6 +5536,7 @@ cat >>confdefs.h <<_ACEOF
|
|||
_ACEOF
|
||||
|
||||
|
||||
# remember to enable before release.
|
||||
# if (test $ac_cv_sizeof_void_p != 4); then
|
||||
# AC_MSG_ERROR([Ikarus can only run in 32-bit mode.])
|
||||
# fi
|
||||
|
|
|
@ -29,6 +29,7 @@ case "$target_os" in
|
|||
|
||||
|
||||
AC_CHECK_SIZEOF(void *)
|
||||
# remember to enable before release.
|
||||
# if (test $ac_cv_sizeof_void_p != 4); then
|
||||
# AC_MSG_ERROR([Ikarus can only run in 32-bit mode.])
|
||||
# fi
|
||||
|
|
|
@ -2059,7 +2059,11 @@
|
|||
|
||||
;;; refer to the picture in src/ikarus-collect.c for details
|
||||
;;; 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-offset (- (+ call-instruction-size (* 2 wordsize))))
|
||||
(define disp-multivalue-rp (- (+ call-instruction-size (* 1 wordsize))))
|
||||
|
|
|
@ -64,18 +64,19 @@
|
|||
(define (put-tag c p)
|
||||
(write-byte (char->integer c) p))
|
||||
|
||||
(define write-int
|
||||
(define write-int32
|
||||
(lambda (x p)
|
||||
(unless (int? x) (die 'write-int "not a int" x))
|
||||
(write-byte (bitwise-and x #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 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)
|
||||
(write-byte (bitwise-and (sra x 32) #xFF) 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))))
|
||||
(write-int32 (sra x 32) p))))
|
||||
|
||||
(define fasl-write-immediate
|
||||
(lambda (x p)
|
||||
|
@ -92,7 +93,7 @@
|
|||
(write-byte n p))
|
||||
(begin
|
||||
(put-tag #\C p)
|
||||
(write-int n p))))]
|
||||
(write-int32 n p))))]
|
||||
[(boolean? x)
|
||||
(put-tag (if x #\T #\F) p)]
|
||||
[(eof-object? x) (put-tag #\E p)]
|
||||
|
@ -164,7 +165,7 @@
|
|||
(write-int (string-length x) p)
|
||||
(let f ([x x] [i 0] [n (string-length x)])
|
||||
(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)))])
|
||||
m]
|
||||
[(gensym? x)
|
||||
|
@ -269,11 +270,11 @@
|
|||
[(fx> mark 0) ; marked but not written
|
||||
(hashtable-set! h x (fx- 0 m))
|
||||
(put-tag #\> p)
|
||||
(write-int m p)
|
||||
(write-int32 m p)
|
||||
(do-write x p h (fxadd1 m))]
|
||||
[else
|
||||
(put-tag #\< p)
|
||||
(write-int (fx- 0 mark) p)
|
||||
(write-int32 (fx- 0 mark) p)
|
||||
m]))]
|
||||
[else (die 'fasl-write "BUG: not in hash table" x)])))
|
||||
(define make-graph
|
||||
|
|
|
@ -23,6 +23,10 @@
|
|||
(except (ikarus code-objects) procedure-annotation)
|
||||
(ikarus system $pairs))
|
||||
|
||||
|
||||
(module (wordsize)
|
||||
(include "ikarus.config.ss"))
|
||||
|
||||
(define fold
|
||||
(lambda (f init ls)
|
||||
(cond
|
||||
|
@ -710,9 +714,10 @@
|
|||
(case (car x)
|
||||
[(byte) (fx+ ac 1)]
|
||||
[(word reloc-word reloc-word+ label-addr foreign-label
|
||||
relative local-relative current-frame-offset)
|
||||
local-relative)
|
||||
(fx+ ac 4)]
|
||||
[(label) ac]
|
||||
[(relative current-frame-offset) (+ ac wordsize)]
|
||||
[else (die 'compute-code-size "unknown instr" x)])))
|
||||
0
|
||||
ls)))
|
||||
|
@ -784,15 +789,17 @@
|
|||
(f (cdr ls) (fx+ idx 1) reloc)]
|
||||
[(reloc-word reloc-word+)
|
||||
(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))]
|
||||
[(relative)
|
||||
(f (cdr ls) (fx+ idx wordsize) (cons (cons idx a) reloc))]
|
||||
[(word)
|
||||
(let ([v (cdr a)])
|
||||
(set-code-word! x idx v)
|
||||
(f (cdr ls) (fx+ idx 4) reloc))]
|
||||
[(current-frame-offset)
|
||||
(set-code-word! x idx idx)
|
||||
(f (cdr ls) (fx+ idx 4) reloc)]
|
||||
(set-code-word! x idx idx) ;;; FIXME 64bit
|
||||
(f (cdr ls) (fx+ idx wordsize) reloc)]
|
||||
[(label)
|
||||
(set-label-loc! (cdr a) (list x idx))
|
||||
(f (cdr ls) idx reloc)]
|
||||
|
@ -800,8 +807,6 @@
|
|||
(die 'whack-instructions "unknown instr" a)])))])))
|
||||
(f ls 0 '())))
|
||||
|
||||
(define wordsize 4)
|
||||
|
||||
|
||||
(define compute-reloc-size
|
||||
(lambda (ls)
|
||||
|
|
|
@ -1 +1 @@
|
|||
1315
|
||||
1316
|
||||
|
|
|
@ -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.
|
||||
;;; Copyright (C) 2006,2007 Abdulaziz Ghuloum
|
||||
;;;
|
||||
|
|
|
@ -219,7 +219,8 @@ ikptr ik_safe_alloc(ikpcb* pcb, int size);
|
|||
#define align(n) \
|
||||
((((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 code_pri_tag vector_tag
|
||||
|
@ -351,7 +352,8 @@ ikptr ik_safe_alloc(ikpcb* pcb, int size);
|
|||
#define align_to_prev_page(x) \
|
||||
((((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_offset (- (call_instruction_size + 2 * wordsize))
|
||||
#define disp_multivale_rp (- (call_instruction_size + 1 * wordsize))
|
||||
|
|
|
@ -110,8 +110,12 @@ void ik_fasl_load(ikpcb* pcb, char* fasl_file){
|
|||
}
|
||||
close(fd);
|
||||
}
|
||||
ikptr val = ik_exec_code(pcb, v);
|
||||
val = void_object;
|
||||
ikptr val = void_object;
|
||||
if(wordsize == 4){
|
||||
ik_exec_code(pcb, v);
|
||||
} else {
|
||||
fprintf(stderr, "NOT EXECING YET\n");
|
||||
}
|
||||
if(val != void_object){
|
||||
/* this is from revision 1
|
||||
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");
|
||||
exit(-10);
|
||||
}
|
||||
if(wordsize == 8){
|
||||
fprintf(stderr, "DONE READING FASL, EXITING ...\n");
|
||||
exit(-1);
|
||||
}
|
||||
}
|
||||
|
||||
static ikptr
|
||||
|
@ -269,7 +277,7 @@ static ikptr do_read(ikpcb* pcb, fasl_port* p){
|
|||
ik_print(p->marks[idx]);
|
||||
exit(-1);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
/* allocate marks */
|
||||
|
@ -279,9 +287,9 @@ static ikptr do_read(ikpcb* pcb, fasl_port* p){
|
|||
}
|
||||
}
|
||||
if(c == 'x'){
|
||||
int code_size;
|
||||
long int code_size;
|
||||
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));
|
||||
ikptr annotation = do_read(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'){
|
||||
/* ascii string */
|
||||
int len;
|
||||
fasl_read_buf(p, &len, sizeof(int));
|
||||
int size = align(len*string_char_size + disp_string_data);
|
||||
long int len;
|
||||
fasl_read_buf(p, &len, sizeof(long int));
|
||||
long int size = align(len*string_char_size + disp_string_data);
|
||||
ikptr str = ik_unsafe_alloc(pcb, size) + string_tag;
|
||||
ref(str, off_string_length) = fix(len);
|
||||
fasl_read_buf(p, (char*)(long)str+off_string_data, len);
|
||||
{
|
||||
unsigned char* pi = (unsigned char*)(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--){
|
||||
pj[i] = integer_to_char(pi[i]);
|
||||
}
|
||||
|
@ -339,9 +347,9 @@ static ikptr do_read(ikpcb* pcb, fasl_port* p){
|
|||
}
|
||||
else if(c == 'S'){
|
||||
/* string */
|
||||
int len;
|
||||
fasl_read_buf(p, &len, sizeof(int));
|
||||
int size = align(len*string_char_size + disp_string_data);
|
||||
long int len;
|
||||
fasl_read_buf(p, &len, sizeof(long int));
|
||||
long int size = align(len*string_char_size + disp_string_data);
|
||||
ikptr str = ik_unsafe_alloc(pcb, size) + string_tag;
|
||||
ref(str, off_string_length) = fix(len);
|
||||
long int i;
|
||||
|
@ -356,17 +364,16 @@ static ikptr do_read(ikpcb* pcb, fasl_port* p){
|
|||
}
|
||||
return str;
|
||||
}
|
||||
|
||||
else if(c == 'V'){
|
||||
int len;
|
||||
fasl_read_buf(p, &len, sizeof(int));
|
||||
int size = align(len * wordsize + disp_vector_data);
|
||||
long int len;
|
||||
fasl_read_buf(p, &len, sizeof(long int));
|
||||
long int size = align(len * wordsize + disp_vector_data);
|
||||
ikptr vec = ik_unsafe_alloc(pcb, size) + vector_tag;
|
||||
if(put_mark_index){
|
||||
p->marks[put_mark_index] = vec;
|
||||
}
|
||||
ref(vec, off_vector_length) = fix(len);
|
||||
int i;
|
||||
long int i;
|
||||
for(i=0; i<len; i++){
|
||||
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'){
|
||||
ikptr fixn;
|
||||
fasl_read_buf(p, &fixn, sizeof(int));
|
||||
fasl_read_buf(p, &fixn, sizeof(ikptr));
|
||||
return fixn;
|
||||
}
|
||||
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 */
|
||||
ikptr name = do_read(pcb, p);
|
||||
ikptr symb = do_read(pcb, p);
|
||||
int i, n;
|
||||
fasl_read_buf(p, &n, sizeof(int));
|
||||
long int i, n;
|
||||
fasl_read_buf(p, &n, sizeof(long int));
|
||||
ikptr fields;
|
||||
if(n == 0){
|
||||
fields = null_object;
|
||||
|
@ -471,9 +478,9 @@ static ikptr do_read(ikpcb* pcb, fasl_port* p){
|
|||
}
|
||||
else if(c == 'v'){
|
||||
/* bytevector */
|
||||
int len;
|
||||
fasl_read_buf(p, &len, sizeof(int));
|
||||
int size = align(len + disp_bytevector_data + 1);
|
||||
long int len;
|
||||
fasl_read_buf(p, &len, sizeof(long int));
|
||||
long int size = align(len + disp_bytevector_data + 1);
|
||||
ikptr x = ik_unsafe_alloc(pcb, size) + bytevector_tag;
|
||||
ref(x, off_bytevector_length) = fix(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'){
|
||||
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;
|
||||
if(put_mark_index){
|
||||
p->marks[put_mark_index] = pair;
|
||||
|
@ -504,17 +507,17 @@ static ikptr do_read(ikpcb* pcb, fasl_port* p){
|
|||
return pair;
|
||||
}
|
||||
else if(c == 'L'){
|
||||
int len;
|
||||
fasl_read_buf(p, &len, sizeof(int));
|
||||
long int len;
|
||||
fasl_read_buf(p, &len, sizeof(long int));
|
||||
if(len < 0){
|
||||
fprintf(stderr, "invalid len=%d\n", len);
|
||||
fprintf(stderr, "invalid len=%ld\n", len);
|
||||
exit(-1);
|
||||
}
|
||||
ikptr pair = ik_unsafe_alloc(pcb, pair_size * (len+1)) + pair_tag;
|
||||
if(put_mark_index){
|
||||
p->marks[put_mark_index] = pair;
|
||||
}
|
||||
int i; ikptr pt = pair;
|
||||
long int i; ikptr pt = pair;
|
||||
for(i=0; i<len; i++){
|
||||
ref(pt, off_car) = do_read(pcb, p);
|
||||
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);
|
||||
}
|
||||
else if(c == 'b'){
|
||||
int len;
|
||||
int sign = 0;
|
||||
fasl_read_buf(p, &len, sizeof(int));
|
||||
long int len;
|
||||
long int sign = 0;
|
||||
fasl_read_buf(p, &len, sizeof(long int));
|
||||
if(len < 0) {
|
||||
sign = 1;
|
||||
len = -len;
|
||||
}
|
||||
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);
|
||||
}
|
||||
unsigned long int tag = bignum_tag | (sign << bignum_sign_shift) |
|
||||
|
|
|
@ -42,8 +42,8 @@ int total_allocated_pages = 0;
|
|||
extern char **environ;
|
||||
|
||||
|
||||
#define segment_size (pagesize*pagesize/wordsize)
|
||||
#define segment_shift (pageshift+pageshift-wordshift)
|
||||
#define segment_size (pagesize*pagesize/4)
|
||||
#define segment_shift (pageshift+pageshift-2)
|
||||
#define segment_index(x) (((unsigned long int)(x)) >> segment_shift)
|
||||
|
||||
ikptr ik_mmap(int size);
|
||||
|
@ -328,9 +328,9 @@ ikpcb* ik_make_pcb(){
|
|||
hi_mem = pcb->heap_base + pcb->heap_size + pagesize;
|
||||
}
|
||||
|
||||
long int lo_seg = segment_index(lo_mem);
|
||||
long int hi_seg = segment_index(hi_mem+segment_size-1);
|
||||
long int vec_size = (hi_seg - lo_seg) * pagesize;
|
||||
unsigned long int lo_seg = segment_index(lo_mem);
|
||||
unsigned long int hi_seg = segment_index(hi_mem+segment_size-1);
|
||||
unsigned long int vec_size = (hi_seg - lo_seg) * pagesize;
|
||||
ikptr dvec = ik_mmap(vec_size);
|
||||
bzero((char*)(long)dvec, vec_size);
|
||||
pcb->dirty_vector_base = (unsigned int*)(long) dvec;
|
||||
|
|
Loading…
Reference in New Issue