Commit 0f3bf354 authored by simonmar's avatar simonmar

[project @ 2000-03-16 12:37:05 by simonmar]

Clean up the module initialisation stuff a bit, and add support for
module initialisation blocks in the native code generator.
parent bbdf493b
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: AbsCSyn.lhs,v 1.27 2000/03/08 17:48:24 simonmar Exp $
% $Id: AbsCSyn.lhs,v 1.28 2000/03/16 12:37:06 simonmar Exp $
%
\section[AbstractC]{Abstract C: the last stop before machine code}
......@@ -202,7 +202,7 @@ stored in a mixed type location.)
TyCon -- which TyCon this table is for
| CModuleInitBlock -- module initialisation block
CAddrMode -- label for init block
CLabel -- label for init block
AbstractC -- initialisation code
| CCostCentreDecl -- A cost centre *declaration*
......
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CLabel.lhs,v 1.30 1999/12/02 17:57:13 simonmar Exp $
% $Id: CLabel.lhs,v 1.31 2000/03/16 12:37:06 simonmar Exp $
%
\section[CLabel]{@CLabel@: Information to make C Labels}
......@@ -34,6 +34,8 @@ module CLabel (
mkAsmTempLabel,
mkModuleInitLabel,
mkErrorStdEntryLabel,
mkUpdInfoLabel,
mkTopTickyCtrLabel,
......@@ -42,6 +44,8 @@ module CLabel (
mkSECAFBlackHoleInfoTableLabel,
mkRtsPrimOpLabel,
moduleRegdLabel,
mkSelectorInfoLabel,
mkSelectorEntryLabel,
......@@ -67,7 +71,7 @@ import {-# SOURCE #-} MachMisc ( underscorePrefix, fmtAsmLbl )
import CmdLineOpts ( opt_Static, opt_DoTickyProfiling )
import CStrings ( pp_cSEP )
import DataCon ( ConTag, DataCon )
import Module ( isDynamicModule )
import Module ( isDynamicModule, ModuleName, moduleNameString )
import Name ( Name, getName, isExternallyVisibleName, nameModule, isLocallyDefinedName )
import TyCon ( TyCon )
import Unique ( pprUnique, Unique )
......@@ -107,6 +111,8 @@ data CLabel
| AsmTempLabel Unique
| ModuleInitLabel ModuleName
| RtsLabel RtsLabelInfo
| CC_Label CostCentre
......@@ -170,6 +176,8 @@ data RtsLabelInfo
| RtsTopTickyCtr
| RtsModuleRegd
deriving (Eq, Ord)
-- Label Type: for generating C declarations.
......@@ -211,6 +219,8 @@ mkClosureTblLabel tycon = TyConLabel tycon
mkAsmTempLabel = AsmTempLabel
mkModuleInitLabel = ModuleInitLabel
-- Some fixed runtime system labels
mkErrorStdEntryLabel = RtsLabel RtsShouldNeverHappenCode
......@@ -224,6 +234,8 @@ mkSECAFBlackHoleInfoTableLabel = if opt_DoTickyProfiling then
panic "mkSECAFBlackHoleInfoTableLabel requires -ticky"
mkRtsPrimOpLabel primop = RtsLabel (RtsPrimOp primop)
moduleRegdLabel = RtsLabel RtsModuleRegd
mkSelectorInfoLabel upd off = RtsLabel (RtsSelectorInfoTbl upd off)
mkSelectorEntryLabel upd off = RtsLabel (RtsSelectorEntry upd off)
......@@ -262,6 +274,7 @@ needsCDecl (CaseLabel _ _) = False
needsCDecl (TyConLabel _) = True
needsCDecl (AsmTempLabel _) = False
needsCDecl (ModuleInitLabel _) = False
needsCDecl (RtsLabel _) = False
needsCDecl (CC_Label _) = False
needsCDecl (CCS_Label _) = False
......@@ -284,6 +297,8 @@ externallyVisibleCLabel (DataConLabel _ _) = True
externallyVisibleCLabel (TyConLabel tc) = True
externallyVisibleCLabel (CaseLabel _ _) = False
externallyVisibleCLabel (AsmTempLabel _) = False
externallyVisibleCLabel (ModuleInitLabel _)= True
externallyVisibleCLabel (RtsLabel RtsModuleRegd) = False --hack
externallyVisibleCLabel (RtsLabel _) = True
externallyVisibleCLabel (IdLabel id _) = isExternallyVisibleName id
externallyVisibleCLabel (CC_Label _) = False -- not strictly true
......@@ -448,6 +463,9 @@ pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
pprCLbl (RtsLabel (RtsPrimOp primop))
= pprPrimOp primop <> ptext SLIT("_fast")
pprCLbl (RtsLabel RtsModuleRegd)
= ptext SLIT("module_registered")
pprCLbl (TyConLabel tc)
= hcat [ppr tc, pp_cSEP, ptext SLIT("closure_tbl")]
......@@ -457,6 +475,8 @@ pprCLbl (DataConLabel con flavor) = ppr con <> ppConFlavor flavor
pprCLbl (CC_Label cc) = ppr cc
pprCLbl (CCS_Label ccs) = ppr ccs
pprCLbl (ModuleInitLabel mod) = ptext SLIT("__init_") <> ptext mod
ppIdFlavor :: IdLabelInfo -> SDoc
ppIdFlavor x = pp_cSEP <>
......
......@@ -563,9 +563,9 @@ pprAbsC stmt@(CRetVector lbl amodes srt liveness) _
LvLarge _ -> SLIT("RET_VEC_BIG")
pprAbsC stmt@(CModuleInitBlock label code) _
pprAbsC stmt@(CModuleInitBlock lbl code) _
= vcat [
ptext SLIT("START_MOD_INIT") <> parens (ppr_amode label),
ptext SLIT("START_MOD_INIT") <> parens (pprCLabel lbl),
case (pprTempAndExternDecls stmt) of { (_, pp_exts) -> pp_exts },
pprAbsC code (costs code),
hcat [ptext SLIT("END_MOD_INIT"), lparen, rparen]
......
......@@ -22,7 +22,7 @@ module CodeGen ( codeGen ) where
import StgSyn
import CgMonad
import AbsCSyn
import CLabel ( CLabel, mkSRTLabel, mkClosureLabel )
import CLabel ( CLabel, mkSRTLabel, mkClosureLabel, mkModuleInitLabel )
import PprAbsC ( dumpRealC )
import AbsCUtils ( mkAbstractCs, mkAbsCStmts, flattenAbsC )
......@@ -117,17 +117,16 @@ mkModuleInit fe_binders mod imps cost_centre_info
(cc_decls, cc_regs) = mkCostCentreStuff cost_centre_info
mk_reg_lbl mod_name
= CLitLit (_PK_ ("__init_" ++ moduleNameString mod_name)) AddrRep
mk_import_register import_name
= CMacroStmt REGISTER_IMPORT [mk_reg_lbl import_name]
= CMacroStmt REGISTER_IMPORT [
CLbl (mkModuleInitLabel import_name) AddrRep
]
register_imports = map mk_import_register imps
in
mkAbstractCs [
mkAbstractCs [
cc_decls,
CModuleInitBlock (mk_reg_lbl (Module.moduleName mod))
CModuleInitBlock (mkModuleInitLabel (Module.moduleName mod))
(mkAbstractCs (register_fes ++
cc_regs :
register_imports))
......
......@@ -23,7 +23,8 @@ import SMRep ( fixedItblSize,
)
import Constants ( mIN_UPD_SIZE )
import CLabel ( CLabel, mkReturnInfoLabel, mkReturnPtLabel,
mkClosureTblLabel, mkStaticClosureLabel )
mkClosureTblLabel, mkStaticClosureLabel,
moduleRegdLabel )
import ClosureInfo ( infoTableLabelFromCI, entryLabelFromCI,
fastLabelFromCI, closureUpdReqd,
staticClosureNeedsLink
......@@ -150,10 +151,26 @@ Here we handle top-level things, like @CCodeBlock@s and
(tyConDataCons tycon) )
]
gentopcode stmt@(CModuleInitBlock lbl absC)
= gencode absC `thenUs` \ code ->
getUniqLabelNCG `thenUs` \ tmp_lbl ->
returnUs ( StSegment DataSegment
: StLabel moduleRegdLabel
: StData IntRep [StInt 0]
: StSegment TextSegment
: StLabel lbl
: StCondJump tmp_lbl (StPrim IntNeOp [StCLbl moduleRegdLabel,
StInt 0])
: StAssign IntRep (StInd IntRep (StCLbl moduleRegdLabel)) (StInt 1)
: code
[ StLabel tmp_lbl
, StAssign PtrRep stgSp (StPrim IntSubOp [stgSp, StInt 4])
, StJump (StInd WordRep stgSp)
])
gentopcode absC
= gencode absC `thenUs` \ code ->
returnUs (StSegment TextSegment : code [])
\end{code}
\begin{code}
......
......@@ -65,6 +65,7 @@ stmt2Instrs stmt = case stmt of
LABEL lab)))
StFunEnd lab -> IF_ARCH_alpha(returnNat (unitOL (FUNEND lab)),
returnNat nilOL)
StLabel lab -> returnNat (unitOL (LABEL lab))
StJump arg -> genJump arg
......
......@@ -166,19 +166,28 @@ macroCode SET_TAG [tag]
case stgReg tagreg of
Always _ -> returnUs id
Save _ -> returnUs (\ xs -> set_tag : xs)
\end{code}
-----------------------------------------------------------------------------
\begin{code}
macroCode REGISTER_IMPORT [arg]
= returnUs (
\xs -> StAssign WordRep (StInd WordRep stgSp) (amodeToStix arg)
: StAssign PtrRep stgSp (StPrim IntAddOp [stgSp, StInt 4])
: xs
)
macroCode REGISTER_FOREIGN_EXPORT [arg]
= returnUs (
\xs -> StCall SLIT("getStablePtr") cCallConv VoidRep [amodeToStix arg]
: xs
)
macroCode other args
= case other of
ARGS_CHK -> error "foobarxyzzy1"
ARGS_CHK_LOAD_NODE -> error "foobarxyzzy2"
UPD_CAF -> error "foobarxyzzy3"
UPD_BH_UPDATABLE -> error "foobarxyzzy4"
UPD_BH_SINGLE_ENTRY -> error "foobarxyzzy5"
PUSH_UPD_FRAME -> error "foobarxyzzy6"
PUSH_SEQ_FRAME -> error "foobarxyzzy7"
UPDATE_SU_FROM_UPD_FRAME -> error "foobarxyzzy8"
SET_TAG -> error "foobarxyzzy9"
SET_TAG -> error "foobarxyzzy8"
_ -> error "StixMacro.macroCode: unknown macro/args"
\end{code}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment