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

I CAN HAZ CONS in 64BIT!

This commit is contained in:
Abdulaziz Ghuloum 2008-04-07 10:20:05 -04:00
parent bf6138f86f
commit 42e3d53d00
3 changed files with 42 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -469,27 +469,24 @@
(lambda (a0 a1)
(cond
[(and (imm? a0) (reg32? a1))
(error 'REC+RM "not here 5")
(if (reg-requires-REX? a1)
(C 4 (REX.R #b001 ac))
ac)]
(if (reg-requires-REX? a1)
(REX.R #b001 ac)
(REX.R 0 ac))]
[(and (imm? a1) (reg32? a0))
(error 'REC+RM "not here 6")
(if (reg-requires-REX? a0)
(C 5 (REX.R #b001 ac))
ac)]
(REX.R #b001 ac)
(REX.R 0 ac))]
[(and (reg32? a0) (reg32? a1))
(error 'REC+RM "not here 7")
(if (reg-requires-REX? a0)
(if (reg-requires-REX? a1)
(error 'REX+RM "unhandled x1" a0 a1)
(C 6 (REX.R #b010 ac)))
(if (reg-requires-REX? a1)
(error 'REX+RM "unhandled x3" a0 a1)
ac))]
(REX.R 0 ac)))]
[(and (imm? a0) (imm? a1))
(error 'REC+RM "not here 8")
ac]
;(error 'REC+RM "not here 8")
(REX.R 0 ac)]
[else (die 'REX+RM "unhandled" a0 a1)]))))]
[(reg? rm)
(let* ([bits 0]
@ -509,6 +506,14 @@
[(4) (CODE c ac)]
[else (REX.R 0 (CODE c ac))]))
(define (trace-ac ac1 ac2)
(printf "~s\n"
(let f ([ls ac2])
(cond
[(eq? ls ac1) '()]
[else (cons (car ls) (f (cdr ls)))])))
ac2)
(define (CR c r ac)
(REX+r r (CODE+r c r ac)))
(define (CR* c r rm ac)
@ -541,9 +546,9 @@
[(cltd) (CODE #x99 ac)]
[(movl src dst)
(cond
[(and (imm? src) (reg? dst)) (CR #xB8 dst (IMM src ac))]
[(and (imm? src) (mem? dst)) (CR* #xC7 '/0 dst (IMM src ac))]
[(and (reg? src) (reg? dst)) (CR* #x89 src dst ac)]
[(and (imm? src) (reg? dst)) (CR #xB8 dst (IMM src ac))]
[(and (imm? src) (mem? dst)) (CR* #xC7 '/0 dst (IMM32 src ac))]
[(and (reg? src) (reg? dst)) (CR* #x89 src dst ac)]
[(and (reg? src) (mem? dst)) (CR* #x89 src dst ac)]
[(and (mem? src) (reg? dst)) (CR* #x8B dst src ac)]
[else (die who "invalid" instr)])]

24
scheme/test64.ss
View File

@ -16,9 +16,9 @@
;;; vim:syntax=scheme
(import
(ikarus compiler)
(ikarus.compiler)
(match)
(except (ikarus) assembler-output))
(except (ikarus) scc-letrec optimize-cp optimize-level assembler-output))
(define (compile1 x)
(let ([p (open-file-output-port "test64.fasl" (file-options no-fail))])
@ -69,6 +69,7 @@
[fx+ $fx+]
[fx- $fx-]
[fx* $fx*]
[fxadd1 $fxadd1]
[fxlogor $fxlogor]
[fxlogand $fxlogand]
[fxlognot $fxlognot]
@ -77,6 +78,10 @@
[fx<= $fx<=]
[fx> $fx>]
[fx>= $fx>=]
[pair? pair?]
[cons cons]
[car $car]
[cdr $cdr]
))
@ -120,6 +125,21 @@
(include "tests/tests-1.4-req.scm")
(include "tests/tests-1.5-req.scm")
(include "tests/tests-1.6-req.scm")
(include "tests/tests-1.7-req.scm")
(include "tests/tests-1.8-req.scm")
(current-primitive-locations
(lambda (x)
(define prims
'(do-overflow
$apply-nonprocedure-error-handler
$incorrect-args-error-handler
$multiple-values-error))
(cond
[(memq x prims) x]
[else (error 'current-primloc "invalid" x)])))
(test-all)
(printf "Passed ~s tests\n" (length all-tests))

2
src/ikarus-print.c
View File

@ -107,7 +107,7 @@ print(FILE* fh, ikptr x){
fprintf(fh, "(");
print(fh, ref(x, off_car));
ikptr d = ref(x, off_cdr);
fprintf(stderr, "d=0x%016lx\n", (long int)d);
/* fprintf(stderr, "d=0x%016lx\n", (long int)d); */
while(1){
if(is_pair(d)){
fprintf(fh, " ");