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
# 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

1
configure.ac
View File

@ -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

6
scheme/ikarus.compiler.ss
View File

@ -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))))

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

@ -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

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

@ -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)

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.
;;; 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) \
((((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))

73
src/ikarus-fasl.c
View File

@ -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) |

10
src/ikarus-runtime.c
View File

@ -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;