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

Passing 709 tests in 64-bit mode

This commit is contained in:
Abdulaziz Ghuloum 2008-04-12 15:06:55 -04:00
parent df0aa2de1f
commit d02e9fe035
10 changed files with 135 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
scheme/ikarus.compiler.altcogen.ss
View File

@ -576,7 +576,7 @@
(do-bind lhs* rhs* (E e))]
[(primcall op rands)
(case op
[(mset bset/c bset/h mset32)
[(mset bset bset/c bset/h mset32)
(S* rands
(lambda (s*)
(make-asm-instr op
@ -1464,9 +1464,9 @@
[(cltd)
(mark-reg/vars-conf! edx vs)
(R s vs (rem-reg edx rs) fs ns)]
[(mset mset32 bset/c bset/h fl:load fl:store fl:add! fl:sub!
fl:mul! fl:div! fl:from-int fl:shuffle
fl:load-single fl:store-single)
[(mset mset32 bset bset/c bset/h
fl:load fl:store fl:add! fl:sub! fl:mul! fl:div! fl:from-int
fl:shuffle fl:load-single fl:store-single)
(R* (list s d) vs rs fs ns)]
[else (error who "invalid effect op" (unparse x))])]
[(ntcall target value args mask size)
@ -1667,7 +1667,7 @@
(make-primcall 'nop '())]
[else
(make-asm-instr op d s)]))]
[(logand logor logxor int+ int- int* mset mset32 bset/c bset/h
[(logand logor logxor int+ int- int* mset bset mset32 bset/c bset/h
sll sra srl bswap!
cltd idiv int-/overflow int+/overflow int*/overflow
fl:load fl:store fl:add! fl:sub! fl:mul! fl:div!
@ -1902,7 +1902,7 @@
(set-union (set-union (R v) (R d)) s))]
[(bset/c)
(set-union (set-union (R v) (R d)) s)]
[(bset/h)
[(bset/h bset)
(when (var? v)
(for-each (lambda (r) (add-edge! g v r))
non-8bit-registers))
@ -2272,7 +2272,7 @@
(eq? b ecx))
(error who "invalid shift" b))
x]
[(mset mset32 bset/c bset/h)
[(mset mset32 bset bset/c bset/h)
(cond
[(not (small-operand? b))
(let ([u (mku)])
@ -2582,6 +2582,7 @@
(cons `(movb ,(R/l s) ,(R/l d)) ac))]
[(bset/c) (cons `(movb ,(BYTE s) ,(R d)) ac)]
[(bset/h) (cons `(movb ,(reg/h s) ,(R d)) ac)]
[(bset) (cons `(movb ,(reg/l s) ,(R d)) ac)]
[(sll) (cons `(sall ,(R/cl s) ,(R d)) ac)]
[(sra) (cons `(sarl ,(R/cl s) ,(R d)) ac)]
[(srl) (cons `(shrl ,(R/cl s) ,(R d)) ac)]

2
scheme/last-revision
View File

@ -1 +1 @@
1446
1447

14
scheme/pass-specify-rep-primops.ss
View File

@ -1668,9 +1668,9 @@
[(<= 128 c 255) (- c 256)]
[else (interrupt)])))]
[else
(prm 'bset/h (T x)
(prm 'bset (T x)
(K (+ i (- disp-bytevector-data bytevector-tag)))
(prm 'sll (T c) (K (- 8 fx-shift))))])]
(prm 'sra (T c) (K fx-shift)))])]
[else
(struct-case c
[(constant c)
@ -1684,11 +1684,11 @@
[(<= 128 c 255) (- c 256)]
[else (interrupt)])))]
[else
(prm 'bset/h (T x)
(prm 'int+
(prm 'sra (T i) (K fx-shift))
(K (- disp-bytevector-data bytevector-tag)))
(prm 'sll (T c) (K (- 8 fx-shift))))])])])
(prm 'bset (T x)
(prm 'int+
(prm 'sra (T i) (K fx-shift))
(K (- disp-bytevector-data bytevector-tag)))
(prm 'sra (T c) (K fx-shift)))])])])
(define-primop $bytevector-ieee-double-native-ref unsafe
[(V bv i)

5
scheme/test64.ss
View File

@ -107,6 +107,11 @@
[fxzero? $fxzero?]
[vector vector]
[symbol? symbol?]
[make-bytevector $make-bytevector]
[bytevector? bytevector?]
[bytevector-set! $bytevector-set!]
[bytevector-ref $bytevector-u8-ref]
[bytevector-length $bytevector-length]
))

54
scheme/tests/tests-1.9-req.scm
View File

@ -227,3 +227,57 @@
(string-set! s 0 #\\)
s) => "\"\\\\\"\n"]
)
(add-tests-with-string-output "bytevectors"
[(bytevector? (make-bytevector 0)) => "#t\n"]
[(make-bytevector 0) => "#vu8()\n"]
[(let ([s (make-bytevector 1)])
(bytevector-set! s 0 12)
(bytevector-ref s 0)) => "12\n"]
[(let ([s (make-bytevector 2)])
(bytevector-set! s 0 12)
(bytevector-set! s 1 13)
(cons (bytevector-ref s 0) (bytevector-ref s 1))) => "(12 . 13)\n"]
[(let ([i (let ([f (lambda () 0)]) (f))])
(let ([s (make-bytevector 1)])
(bytevector-set! s i 12)
(bytevector-ref s i))) => "12\n"]
[(let ([i (let ([f (lambda () 0)]) (f))]
[j (let ([f (lambda () 1)]) (f))])
(let ([s (make-bytevector 2)])
(bytevector-set! s i 12)
(bytevector-set! s j 13)
(cons (bytevector-ref s i) (bytevector-ref s j)))) => "(12 . 13)\n"]
[(let ([i (lambda () 0)])
(let ([s (make-bytevector 1)])
(bytevector-set! s 0 12)
(bytevector-ref s (i)))) => "12\n"]
[(let ([c (lambda () 12)])
(let ([s (make-bytevector 1)])
(bytevector-set! s 0 (c))
s)) => "#vu8(12)\n"]
[(let ([i (lambda () 0)])
(let ([s (make-bytevector 1)])
(bytevector-set! s (i) 12)
(bytevector-ref s 0))) => "12\n"]
[(let ([c (lambda () 12)])
(let ([s (make-bytevector 1)])
(bytevector-set! s 0 (c))
(bytevector-ref s 0))) => "12\n"]
[(let ([i (lambda () 0)] [c (lambda () 12)])
(let ([s (make-bytevector 1)])
(bytevector-set! s (i) (c))
(bytevector-ref s (i)))) => "12\n"]
[(bytevector-length (make-bytevector 12)) => "12\n"]
[(bytevector? (make-vector 12)) => "#f\n"]
[(bytevector? (cons 1 2)) => "#f\n"]
[(bytevector? 1287) => "#f\n"]
[(bytevector? ()) => "#f\n"]
[(bytevector? #t) => "#f\n"]
[(bytevector? #f) => "#f\n"]
[(pair? (make-bytevector 12)) => "#f\n"]
[(null? (make-bytevector 12)) => "#f\n"]
[(boolean? (make-bytevector 12)) => "#f\n"]
[(vector? (make-bytevector 12)) => "#f\n"]
)

2
src/ikarus-data.h
View File

@ -206,7 +206,7 @@ ikptr ik_unsafe_alloc(ikpcb* pcb, int size);
ikptr ik_safe_alloc(ikpcb* pcb, int size);
#define IK_HEAP_EXT_SIZE (32 * 4096)
#define IK_HEAPSIZE (1024 * 4096) /* 4 MB */
#define IK_HEAPSIZE (1024 * ((wordsize==4)?1:2) * 4096) /* 4/8 MB */
#define wordsize (sizeof(ikptr))
#define wordshift ((wordsize == 4)?2:3)

29
src/ikarus-enter.S
View File

@ -147,8 +147,33 @@ _ik_foreign_call:
je L_zero_args
cmpq $-8, %rax
je L_one_arg
movq $0, %rax
movq %rax,0(%rax)
cmpq $-16, %rax
je L_two_args
cmpq $-24, %rax
je L_three_args
cmpq $-32, %rax
je L_four_args
movq $0, %rbx
movq %rbx,0(%rbx)
L_four_args:
movq %rdi, %r8 # pcb
movq -8(%rbx), %rdi
movq -16(%rbx), %rsi
movq -24(%rbx), %rdx
movq -32(%rbx), %rcx
jmp L_set
L_three_args:
movq %rdi, %rcx # pcb
movq -8(%rbx), %rdi
movq -16(%rbx), %rsi
movq -24(%rbx), %rdx
jmp L_set
L_two_args:
movq %rdi, %rdx # pcb
movq -8(%rbx), %rdi
movq -16(%rbx), %rsi
jmp L_set
L_one_arg:
movq %rdi, %rsi
movq -8(%rbx), %rdi

8
src/ikarus-fasl.c
View File

@ -110,12 +110,8 @@ void ik_fasl_load(ikpcb* pcb, char* fasl_file){
}
close(fd);
}
if(wordsize == 4){
ik_exec_code(pcb, v);
} else {
fprintf(stderr, ";;; EXECING ...\n");
ikptr val = ik_exec_code(pcb, v);
fprintf(stderr, ";;; RETURNED ...\n");
ikptr val = ik_exec_code(pcb, v);
if(val != void_object){
ik_print(val);
}
}

16
src/ikarus-io.c
View File

@ -136,6 +136,22 @@ ikrt_read_fd(ikptr fd, ikptr bv, ikptr off, ikptr cnt, ikpcb* pcb){
ikptr
ikrt_write_fd(ikptr fd, ikptr bv, ikptr off, ikptr cnt, ikpcb* pcb){
#if 0
if (0) {
fprintf(stderr, "WRITE %d, %p %d %d %d\n",
unfix(fd),
bv,
unfix(ref(bv, off_bytevector_length)),
unfix(off),
unfix(cnt));
int i;
for(i=0; i<100; i++){
fprintf(stderr, "bv[%d]=0x%02x ", i,
((char*)(bv+off_bytevector_data))[i]);
}
fprintf(stderr, "\n");
}
#endif
ssize_t bytes =
write(unfix(fd),
(char*)(long)(bv+off_bytevector_data+unfix(off)),

14
src/ikarus-print.c
View File

@ -156,6 +156,20 @@ print(FILE* fh, ikptr x){
}
fprintf(fh, "\"");
}
else if(tagof(x) == bytevector_tag){
ikptr fxlen = ref(x, off_bytevector_length);
int len = unfix(fxlen);
unsigned char* data = (unsigned char*)(x + off_bytevector_data);
fprintf(fh, "#vu8(");
int i;
for(i=0; i<(len-1); i++){
fprintf(fh, "%d ", data[i]);
}
if(i < len){
fprintf(fh, "%d", data[i]);
}
fprintf(fh, ")");
}
else {
fprintf(fh, "#<unknown>");
}