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

View File

@ -469,27 +469,24 @@
(lambda (a0 a1) (lambda (a0 a1)
(cond (cond
[(and (imm? a0) (reg32? a1)) [(and (imm? a0) (reg32? a1))
(error 'REC+RM "not here 5")
(if (reg-requires-REX? a1) (if (reg-requires-REX? a1)
(C 4 (REX.R #b001 ac)) (REX.R #b001 ac)
ac)] (REX.R 0 ac))]
[(and (imm? a1) (reg32? a0)) [(and (imm? a1) (reg32? a0))
(error 'REC+RM "not here 6")
(if (reg-requires-REX? a0) (if (reg-requires-REX? a0)
(C 5 (REX.R #b001 ac)) (REX.R #b001 ac)
ac)] (REX.R 0 ac))]
[(and (reg32? a0) (reg32? a1)) [(and (reg32? a0) (reg32? a1))
(error 'REC+RM "not here 7")
(if (reg-requires-REX? a0) (if (reg-requires-REX? a0)
(if (reg-requires-REX? a1) (if (reg-requires-REX? a1)
(error 'REX+RM "unhandled x1" a0 a1) (error 'REX+RM "unhandled x1" a0 a1)
(C 6 (REX.R #b010 ac))) (C 6 (REX.R #b010 ac)))
(if (reg-requires-REX? a1) (if (reg-requires-REX? a1)
(error 'REX+RM "unhandled x3" a0 a1) (error 'REX+RM "unhandled x3" a0 a1)
ac))] (REX.R 0 ac)))]
[(and (imm? a0) (imm? a1)) [(and (imm? a0) (imm? a1))
(error 'REC+RM "not here 8") ;(error 'REC+RM "not here 8")
ac] (REX.R 0 ac)]
[else (die 'REX+RM "unhandled" a0 a1)]))))] [else (die 'REX+RM "unhandled" a0 a1)]))))]
[(reg? rm) [(reg? rm)
(let* ([bits 0] (let* ([bits 0]
@ -509,6 +506,14 @@
[(4) (CODE c ac)] [(4) (CODE c ac)]
[else (REX.R 0 (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) (define (CR c r ac)
(REX+r r (CODE+r c r ac))) (REX+r r (CODE+r c r ac)))
(define (CR* c r rm ac) (define (CR* c r rm ac)
@ -541,9 +546,9 @@
[(cltd) (CODE #x99 ac)] [(cltd) (CODE #x99 ac)]
[(movl src dst) [(movl src dst)
(cond (cond
[(and (imm? src) (reg? dst)) (CR #xB8 dst (IMM src ac))] [(and (imm? src) (reg? dst)) (CR #xB8 dst (IMM src ac))]
[(and (imm? src) (mem? dst)) (CR* #xC7 '/0 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) (reg? dst)) (CR* #x89 src dst ac)]
[(and (reg? src) (mem? 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)] [(and (mem? src) (reg? dst)) (CR* #x8B dst src ac)]
[else (die who "invalid" instr)])] [else (die who "invalid" instr)])]

View File

@ -16,9 +16,9 @@
;;; vim:syntax=scheme ;;; vim:syntax=scheme
(import (import
(ikarus compiler) (ikarus.compiler)
(match) (match)
(except (ikarus) assembler-output)) (except (ikarus) scc-letrec optimize-cp optimize-level assembler-output))
(define (compile1 x) (define (compile1 x)
(let ([p (open-file-output-port "test64.fasl" (file-options no-fail))]) (let ([p (open-file-output-port "test64.fasl" (file-options no-fail))])
@ -69,6 +69,7 @@
[fx+ $fx+] [fx+ $fx+]
[fx- $fx-] [fx- $fx-]
[fx* $fx*] [fx* $fx*]
[fxadd1 $fxadd1]
[fxlogor $fxlogor] [fxlogor $fxlogor]
[fxlogand $fxlogand] [fxlogand $fxlogand]
[fxlognot $fxlognot] [fxlognot $fxlognot]
@ -77,6 +78,10 @@
[fx<= $fx<=] [fx<= $fx<=]
[fx> $fx>] [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.4-req.scm")
(include "tests/tests-1.5-req.scm") (include "tests/tests-1.5-req.scm")
(include "tests/tests-1.6-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) (test-all)
(printf "Passed ~s tests\n" (length all-tests)) (printf "Passed ~s tests\n" (length all-tests))

View File

@ -107,7 +107,7 @@ print(FILE* fh, ikptr x){
fprintf(fh, "("); fprintf(fh, "(");
print(fh, ref(x, off_car)); print(fh, ref(x, off_car));
ikptr d = ref(x, off_cdr); 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){ while(1){
if(is_pair(d)){ if(is_pair(d)){
fprintf(fh, " "); fprintf(fh, " ");