570 tests in 64-bit mode
This commit is contained in:
Abdulaziz Ghuloum
parent
aa44ce2733
commit
f63f85e1cc
|
|
@ -486,6 +486,11 @@
|
|||
(S* rands
|
||||
(lambda (rands)
|
||||
(make-set d (make-disp (car rands) (cadr rands)))))]
|
||||
[(mref32)
|
||||
(S* rands
|
||||
(lambda (rands)
|
||||
(make-asm-instr 'load32 d
|
||||
(make-disp (car rands) (cadr rands)))))]
|
||||
[(bref)
|
||||
(S* rands
|
||||
(lambda (rands)
|
||||
|
|
@ -571,7 +576,7 @@
|
|||
(do-bind lhs* rhs* (E e))]
|
||||
[(primcall op rands)
|
||||
(case op
|
||||
[(mset bset/c bset/h)
|
||||
[(mset bset/c bset/h mset32)
|
||||
(S* rands
|
||||
(lambda (s*)
|
||||
(make-asm-instr op
|
||||
|
|
@ -1280,7 +1285,7 @@
|
|||
(union-nfvs ns1 ns2)))]
|
||||
[(asm-instr op d s)
|
||||
(case op
|
||||
[(move move-byte)
|
||||
[(move move-byte load32)
|
||||
(cond
|
||||
[(reg? d)
|
||||
(cond
|
||||
|
|
@ -1459,7 +1464,7 @@
|
|||
[(cltd)
|
||||
(mark-reg/vars-conf! edx vs)
|
||||
(R s vs (rem-reg edx rs) fs ns)]
|
||||
[(mset bset/c bset/h fl:load fl:store fl:add! fl:sub!
|
||||
[(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)
|
||||
(R* (list s d) vs rs fs ns)]
|
||||
|
|
@ -1655,14 +1660,14 @@
|
|||
(make-conditional (P e0) (E e1) (E e2))]
|
||||
[(asm-instr op d s)
|
||||
(case op
|
||||
[(move move-byte)
|
||||
[(move move-byte load32)
|
||||
(let ([d (R d)] [s (R s)])
|
||||
(cond
|
||||
[(eq? d s)
|
||||
(make-primcall 'nop '())]
|
||||
[else
|
||||
(make-asm-instr op d s)]))]
|
||||
[(logand logor logxor int+ int- int* mset bset/c bset/h
|
||||
[(logand logor logxor int+ int- int* mset 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!
|
||||
|
|
@ -1872,7 +1877,7 @@
|
|||
(struct-case x
|
||||
[(asm-instr op d v)
|
||||
(case op
|
||||
[(move)
|
||||
[(move load32)
|
||||
(let ([s (set-rem d s)])
|
||||
(set-for-each (lambda (y) (add-edge! g d y)) s)
|
||||
(set-union (R v) s))]
|
||||
|
|
@ -1915,7 +1920,7 @@
|
|||
s))
|
||||
(set-union (set-union (R eax) (R edx))
|
||||
(set-union (R v) s)))]
|
||||
[(mset fl:load fl:store fl:add! fl:sub! fl:mul! fl:div!
|
||||
[(mset mset32 fl:load fl:store fl:add! fl:sub! fl:mul! fl:div!
|
||||
fl:from-int fl:shuffle fl:store-single
|
||||
fl:load-single)
|
||||
(set-union (R v) (set-union (R d) s))]
|
||||
|
|
@ -2176,7 +2181,8 @@
|
|||
(make-conditional (P e0) (E e1) (E e2))]
|
||||
[(asm-instr op a b)
|
||||
(case op
|
||||
[(logor logxor logand int+ int- int* move move-byte
|
||||
[(logor logxor logand int+ int- int* move
|
||||
move-byte load32
|
||||
int-/overflow int+/overflow int*/overflow)
|
||||
(cond
|
||||
[(and (eq? op 'move) (eq? a b))
|
||||
|
|
@ -2196,19 +2202,26 @@
|
|||
(E (make-asm-instr op u b)))
|
||||
(E (make-asm-instr 'move a u))))]
|
||||
[(and (mem? a) (not (small-operand? b)))
|
||||
(let ([u (mku)])
|
||||
(make-seq
|
||||
(E (make-asm-instr 'move u b))
|
||||
(E (make-asm-instr op a u))))]
|
||||
(case op
|
||||
[(load32)
|
||||
(let ([u (mku)])
|
||||
(make-seq
|
||||
(E (make-asm-instr 'load32 u b))
|
||||
(E (make-asm-instr 'move a u))))]
|
||||
[else
|
||||
(let ([u (mku)])
|
||||
(make-seq
|
||||
(E (make-asm-instr 'move u b))
|
||||
(E (make-asm-instr op a u))))])]
|
||||
[(disp? a)
|
||||
(let ([s0 (disp-s0 a)] [s1 (disp-s1 a)])
|
||||
(cond
|
||||
[(mem? s0)
|
||||
[(not (small-operand? s0))
|
||||
(let ([u (mku)])
|
||||
(make-seq
|
||||
(E (make-asm-instr 'move u s0))
|
||||
(E (make-asm-instr op (make-disp u s1) b))))]
|
||||
[(mem? s1)
|
||||
[(not (small-operand? s1))
|
||||
(let ([u (mku)])
|
||||
(make-seq
|
||||
(E (make-asm-instr 'move u s1))
|
||||
|
|
@ -2222,12 +2235,12 @@
|
|||
[(disp? b)
|
||||
(let ([s0 (disp-s0 b)] [s1 (disp-s1 b)])
|
||||
(cond
|
||||
[(mem? s0)
|
||||
[(not (small-operand? s0))
|
||||
(let ([u (mku)])
|
||||
(make-seq
|
||||
(E (make-asm-instr 'move u s0))
|
||||
(E (make-asm-instr op a (make-disp u s1)))))]
|
||||
[(mem? s1)
|
||||
[(not (small-operand? s1))
|
||||
(let ([u (mku)])
|
||||
(make-seq
|
||||
(E (make-asm-instr 'move u s1))
|
||||
|
|
@ -2259,7 +2272,7 @@
|
|||
(eq? b ecx))
|
||||
(error who "invalid shift" b))
|
||||
x]
|
||||
[(mset bset/c bset/h)
|
||||
[(mset mset32 bset/c bset/h)
|
||||
(cond
|
||||
[(not (small-operand? b))
|
||||
(let ([u (mku)])
|
||||
|
|
@ -2299,7 +2312,7 @@
|
|||
(E (make-asm-instr op u b))))]
|
||||
[else x])]
|
||||
[(fl:from-int fl:shuffle) x]
|
||||
[else (error who "invalid effect" op)])]
|
||||
[else (error who "invalid effect op" op)])]
|
||||
[(primcall op rands)
|
||||
(case op
|
||||
[(nop interrupt incr/zero? fl:single->double
|
||||
|
|
@ -2568,6 +2581,8 @@
|
|||
(let ([s (R s)] [d (R d)])
|
||||
(unless (eq? s d) (error who "invalid instr" x))
|
||||
(cons `(bswap ,s) ac))]
|
||||
[(mset32) (cons `(mov32 ,(R s) ,(R d)) ac)]
|
||||
[(load32) (cons `(mov32 ,(R s) ,(R d)) ac)]
|
||||
[(int-/overflow)
|
||||
(let ([L (or (exception-label)
|
||||
(error who "no exception label"))])
|
||||
|
|
|
|||
|
|
@ -2450,6 +2450,7 @@
|
|||
(define unbound #x6F) ; double check
|
||||
(define void-object #x7F) ; double check
|
||||
(define bwp-object #x8F) ; double check
|
||||
(define char-size 4)
|
||||
(define char-shift 8)
|
||||
(define char-tag #x0F)
|
||||
(define char-mask #xFF)
|
||||
|
|
|
|||
|
|
@ -451,13 +451,13 @@
|
|||
[(and (imm? a0) (reg32? a1))
|
||||
(error 'REC+RM "not here 1")
|
||||
(if (reg-requires-REX? a1)
|
||||
(C 0 (REX.R #b101 ac))
|
||||
(C 1 (REX.R #b100 ac)))]
|
||||
(REX.R #b101 ac)
|
||||
(REX.R #b100 ac))]
|
||||
[(and (imm? a1) (reg32? a0))
|
||||
(error 'REC+RM "not here 2")
|
||||
(if (reg-requires-REX? a0)
|
||||
(C 2 (REX.R #b101 ac))
|
||||
(C 3 (REX.R #b100 ac)))]
|
||||
(REX.R #b101 ac)
|
||||
(REX.R #b100 ac))]
|
||||
[(and (reg32? a0) (reg32? a1))
|
||||
(error 'REC+RM "not here 3")
|
||||
(if (or (reg-requires-REX? a0) (reg-requires-REX? a1))
|
||||
|
|
@ -482,7 +482,7 @@
|
|||
(if (reg-requires-REX? a0)
|
||||
(if (reg-requires-REX? a1)
|
||||
(error 'REX+RM "unhandled x1" a0 a1)
|
||||
(C 6 (REX.R #b010 ac)))
|
||||
(REX.R #b010 ac))
|
||||
(if (reg-requires-REX? a1)
|
||||
(error 'REX+RM "unhandled x3" a0 a1)
|
||||
(REX.R 0 ac)))]
|
||||
|
|
@ -519,11 +519,12 @@
|
|||
(define (CR c r ac)
|
||||
(REX+r r (CODE+r c r ac)))
|
||||
(define (CR* c r rm ac)
|
||||
;(CODE c (RM r rm ac)))
|
||||
(REX+RM r rm (CODE c (RM r rm ac))))
|
||||
(define (CR*-no-rex c r rm ac)
|
||||
(CODE c (RM r rm ac)))
|
||||
(define (CCR* c0 c1 r rm ac)
|
||||
(CODE c0 (CODE c1 (RM r rm ac))))
|
||||
;(REX+RM r rm (CODE c0 (CODE c1 (RM r rm ac)))))
|
||||
;(CODE c0 (CODE c1 (RM r rm ac))))
|
||||
(REX+RM r rm (CODE c0 (CODE c1 (RM r rm ac)))))
|
||||
(define (CCR c0 c1 r ac)
|
||||
(CODE c0 (CODE+r c1 r ac)))
|
||||
;(REX+r r (CODE c0 (CODE+r c1 r ac))))
|
||||
|
|
@ -554,6 +555,22 @@
|
|||
[(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)])]
|
||||
[(mov32 src dst)
|
||||
;;; FIXME
|
||||
(cond
|
||||
[(and (imm? src) (reg? dst))
|
||||
(error 'mov32 "here1")
|
||||
(CR #xB8 dst (IMM32 src ac))]
|
||||
[(and (imm? src) (mem? dst)) (CR*-no-rex #xC7 '/0 dst (IMM32 src ac))]
|
||||
[(and (reg? src) (reg? dst))
|
||||
(error 'mov32 "here3")
|
||||
(CR* #x89 src dst ac)]
|
||||
[(and (reg? src) (mem? dst)) (CR*-no-rex #x89 src dst ac)]
|
||||
[(and (mem? src) (reg? dst))
|
||||
(if (= wordsize 4)
|
||||
(CR* #x8B dst src ac)
|
||||
(CCR* #x0F #xB7 dst src ac))]
|
||||
[else (die who "invalid" instr)])]
|
||||
[(movb src dst)
|
||||
(cond
|
||||
[(and (imm8? src) (mem? dst)) (CR* #xC6 '/0 dst (IMM8 src ac))]
|
||||
|
|
@ -784,10 +801,10 @@
|
|||
(fx+ ac 1)
|
||||
(case (car x)
|
||||
[(byte) (fx+ ac 1)]
|
||||
[(relative reloc-word+ foreign-label local-relative)
|
||||
[(relative foreign-label local-relative)
|
||||
(fx+ ac 4)]
|
||||
[(label) ac]
|
||||
[(word reloc-word label-addr current-frame-offset)
|
||||
[(word reloc-word reloc-word+ label-addr current-frame-offset)
|
||||
(+ ac wordsize)]
|
||||
[else (die 'compute-code-size "unknown instr" x)])))
|
||||
0
|
||||
|
|
@ -858,11 +875,9 @@
|
|||
[(byte)
|
||||
(code-set! x idx (cdr a))
|
||||
(f (cdr ls) (fx+ idx 1) reloc)]
|
||||
[(reloc-word+)
|
||||
(f (cdr ls) (fx+ idx 4) (cons (cons idx a) reloc))]
|
||||
[(relative local-relative foreign-label)
|
||||
(f (cdr ls) (fx+ idx 4) (cons (cons idx a) reloc))]
|
||||
[(reloc-word label-addr)
|
||||
[(reloc-word reloc-word+ label-addr)
|
||||
(f (cdr ls) (fx+ idx wordsize) (cons (cons idx a) reloc))]
|
||||
[(word)
|
||||
(let ([v (cdr a)])
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
1440
|
||||
1441
|
||||
|
|
|
|||
|
|
@ -1857,12 +1857,16 @@
|
|||
(struct-case i
|
||||
[(constant i)
|
||||
(unless (fixnum? i) (interrupt))
|
||||
(prm 'mref (T s)
|
||||
(K (+ (* i fx-scale)
|
||||
(prm 'mref32 (T s)
|
||||
(K (+ (* i char-size)
|
||||
(- disp-string-data string-tag))))]
|
||||
[else
|
||||
(prm 'mref (T s)
|
||||
(prm 'int+ (T i)
|
||||
(prm 'mref32 (T s)
|
||||
(prm 'int+
|
||||
(cond
|
||||
[(= wordsize char-size) (T i)]
|
||||
[(= wordsize 8) (prm 'sra (T i) (K 1))]
|
||||
[else (error '$string-ref "invalid operand")])
|
||||
(K (- disp-string-data string-tag))))])]
|
||||
[(P s i) (K #t)]
|
||||
[(E s i) (nop)])
|
||||
|
|
@ -1903,12 +1907,18 @@
|
|||
(struct-case i
|
||||
[(constant i)
|
||||
(unless (fixnum? i) (interrupt))
|
||||
(prm 'mset (T x)
|
||||
(K (+ (* i fx-scale) (- disp-string-data string-tag)))
|
||||
(prm 'mset32 (T x)
|
||||
(K (+ (* i char-size)
|
||||
(- disp-string-data string-tag)))
|
||||
(T c))]
|
||||
[else
|
||||
(prm 'mset (T x)
|
||||
(prm 'int+ (T i) (K (- disp-string-data string-tag)))
|
||||
(prm 'mset32 (T x)
|
||||
(prm 'int+
|
||||
(cond
|
||||
[(= wordsize char-size) (T i)]
|
||||
[(= wordsize 8) (prm 'sra (T i) (K 1))]
|
||||
[else (error '$string-set! "invalid operand")])
|
||||
(K (- disp-string-data string-tag)))
|
||||
(T c))])])
|
||||
|
||||
/section)
|
||||
|
|
|
|||
|
|
@ -140,6 +140,11 @@
|
|||
...)])))]
|
||||
[(begin ,[e] ,[e*] ...)
|
||||
`(begin ,e ,e* ...)]
|
||||
[(set! ,x ,[v])
|
||||
(cond
|
||||
[(assq x env) => (lambda (p) `(set! ,(cdr p) ,v))]
|
||||
[else (error 'fixup "unbound" x)])]
|
||||
[(,[rator] ,[rand*] ...) `(,rator ,rand* ...)]
|
||||
[,_ (error 'fixup "invalid expression" _)]))
|
||||
(Expr x '()))
|
||||
|
||||
|
|
@ -160,9 +165,10 @@
|
|||
(include "tests/tests-1.6-req.scm")
|
||||
(include "tests/tests-1.7-req.scm")
|
||||
(include "tests/tests-1.8-req.scm")
|
||||
(include "tests/tests-1.9-req.scm"))
|
||||
|
||||
(include "tests/tests-2.1-req.scm")
|
||||
(include "tests/tests-1.9-req.scm")
|
||||
(include "tests/tests-2.1-req.scm")
|
||||
(include "tests/tests-2.2-req.scm")
|
||||
(include "tests/tests-2.3-req.scm"))
|
||||
|
||||
|
||||
(current-primitive-locations
|
||||
|
|
|
|||
|
|
@ -129,7 +129,7 @@ print(FILE* fh, ikptr x){
|
|||
else if(tagof(x) == string_tag){
|
||||
ikptr fxlen = ref(x, off_string_length);
|
||||
int len = unfix(fxlen);
|
||||
long int * data = (long int*)(x + off_string_data);
|
||||
int * data = (int*)(x + off_string_data);
|
||||
fprintf(fh, "\"");
|
||||
int i;
|
||||
for(i=0; i<len; i++){
|
||||
|
|
|
|||
Loading…
Reference in New Issue