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

fixed gc bug in 64-bit mode along with another 64-bit bug in the 

assembler when addressing using special %eax/%rax instructions.
This commit is contained in:
Abdulaziz Ghuloum 2008-07-21 22:07:31 -07:00
parent 358eee03ee
commit acc9940379
11 changed files with 42 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
benchmarks/Makefile.in
View File

@ -223,9 +223,9 @@ $(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps)
exit 1;; \ exit 1;; \
esac; \ esac; \
done; \ done; \
echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign benchmarks/Makefile'; \ echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu benchmarks/Makefile'; \
cd $(top_srcdir) && \ cd $(top_srcdir) && \
$(AUTOMAKE) --foreign benchmarks/Makefile $(AUTOMAKE) --gnu benchmarks/Makefile
.PRECIOUS: Makefile .PRECIOUS: Makefile
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
@case '$?' in \ @case '$?' in \

3
c64
View File

@ -1,6 +1,7 @@
#!/usr/bin/env sh #!/usr/bin/env sh
./configure CFLAGS="-m64 -g -I/Users/ikarus/.opt64/include" \ ./configure --prefix=/Users/ikarus/.opt \
CFLAGS="-m64 -g -I/Users/ikarus/.opt64/include" \
LDFLAGS="-m64 -g -L/Users/ikarus/.opt64/lib" \ LDFLAGS="-m64 -g -L/Users/ikarus/.opt64/lib" \
&& make clean \ && make clean \
&& make && make

4
doc/Makefile.in
View File

@ -170,9 +170,9 @@ $(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps)
exit 1;; \ exit 1;; \
esac; \ esac; \
done; \ done; \
echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign doc/Makefile'; \ echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu doc/Makefile'; \
cd $(top_srcdir) && \ cd $(top_srcdir) && \
$(AUTOMAKE) --foreign doc/Makefile $(AUTOMAKE) --gnu doc/Makefile
.PRECIOUS: Makefile .PRECIOUS: Makefile
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
@case '$?' in \ @case '$?' in \

4
lib/Makefile.in
View File

@ -172,9 +172,9 @@ $(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps)
exit 1;; \ exit 1;; \
esac; \ esac; \
done; \ done; \
echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign lib/Makefile'; \ echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu lib/Makefile'; \
cd $(top_srcdir) && \ cd $(top_srcdir) && \
$(AUTOMAKE) --foreign lib/Makefile $(AUTOMAKE) --gnu lib/Makefile
.PRECIOUS: Makefile .PRECIOUS: Makefile
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
@case '$?' in \ @case '$?' in \

4
scheme/Makefile.in
View File

@ -198,9 +198,9 @@ $(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps)
exit 1;; \ exit 1;; \
esac; \ esac; \
done; \ done; \
echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign scheme/Makefile'; \ echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu scheme/Makefile'; \
cd $(top_srcdir) && \ cd $(top_srcdir) && \
$(AUTOMAKE) --foreign scheme/Makefile $(AUTOMAKE) --gnu scheme/Makefile
.PRECIOUS: Makefile .PRECIOUS: Makefile
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
@case '$?' in \ @case '$?' in \

BIN
scheme/ikarus.boot.8.prebuilt
View File

Binary file not shown.

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

@ -555,14 +555,13 @@
[(ret) (CODE #xC3 ac)] [(ret) (CODE #xC3 ac)]
[(cltd) (C #x99 ac)] [(cltd) (C #x99 ac)]
[(movl src dst) [(movl src dst)
(trace-ac ac `(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 (IMM32 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)])]
[(mov32 src dst) [(mov32 src dst)
;;; FIXME ;;; FIXME
(cond (cond
@ -590,12 +589,10 @@
[(and (imm8? src) (reg? dst)) (CR* #x83 '/0 dst (IMM8 src ac))] [(and (imm8? src) (reg? dst)) (CR* #x83 '/0 dst (IMM8 src ac))]
[(and (imm32? src) (eq? dst '%eax)) (C #x05 (IMM32 src ac))] [(and (imm32? src) (eq? dst '%eax)) (C #x05 (IMM32 src ac))]
[(and (imm32? src) (reg? dst)) (CR* #x81 '/0 dst (IMM32 src ac))] [(and (imm32? src) (reg? dst)) (CR* #x81 '/0 dst (IMM32 src ac))]
[(and (reg? src) (reg? dst)) [(and (reg? src) (reg? dst)) (CR* #x01 src dst ac)]
(trace-ac ac `(addl ,src ,dst) (CR* #x01 src dst ac))]
[(and (mem? src) (reg? dst)) (CR* #x03 dst src ac)] [(and (mem? src) (reg? dst)) (CR* #x03 dst src ac)]
[(and (imm32? src) (mem? dst)) (CR* #x81 '/0 dst (IMM32 src ac))] [(and (imm32? src) (mem? dst)) (CR* #x81 '/0 dst (IMM32 src ac))]
[(and (reg? src) (mem? dst)) [(and (reg? src) (mem? dst)) (CR* #x01 src dst ac)]
(trace-ac ac `(addl ,src ,dst) (CR* #x01 src dst ac))]
[else (die who "invalid" instr)])] [else (die who "invalid" instr)])]
[(subl src dst) [(subl src dst)
(cond (cond
@ -624,16 +621,14 @@
[(and (eq? src '%cl) (mem? dst)) (CR* #xD3 '/5 dst ac)] [(and (eq? src '%cl) (mem? dst)) (CR* #xD3 '/5 dst ac)]
[else (die who "invalid" instr)])] [else (die who "invalid" instr)])]
[(sarl src dst) [(sarl src dst)
(trace-ac ac `(sarl ,src ,dst)
(cond (cond
[(and (equal? 1 src) (reg? dst)) (CR* #xD1 '/7 dst ac)] [(and (equal? 1 src) (reg? dst)) (CR* #xD1 '/7 dst ac)]
[(and (imm8? src) (reg? dst)) (CR* #xC1 '/7 dst (IMM8 src ac))] [(and (imm8? src) (reg? dst)) (CR* #xC1 '/7 dst (IMM8 src ac))]
[(and (imm8? src) (mem? dst)) (CR* #xC1 '/7 dst (IMM8 src ac))] [(and (imm8? src) (mem? dst)) (CR* #xC1 '/7 dst (IMM8 src ac))]
[(and (eq? src '%cl) (reg? dst)) (CR* #xD3 '/7 dst ac)] [(and (eq? src '%cl) (reg? dst)) (CR* #xD3 '/7 dst ac)]
[(and (eq? src '%cl) (mem? dst)) (CR* #xD3 '/7 dst ac)] [(and (eq? src '%cl) (mem? dst)) (CR* #xD3 '/7 dst ac)]
[else (die who "invalid" instr)]))] [else (die who "invalid" instr)])]
[(andl src dst) [(andl src dst)
(trace-ac ac `(andl ,src ,dst)
(cond (cond
[(and (imm32? src) (mem? dst)) (CR* #x81 '/4 dst (IMM32 src ac))] [(and (imm32? src) (mem? dst)) (CR* #x81 '/4 dst (IMM32 src ac))]
[(and (imm8? src) (reg? dst)) (CR* #x83 '/4 dst (IMM8 src ac))] [(and (imm8? src) (reg? dst)) (CR* #x83 '/4 dst (IMM8 src ac))]
@ -642,13 +637,13 @@
[(and (reg? src) (reg? dst)) (CR* #x21 src dst ac)] [(and (reg? src) (reg? dst)) (CR* #x21 src dst ac)]
[(and (reg? src) (mem? dst)) (CR* #x21 src dst ac)] [(and (reg? src) (mem? dst)) (CR* #x21 src dst ac)]
[(and (mem? src) (reg? dst)) (CR* #x23 dst src ac)] [(and (mem? src) (reg? dst)) (CR* #x23 dst src ac)]
[else (die who "invalid" instr)]))] [else (die who "invalid" instr)])]
[(orl src dst) [(orl src dst)
(cond (cond
[(and (imm32? src) (mem? dst)) (CR* #x81 '/1 dst (IMM32 src ac))] [(and (imm32? src) (mem? dst)) (CR* #x81 '/1 dst (IMM32 src ac))]
[(and (reg? src) (mem? dst)) (CR* #x09 src dst ac)] [(and (reg? src) (mem? dst)) (CR* #x09 src dst ac)]
[(and (imm8? src) (reg? dst)) (CR* #x83 '/1 dst (IMM8 src ac))] [(and (imm8? src) (reg? dst)) (CR* #x83 '/1 dst (IMM8 src ac))]
[(and (imm32? src) (eq? dst '%eax)) (CODE #x0D (IMM32 src ac))] [(and (imm32? src) (eq? dst '%eax)) (C #x0D (IMM32 src ac))]
[(and (imm32? src) (reg? dst)) (CR* #x81 '/1 dst (IMM32 src ac))] [(and (imm32? src) (reg? dst)) (CR* #x81 '/1 dst (IMM32 src ac))]
[(and (reg? src) (reg? dst)) (CR* #x09 src dst ac)] [(and (reg? src) (reg? dst)) (CR* #x09 src dst ac)]
[(and (mem? src) (reg? dst)) (CR* #x0B dst src ac)] [(and (mem? src) (reg? dst)) (CR* #x0B dst src ac)]
@ -657,7 +652,7 @@
(cond (cond
[(and (imm8? src) (reg? dst)) (CR* #x83 '/6 dst (IMM8 src ac))] [(and (imm8? src) (reg? dst)) (CR* #x83 '/6 dst (IMM8 src ac))]
[(and (imm8? src) (mem? dst)) (CR* #x83 '/6 dst (IMM8 src ac))] [(and (imm8? src) (mem? dst)) (CR* #x83 '/6 dst (IMM8 src ac))]
[(and (imm32? src) (eq? dst '%eax)) (CODE #x35 (IMM32 src ac))] [(and (imm32? src) (eq? dst '%eax)) (C #x35 (IMM32 src ac))]
[(and (reg? src) (reg? dst)) (CR* #x31 src dst ac)] [(and (reg? src) (reg? dst)) (CR* #x31 src dst ac)]
[(and (mem? src) (reg? dst)) (CR* #x33 dst src ac)] [(and (mem? src) (reg? dst)) (CR* #x33 dst src ac)]
[(and (reg? src) (mem? dst)) (CR* #x31 src dst ac)] [(and (reg? src) (mem? dst)) (CR* #x31 src dst ac)]
@ -667,15 +662,16 @@
[(and (mem? src) (reg? dst)) (CR* #x8D dst src ac)] [(and (mem? src) (reg? dst)) (CR* #x8D dst src ac)]
[else (die who "invalid" instr)])] [else (die who "invalid" instr)])]
[(cmpl src dst) [(cmpl src dst)
(trace-ac ac `(cmpl ,src ,dst)
(cond (cond
[(and (imm8? src) (reg? dst)) (CR* #x83 '/7 dst (IMM8 src ac))] [(and (imm8? src) (reg? dst)) (CR* #x83 '/7 dst (IMM8 src ac))]
[(and (imm32? src) (eq? dst '%eax)) (CODE #x3D (IMM32 src ac))] [(and (imm32? src) (eq? dst '%eax)) (C #x3D (IMM32 src ac))]
[(and (imm32? src) (reg? dst)) (CR* #x81 '/7 dst (IMM32 src ac))] [(and (imm32? src) (reg? dst)) (CR* #x81 '/7 dst (IMM32 src ac))]
[(and (reg? src) (reg? dst)) (CR* #x39 src dst ac)] [(and (reg? src) (reg? dst)) (CR* #x39 src dst ac)]
[(and (mem? src) (reg? dst)) (CR* #x3B dst src ac)] [(and (mem? src) (reg? dst)) (CR* #x3B dst src ac)]
[(and (imm8? src) (mem? dst)) (CR* #x83 '/7 dst (IMM8 src ac))] [(and (imm8? src) (mem? dst)) (CR* #x83 '/7 dst (IMM8 src ac))]
[(and (imm32? src) (mem? dst)) (CR* #x81 '/7 dst (IMM32 src ac))] [(and (imm32? src) (mem? dst)) (CR* #x81 '/7 dst (IMM32 src ac))]
[else (die who "invalid" instr)])] [else (die who "invalid" instr)]))]
[(imull src dst) [(imull src dst)
(cond (cond
[(and (imm8? src) (reg? dst)) (CR* #x6B dst dst (IMM8 src ac))] [(and (imm8? src) (reg? dst)) (CR* #x6B dst dst (IMM8 src ac))]

2
scheme/last-revision
View File

@ -1 +1 @@
1546 1547

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

@ -818,13 +818,13 @@
[(V a b) [(V a b)
(struct-case a (struct-case a
[(constant a) [(constant a)
(unless (fixnum? a) (interrupt)) (unless (fx? a) (interrupt))
(prm 'int* (T b) (K a))] (prm 'int* (T b) (K a))]
[(known a t) (cogen-value-$fx* a b)] [(known a t) (cogen-value-$fx* a b)]
[else [else
(struct-case b (struct-case b
[(constant b) [(constant b)
(unless (fixnum? b) (interrupt)) (unless (fx? b) (interrupt))
(prm 'int* (T a) (K b))] (prm 'int* (T a) (K b))]
[(known b t) (cogen-value-$fx* a b)] [(known b t) (cogen-value-$fx* a b)]
[else [else
@ -963,7 +963,7 @@
[(V s i) [(V s i)
(struct-case i (struct-case i
[(constant i) [(constant i)
(unless (fixnum? i) (interrupt)) (unless (fx? i) (interrupt))
(prm 'sll (prm 'sll
(prm 'logand (prm 'logand
(prm 'mref (T s) (prm 'mref (T s)
@ -1033,7 +1033,7 @@
[(V s i) [(V s i)
(struct-case i (struct-case i
[(constant i) [(constant i)
(unless (and (fixnum? i) (fx<= 0 i) (fx<= i 7)) (unless (and (fx? i) (fx<= 0 i) (fx<= i 7))
(interrupt)) (interrupt))
(prm 'sll (prm 'sll
(prm 'logand (prm 'logand
@ -1058,7 +1058,7 @@
[(E x i v) [(E x i v)
(struct-case i (struct-case i
[(constant i) [(constant i)
(unless (and (fixnum? i) (fx<= 0 i) (fx<= i 7)) (unless (and (fx? i) (fx<= 0 i) (fx<= i 7))
(interrupt)) (interrupt))
(prm 'bset (prm 'bset
(T x) (T x)
@ -1544,7 +1544,7 @@
(struct-case n (struct-case n
[(constant i) [(constant i)
(cond (cond
[(and (fixnum? i) [(and (fx? i)
(>= i 0) (>= i 0)
(< i (- (* wordsize 8) fx-shift))) (< i (- (* wordsize 8) fx-shift)))
(with-tmp ([x (T x)]) (with-tmp ([x (T x)])
@ -1588,7 +1588,7 @@
(struct-case n (struct-case n
[(constant i) [(constant i)
(cond (cond
[(and (fixnum? i) (> i 0) (log2 i)) => [(and (fx? i) (> i 0) (log2 i)) =>
(lambda (bits) (lambda (bits)
(seq* (seq*
(interrupt-unless (cogen-pred-fixnum? x)) (interrupt-unless (cogen-pred-fixnum? x))
@ -1641,7 +1641,7 @@
[(V rtd len) [(V rtd len)
(struct-case len (struct-case len
[(constant i) [(constant i)
(unless (fixnum? i) (interrupt)) (unless (fx? i) (interrupt))
(with-tmp ([t (prm 'alloc (with-tmp ([t (prm 'alloc
(K (align (+ (* i wordsize) disp-struct-data))) (K (align (+ (* i wordsize) disp-struct-data)))
(K vector-tag))]) (K vector-tag))])
@ -1817,7 +1817,7 @@
[(V n) [(V n)
(struct-case n (struct-case n
[(constant n) [(constant n)
(unless (fixnum? n) (interrupt)) (unless (fx? n) (interrupt))
(with-tmp ([s (prm 'alloc (with-tmp ([s (prm 'alloc
(K (align (+ n 1 disp-bytevector-data))) (K (align (+ n 1 disp-bytevector-data)))
(K bytevector-tag))]) (K bytevector-tag))])
@ -1857,7 +1857,7 @@
[(V s i) [(V s i)
(struct-case i (struct-case i
[(constant i) [(constant i)
(unless (fixnum? i) (interrupt)) (unless (fx? i) (interrupt))
(prm 'sll (prm 'sll
(prm 'logand (prm 'logand
(prm 'bref (T s) (prm 'bref (T s)
@ -1906,10 +1906,10 @@
[(E x i c) [(E x i c)
(struct-case i (struct-case i
[(constant i) [(constant i)
(unless (fixnum? i) (interrupt)) (unless (fx? i) (interrupt))
(struct-case c (struct-case c
[(constant c) [(constant c)
(unless (fixnum? c) (interrupt)) (unless (fx? c) (interrupt))
(prm 'bset/c (T x) (prm 'bset/c (T x)
(K (+ i (- disp-bytevector-data bytevector-tag))) (K (+ i (- disp-bytevector-data bytevector-tag)))
(K (cond (K (cond
@ -1923,7 +1923,7 @@
[else [else
(struct-case c (struct-case c
[(constant c) [(constant c)
(unless (fixnum? c) (interrupt)) (unless (fx? c) (interrupt))
(prm 'bset/c (T x) (prm 'bset/c (T x)
(prm 'int+ (prm 'int+
(prm 'sra (T i) (K fx-shift)) (prm 'sra (T i) (K fx-shift))
@ -2103,7 +2103,7 @@
[(V n) [(V n)
(struct-case n (struct-case n
[(constant n) [(constant n)
(unless (fixnum? n) (interrupt)) (unless (fx? n) (interrupt))
(with-tmp ([s (prm 'alloc (with-tmp ([s (prm 'alloc
(K (align (+ (* n wordsize) disp-string-data))) (K (align (+ (* n wordsize) disp-string-data)))
(K string-tag))]) (K string-tag))])
@ -2134,7 +2134,7 @@
[(V s i) [(V s i)
(struct-case i (struct-case i
[(constant i) [(constant i)
(unless (fixnum? i) (interrupt)) (unless (fx? i) (interrupt))
(prm 'mref32 (T s) (prm 'mref32 (T s)
(K (+ (* i char-size) (K (+ (* i char-size)
(- disp-string-data string-tag))))] (- disp-string-data string-tag))))]
@ -2154,7 +2154,7 @@
[(x) [(x)
(struct-case x (struct-case x
[(constant i) [(constant i)
(if (fixnum? i) (nop) (interrupt))] (if (fx? i) (nop) (interrupt))]
[(known expr t) [(known expr t)
(case (T:fixnum? t) (case (T:fixnum? t)
[(yes) (nop)] [(yes) (nop)]
@ -2195,7 +2195,7 @@
[(E x i c) [(E x i c)
(struct-case i (struct-case i
[(constant i) [(constant i)
(unless (fixnum? i) (interrupt)) (unless (fx? i) (interrupt))
(prm 'mset32 (T x) (prm 'mset32 (T x)
(K (+ (* i char-size) (K (+ (* i char-size)
(- disp-string-data string-tag))) (- disp-string-data string-tag)))

4
src/Makefile.in
View File

@ -203,9 +203,9 @@ $(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps)
exit 1;; \ exit 1;; \
esac; \ esac; \
done; \ done; \
echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign src/Makefile'; \ echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu src/Makefile'; \
cd $(top_srcdir) && \ cd $(top_srcdir) && \
$(AUTOMAKE) --foreign src/Makefile $(AUTOMAKE) --gnu src/Makefile
.PRECIOUS: Makefile .PRECIOUS: Makefile
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
@case '$?' in \ @case '$?' in \

4
src/ikarus-collect.c
View File

@ -191,8 +191,8 @@ gc_alloc_new_large_ptr(int size, gc_t* gc){
static inline void static inline void
enqueue_large_ptr(ikptr mem, int size, gc_t* gc){ enqueue_large_ptr(ikptr mem, int size, gc_t* gc){
int i = page_index(mem); long int i = page_index(mem);
int j = page_index(mem+size-1); long int j = page_index(mem+size-1);
while(i<=j){ while(i<=j){
gc->segment_vector[i] = gc->segment_vector[i] =
pointers_mt | large_object_tag | gc->collect_gen_tag; pointers_mt | large_object_tag | gc->collect_gen_tag;