From: simonm Date: Mon, 1 Mar 1999 17:41:24 +0000 (+0000) Subject: [project @ 1999-03-01 17:41:21 by simonm] X-Git-Tag: Approximately_9120_patches~6477 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=de5fbb6984f5ca3cd3f419916cf6dea8ddab0b1c;p=ghc-hetmet.git [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 --- 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 --- 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 --- 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