From af875ba836454eaf5a45dea24da08460733efe36 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 2 Jul 2009 00:51:06 -0500
Subject: [PATCH] compiler.cfg: bug fixes in GC check insertion and fixnum
intrinsics
---
.../cfg/instructions/instructions.factor | 2 +-
.../cfg/intrinsics/fixnum/fixnum.factor | 43 +++++++------------
.../linear-scan/assignment/assignment.factor | 4 +-
3 files changed, 18 insertions(+), 31 deletions(-)
diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor
index 17a02175d5..8e2d2ff75e 100644
--- a/basis/compiler/cfg/instructions/instructions.factor
+++ b/basis/compiler/cfg/instructions/instructions.factor
@@ -240,7 +240,7 @@ INSN: _compare-imm-branch label { src1 vreg } { src2 integer } cc ;
INSN: _compare-float-branch < _conditional-branch ;
-TUPLE: spill-slot n ; C: <spill-slot> spill-slot
+TUPLE: spill-slot { n integer } ; C: <spill-slot> spill-slot
INSN: _gc { temp1 vreg } { temp2 vreg } gc-roots gc-root-count gc-root-size ;
diff --git a/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor b/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor
index bfae02f553..9efac9e81a 100644
--- a/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor
+++ b/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor
@@ -39,38 +39,25 @@ IN: compiler.cfg.intrinsics.fixnum
:: emit-commutative-fixnum-op ( node insn imm-insn -- )
[let | infos [ node node-input-infos ] |
- infos first value-info-small-tagged?
- [ infos imm-insn emit-fixnum-imm-op1 ]
- [
- infos second value-info-small-tagged? [
- infos imm-insn emit-fixnum-imm-op2
- ] [
- insn (emit-fixnum-op)
- ] if
- ] if
+ {
+ { [ infos first value-info-small-tagged? ] [ infos imm-insn emit-fixnum-imm-op1 ] }
+ { [ infos second value-info-small-tagged? ] [ infos imm-insn emit-fixnum-imm-op2 ] }
+ [ insn (emit-fixnum-op) ]
+ } cond
ds-push
] ; inline
-: (emit-fixnum-shift-fast) ( obj node -- obj )
- literal>> dup sgn {
- { -1 [ neg tag-bits get + ^^sar-imm ^^tag-fixnum ] }
- { 0 [ drop ] }
- { 1 [ ^^shl-imm ] }
- } case ;
-
: emit-fixnum-shift-fast ( node -- )
- dup node-input-infos dup first value-info-small-fixnum? [
+ dup node-input-infos dup second value-info-small-fixnum? [
nip
- [ ds-pop ds-drop ] dip first (emit-fixnum-shift-fast) ds-push
- ] [
- drop
- dup node-input-infos dup second value-info-small-fixnum? [
- nip
- [ ds-drop ds-pop ] dip second (emit-fixnum-shift-fast) ds-push
- ] [
- drop emit-primitive
- ] if
- ] if ;
+ [ ds-drop ds-pop ] dip
+ second literal>> dup sgn {
+ { -1 [ neg tag-bits get + ^^sar-imm ^^tag-fixnum ] }
+ { 0 [ drop ] }
+ { 1 [ ^^shl-imm ] }
+ } case
+ ds-push
+ ] [ drop emit-primitive ] if ;
: emit-fixnum-bitnot ( -- )
ds-pop ^^not tag-mask get ^^xor-imm ds-push ;
@@ -89,7 +76,7 @@ IN: compiler.cfg.intrinsics.fixnum
: emit-fixnum*fast ( node -- )
node-input-infos
- dup first value-info-small-fixnum?
+ dup first value-info-small-fixnum? drop f
[
(emit-fixnum*fast-imm1)
] [
diff --git a/basis/compiler/cfg/linear-scan/assignment/assignment.factor b/basis/compiler/cfg/linear-scan/assignment/assignment.factor
index 745146b56e..0956b7263f 100644
--- a/basis/compiler/cfg/linear-scan/assignment/assignment.factor
+++ b/basis/compiler/cfg/linear-scan/assignment/assignment.factor
@@ -136,8 +136,8 @@ M: vreg-insn assign-registers-in-insn
register-mapping ;
: compute-live-spill-slots ( -- spill-slots )
- spill-slots get values [ values ] map concat
- [ [ vreg>> ] [ reload-from>> ] bi ] { } map>assoc ;
+ spill-slots get values
+ [ [ vreg>> swap ] { } assoc-map-as ] map concat ;
M: ##gc assign-registers-in-insn
dup call-next-method