From: simonmar Date: Mon, 15 May 2000 15:03:36 +0000 (+0000) Subject: [project @ 2000-05-15 15:03:36 by simonmar] X-Git-Tag: Approximately_9120_patches~4457 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=0b3dcf9dd504c2db156d08f1908e906e00e66c7a;p=ghc-hetmet.git [project @ 2000-05-15 15:03:36 by simonmar] I lied earlier. _ccall_GC_ should work now. --- diff --git a/ghc/compiler/absCSyn/AbsCSyn.lhs b/ghc/compiler/absCSyn/AbsCSyn.lhs index 3cf44fa..d21f785 100644 --- a/ghc/compiler/absCSyn/AbsCSyn.lhs +++ b/ghc/compiler/absCSyn/AbsCSyn.lhs @@ -1,7 +1,7 @@ % % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % -% $Id: AbsCSyn.lhs,v 1.29 2000/03/23 17:45:17 simonpj Exp $ +% $Id: AbsCSyn.lhs,v 1.30 2000/05/15 15:03:36 simonmar Exp $ % \section[AbstractC]{Abstract C: the last stop before machine code} @@ -473,6 +473,9 @@ data MagicId PrimRep -- Int64Rep or Word64Rep FAST_INT -- its number (1 .. mAX_Long_REG) + | CurrentTSO -- pointer to current thread's TSO + | CurrentNursery -- pointer to allocation area + node = VanillaReg PtrRep ILIT(1) -- A convenient alias for Node tagreg = VanillaReg WordRep ILIT(2) -- A convenient alias for TagReg diff --git a/ghc/compiler/absCSyn/AbsCUtils.lhs b/ghc/compiler/absCSyn/AbsCUtils.lhs index e7a563e..07a91bf 100644 --- a/ghc/compiler/absCSyn/AbsCUtils.lhs +++ b/ghc/compiler/absCSyn/AbsCUtils.lhs @@ -133,6 +133,8 @@ magicIdPrimRep Hp = PtrRep magicIdPrimRep HpLim = PtrRep magicIdPrimRep CurCostCentre = CostCentreRep magicIdPrimRep VoidReg = VoidRep +magicIdPrimRep CurrentTSO = ThreadIdRep +magicIdPrimRep CurrentNursery = PtrRep \end{code} %************************************************************************ diff --git a/ghc/compiler/absCSyn/CLabel.lhs b/ghc/compiler/absCSyn/CLabel.lhs index 523fc09..705da74 100644 --- a/ghc/compiler/absCSyn/CLabel.lhs +++ b/ghc/compiler/absCSyn/CLabel.lhs @@ -1,7 +1,7 @@ % % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % -% $Id: CLabel.lhs,v 1.33 2000/04/13 11:56:35 simonpj Exp $ +% $Id: CLabel.lhs,v 1.34 2000/05/15 15:03:36 simonmar Exp $ % \section[CLabel]{@CLabel@: Information to make C Labels} @@ -418,7 +418,7 @@ pprCLbl (CaseLabel u CaseBitmap) pprCLbl (RtsLabel RtsShouldNeverHappenCode) = ptext SLIT("stg_error_entry") -pprCLbl (RtsLabel RtsUpdInfo) = ptext SLIT("Upd_frame_info") +pprCLbl (RtsLabel RtsUpdInfo) = ptext SLIT("upd_frame_info") pprCLbl (RtsLabel RtsTopTickyCtr) = ptext SLIT("top_ct") diff --git a/ghc/compiler/nativeGen/MachRegs.lhs b/ghc/compiler/nativeGen/MachRegs.lhs index bd72d6b..81ff772 100644 --- a/ghc/compiler/nativeGen/MachRegs.lhs +++ b/ghc/compiler/nativeGen/MachRegs.lhs @@ -584,6 +584,8 @@ baseRegOffset (LongReg _ ILIT(2)) = OFFSET_Lng2 #endif baseRegOffset Hp = OFFSET_Hp baseRegOffset HpLim = OFFSET_HpLim +baseRegOffset CurrentTSO = OFFSET_CurrentTSO +baseRegOffset CurrentNursery = OFFSET_CurrentNursery #ifdef DEBUG baseRegOffset BaseReg = panic "baseRegOffset:BaseReg" baseRegOffset CurCostCentre = panic "baseRegOffset:CurCostCentre" @@ -657,6 +659,12 @@ callerSaves Hp = True #ifdef CALLER_SAVES_HpLim callerSaves HpLim = True #endif +#ifdef CALLER_SAVES_CurrentTSO +callerSaves CurrentTSO = True +#endif +#ifdef CALLER_SAVES_CurrentNursery +callerSaves CurrentNursery = True +#endif callerSaves _ = False \end{code} @@ -735,6 +743,12 @@ magicIdRegMaybe Hp = Just (FixedReg ILIT(REG_Hp)) #ifdef REG_HpLim magicIdRegMaybe HpLim = Just (FixedReg ILIT(REG_HpLim)) #endif +#ifdef REG_CurrentTSO +magicIdRegMaybe CurrentTSO = Just (FixedReg ILIT(REG_CurrentTSO)) +#endif +#ifdef REG_CurrentNursery +magicIdRegMaybe CurrentNursery = Just (FixedReg ILIT(REG_CurrentNursery)) +#endif magicIdRegMaybe _ = Nothing \end{code} diff --git a/ghc/compiler/nativeGen/RegAllocInfo.lhs b/ghc/compiler/nativeGen/RegAllocInfo.lhs index 2f3f5da..d5d3502 100644 --- a/ghc/compiler/nativeGen/RegAllocInfo.lhs +++ b/ghc/compiler/nativeGen/RegAllocInfo.lhs @@ -437,8 +437,8 @@ regUsage instr = case instr of usageM (OpReg reg) = mkRU [reg] [reg] usageM (OpAddr ea) = mkRU (use_EA ea) [] - --callClobberedRegs = [ eax, ecx, edx ] -- according to gcc, anyway. - callClobberedRegs = [eax,fake0,fake1,fake2,fake3,fake4,fake5] + -- caller-saves registers + callClobberedRegs = [eax,ecx,edx,fake0,fake1,fake2,fake3,fake4,fake5] -- Registers defd when an operand is written. def_W (OpReg reg) = [reg] diff --git a/ghc/compiler/nativeGen/Stix.lhs b/ghc/compiler/nativeGen/Stix.lhs index c521ad9..04e1e19 100644 --- a/ghc/compiler/nativeGen/Stix.lhs +++ b/ghc/compiler/nativeGen/Stix.lhs @@ -9,7 +9,8 @@ module Stix ( stixCountTempUses, stixSubst, stgBaseReg, stgNode, stgSp, stgSu, stgSpLim, - stgHp, stgHpLim, stgTagReg, stgR9, stgR10, + stgHp, stgHpLim, stgTagReg, stgR9, stgR10, + stgCurrentTSO, stgCurrentNursery, fixedHS, arrWordsHS, arrPtrsHS, @@ -227,6 +228,8 @@ stgSu = StReg (StixMagicId Su) stgSpLim = StReg (StixMagicId SpLim) stgHp = StReg (StixMagicId Hp) stgHpLim = StReg (StixMagicId HpLim) +stgCurrentTSO = StReg (StixMagicId CurrentTSO) +stgCurrentNursery = StReg (StixMagicId CurrentNursery) stgR9 = StReg (StixMagicId (VanillaReg WordRep ILIT(9))) stgR10 = StReg (StixMagicId (VanillaReg WordRep ILIT(10))) diff --git a/ghc/compiler/nativeGen/StixMacro.lhs b/ghc/compiler/nativeGen/StixMacro.lhs index 522aceb..8eee4e5 100644 --- a/ghc/compiler/nativeGen/StixMacro.lhs +++ b/ghc/compiler/nativeGen/StixMacro.lhs @@ -205,7 +205,7 @@ bh_info, ind_static_info, ind_info :: StixTree 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_info") +upd_frame_info = sStLitLbl SLIT("upd_frame_info") seq_frame_info = sStLitLbl SLIT("seq_frame_info") -- Some common call trees diff --git a/ghc/compiler/nativeGen/StixPrim.lhs b/ghc/compiler/nativeGen/StixPrim.lhs index 49dc68b..034e641 100644 --- a/ghc/compiler/nativeGen/StixPrim.lhs +++ b/ghc/compiler/nativeGen/StixPrim.lhs @@ -14,17 +14,18 @@ import StixInteger import AbsCSyn hiding ( spRel ) import AbsCUtils ( getAmodeRep, mixedTypeLocn ) -import Constants ( uF_UPDATEE ) import SMRep ( fixedHdrSize ) import Literal ( Literal(..), word2IntLit ) import CallConv ( cCallConv ) import PrimOp ( PrimOp(..), CCall(..), CCallTarget(..) ) import PrimRep ( PrimRep(..), isFloatingRep ) import UniqSupply ( returnUs, thenUs, getUniqueUs, UniqSM ) -import Constants ( mIN_INTLIKE ) +import Constants ( mIN_INTLIKE, uF_UPDATEE, bLOCK_SIZE ) import Outputable -import Char ( ord ) +import Char ( ord, isAlphaNum ) + +#include "NCG.h" \end{code} The main honcho here is primCode, which handles the guts of COpStmts. @@ -242,14 +243,17 @@ primCode lhs (CCallOp (CCall (StaticTarget fn) is_asm may_gc cconv)) rhs | is_asm = error "ERROR: Native code generator can't handle casm" | not may_gc = returnUs (\xs -> ccall : xs) | otherwise = + save_thread_state `thenUs` \ save -> + load_thread_state `thenUs` \ load -> getUniqueUs `thenUs` \ uniq -> let - id = StReg (StixTemp uniq IntRep) + id = StReg (StixTemp uniq IntRep) + suspend = StAssign IntRep id (StCall SLIT("suspendThread") cconv IntRep [stgBaseReg]) resume = StCall SLIT("resumeThread") cconv VoidRep [id] in - returnUs (\xs -> suspend : ccall : resume : xs) + returnUs (\xs -> save (suspend : ccall : resume : load xs)) where args = map amodeCodeForCCall rhs @@ -459,12 +463,11 @@ amodeToStix (CMacroExpr _ macro [arg]) litLitToStix :: String -> StixTree litLitToStix nm - = case nm of - "stdout" -> stixFor_stdout - "stderr" -> stixFor_stderr - "stdin" -> stixFor_stdin - other -> error ("\nlitLitToStix: can't handle `" ++ nm ++ "'\n" + | all is_id nm = StLitLbl (text nm) + | otherwise = error ("\nlitLitToStix: can't handle `" ++ nm ++ "'\n" ++ "suggested workaround: use flag -fvia-C\n") + + where is_id c = isAlphaNum c || c == '_' \end{code} Sizes of the CharLike and IntLike closures that are arranged as arrays @@ -495,3 +498,62 @@ mutArrPtrsFrozen_info = sStLitLbl SLIT("MUT_ARR_PTRS_FROZEN_info") charLikeSize = (fixedHdrSize + 1) * (fromInteger (sizeOf PtrRep)) intLikeSize = (fixedHdrSize + 1) * (fromInteger (sizeOf PtrRep)) \end{code} + + +\begin{code} +save_thread_state + = getUniqueUs `thenUs` \tso_uq -> + let tso = StReg (StixTemp tso_uq ThreadIdRep) in + returnUs (\xs -> + StAssign ThreadIdRep tso stgCurrentTSO : + StAssign PtrRep + (StInd PtrRep (StPrim IntAddOp + [tso, StInt (toInteger (TSO_SP*BYTES_PER_WORD))])) + stgSp : + StAssign PtrRep + (StInd PtrRep (StPrim IntAddOp + [tso, StInt (toInteger (TSO_SU*BYTES_PER_WORD))])) + stgSu : + StAssign PtrRep + (StInd PtrRep (StPrim IntAddOp + [tso, StInt (toInteger (TSO_SPLIM*BYTES_PER_WORD))])) + stgSpLim : + StAssign PtrRep + (StInd PtrRep (StPrim IntAddOp + [stgCurrentNursery, + StInt (toInteger (BDESCR_FREE * BYTES_PER_WORD))])) + (StPrim IntAddOp [stgHp, StInt (toInteger (1 * BYTES_PER_WORD))]) : + xs + ) + +load_thread_state + = getUniqueUs `thenUs` \tso_uq -> + let tso = StReg (StixTemp tso_uq ThreadIdRep) in + returnUs (\xs -> + StAssign ThreadIdRep tso stgCurrentTSO : + StAssign PtrRep stgSp + (StInd PtrRep (StPrim IntAddOp + [tso, StInt (toInteger (TSO_SP*BYTES_PER_WORD))])) : + StAssign PtrRep stgSu + (StInd PtrRep (StPrim IntAddOp + [tso, StInt (toInteger (TSO_SU*BYTES_PER_WORD))])) : + StAssign PtrRep stgSpLim + (StInd PtrRep (StPrim IntAddOp + [tso, StInt (toInteger (TSO_SPLIM*BYTES_PER_WORD))])) : + StAssign PtrRep stgHp + (StPrim IntSubOp [ + StInd PtrRep (StPrim IntAddOp + [stgCurrentNursery, + StInt (toInteger (BDESCR_FREE * BYTES_PER_WORD))]), + StInt (toInteger (1 * BYTES_PER_WORD)) + ]) : + StAssign PtrRep stgHpLim + (StPrim IntAddOp [ + StInd PtrRep (StPrim IntAddOp + [stgCurrentNursery, + StInt (toInteger (BDESCR_START * BYTES_PER_WORD))]), + StInt (toInteger (bLOCK_SIZE - (1 * BYTES_PER_WORD))) + ]) : + xs + ) +\end{code}