[project @ 1999-03-01 17:41:21 by simonm]

Some native codegen updates.

diff --git a/ghc/compiler/codeGen/SMRep.lhs b/ghc/compiler/codeGen/SMRep.lhs
index 9a36a33..0e8f628 100644 (file)
--- a/ghc/compiler/codeGen/SMRep.lhs
+++ b/ghc/compiler/codeGen/SMRep.lhs
@@ -14,19 +14,34 @@ module SMRep (
 
 #ifndef OMIT_NATIVE_CODEGEN
        , getSMRepClosureTypeInt
-       , cONSTR                  
-       , cONSTR_STATIC           
-       , cONSTR_NOCAF_STATIC     
-       , fUN                     
-       , fUN_STATIC              
-       , tHUNK                   
-       , tHUNK_STATIC            
-       , tHUNK_SELECTOR          
-       , rET_SMALL               
-       , rET_VEC_SMALL           
-       , rET_BIG                 
+       , cONSTR
+       , cONSTR_1_0
+       , cONSTR_0_1
+       , cONSTR_2_0
+       , cONSTR_1_1
+       , cONSTR_0_2
+       , cONSTR_STATIC
+       , cONSTR_NOCAF_STATIC
+       , fUN
+       , fUN_1_0
+       , fUN_0_1
+       , fUN_2_0
+       , fUN_1_1
+       , fUN_0_2
+       , fUN_STATIC
+       , tHUNK
+       , tHUNK_1_0
+       , tHUNK_0_1
+       , tHUNK_2_0
+       , tHUNK_1_1
+       , tHUNK_0_2
+       , tHUNK_STATIC
+       , tHUNK_SELECTOR
+       , rET_SMALL
+       , rET_VEC_SMALL
+       , rET_BIG
        , rET_VEC_BIG
-       , bLACKHOLE               
+       , bLACKHOLE
 #endif
     ) where
 
@@ -34,9 +49,9 @@ module SMRep (
 
 import CmdLineOpts
 import AbsCSyn         ( Liveness(..) )
-import Constants       ( sTD_HDR_SIZE, pROF_HDR_SIZE, 
+import Constants       ( sTD_HDR_SIZE, pROF_HDR_SIZE,
                          gRAN_HDR_SIZE, tICKY_HDR_SIZE, aRR_HDR_SIZE,
-                         sTD_ITBL_SIZE, pROF_ITBL_SIZE, 
+                         sTD_ITBL_SIZE, pROF_ITBL_SIZE,
                          gRAN_ITBL_SIZE, tICKY_ITBL_SIZE )
 import Outputable
 import GlaExts         ( Int(..), Int#, (<#), (==#), (<#), (>#) )
@@ -158,14 +173,29 @@ pprClosureType THUNK_SELECTOR   = ptext SLIT("THUNK_SELECTOR")
 #ifndef OMIT_NATIVE_CODEGEN
 getSMRepClosureTypeInt :: SMRep -> Int
 getSMRepClosureTypeInt (GenericRep _ _ t) =
-  case t of 
+  case t of
     CONSTR        -> cONSTR
+    CONSTR_p_n 1 0 -> cONSTR_1_0
+    CONSTR_p_n 0 1 -> cONSTR_0_1
+    CONSTR_p_n 2 0 -> cONSTR_2_0
+    CONSTR_p_n 1 1 -> cONSTR_1_1
+    CONSTR_p_n 0 2 -> cONSTR_0_2
     CONSTR_NOCAF   -> panic "getClosureTypeInt: CONSTR_NOCAF"
     FUN           -> fUN
+    FUN_p_n 1 0    -> fUN_1_0
+    FUN_p_n 0 1    -> fUN_0_1
+    FUN_p_n 2 0    -> fUN_2_0
+    FUN_p_n 1 1    -> fUN_1_1
+    FUN_p_n 0 2    -> fUN_0_2
     THUNK         -> tHUNK
+    THUNK_p_n 1 0  -> tHUNK_1_0
+    THUNK_p_n 0 1  -> tHUNK_0_1
+    THUNK_p_n 2 0  -> tHUNK_2_0
+    THUNK_p_n 1 1  -> tHUNK_1_1
+    THUNK_p_n 0 2  -> tHUNK_0_2
     THUNK_SELECTOR -> tHUNK_SELECTOR
 getSMRepClosureTypeInt (StaticRep _ _ t) =
-  case t of 
+  case t of
     CONSTR        -> cONSTR_STATIC
     CONSTR_NOCAF   -> cONSTR_NOCAF_STATIC
     FUN           -> fUN_STATIC
@@ -181,11 +211,26 @@ getSMRepClosureTypeInt BlackHoleRep = bLACKHOLE
 #include "../includes/ClosureTypes.h"
 
 cONSTR                  = (CONSTR               :: Int)
+cONSTR_1_0              = (CONSTR_1_0           :: Int)
+cONSTR_0_1              = (CONSTR_0_1           :: Int)
+cONSTR_2_0              = (CONSTR_2_0           :: Int)
+cONSTR_1_1              = (CONSTR_1_1           :: Int)
+cONSTR_0_2              = (CONSTR_0_2           :: Int)
 cONSTR_STATIC           = (CONSTR_STATIC        :: Int)
 cONSTR_NOCAF_STATIC     = (CONSTR_NOCAF_STATIC  :: Int)
 fUN                     = (FUN                  :: Int)
+fUN_1_0                 = (FUN_1_0              :: Int)
+fUN_0_1                 = (FUN_0_1              :: Int)
+fUN_2_0                 = (FUN_2_0              :: Int)
+fUN_1_1                 = (FUN_1_1              :: Int)
+fUN_0_2                 = (FUN_0_2              :: Int)
 fUN_STATIC              = (FUN_STATIC           :: Int)
 tHUNK                   = (THUNK                :: Int)
+tHUNK_1_0               = (THUNK_1_0            :: Int)
+tHUNK_0_1               = (THUNK_0_1            :: Int)
+tHUNK_2_0               = (THUNK_2_0            :: Int)
+tHUNK_1_1               = (THUNK_1_1            :: Int)
+tHUNK_0_2               = (THUNK_0_2            :: Int)
 tHUNK_STATIC            = (THUNK_STATIC         :: Int)
 tHUNK_SELECTOR          = (THUNK_SELECTOR       :: Int)
 rET_SMALL               = (RET_SMALL            :: Int)

diff --git a/ghc/compiler/nativeGen/MachCode.lhs b/ghc/compiler/nativeGen/MachCode.lhs
index 0fd076d..cbfe9dc 100644 (file)
--- a/ghc/compiler/nativeGen/MachCode.lhs
+++ b/ghc/compiler/nativeGen/MachCode.lhs
@@ -757,7 +757,7 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
                          mkSeqInstr (LEA sz (OpAddr (AddrBaseIndex (Just src1) Nothing src2)) (OpReg dst))
        in
        returnUs (Any IntRep code__2)
-
+{-
     add_code sz x (StInd _ mem)
       = getRegister x          `thenUs` \ register1 ->
        --getNewRegNCG (registerRep register1)
@@ -767,7 +767,6 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
            code2 = amodeCode amode
            src2  = amodeAddr amode
 
---         fixedname  = registerName register1 eax
            code__2 dst = let code1 = registerCode register1 dst
                              src1  = registerName register1 dst
                          in asmParThen [code2 asmVoid,code1 asmVoid] .
@@ -788,7 +787,6 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
            code1 = amodeCode amode
            src1  = amodeAddr amode
 
---         fixedname  = registerName register2 eax
            code__2 dst = let code2 = registerCode register2 dst
                              src2  = registerName register2 dst
                          in asmParThen [code1 asmVoid,code2 asmVoid] .
@@ -799,7 +797,7 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
                                    mkSeqInstrs [ADD sz (OpAddr src1) (OpReg src2)]
        in
        returnUs (Any IntRep code__2)
-
+-}
     add_code sz x y
       = getRegister x          `thenUs` \ register1 ->
        getRegister y           `thenUs` \ register2 ->
@@ -2786,7 +2784,6 @@ trivialCode instr x y
   = getRegister x              `thenUs` \ register1 ->
     --getNewRegNCG IntRep      `thenUs` \ tmp1 ->
     let
---     fixedname  = registerName register1 eax
        code__2 dst = let code1 = registerCode register1 dst
                          src1  = registerName register1 dst
                      in code1 .
@@ -2806,7 +2803,6 @@ trivialCode instr x y
   = getRegister y              `thenUs` \ register1 ->
     --getNewRegNCG IntRep      `thenUs` \ tmp1 ->
     let
---     fixedname  = registerName register1 eax
        code__2 dst = let code1 = registerCode register1 dst
                          src1  = registerName register1 dst
                      in code1 .
@@ -2820,13 +2816,12 @@ trivialCode instr x y
   where
     imm = maybeImm x
     imm__2 = case imm of Just x -> x
-
+{-
 trivialCode instr x (StInd pk mem)
   = getRegister x              `thenUs` \ register ->
     --getNewRegNCG IntRep      `thenUs` \ tmp ->
     getAmode mem               `thenUs` \ amode ->
     let
---     fixedname  = registerName register eax
        code2 = amodeCode amode asmVoid
        src2  = amodeAddr amode
        code__2 dst = let code1 = registerCode register dst asmVoid
@@ -2845,7 +2840,6 @@ trivialCode instr (StInd pk mem) y
     --getNewRegNCG IntRep      `thenUs` \ tmp ->
     getAmode mem               `thenUs` \ amode ->
     let
---     fixedname  = registerName register eax
        code2 = amodeCode amode asmVoid
        src2  = amodeAddr amode
        code__2 dst = let
@@ -2859,14 +2853,13 @@ trivialCode instr (StInd pk mem) y
                                mkSeqInstr (instr (OpAddr src2) (OpReg src1))
     in
     returnUs (Any pk code__2)
-
+-}
 trivialCode instr x y
   = getRegister x              `thenUs` \ register1 ->
     getRegister y              `thenUs` \ register2 ->
     --getNewRegNCG IntRep      `thenUs` \ tmp1 ->
     getNewRegNCG IntRep                `thenUs` \ tmp2 ->
     let
---     fixedname  = registerName register1 eax
        code2 = registerCode register2 tmp2 asmVoid
        src2  = registerName register2 tmp2
        code__2 dst = let
@@ -2886,7 +2879,6 @@ trivialUCode instr x
   = getRegister x              `thenUs` \ register ->
 --    getNewRegNCG IntRep      `thenUs` \ tmp ->
     let
---     fixedname = registerName register eax
        code__2 dst = let
                          code = registerCode register dst
                          src  = registerName register dst
@@ -3241,7 +3233,6 @@ chrCode x
   = getRegister x              `thenUs` \ register ->
     --getNewRegNCG IntRep      `thenUs` \ reg ->
     let
---     fixedname = registerName register eax
        code__2 dst = let
                          code = registerCode register dst
                          src  = registerName register dst

diff --git a/ghc/compiler/nativeGen/StixMacro.lhs b/ghc/compiler/nativeGen/StixMacro.lhs
index 2597734..747759e 100644 (file)
--- a/ghc/compiler/nativeGen/StixMacro.lhs
+++ b/ghc/compiler/nativeGen/StixMacro.lhs
@@ -76,7 +76,7 @@ macroCode UPD_CAF args
        blocking_queue = StInd PtrRep (StIndex PtrRep bhptr fixedHS)
        a1 = StAssign PtrRep w0 ind_static_info
        a2 = StAssign PtrRep w1 bhptr
-       a3 = StAssign PtrRep blocking_queue end_tso_queue
+       a3 = StCall SLIT("newCAF") cCallConv VoidRep [cafptr]
     in
     returnUs (\xs -> a1 : a2 : a3 : xs)
 \end{code}
@@ -161,7 +161,6 @@ bh_info     = sStLitLbl SLIT("BLACKHOLE_info")
 ind_static_info        = sStLitLbl SLIT("IND_STATIC_info")
 ind_info       = sStLitLbl SLIT("IND_info")
 upd_frame_info = sStLitLbl SLIT("Upd_frame_entry")
-end_tso_queue  = sStLitLbl SLIT("END_TSO_QUEUE_closure")
 
 -- Some common call trees