I CAN HAZ CONS in 64BIT!
This commit is contained in:
parent
bf6138f86f
commit
42e3d53d00
|
@ -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)])]
|
||||||
|
|
|
@ -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))
|
||||||
|
|
|
@ -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, " ");
|
||||||
|
|
Loading…
Reference in New Issue