# -----------------------------------------------------------------------------
-# $Id: Makefile,v 1.55 1999/05/11 16:37:29 keithw Exp $
+# $Id: Makefile,v 1.56 1999/05/13 17:30:50 simonm Exp $
TOP = ..
include $(TOP)/mk/boilerplate.mk
parser/U_tree_HC_OPTS = -H12m -fvia-C '-\#include"hspincl.h"'
parser/U_ttype_HC_OPTS = -fvia-C '-\#include"hspincl.h"'
+# Avoids Bug in 3.02, it seems
+usageSP/UsageSPInf_HC_OPTS = -Onot
+
prelude/PrimOp_HC_OPTS = -H12m -K3m
reader/Lex_HC_OPTS = -K2m -H16m -fvia-C
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: AbsCSyn.lhs,v 1.22 1999/04/26 16:06:27 simonm Exp $
+% $Id: AbsCSyn.lhs,v 1.23 1999/05/13 17:30:52 simonm Exp $
%
\section[AbstractC]{Abstract C: the last stop before machine code}
-- (for the benefit of the native code generators)
-- Equivalent to CJump in C land
- | CReturn -- This used to be RetVecRegRel
- CAddrMode -- Any base address mode
- ReturnInfo -- How to get the return address from the base address
+ | CReturn -- Perform a return
+ CAddrMode -- Address of a RET_<blah> info table
+ ReturnInfo -- Whether it's a direct or vectored return
| CSwitch !CAddrMode
[(Literal, AbstractC)] -- alternatives
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: CLabel.lhs,v 1.26 1999/05/11 16:44:04 keithw Exp $
+% $Id: CLabel.lhs,v 1.27 1999/05/13 17:30:52 simonm Exp $
%
\section[CLabel]{@CLabel@: Information to make C Labels}
mkAsmTempLabel,
mkErrorStdEntryLabel,
- mkUpdEntryLabel,
+ mkUpdInfoLabel,
mkCAFBlackHoleInfoTableLabel,
mkSECAFBlackHoleInfoTableLabel,
mkRtsPrimOpLabel,
mkCC_Label, mkCCS_Label,
- needsCDecl, isReadOnly, isAsmTemp, externallyVisibleCLabel,
+ needsCDecl, isAsmTemp, externallyVisibleCLabel,
CLabelType(..), labelType, labelDynamic,
| RtsBlackHoleInfoTbl FAST_STRING -- black hole with info table name
- | RtsUpdEntry
+ | RtsUpdInfo
| RtsSelectorInfoTbl Bool{-updatable-} Int{-offset-} -- Selector thunks
| RtsSelectorEntry Bool{-updatable-} Int{-offset-}
-- Some fixed runtime system labels
mkErrorStdEntryLabel = RtsLabel RtsShouldNeverHappenCode
-mkUpdEntryLabel = RtsLabel RtsUpdEntry
+mkUpdInfoLabel = RtsLabel RtsUpdInfo
mkCAFBlackHoleInfoTableLabel = RtsLabel (RtsBlackHoleInfoTbl SLIT("CAF_BLACKHOLE_info"))
mkSECAFBlackHoleInfoTableLabel = if opt_DoTickyProfiling then
RtsLabel (RtsBlackHoleInfoTbl SLIT("SE_CAF_BLACKHOLE_info"))
\begin{code}
needsCDecl :: CLabel -> Bool -- False <=> it's pre-declared; don't bother
-isReadOnly :: CLabel -> Bool -- lives in C "text space"
isAsmTemp :: CLabel -> Bool -- is a local temporary for native code generation
externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
\end{code}
needsCDecl (CCS_Label _) = False
\end{code}
-Whether the labelled thing can be put in C "text space":
-
-\begin{code}
-isReadOnly (IdLabel _ InfoTbl) = True -- info-tables: yes
-isReadOnly (IdLabel _ other) = False -- others: pessimistically, no
-
-isReadOnly (DataConLabel _ _) = True -- and so on, for other
-isReadOnly (TyConLabel _) = True
-isReadOnly (CaseLabel _ _) = True
-isReadOnly (AsmTempLabel _) = True
-isReadOnly (RtsLabel _) = True
-isReadOnly (CC_Label _) = True
-isReadOnly (CCS_Label _) = True
-\end{code}
-
Whether the label is an assembler temporary:
\begin{code}
labelType (RtsLabel (RtsBlackHoleInfoTbl _)) = InfoTblType
labelType (RtsLabel (RtsSelectorInfoTbl _ _)) = InfoTblType
labelType (RtsLabel (RtsApInfoTbl _ _)) = InfoTblType
+labelType (RtsLabel RtsUpdInfo) = InfoTblType
labelType (CaseLabel _ CaseReturnInfo) = InfoTblType
labelType (CaseLabel _ CaseReturnPt) = CodeType
labelType (CaseLabel _ CaseVecTbl) = VecTblType
pprCLbl (RtsLabel RtsShouldNeverHappenCode) = ptext SLIT("stg_error_entry")
-pprCLbl (RtsLabel RtsUpdEntry) = ptext SLIT("Upd_frame_entry")
+pprCLbl (RtsLabel RtsUpdInfo) = ptext SLIT("Upd_frame_info")
pprCLbl (RtsLabel (RtsBlackHoleInfoTbl info)) = ptext info
import Constants ( mIN_UPD_SIZE )
import CallConv ( CallConv, callConvAttribute, cCallConv )
import CLabel ( externallyVisibleCLabel, mkErrorStdEntryLabel,
- isReadOnly, needsCDecl, pprCLabel,
+ needsCDecl, pprCLabel,
mkReturnInfoLabel, mkReturnPtLabel, mkClosureTblLabel,
mkStaticClosureLabel,
CLabel, CLabelType(..), labelType, labelDynamic
(hcat [text jmp_lit, target, pp_paren_semi ])
where
target = case return_info of
- DirectReturn -> hcat [char '(', pprAmode am, rparen]
+ DirectReturn -> hcat [ptext SLIT("ENTRY_CODE"), lparen,
+ pprAmode am, rparen]
DynamicVectoredReturn am' -> mk_vector (pprAmode am')
StaticVectoredReturn n -> mk_vector (int n) -- Always positive
mk_vector x = hcat [text "RET_VEC", char '(', pprAmode am, comma,
LvLarge _ -> SLIT("RET_BIG")
pprAbsC stmt@(CRetVector label amodes srt liveness) _
- = vcat [
- pp_vector,
+ = case (pprTempAndExternDecls stmt) of { (_, pp_exts) ->
+ vcat [
+ pp_exts,
hcat [
- ptext SLIT(" }"), comma, ptext SLIT("\n VEC_INFO_TABLE"),
- lparen,
- pp_liveness liveness, comma, -- bitmap liveness mask
- pp_srt_info srt, -- SRT
- ptext type_str, -- or big, depending on the size
- -- of the liveness mask.
- rparen
- ],
- text "};"
+ ptext SLIT("VEC_INFO_") <> int size,
+ lparen,
+ pprCLabel label, comma,
+ pp_liveness liveness, comma, -- bitmap liveness mask
+ pp_srt_info srt, -- SRT
+ ptext type_str, comma,
+ ppLocalness label, comma
+ ],
+ nest 2 (sep (punctuate comma (map ppr_item amodes))),
+ text ");"
]
+ }
where
- pp_vector =
- case (pprTempAndExternDecls stmt) of { (_, pp_exts) ->
- vcat [
- pp_exts,
- hcat [ppLocalness label,
- ptext SLIT(" vec_info_"), int size, space,
- pprCLabel label, text "= { {"
- ],
- nest 2 (sep (punctuate comma (map ppr_item (reverse amodes))))
- ] }
-
ppr_item item = (<>) (text "(F_) ") (ppr_amode item)
size = length amodes
\begin{code}
ppLocalness label
- = (<>) static const
- where
- static = if (externallyVisibleCLabel label)
+ = if (externallyVisibleCLabel label)
then empty
else ptext SLIT("static ")
- const = if not (isReadOnly label)
- then empty
- else ptext SLIT("const")
-- Horrible macros for declaring the types and locality of labels (see
-- StgMacros.h).
CodeType -> ptext SLIT("F_")
InfoTblType -> ptext SLIT("I_")
ClosureTblType -> ptext SLIT("CP_")
- DataType -> ptext SLIT("D_") <>
- if isReadOnly clabel
- then ptext SLIT("RO_")
- else empty
+ DataType -> ptext SLIT("D_")
]
where
is_visible = externallyVisibleCLabel clabel
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: CgCase.lhs,v 1.27 1999/04/27 12:34:52 simonm Exp $
+% $Id: CgCase.lhs,v 1.28 1999/05/13 17:30:55 simonm Exp $
%
%********************************************************
%* *
if is_alg && isUnboxedTupleTyCon spec_tycon then
case alts of
[alt] -> let lbl = mkReturnInfoLabel uniq in
- cgUnboxedTupleAlt lbl cc_slot True alt
+ cgUnboxedTupleAlt uniq cc_slot True alt
`thenFC` \ abs_c ->
getSRTLabel `thenFC` \srt_label ->
absC (CRetDirect uniq abs_c (srt_label, srt)
(srt_label,srt) liveness_mask) `thenC`
-- Return an amode for the block
- returnFC (CaseAlts (CLbl (mkReturnPtLabel uniq) RetRep) Nothing)
+ returnFC (CaseAlts (CLbl (mkReturnInfoLabel uniq) RetRep) Nothing)
\end{code}
lbl = mkAltLabel uniq tag
cgUnboxedTupleAlt
- :: CLabel -- label of the alternative
+ :: Unique -- unique for label of the alternative
-> Maybe VirtualSpOffset -- Restore cost centre
-> Bool -- ctxt switch
-> (DataCon, [Id], [Bool], StgExpr) -- alternative
-> Bool -- True <=> algebraic case
-> [MagicId] -- live registers
-> [(VirtualSpOffset,Int)] -- stack slots to tag
- -> Maybe CLabel -- return address
+ -> Maybe Unique -- return address unique
-> Code -- continuation
-> Code
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: CgClosure.lhs,v 1.29 1999/05/11 16:44:02 keithw Exp $
+% $Id: CgClosure.lhs,v 1.30 1999/05/13 17:30:56 simonm Exp $
%
\section[CgClosure]{Code generation for closures}
getSpRelOffset, getHpRelOffset
)
import CLabel ( CLabel, mkClosureLabel, mkFastEntryLabel,
- mkRednCountsLabel, mkStdEntryLabel
+ mkRednCountsLabel, mkInfoTableLabel
)
import ClosureInfo -- lots and lots of stuff
import CmdLineOpts ( opt_GranMacros, opt_SccProfilingOn, opt_DoTickyProfiling )
enterCostCentreCode closure_info cc IsFunction False `thenC`
-- Do the business
- funWrapper closure_info arg_regs stk_tags slow_label (cgExpr body)
+ funWrapper closure_info arg_regs stk_tags info_label (cgExpr body)
in
-- Make a labelled code-block for the slow and fast entry code
forkAbsC (if slow_code_needed then slow_entry_code else absC AbsCNop)
-- Manufacture labels
name = closureName closure_info
fast_label = mkFastEntryLabel name stg_arity
- slow_label = mkStdEntryLabel name
+ info_label = mkInfoTableLabel name
\end{code}
For lexically scoped profiling we have to load the cost centre from
funWrapper :: ClosureInfo -- Closure whose code body this is
-> [MagicId] -- List of argument registers (if any)
-> [(VirtualSpOffset,Int)] -- tagged stack slots
- -> CLabel -- slow entry point for heap check ret.
+ -> CLabel -- info table for heap check ret.
-> Code -- Body of function being compiled
-> Code
-funWrapper closure_info arg_regs stk_tags slow_label fun_body
+funWrapper closure_info arg_regs stk_tags info_label fun_body
= -- Stack overflow check
nodeMustPointToIt (closureLFInfo closure_info) `thenFC` \ node_points ->
let
else absC AbsCNop) `thenC`
-- heap and/or stack checks
- fastEntryChecks arg_regs stk_tags slow_label node_points (
+ fastEntryChecks arg_regs stk_tags info_label node_points (
-- Finally, do the business
fun_body
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: CgHeapery.lhs,v 1.15 1999/03/08 17:05:41 simonm Exp $
+% $Id: CgHeapery.lhs,v 1.16 1999/05/13 17:30:56 simonm Exp $
%
\section[CgHeapery]{Heap management functions}
closureSMRep
)
import PrimRep ( PrimRep(..), isFollowableRep )
+import Unique ( Unique )
import CmdLineOpts ( opt_SccProfilingOn )
import GlaExts
import Outputable
-> [MagicId] -- live registers
-> [(VirtualSpOffset,Int)] -- stack slots to tag
-> AbstractC
- -> Maybe CLabel -- ret address if not on top of stack.
+ -> Maybe Unique -- uniq of ret address (possibly)
-> Code
-> Code
checking_code tag_assts =
case non_void_regs of
+{- no: there might be stuff on top of the retn. addr. on the stack.
+ [{-no regs-}] ->
+ CCheck HP_CHK_NOREGS
+ [mkIntCLit words_required]
+ tag_assts
+-}
-- this will cover all cases for x86
[VanillaReg rep ILIT(1)]
CCheck HP_CHK_UT_ALT
[mkIntCLit words_required, mkIntCLit 1, mkIntCLit 0,
CReg (VanillaReg RetRep ILIT(2)),
- CLbl ret_addr RetRep]
+ CLbl (mkReturnInfoLabel ret_addr) RetRep]
tag_assts
| otherwise ->
CCheck HP_CHK_UT_ALT
[mkIntCLit words_required, mkIntCLit 0, mkIntCLit 1,
CReg (VanillaReg RetRep ILIT(2)),
- CLbl ret_addr RetRep]
+ CLbl (mkReturnInfoLabel ret_addr) RetRep]
tag_assts
several_regs ->
CCheck HP_CHK_GEN
[mkIntCLit words_required,
mkIntCLit (IBOX(word2Int# liveness)),
- CLbl ret_addr RetRep]
+ -- HP_CHK_GEN needs a direct return address,
+ -- not an info table (might be different if
+ -- we're not assembly-mangling/tail-jumping etc.)
+ CLbl (mkReturnPtLabel ret_addr) RetRep]
tag_assts
-- normal algebraic and primitive case alternatives:
%
% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
%
-% $Id: CgLetNoEscape.lhs,v 1.12 1998/12/18 17:40:51 simonpj Exp $
+% $Id: CgLetNoEscape.lhs,v 1.13 1999/05/13 17:30:57 simonm Exp $
%
%********************************************************
%* *
import CgStackery ( mkTaggedVirtStkOffsets,
allocStackTop, deAllocStackTop, freeStackSlots )
import CgUsages ( setRealAndVirtualSp, getRealSp, getSpRelOffset )
-import CLabel ( mkReturnPtLabel )
+import CLabel ( mkReturnInfoLabel )
import ClosureInfo ( mkLFLetNoEscape )
import CostCentre ( CostCentreStack )
import Id ( idPrimRep, Id )
import Var ( idUnique )
import PrimRep ( PrimRep(..), retPrimRepSize )
+import Unique ( Unique )
import BasicTypes ( RecFlag(..) )
\end{code}
arity = length args
lf_info = mkLFLetNoEscape arity
uniq = idUnique binder
- lbl = mkReturnPtLabel uniq
in
-- saveVolatileVarsAndRegs done earlier in cgExpr.
(deAllocStackTop retPrimRepSize `thenFC` \_ ->
buildContLivenessMask uniq `thenFC` \ liveness ->
- forkAbsC (cgLetNoEscapeBody binder cc args body lbl)
+ forkAbsC (cgLetNoEscapeBody binder cc args body uniq)
`thenFC` \ code ->
getSRTLabel `thenFC` \ srt_label ->
absC (CRetDirect uniq code (srt_label,srt) liveness)
-> CostCentreStack
-> [Id] -- Args
-> StgExpr -- Body
- -> CLabel -- Entry label
+ -> Unique -- Unique for entry label
-> Code
-cgLetNoEscapeBody binder cc all_args body lbl
+cgLetNoEscapeBody binder cc all_args body uniq
=
-- this is where the stack frame lives:
getRealSp `thenFC` \sp ->
-- fill in the frame header only if we fail a heap check:
-- otherwise it isn't needed.
getSpRelOffset sp `thenFC` \sp_rel ->
- let frame_hdr_asst = CAssign (CVal sp_rel RetRep) (CLbl lbl RetRep)
+ let lbl = mkReturnInfoLabel uniq
+ frame_hdr_asst = CAssign (CVal sp_rel RetRep) (CLbl lbl RetRep)
in
-- Do heap check [ToDo: omit for non-recursive case by recording in
-- in envt and absorbing at call site]
- altHeapCheck False arg_regs stk_tags frame_hdr_asst (Just lbl) (
+ altHeapCheck False arg_regs stk_tags frame_hdr_asst (Just uniq) (
cgExpr body
)
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: CgMonad.lhs,v 1.18 1999/03/02 14:34:38 sof Exp $
+% $Id: CgMonad.lhs,v 1.19 1999/05/13 17:30:57 simonm Exp $
%
\section[CgMonad]{The code generation monad}
import AbsCSyn
import AbsCUtils ( mkAbsCStmts )
import CmdLineOpts ( opt_SccProfilingOn, opt_DoTickyProfiling )
-import CLabel ( CLabel, mkUpdEntryLabel )
+import CLabel ( CLabel, mkUpdInfoLabel )
import Module ( Module )
import DataCon ( ConTag )
import Id ( Id )
-- that Sp is pointing to the top word of the return address. This
-- seems unclean but there you go.
+-- sequelToAmode returns an amode which refers to an info table. The info
+-- table will always be of the RET(_VEC)?_(BIG|SMALL) kind. We're careful
+-- not to handle real code pointers, just in case we're compiling for
+-- an unregisterised/untailcallish architecture, where info pointers and
+-- code pointers aren't the same.
+
sequelToAmode :: Sequel -> FCode CAddrMode
sequelToAmode (OnStack virt_sp_offset)
= getSpRelOffset virt_sp_offset `thenFC` \ sp_rel ->
returnFC (CVal sp_rel RetRep)
-sequelToAmode UpdateCode = returnFC (CLbl mkUpdEntryLabel CodePtrRep)
+sequelToAmode UpdateCode = returnFC (CLbl mkUpdInfoLabel RetRep)
sequelToAmode (CaseAlts amode _) = returnFC amode
sequelToAmode (SeqFrame _ _) = panic "sequelToAmode: SeqFrame"
%
% (c) The GRASP Project, Glasgow University, 1992-1998
%
-% $Id: CgRetConv.lhs,v 1.18 1999/01/22 10:45:21 simonm Exp $
+% $Id: CgRetConv.lhs,v 1.19 1999/05/13 17:30:58 simonm Exp $
%
\section[CgRetConv]{Return conventions for the code generator}
import AbsCSyn -- quite a few things
import Constants ( mAX_FAMILY_SIZE_FOR_VEC_RETURNS,
mAX_Vanilla_REG, mAX_Float_REG,
- mAX_Double_REG, mAX_Real_Double_REG,
- mAX_Real_Vanilla_REG, mAX_Real_Float_REG,
- mAX_Long_REG, mAX_Real_Long_REG
+ mAX_Double_REG, mAX_Long_REG
+ )
+import CmdLineOpts ( opt_UseVanillaRegs, opt_UseFloatRegs,
+ opt_UseDoubleRegs, opt_UseLongRegs
)
import Maybes ( catMaybes )
import DataCon ( dataConRawArgTys, DataCon )
\begin{code}
vanillaRegNos, floatRegNos, doubleRegNos, longRegNos :: [Int]
-vanillaRegNos = regList mAX_Real_Vanilla_REG
-floatRegNos = regList mAX_Real_Float_REG
-doubleRegNos = regList mAX_Real_Double_REG
-longRegNos = regList mAX_Real_Long_REG
+vanillaRegNos = regList opt_UseVanillaRegs
+floatRegNos = regList opt_UseFloatRegs
+doubleRegNos = regList opt_UseDoubleRegs
+longRegNos = regList opt_UseLongRegs
allVanillaRegNos, allFloatRegNos, allDoubleRegNos, allLongRegNos :: [Int]
allVanillaRegNos = regList mAX_Vanilla_REG
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: CgTailCall.lhs,v 1.18 1999/01/21 10:31:57 simonm Exp $
+% $Id: CgTailCall.lhs,v 1.19 1999/05/13 17:30:58 simonm Exp $
%
%********************************************************
%* *
import CgStackery ( adjustRealSp, mkTaggedStkAmodes, adjustStackHW )
import CgUsages ( getSpRelOffset )
import CgUpdate ( pushSeqFrame )
-import CLabel ( mkUpdEntryLabel, mkRtsPrimOpLabel )
+import CLabel ( mkUpdInfoLabel, mkRtsPrimOpLabel )
import ClosureInfo ( nodeMustPointToIt,
getEntryConvention, EntryConvention(..),
LambdaFormInfo
UpdateCode -> -- Ha! We can go direct to the update code,
-- (making sure to jump to the *correct* update
-- code.)
- absC (CReturn (CLbl mkUpdEntryLabel CodePtrRep)
+ absC (CReturn (CLbl mkUpdInfoLabel CodePtrRep)
return_info)
CaseAlts _ (Just (alts, _)) -> -- Ho! We know the constructor so
intSwitchSet,
switchIsOn,
- opt_AllStrict,
- opt_AllowOverlappingInstances,
- opt_AllowUndecidableInstances,
- opt_AutoSccsOnAllToplevs,
- opt_AutoSccsOnExportedToplevs,
- opt_AutoSccsOnIndividualCafs,
- opt_AutoSccsOnDicts,
- opt_CompilingPrelude,
+ -- debugging opts
opt_D_dump_absC,
opt_D_dump_asm,
+ opt_D_dump_cpranal,
opt_D_dump_deriv,
opt_D_dump_ds,
opt_D_dump_flatC,
- opt_D_dump_inlinings,
opt_D_dump_foreign,
+ opt_D_dump_inlinings,
opt_D_dump_occur_anal,
opt_D_dump_rdr,
opt_D_dump_realC,
opt_D_dump_spec,
opt_D_dump_stg,
opt_D_dump_stranal,
- opt_D_dump_cpranal,
- opt_D_dump_worker_wrapper,
opt_D_dump_tc,
opt_D_dump_usagesp,
+ opt_D_dump_worker_wrapper,
opt_D_show_passes,
- opt_D_show_rn_trace,
opt_D_show_rn_imports,
+ opt_D_show_rn_stats,
+ opt_D_show_rn_trace,
opt_D_simplifier_stats,
opt_D_source_stats,
opt_D_verbose_core2core,
opt_D_verbose_stg2stg,
- opt_DictsStrict,
opt_DoCoreLinting,
- opt_DoUSPLinting,
opt_DoStgLinting,
- opt_DoSemiTagging,
- opt_DoEtaReduction,
+ opt_DoUSPLinting,
+ opt_PprStyle_Debug,
+ opt_PprStyle_NoPrags,
+ opt_PprUserLength,
+
+ -- warning opts
+ opt_WarnDuplicateExports,
+ opt_WarnHiShadows,
+ opt_WarnIncompletePatterns,
+ opt_WarnMissingMethods,
+ opt_WarnMissingSigs,
+ opt_WarnNameShadowing,
+ opt_WarnOverlappingPatterns,
+ opt_WarnSimplePatterns,
+ opt_WarnTypeDefaults,
+ opt_WarnUnusedBinds,
+ opt_WarnUnusedImports,
+ opt_WarnUnusedMatches,
+
+ -- profiling opts
+ opt_AutoSccsOnAllToplevs,
+ opt_AutoSccsOnExportedToplevs,
+ opt_AutoSccsOnIndividualCafs,
+ opt_AutoSccsOnDicts,
+ opt_SccGroup,
+ opt_SccProfilingOn,
opt_DoTickyProfiling,
- opt_EmitCExternDecls,
- opt_EnsureSplittableC,
+
+ -- language opts
+ opt_AllStrict,
+ opt_DictsStrict,
+ opt_MaxContextReductionDepth,
+ opt_AllowOverlappingInstances,
+ opt_AllowUndecidableInstances,
+ opt_GlasgowExts,
+ opt_IrrefutableTuples,
+ opt_NumbersStrict,
+ opt_Parallel,
+
+ -- optimisation opts
+ opt_DoEtaReduction,
+ opt_DoSemiTagging,
opt_FoldrBuildOn,
- opt_UnboxStrictFields,
+ opt_InterfaceUnfoldThreshold,
+ opt_LiberateCaseThreshold,
+ opt_NoPreInlining,
+ opt_StgDoLetNoEscapes,
+ opt_UnfoldCasms,
+ opt_UnfoldingConDiscount,
+ opt_UnfoldingCreationThreshold,
+ opt_UnfoldingKeenessFactor,
+ opt_UnfoldingUseThreshold,
opt_UsageSPOn,
- opt_GlasgowExts,
+ opt_UnboxStrictFields,
+
+ -- misc opts
+ opt_CompilingPrelude,
+ opt_EmitCExternDecls,
+ opt_EnsureSplittableC,
opt_GranMacros,
opt_HiMap,
opt_HiVersion,
- opt_IgnoreIfacePragmas,
opt_IgnoreAsserts,
- opt_IrrefutableTuples,
- opt_LiberateCaseThreshold,
- opt_MaxContextReductionDepth,
- opt_MultiParamClasses,
+ opt_IgnoreIfacePragmas,
opt_NoHiCheck,
opt_NoImplicitPrelude,
- opt_NoPreInlining,
- opt_NumbersStrict,
opt_OmitBlackHoling,
opt_OmitInterfacePragmas,
- opt_PprStyle_NoPrags,
- opt_PprStyle_Debug,
- opt_PprUserLength,
opt_ProduceC,
- opt_ProduceHi,
- opt_ProduceS,
opt_ProduceExportCStubs,
opt_ProduceExportHStubs,
+ opt_ProduceHi,
+ opt_ProduceS,
+ opt_PruneInstDecls,
+ opt_PruneTyDecls,
opt_ReportCompile,
- opt_SccGroup,
- opt_SccProfilingOn,
opt_SourceUnchanged,
opt_Static,
- opt_StgDoLetNoEscapes,
- opt_Parallel,
-
- opt_InterfaceUnfoldThreshold,
- opt_UnfoldCasms,
- opt_UnfoldingCreationThreshold,
- opt_UnfoldingConDiscount,
- opt_UnfoldingUseThreshold,
- opt_UnfoldingKeenessFactor,
-
+ opt_Unregisterised,
opt_Verbose,
- opt_WarnNameShadowing,
- opt_WarnUnusedMatches,
- opt_WarnUnusedBinds,
- opt_WarnUnusedImports,
- opt_WarnIncompletePatterns,
- opt_WarnOverlappingPatterns,
- opt_WarnSimplePatterns,
- opt_WarnTypeDefaults,
- opt_WarnMissingMethods,
- opt_WarnDuplicateExports,
- opt_WarnHiShadows,
- opt_WarnMissingSigs,
- opt_PruneTyDecls, opt_PruneInstDecls,
- opt_D_show_rn_stats
+ opt_UseVanillaRegs,
+ opt_UseFloatRegs,
+ opt_UseDoubleRegs,
+ opt_UseLongRegs
) where
#include "HsVersions.h"
\end{code}
\begin{code}
-opt_AllStrict = lookUp SLIT("-fall-strict")
-opt_AllowOverlappingInstances = lookUp SLIT("-fallow-overlapping-instances")
-opt_AllowUndecidableInstances = lookUp SLIT("-fallow-undecidable-instances")
-opt_AutoSccsOnAllToplevs = lookUp SLIT("-fauto-sccs-on-all-toplevs")
-opt_AutoSccsOnExportedToplevs = lookUp SLIT("-fauto-sccs-on-exported-toplevs")
-opt_AutoSccsOnIndividualCafs = lookUp SLIT("-fauto-sccs-on-individual-cafs")
-opt_AutoSccsOnDicts = lookUp SLIT("-fauto-sccs-on-dicts")
- {-
- It's a bit unfortunate to have to re-introduce this chap, but on Win32
- platforms we do need a way of distinguishing between the case when we're
- compiling a static version of the Prelude and one that's going to be
- put into a DLL. Why? Because the compiler's wired in modules need to
- be attributed as either coming from a DLL or not.
- -}
-opt_CompilingPrelude = lookUp SLIT("-fcompiling-prelude")
+-- debugging opts
opt_D_dump_absC = lookUp SLIT("-ddump-absC")
opt_D_dump_asm = lookUp SLIT("-ddump-asm")
+opt_D_dump_cpranal = lookUp SLIT("-ddump-cpranalyse")
opt_D_dump_deriv = lookUp SLIT("-ddump-deriv")
opt_D_dump_ds = lookUp SLIT("-ddump-ds")
opt_D_dump_flatC = lookUp SLIT("-ddump-flatC")
-opt_D_dump_inlinings = lookUp SLIT("-ddump-inlinings")
opt_D_dump_foreign = lookUp SLIT("-ddump-foreign-stubs")
+opt_D_dump_inlinings = lookUp SLIT("-ddump-inlinings")
opt_D_dump_occur_anal = lookUp SLIT("-ddump-occur-anal")
opt_D_dump_rdr = lookUp SLIT("-ddump-rdr")
opt_D_dump_realC = lookUp SLIT("-ddump-realC")
opt_D_dump_spec = lookUp SLIT("-ddump-spec")
opt_D_dump_stg = lookUp SLIT("-ddump-stg")
opt_D_dump_stranal = lookUp SLIT("-ddump-stranal")
-opt_D_dump_worker_wrapper = lookUp SLIT("-ddump-workwrap")
-opt_D_dump_cpranal = lookUp SLIT("-ddump-cpranalyse")
opt_D_dump_tc = lookUp SLIT("-ddump-tc")
opt_D_dump_usagesp = lookUp SLIT("-ddump-usagesp")
+opt_D_dump_worker_wrapper = lookUp SLIT("-ddump-workwrap")
opt_D_show_passes = lookUp SLIT("-dshow-passes")
-opt_D_show_rn_trace = lookUp SLIT("-dshow-rn-trace")
opt_D_show_rn_imports = lookUp SLIT("-dshow-rn-imports")
+opt_D_show_rn_trace = lookUp SLIT("-dshow-rn-trace")
+opt_D_show_rn_stats = lookUp SLIT("-dshow-rn-stats")
opt_D_simplifier_stats = lookUp SLIT("-dsimplifier-stats")
opt_D_source_stats = lookUp SLIT("-dsource-stats")
opt_D_verbose_core2core = lookUp SLIT("-dverbose-simpl")
opt_D_verbose_stg2stg = lookUp SLIT("-dverbose-stg")
-opt_DictsStrict = lookUp SLIT("-fdicts-strict")
opt_DoCoreLinting = lookUp SLIT("-dcore-lint")
opt_DoStgLinting = lookUp SLIT("-dstg-lint")
+opt_DoUSPLinting = lookUp SLIT("-dusagesp-lint")
+opt_PprStyle_NoPrags = lookUp SLIT("-dppr-noprags")
+opt_PprStyle_Debug = lookUp SLIT("-dppr-debug")
+opt_PprUserLength = lookup_def_int "-dppr-user-length" 5 --ToDo: give this a name
+
+-- warning opts
+opt_WarnDuplicateExports = lookUp SLIT("-fwarn-duplicate-exports")
+opt_WarnHiShadows = lookUp SLIT("-fwarn-hi-shadowing")
+opt_WarnIncompletePatterns = lookUp SLIT("-fwarn-incomplete-patterns")
+opt_WarnMissingMethods = lookUp SLIT("-fwarn-missing-methods")
+opt_WarnMissingSigs = lookUp SLIT("-fwarn-missing-signatures")
+opt_WarnNameShadowing = lookUp SLIT("-fwarn-name-shadowing")
+opt_WarnOverlappingPatterns = lookUp SLIT("-fwarn-overlapping-patterns")
+opt_WarnSimplePatterns = lookUp SLIT("-fwarn-simple-patterns")
+opt_WarnTypeDefaults = lookUp SLIT("-fwarn-type-defaults")
+opt_WarnUnusedBinds = lookUp SLIT("-fwarn-unused-binds")
+opt_WarnUnusedImports = lookUp SLIT("-fwarn-unused-imports")
+opt_WarnUnusedMatches = lookUp SLIT("-fwarn-unused-matches")
+
+-- profiling opts
+opt_AutoSccsOnAllToplevs = lookUp SLIT("-fauto-sccs-on-all-toplevs")
+opt_AutoSccsOnExportedToplevs = lookUp SLIT("-fauto-sccs-on-exported-toplevs")
+opt_AutoSccsOnIndividualCafs = lookUp SLIT("-fauto-sccs-on-individual-cafs")
+opt_AutoSccsOnDicts = lookUp SLIT("-fauto-sccs-on-dicts")
+opt_SccGroup = lookup_str "-G="
+opt_SccProfilingOn = lookUp SLIT("-fscc-profiling")
+opt_DoTickyProfiling = lookUp SLIT("-fticky-ticky")
+
+-- language opts
+opt_AllStrict = lookUp SLIT("-fall-strict")
+opt_DictsStrict = lookUp SLIT("-fdicts-strict")
+opt_AllowOverlappingInstances = lookUp SLIT("-fallow-overlapping-instances")
+opt_AllowUndecidableInstances = lookUp SLIT("-fallow-undecidable-instances")
+opt_GlasgowExts = lookUp SLIT("-fglasgow-exts")
+opt_IrrefutableTuples = lookUp SLIT("-firrefutable-tuples")
+opt_MaxContextReductionDepth = lookup_def_int "-fcontext-stack" mAX_CONTEXT_REDUCTION_DEPTH
+opt_NumbersStrict = lookUp SLIT("-fnumbers-strict")
+opt_Parallel = lookUp SLIT("-fparallel")
+
+-- optimisation opts
opt_DoEtaReduction = lookUp SLIT("-fdo-eta-reduction")
-opt_UsageSPOn = lookUp SLIT("-fusagesp-on")
opt_DoSemiTagging = lookUp SLIT("-fsemi-tagging")
-opt_DoTickyProfiling = lookUp SLIT("-fticky-ticky")
-opt_DoUSPLinting = lookUp SLIT("-dusagesp-lint")
-opt_EmitCExternDecls = lookUp SLIT("-femit-extern-decls")
-opt_EnsureSplittableC = lookUp SLIT("-fglobalise-toplev-names")
opt_FoldrBuildOn = lookUp SLIT("-ffoldr-build-on")
+opt_InterfaceUnfoldThreshold = lookup_def_int "-funfolding-interface-threshold" iNTERFACE_UNFOLD_THRESHOLD
+opt_LiberateCaseThreshold = lookup_def_int "-fliberate-case-threshold" lIBERATE_CASE_THRESHOLD
+opt_NoPreInlining = lookUp SLIT("-fno-pre-inlining")
+opt_StgDoLetNoEscapes = lookUp SLIT("-flet-no-escape")
+opt_UnfoldCasms = lookUp SLIT("-funfold-casms-in-hi-file")
+opt_UnfoldingConDiscount = lookup_def_int "-funfolding-con-discount" uNFOLDING_CON_DISCOUNT_WEIGHT
+opt_UnfoldingCreationThreshold = lookup_def_int "-funfolding-creation-threshold" uNFOLDING_CREATION_THRESHOLD
+opt_UnfoldingKeenessFactor = lookup_def_float "-funfolding-keeness-factor" uNFOLDING_KEENESS_FACTOR
+opt_UnfoldingUseThreshold = lookup_def_int "-funfolding-use-threshold" uNFOLDING_USE_THRESHOLD
+opt_UsageSPOn = lookUp SLIT("-fusagesp-on")
opt_UnboxStrictFields = lookUp SLIT("-funbox-strict-fields")
+
+ {-
+ It's a bit unfortunate to have to re-introduce this chap, but on Win32
+ platforms we do need a way of distinguishing between the case when we're
+ compiling a static version of the Prelude and one that's going to be
+ put into a DLL. Why? Because the compiler's wired in modules need to
+ be attributed as either coming from a DLL or not.
+ -}
+opt_CompilingPrelude = lookUp SLIT("-fcompiling-prelude")
+opt_EmitCExternDecls = lookUp SLIT("-femit-extern-decls")
+opt_EnsureSplittableC = lookUp SLIT("-fglobalise-toplev-names")
opt_GranMacros = lookUp SLIT("-fgransim")
-opt_GlasgowExts = lookUp SLIT("-fglasgow-exts")
opt_HiMap = lookup_str "-himap=" -- file saying where to look for .hi files
opt_HiVersion = lookup_def_int "-fhi-version=" 0 -- what version we're compiling.
-opt_IgnoreIfacePragmas = lookUp SLIT("-fignore-interface-pragmas")
opt_IgnoreAsserts = lookUp SLIT("-fignore-asserts")
-opt_IrrefutableTuples = lookUp SLIT("-firrefutable-tuples")
-opt_MaxContextReductionDepth = lookup_def_int "-fcontext-stack" mAX_CONTEXT_REDUCTION_DEPTH
-opt_MultiParamClasses = opt_GlasgowExts
+opt_IgnoreIfacePragmas = lookUp SLIT("-fignore-interface-pragmas")
opt_NoHiCheck = lookUp SLIT("-fno-hi-version-check")
opt_NoImplicitPrelude = lookUp SLIT("-fno-implicit-prelude")
-opt_NoPreInlining = lookUp SLIT("-fno-pre-inlining")
-opt_NumbersStrict = lookUp SLIT("-fnumbers-strict")
opt_OmitBlackHoling = lookUp SLIT("-dno-black-holing")
opt_OmitInterfacePragmas = lookUp SLIT("-fomit-interface-pragmas")
-opt_PprStyle_NoPrags = lookUp SLIT("-dppr-noprags")
-opt_PprStyle_Debug = lookUp SLIT("-dppr-debug")
-opt_PprUserLength = lookup_def_int "-dppr-user-length" 5 --ToDo: give this a name
opt_ProduceC = lookup_str "-C="
-opt_ProduceS = lookup_str "-S="
opt_ProduceExportCStubs = lookup_str "-F="
opt_ProduceExportHStubs = lookup_str "-FH="
opt_ProduceHi = lookup_str "-hifile=" -- the one to produce this time
+opt_ProduceS = lookup_str "-S="
opt_ReportCompile = lookUp SLIT("-freport-compile")
-opt_SccProfilingOn = lookUp SLIT("-fscc-profiling")
+opt_PruneTyDecls = not (lookUp SLIT("-fno-prune-tydecls"))
+opt_PruneInstDecls = not (lookUp SLIT("-fno-prune-instdecls"))
opt_SourceUnchanged = lookUp SLIT("-fsource-unchanged")
-opt_StgDoLetNoEscapes = lookUp SLIT("-flet-no-escape")
-opt_Parallel = lookUp SLIT("-fparallel")
opt_Static = lookUp SLIT("-static")
-opt_SccGroup = lookup_str "-G="
+opt_Unregisterised = lookUp SLIT("-funregisterised")
opt_Verbose = lookUp SLIT("-v")
-opt_UnfoldCasms = lookUp SLIT("-funfold-casms-in-hi-file")
-opt_InterfaceUnfoldThreshold = lookup_def_int "-funfolding-interface-threshold" iNTERFACE_UNFOLD_THRESHOLD
-opt_UnfoldingCreationThreshold = lookup_def_int "-funfolding-creation-threshold" uNFOLDING_CREATION_THRESHOLD
-opt_UnfoldingUseThreshold = lookup_def_int "-funfolding-use-threshold" uNFOLDING_USE_THRESHOLD
-opt_UnfoldingConDiscount = lookup_def_int "-funfolding-con-discount" uNFOLDING_CON_DISCOUNT_WEIGHT
-
-opt_LiberateCaseThreshold = lookup_def_int "-fliberate-case-threshold" lIBERATE_CASE_THRESHOLD
-opt_UnfoldingKeenessFactor = lookup_def_float "-funfolding-keeness-factor" uNFOLDING_KEENESS_FACTOR
-opt_WarnNameShadowing = lookUp SLIT("-fwarn-name-shadowing")
-opt_WarnHiShadows = lookUp SLIT("-fwarn-hi-shadowing")
-opt_WarnIncompletePatterns = lookUp SLIT("-fwarn-incomplete-patterns")
-opt_WarnOverlappingPatterns = lookUp SLIT("-fwarn-overlapping-patterns")
-opt_WarnSimplePatterns = lookUp SLIT("-fwarn-simple-patterns")
-opt_WarnTypeDefaults = lookUp SLIT("-fwarn-type-defaults")
-opt_WarnUnusedMatches = lookUp SLIT("-fwarn-unused-matches")
-opt_WarnUnusedBinds = lookUp SLIT("-fwarn-unused-binds")
-opt_WarnUnusedImports = lookUp SLIT("-fwarn-unused-imports")
-opt_WarnMissingMethods = lookUp SLIT("-fwarn-missing-methods")
-opt_WarnDuplicateExports = lookUp SLIT("-fwarn-duplicate-exports")
-opt_WarnMissingSigs = lookUp SLIT("-fwarn-missing-signatures")
-opt_PruneTyDecls = not (lookUp SLIT("-fno-prune-tydecls"))
-opt_PruneInstDecls = not (lookUp SLIT("-fno-prune-instdecls"))
-opt_D_show_rn_stats = lookUp SLIT("-dshow-rn-stats")
+opt_UseVanillaRegs | opt_Unregisterised = 0
+ | otherwise = mAX_Real_Vanilla_REG
+opt_UseFloatRegs | opt_Unregisterised = 0
+ | otherwise = mAX_Real_Float_REG
+opt_UseDoubleRegs | opt_Unregisterised = 0
+ | otherwise = mAX_Real_Double_REG
+opt_UseLongRegs | opt_Unregisterised = 0
+ | otherwise = mAX_Real_Long_REG
-- opt_UnfoldingOverrideThreshold = lookup_int "-funfolding-override-threshold"
\end{code}
# the make variable names for them here.
#
-WAY_NAMES = $(foreach way,$(ALL_WAYS),WAY_$(way)_NAME)
-WAY_OPTS = $(foreach way,$(ALL_WAYS),WAY_$(way)_HC_OPTS)
+USER_WAY_NAMES = $(foreach way,$(USER_WAYS),WAY_$(way)_NAME)
+USER_WAY_OPTS = $(foreach way,$(USER_WAYS),WAY_$(way)_REAL_OPTS)
ifeq "$(INSTALLING)" "1"
TOP_PWD := $(prefix)
GHC_OPT_HILEV_ASM GhcWithNativeCodeGen LeadingUnderscore\
GHC_UNLIT GHC_HSCPP GHC_HSC GHC_SYSMAN EnableWin32DLLs \
CP RM CONTEXT_DIFF LibGmp \
- $(WAY_NAMES) $(WAY_OPTS)
+ $(USER_WAY_NAMES) $(USER_WAY_OPTS)
#
# When creating a binary distribution, we prefix the driver script
dist ::
@echo "Patching dist tree: removing $(SRC_DIST_DIR)/ghc symlink"
$(RM) $(SRC_DIST_DIR)/ghc
-
-#
-# Option vars for the special ways (that the driver has special pleading for).
-#
-# ToDo: rename -DPROFILING to -D__SCC_PROFILING (or somesuch)
-# -DTICKY-TICKY TO __TICKY_TICKY__
-#
-# (this is to make the naming consistent with other `standard' hscpp #defines )
-
-# Way p:
-WAY_p_NAME=profiling
-WAY_p_HC_OPTS+=-fscc-profiling -DPROFILING -optc-DPROFILING
-
-# Way t:
-WAY_t_NAME+=ticky-ticky profiling
-WAY_t_HC_OPTS=-fticky-ticky -DTICKY_TICKY -optc-DTICKY_TICKY
-
-# Way `u':
-WAY_u_NAME=unregisterized (using portable C only)
-WAY_u_HC_OPTS=
-
-# Way `mp':
-WAY_mp_NAME=parallel
-WAY_mp_HC_OPTS+=-fstack-check -fparallel -D__PARALLEL_HASKELL__ -optc-DPAR
-
-#
-# Way `mg':
-# Q: is passing -D__GRANSIM__ and -DGRAN to hscpp needed? No, just -D__GRANSIM__
-WAY_mg_NAME=GranSim
-WAY_mg_HC_OPTS+=-fstack-check -fconcurrent -fgransim -D__GRANSIM__ -D__CONCURRENT_HASKELL__ -optc-DCONCURRENT -optc-DGRAN
-
-#
-# Ways for different garbage collectors
-#
-WAY_2s_NAME=2-space GC
-WAY_2s_HC_OPTS+=-optc-DGC2s
-
-WAY_1s_NAME=1-space GC
-WAY_1s_HC_OPTS+=-optc-DGC1s
-
-WAY_du_NAME=dual-mode GC
-WAY_du_HC_OPTS+=-optc-DGCdu
CP RM CONTEXT_DIFF
-WAY_*_NAME WAY_*_HC_OPTS
+WAY_*_NAME WAY_*_REAL_OPTS
LeadingUnderscore
$BuildTag = ''; # default is sequential build w/ Appel-style GC
%BuildDescr = (# system ways begin
- '', 'normal sequential',
- '_p', "$WAY_p_NAME",
- '_t', "$WAY_t_NAME",
- '_u', "$WAY_u_NAME",
- '_mp', "$WAY_mp_NAME",
- '_mg', "$WAY_mg_NAME",
+ '', 'Normal Sequential',
+ '_p', "Profiling",
+ '_t', "Ticky-ticky Profiling",
+ '_u', "Unregisterised",
+ '_mp', "Parallel",
+ '_mg', "Gransim",
# system ways end
'_a', "$WAY_a_NAME",
'_b', "$WAY_b_NAME",
#
%SetupOpts =
(
- '_a', "$WAY_a_HC_OPTS",
- '_b', "$WAY_b_HC_OPTS",
- '_c', "$WAY_c_HC_OPTS",
- '_d', "$WAY_d_HC_OPTS",
- '_e', "$WAY_e_HC_OPTS",
- '_f', "$WAY_f_HC_OPTS",
- '_g', "$WAY_g_HC_OPTS",
- '_h', "$WAY_h_HC_OPTS",
- '_i', "$WAY_i_HC_OPTS",
- '_j', "$WAY_j_HC_OPTS",
- '_k', "$WAY_k_HC_OPTS",
- '_l', "$WAY_l_HC_OPTS",
- '_m', "$WAY_m_HC_OPTS",
- '_n', "$WAY_n_HC_OPTS",
- '_o', "$WAY_o_HC_OPTS",
- '_A', "$WAY_A_HC_OPTS",
- '_B', "$WAY_B_HC_OPTS",
+ '_a', "$WAY_a_REAL_OPTS",
+ '_b', "$WAY_b_REAL_OPTS",
+ '_c', "$WAY_c_REAL_OPTS",
+ '_d', "$WAY_d_REAL_OPTS",
+ '_e', "$WAY_e_REAL_OPTS",
+ '_f', "$WAY_f_REAL_OPTS",
+ '_g', "$WAY_g_REAL_OPTS",
+ '_h', "$WAY_h_REAL_OPTS",
+ '_i', "$WAY_i_REAL_OPTS",
+ '_j', "$WAY_j_REAL_OPTS",
+ '_k', "$WAY_k_REAL_OPTS",
+ '_l', "$WAY_l_REAL_OPTS",
+ '_m', "$WAY_m_REAL_OPTS",
+ '_n', "$WAY_n_REAL_OPTS",
+ '_o', "$WAY_o_REAL_OPTS",
+ '_A', "$WAY_A_REAL_OPTS",
+ '_B', "$WAY_B_REAL_OPTS",
# system ways
- '_p', "$WAY_p_HC_OPTS",
- '_t', "$WAY_t_HC_OPTS",
- '_u', "$WAY_u_HC_OPTS",
- '_mp', "$WAY_mp_HC_OPTS",
- '_mg', "$WAY_mg_HC_OPTS");
+ '_p', "-fscc-profiling -DPROFILING -optc-DPROFILING",
+ '_t', "-fticky-ticky -DTICKY_TICKY -optc-DTICKY_TICKY",
+ '_u', "-optc-DNO_REGS -optc-DUSE_MINIINTERPRETER -fno-asm-mangling -funregisterised",
+ '_mp', "-fstack-check -fparallel -D__PARALLEL_HASKELL__ -optc-DPAR",
+ '_mg', "-fstack-check -fconcurrent -fgransim -D__GRANSIM__ -D__CONCURRENT_HASKELL__ -optc-DCONCURRENT -optc-DGRAN");
\end{code}
$TICKYing = ''; # set to t if compiling for ticky-ticky profiling
$PARing = ''; # set to p if compiling for PAR
$GRANing = ''; # set to g if compiling for GRAN
+$UNREGing = ''; # set to u if compiling unregisterised
$Specific_hi_file = ''; # set by -ohi <file>; "-" for stdout
$Specific_dump_file = ''; # set by -odump <file>; "-" for stdout
$Using_dump_file = 0;
%************************************************************************
Sort out @$BuildTag@, @$PROFing@, @$PARing@,
-@$GRANing@, @$TICKYing@:
+@$GRANing@, @$TICKYing@, @UNREGing@:
\begin{code}
sub setupBuildFlags {
} elsif ( $TICKYing eq 't' ) {
$BuildTag = '_t';
+
+ } elsif ( $UNREGing eq 'u' ) {
+ $BuildTag = '_u';
}
\end{code}
}
next arg; };
+ /^-unreg$/ && do { $UNREGing = 'u'; next arg; };
+ /^-funregisterised$/ && do { push(@HsC_flags, $_); next arg; };
/^-fno-asm-mangling$/ && do { $DoAsmMangling = 0; next arg; };
/^-fallow-overlapping-instances$/ && do { push(@HsC_flags, $_); next arg; };
/* ----------------------------------------------------------------------------
- * $Id: ClosureMacros.h,v 1.15 1999/05/11 16:47:39 keithw Exp $
+ * $Id: ClosureMacros.h,v 1.16 1999/05/13 17:31:06 simonm Exp $
*
* (c) The GHC Team, 1998-1999
*
#if USE_MINIINTERPRETER
#define INIT_ENTRY(e) entry : (F_)(e)
#define GET_ENTRY(c) ((c)->header.info->entry)
-#define ENTRY_CODE(info) (stgCast(StgInfoTable*,info)->entry)
-#define INFO_PTR_TO_STRUCT(info) (info)
+#define ENTRY_CODE(info) (((StgInfoTable *)info)->entry)
+#define INFO_PTR_TO_STRUCT(info) ((StgInfoTable *)info)
#define get_itbl(c) ((c)->header.info)
static __inline__ StgFunPtr get_entry(const StgInfoTable *itbl) {
return itbl->entry;
}
#else
#define INIT_ENTRY(e) code : {}
-#define GET_ENTRY(c) stgCast(StgFunPtr,((c)->header.info))
+#define GET_ENTRY(c) ((StgFunPtr)((c)->header.info))
#define ENTRY_CODE(info) (info)
#define INFO_PTR_TO_STRUCT(info) ((StgInfoTable *)(info) - 1)
-#define get_itbl(c) (stgCast(StgInfoTable*,(c)->header.info) -1)
+#define get_itbl(c) (((c)->header.info) - 1)
static __inline__ StgFunPtr get_entry(const StgInfoTable *itbl) {
- return stgCast(StgFunPtr,itbl+1);
+ return (StgFunPtr)(itbl+1);
}
#endif
#define LOOKS_LIKE_STATIC(r) (!(HEAP_ALLOCED(r)))
/* Tiresome predicates needed to check for pointers into the closure tables */
-#define IS_CHARLIKE_CLOSURE(p) ( stgCast(StgPtr,p) >= stgCast(StgPtr,CHARLIKE_closure) && stgCast(char*,p) <= (stgCast(char*,CHARLIKE_closure) + 255 * sizeof(StgIntCharlikeClosure)))
-#define IS_INTLIKE_CLOSURE(p) ( stgCast(StgPtr,p) >= stgCast(StgPtr,INTLIKE_closure) && stgCast(char*,p) <= (stgCast(char*,INTLIKE_closure) + 32 * sizeof(StgIntCharlikeClosure)))
+#define IS_CHARLIKE_CLOSURE(p) ( (P_)(p) >= (P_)CHARLIKE_closure && (char*)(p) <= ((char*)CHARLIKE_closure + 255 * sizeof(StgIntCharlikeClosure)) )
+#define IS_INTLIKE_CLOSURE(p) ( (P_)(p) >= (P_)INTLIKE_closure && (char*)(p) <= ((char*)INTLIKE_closure + 32 * sizeof(StgIntCharlikeClosure)) )
#define LOOKS_LIKE_STATIC_CLOSURE(r) (((*(((unsigned long *)(r))-1)) == 0) || IS_CHARLIKE_CLOSURE(r) || IS_INTLIKE_CLOSURE(r))
#else
approximations. This absolutely has to be fixed.
-------------------------------------------------------------------------- */
+#ifdef INTERPRETER
#ifdef USE_MINIINTERPRETER
/* yoiks: one of the dreaded pointer equality tests */
-#define IS_HUGS_CONSTR_INFO(info) (stgCast(StgInfoTable*,info)->entry == stgCast(StgFunPtr,&Hugs_CONSTR_entry))
+#define IS_HUGS_CONSTR_INFO(info) (((StgInfoTable *)(info))->entry == (StgFunPtr)&Hugs_CONSTR_entry)
+#else
+#define IS_HUGS_CONSTR_INFO(info) 0 /* ToDo: more than mildly bogus */
+#endif
#else
#define IS_HUGS_CONSTR_INFO(info) 0 /* ToDo: more than mildly bogus */
#endif
/* ----------------------------------------------------------------------------
- * $Id: InfoMacros.h,v 1.5 1999/03/15 16:30:25 simonm Exp $
+ * $Id: InfoMacros.h,v 1.6 1999/05/13 17:31:06 simonm Exp $
*
* (c) The GHC Team, 1998-1999
*
srt_len : srt_len_, \
type : type_
+#ifdef USE_MINIINTERPRETER
+#define INIT_VECTOR {}
+#else
+#define INIT_VECTOR
+#endif
+
/* function/thunk info tables --------------------------------------------- */
#define \
info_class, entry_class, /* C storage classes */ \
prof_descr, prof_type) /* profiling info */ \
entry_class(entry); \
- info_class StgInfoTable info = { \
+ info_class INFO_TBL_CONST StgInfoTable info = { \
layout : { payload : {ptrs,nptrs} }, \
SRT_INFO(type,srt_,srt_off_,srt_len_), \
- INIT_ENTRY(entry) \
+ INIT_ENTRY(entry), \
+ INIT_VECTOR \
}
/* direct-return address info tables --------------------------------------*/
-#define \
-INFO_TABLE_SRT_BITMAP(info, entry, bitmap_, srt_, srt_off_, srt_len_, \
- type, info_class, entry_class, \
- prof_descr, prof_type) \
- entry_class(entry); \
- info_class StgInfoTable info = { \
- layout : { bitmap : (StgWord32)bitmap_ },\
- SRT_INFO(type,srt_,srt_off_,srt_len_), \
- INIT_ENTRY(entry) \
+#define \
+INFO_TABLE_SRT_BITMAP(info, entry, bitmap_, srt_, srt_off_, srt_len_, \
+ type, info_class, entry_class, \
+ prof_descr, prof_type) \
+ entry_class(entry); \
+ info_class INFO_TBL_CONST StgInfoTable info = { \
+ layout : { bitmap : (StgWord32)bitmap_ }, \
+ SRT_INFO(type,srt_,srt_off_,srt_len_), \
+ INIT_ENTRY(entry), \
+ INIT_VECTOR \
}
/* info-table without an SRT -----------------------------------------------*/
-#define \
-INFO_TABLE(info, entry, ptrs, nptrs, type, info_class, \
- entry_class, prof_descr, prof_type) \
- entry_class(entry); \
- info_class StgInfoTable info = { \
- layout : { payload : {ptrs,nptrs} }, \
+#define \
+INFO_TABLE(info, entry, ptrs, nptrs, type, info_class, \
+ entry_class, prof_descr, prof_type) \
+ entry_class(entry); \
+ info_class INFO_TBL_CONST StgInfoTable info = { \
+ layout : { payload : {ptrs,nptrs} }, \
STD_INFO(type), \
- INIT_ENTRY(entry) \
+ INIT_ENTRY(entry), \
+ INIT_VECTOR \
}
/* special selector-thunk info table ---------------------------------------*/
-#define \
-INFO_TABLE_SELECTOR(info, entry, offset, info_class, \
- entry_class, prof_descr, prof_type) \
- entry_class(entry); \
- info_class StgInfoTable info = { \
- layout : { selector_offset : offset }, \
+#define \
+INFO_TABLE_SELECTOR(info, entry, offset, info_class, \
+ entry_class, prof_descr, prof_type) \
+ entry_class(entry); \
+ info_class INFO_TBL_CONST StgInfoTable info = { \
+ layout : { selector_offset : offset }, \
STD_INFO(THUNK_SELECTOR), \
- INIT_ENTRY(entry) \
+ INIT_ENTRY(entry), \
+ INIT_VECTOR \
}
/* constructor info table --------------------------------------------------*/
#define \
-INFO_TABLE_CONSTR(info, entry, ptrs, nptrs, tag_,type_,info_class, \
- entry_class, prof_descr, prof_type) \
- entry_class(entry); \
- info_class StgInfoTable info = { \
- layout : { payload : {ptrs,nptrs} }, \
- srt_len : tag_, \
- type : type_, \
- INIT_ENTRY(entry) \
+INFO_TABLE_CONSTR(info, entry, ptrs, nptrs, tag_,type_,info_class, \
+ entry_class, prof_descr, prof_type) \
+ entry_class(entry); \
+ info_class INFO_TBL_CONST StgInfoTable info = { \
+ layout : { payload : {ptrs,nptrs} }, \
+ srt_len : tag_, \
+ type : type_, \
+ INIT_ENTRY(entry), \
+ INIT_VECTOR \
}
#define constrTag(con) (get_itbl(con)->srt_len)
* layout field, so we only need one macro for these.
*/
+#ifndef USE_MINIINTERPRETER
+
typedef struct {
StgFunPtr vec[2];
StgInfoTable i;
StgInfoTable i;
} vec_info_8;
-#define VEC_INFO_TABLE(bitmap_,srt_,srt_off_,srt_len_,type) \
- i : { \
- layout : { bitmap : (StgWord32)bitmap_ }, \
- SRT_INFO(type,srt_,srt_off_,srt_len_) \
+#define VEC_INFO_2(info,bitmap_,srt_,srt_off_,srt_len_, \
+ type, info_class, \
+ alt_1, alt_2) \
+ info_class INFO_TBL_CONST vec_info_2 info = { \
+ { alt_2, alt_1 }, \
+ i : { \
+ layout : { bitmap : (StgWord32)bitmap_ }, \
+ SRT_INFO(type,srt_,srt_off_,srt_len_) \
+ } \
+ }
+
+#define VEC_INFO_3(info,bitmap_,srt_,srt_off_,srt_len_, \
+ type, info_class, \
+ alt_1, alt_2, alt_3 \
+ ) \
+ info_class INFO_TBL_CONST vec_info_3 info = { \
+ { alt_3, alt_2, alt_1 }, \
+ i : { \
+ layout : { bitmap : (StgWord32)bitmap_ }, \
+ SRT_INFO(type,srt_,srt_off_,srt_len_) \
+ } \
+ }
+
+#define VEC_INFO_4(info,bitmap_,srt_,srt_off_,srt_len_, \
+ type, info_class, \
+ alt_1, alt_2, alt_3, alt_4 \
+ ) \
+ info_class INFO_TBL_CONST vec_info_4 info = { \
+ { alt_4, alt_3, alt_2, alt_1 }, \
+ i : { \
+ layout : { bitmap : (StgWord32)bitmap_ }, \
+ SRT_INFO(type,srt_,srt_off_,srt_len_) \
+ } \
+ }
+
+#define VEC_INFO_5(info,bitmap_,srt_,srt_off_,srt_len_, \
+ type, info_class, \
+ alt_1, alt_2, alt_3, alt_4, \
+ alt_5 \
+ ) \
+ info_class INFO_TBL_CONST vec_info_5 info = { \
+ { alt_5, alt_4, alt_3, alt_2, \
+ alt_1 }, \
+ i : { \
+ layout : { bitmap : (StgWord32)bitmap_ }, \
+ SRT_INFO(type,srt_,srt_off_,srt_len_) \
+ } \
+ }
+
+#define VEC_INFO_6(info,bitmap_,srt_,srt_off_,srt_len_, \
+ type, info_class, \
+ alt_1, alt_2, alt_3, alt_4, \
+ alt_5, alt_6 \
+ ) \
+ info_class INFO_TBL_CONST vec_info_6 info = { \
+ { alt_6, alt_5, alt_4, alt_3, \
+ alt_2, alt_1 }, \
+ i : { \
+ layout : { bitmap : (StgWord32)bitmap_ }, \
+ SRT_INFO(type,srt_,srt_off_,srt_len_) \
+ } \
+ }
+
+#define VEC_INFO_7(info,bitmap_,srt_,srt_off_,srt_len_, \
+ type, info_class, \
+ alt_1, alt_2, alt_3, alt_4, \
+ alt_5, alt_6, alt_7 \
+ ) \
+ info_class INFO_TBL_CONST vec_info_7 info = { \
+ { alt_7, alt_6, alt_5, alt_4, \
+ alt_3, alt_2, alt_1 }, \
+ i : { \
+ layout : { bitmap : (StgWord32)bitmap_ }, \
+ SRT_INFO(type,srt_,srt_off_,srt_len_) \
+ } \
+ }
+
+#define VEC_INFO_8(info,bitmap_,srt_,srt_off_,srt_len_, \
+ type, info_class, \
+ alt_1, alt_2, alt_3, alt_4, \
+ alt_5, alt_6, alt_7, alt_8 \
+ ) \
+ info_class INFO_TBL_CONST vec_info_8 info = { \
+ { alt_8, alt_7, alt_6, alt_5, \
+ alt_4, alt_3, alt_2, alt_1 }, \
+ i : { \
+ layout : { bitmap : (StgWord32)bitmap_ }, \
+ SRT_INFO(type,srt_,srt_off_,srt_len_) \
+ } \
+ }
+
+
+#else
+
+/* We have to define these structure to work around a bug in gcc: if we
+ * try to initialise the vector directly (it's defined as a zero-length
+ * array tacked on the end of the info table structor), then gcc silently
+ * throws away our vector table sometimes.
+ */
+
+typedef struct {
+ StgInfoTable i;
+ StgFunPtr vec[2];
+} vec_info_2;
+
+typedef struct {
+ StgInfoTable i;
+ StgFunPtr vec[3];
+} vec_info_3;
+
+typedef struct {
+ StgInfoTable i;
+ StgFunPtr vec[4];
+} vec_info_4;
+
+typedef struct {
+ StgInfoTable i;
+ StgFunPtr vec[5];
+} vec_info_5;
+
+typedef struct {
+ StgInfoTable i;
+ StgFunPtr vec[6];
+} vec_info_6;
+
+typedef struct {
+ StgInfoTable i;
+ StgFunPtr vec[7];
+} vec_info_7;
+
+typedef struct {
+ StgInfoTable i;
+ StgFunPtr vec[8];
+} vec_info_8;
+
+#define VEC_INFO_2(info,bitmap_,srt_,srt_off_,srt_len_, \
+ type, info_class, \
+ alt_1, alt_2) \
+ info_class INFO_TBL_CONST vec_info_2 info = { \
+ i : { layout : { bitmap : (StgWord32)bitmap_ }, \
+ SRT_INFO(type,srt_,srt_off_,srt_len_), \
+ INIT_ENTRY(NULL), \
+ }, \
+ vec : { alt_1, alt_2 } \
+ }
+
+#define VEC_INFO_3(info,bitmap_,srt_,srt_off_,srt_len_, \
+ type, info_class, \
+ alt_1, alt_2, alt_3 \
+ ) \
+ info_class INFO_TBL_CONST vec_info_3 info = { \
+ i : { layout : { bitmap : (StgWord32)bitmap_ }, \
+ SRT_INFO(type,srt_,srt_off_,srt_len_), \
+ INIT_ENTRY(NULL), \
+ }, \
+ vec : { alt_1, alt_2, alt_3 } \
+ }
+
+#define VEC_INFO_4(info,bitmap_,srt_,srt_off_,srt_len_, \
+ type, info_class, \
+ alt_1, alt_2, alt_3, alt_4 \
+ ) \
+ info_class INFO_TBL_CONST vec_info_4 info = { \
+ i : { layout : { bitmap : (StgWord32)bitmap_ }, \
+ SRT_INFO(type,srt_,srt_off_,srt_len_), \
+ INIT_ENTRY(NULL), \
+ }, \
+ vec : { alt_1, alt_2, alt_3, alt_4 } \
+ }
+
+#define VEC_INFO_5(info,bitmap_,srt_,srt_off_,srt_len_, \
+ type, info_class, \
+ alt_1, alt_2, alt_3, alt_4, \
+ alt_5 \
+ ) \
+ info_class INFO_TBL_CONST vec_info_5 info = { \
+ i : { layout : { bitmap : (StgWord32)bitmap_ }, \
+ SRT_INFO(type,srt_,srt_off_,srt_len_), \
+ INIT_ENTRY(NULL), \
+ }, \
+ vec : { alt_1, alt_2, alt_3, alt_4, \
+ alt_5 } \
+ }
+
+#define VEC_INFO_6(info,bitmap_,srt_,srt_off_,srt_len_, \
+ type, info_class, \
+ alt_1, alt_2, alt_3, alt_4, \
+ alt_5, alt_6 \
+ ) \
+ info_class INFO_TBL_CONST vec_info_6 info = { \
+ i : { layout : { bitmap : (StgWord32)bitmap_ }, \
+ SRT_INFO(type,srt_,srt_off_,srt_len_), \
+ INIT_ENTRY(NULL), \
+ }, \
+ vec : { alt_1, alt_2, alt_3, alt_4, \
+ alt_5, alt_6 } \
+ }
+
+#define VEC_INFO_7(info,bitmap_,srt_,srt_off_,srt_len_, \
+ type, info_class, \
+ alt_1, alt_2, alt_3, alt_4, \
+ alt_5, alt_6, alt_7 \
+ ) \
+ info_class INFO_TBL_CONST vec_info_7 info = { \
+ i : { layout : { bitmap : (StgWord32)bitmap_ }, \
+ SRT_INFO(type,srt_,srt_off_,srt_len_), \
+ INIT_ENTRY(NULL), \
+ }, \
+ vec : { alt_1, alt_2, alt_3, alt_4, \
+ alt_5, alt_6, alt_7 } \
}
+#define VEC_INFO_8(info,bitmap_,srt_,srt_off_,srt_len_, \
+ type, info_class, \
+ alt_1, alt_2, alt_3, alt_4, \
+ alt_5, alt_6, alt_7, alt_8 \
+ ) \
+ info_class INFO_TBL_CONST vec_info_8 info = { \
+ i : { layout : { bitmap : (StgWord32)bitmap_ }, \
+ SRT_INFO(type,srt_,srt_off_,srt_len_), \
+ INIT_ENTRY(NULL), \
+ }, \
+ vec : { alt_1, alt_2, alt_3, alt_4, \
+ alt_5, alt_6, alt_7, alt_8 } \
+ }
+
+#endif /* MINI_INTERPRETER */
+
/* For polymorphic activation records, we need both a direct return
* address and a return vector:
*/
+typedef vec_info_8 StgPolyInfoTable;
+
#ifdef USE_MINIINTERPRETER
-typedef StgInfoTable StgPolyInfoTable;
-#define POLY_VEC(nm) \
- { \
- (F_) nm##_0_entry, \
- (F_) nm##_1_entry, \
- (F_) nm##_2_entry, \
- (F_) nm##_3_entry, \
- (F_) nm##_4_entry, \
- (F_) nm##_5_entry, \
- (F_) nm##_6_entry, \
- (F_) nm##_7_entry \
- }
-#define VEC_POLY_INFO_TABLE(nm,bitmap_,srt_,srt_off_,srt_len_,type) \
- StgFunPtr nm##_vec[8] = POLY_VEC(nm); \
- const StgInfoTable nm##_info = { \
- layout : { bitmap : (StgWord32)bitmap_ }, \
- SRT_INFO(type,srt_,srt_off_,srt_len_), \
- vector : &nm##_vec, \
- INIT_ENTRY(nm##_entry) \
+
+#define VEC_POLY_INFO_TABLE(nm, bitmap_, \
+ srt_, srt_off_, srt_len_, \
+ type, info_class, entry_class \
+ ) \
+ info_class INFO_TBL_CONST vec_info_8 nm##_info = { \
+ i : { layout : { bitmap : (StgWord32)bitmap_ }, \
+ SRT_INFO(type,srt_,srt_off_,srt_len_), \
+ INIT_ENTRY(nm##_entry), \
+ INIT_VECTOR \
+ }, \
+ vec : { \
+ (F_) nm##_0_entry, \
+ (F_) nm##_1_entry, \
+ (F_) nm##_2_entry, \
+ (F_) nm##_3_entry, \
+ (F_) nm##_4_entry, \
+ (F_) nm##_5_entry, \
+ (F_) nm##_6_entry, \
+ (F_) nm##_7_entry \
+ } \
}
#else
-typedef vec_info_8 StgPolyInfoTable;
-#define POLY_VEC(nm) \
- { \
- (F_) nm##_7_entry, \
- (F_) nm##_6_entry, \
- (F_) nm##_5_entry, \
- (F_) nm##_4_entry, \
- (F_) nm##_3_entry, \
- (F_) nm##_2_entry, \
- (F_) nm##_1_entry, \
- (F_) nm##_0_entry \
- }
-#define VEC_POLY_INFO_TABLE(nm,bitmap_,srt_,srt_off_,srt_len_,type) \
- const vec_info_8 nm##_info = { \
- vec : POLY_VEC(nm), \
- i : { \
- layout : { bitmap : (StgWord32)bitmap_ }, \
- SRT_INFO(type,srt_,srt_off_,srt_len_), \
- INIT_ENTRY(nm##_entry) \
- } \
- }
+
+#define VEC_POLY_INFO_TABLE(nm, bitmap_, \
+ srt_, srt_off_, srt_len_, \
+ type, info_class, entry_class \
+ ) \
+ info_class INFO_TBL_CONST vec_info_8 nm##_info = { \
+ { \
+ (F_) nm##_7_entry, \
+ (F_) nm##_6_entry, \
+ (F_) nm##_5_entry, \
+ (F_) nm##_4_entry, \
+ (F_) nm##_3_entry, \
+ (F_) nm##_2_entry, \
+ (F_) nm##_1_entry, \
+ (F_) nm##_0_entry \
+ }, \
+ i : { \
+ layout : { bitmap : (StgWord32)bitmap_ }, \
+ SRT_INFO(type,srt_,srt_off_,srt_len_), \
+ INIT_ENTRY(nm##_entry) \
+ } \
+ }
+
#endif
#define SRT(lbl) \
/* ----------------------------------------------------------------------------
- * $Id: InfoTables.h,v 1.14 1999/03/18 17:57:19 simonm Exp $
+ * $Id: InfoTables.h,v 1.15 1999/05/13 17:31:07 simonm Exp $
*
* (c) The GHC Team, 1998-1999
*
StgWord srt_len : 16; /* } */
#endif
#if USE_MINIINTERPRETER
- StgFunPtr (*vector)[];
StgFunPtr entry;
+ StgFunPtr vector[0];
#else
StgCode code[0];
#endif
} StgInfoTable;
+/* Info tables are read-only, therefore we uniformly declare them with
+ * C's const attribute. This isn't just a nice thing to do: it's
+ * necessary because the garbage collector has to distinguish between
+ * closure pointers and info table pointers when traversing the
+ * stack. We distinguish the two by checking whether the pointer is
+ * into text-space or not.
+ */
+
+#define INFO_TBL_CONST const
+
#endif /* INFOTABLES_H */
/* -----------------------------------------------------------------------------
- * $Id: StgMacros.h,v 1.10 1999/05/11 16:47:41 keithw Exp $
+ * $Id: StgMacros.h,v 1.11 1999/05/13 17:31:07 simonm Exp $
*
* (c) The GHC Team, 1998-1999
*
#define ED_RO_ extern const
#define ID_ extern
#define ID_RO_ extern const
-#define EI_ extern const StgInfoTable
-#define EDI_ extern DLLIMPORT const StgInfoTable
-#define II_ extern const StgInfoTable
+#define EI_ extern INFO_TBL_CONST StgInfoTable
+#define EDI_ extern DLLIMPORT INFO_TBL_CONST StgInfoTable
+#define II_ extern INFO_TBL_CONST StgInfoTable
#define EC_ extern StgClosure
#define EDC_ extern DLLIMPORT StgClosure
#define IC_ extern StgClosure
#define R6_PTR 1<<5
#define R7_PTR 1<<6
#define R8_PTR 1<<7
+
#define HP_CHK_GEN(headroom,liveness,reentry,tag_assts) \
if ((Hp += (headroom)) > HpLim ) { \
EF_(stg_gen_chk); \
-------------------------------------------------------------------------- */
#ifdef USE_MINIINTERPRETER
-#define RET_VEC(p,t) ((*(stgCast(StgInfoTable*,p)->vector))[t])
+#define RET_VEC(p,t) (((StgInfoTable *)p)->vector[t])
#else
#define RET_VEC(p,t) (*((P_)(p) - sizeofW(StgInfoTable) - t - 1))
#endif
/* -----------------------------------------------------------------------------
- * $Id: Updates.h,v 1.10 1999/05/11 16:47:42 keithw Exp $
+ * $Id: Updates.h,v 1.11 1999/05/13 17:31:08 simonm Exp $
*
* (c) The GHC Team, 1998-1999
*
#define PUSH_UPD_FRAME(target, Sp_offset) \
{ \
StgUpdateFrame *__frame; \
- TICK_UPDF_PUSHED(target, GET_INFO((StgClosure*)target)); \
+ TICK_UPDF_PUSHED(target, GET_INFO((StgClosure*)target)); \
__frame = stgCast(StgUpdateFrame*,Sp + (Sp_offset)) - 1; \
SET_INFO(__frame,stgCast(StgInfoTable*,&Upd_frame_info)); \
__frame->link = Su; \
endif
#
-# Profiling options
-WAY_p_HC_OPTS += -GPrelude
-WAY_mr_HC_OPTS += -GPrelude
-
-#
# Object and interface files have suffixes tagged with their ways
#
ifneq "$(way)" ""
/* -----------------------------------------------------------------------------
- * $Id: HeapStackCheck.hc,v 1.6 1999/03/17 16:25:07 sewardj Exp $
+ * $Id: HeapStackCheck.hc,v 1.7 1999/05/13 17:31:10 simonm Exp $
*
* (c) The GHC Team, 1998-1999
*
INFO_TABLE_SRT_BITMAP(stg_gc_unpt_r1_info, stg_gc_unpt_r1_entry, 0/*BITMAP*/,
0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/,
- RET_SMALL, const, EF_, 0, 0);
+ RET_SMALL,, EF_, 0, 0);
EXTFUN(stg_gc_unpt_r1_entry)
{
INFO_TABLE_SRT_BITMAP(stg_gc_unbx_r1_info, stg_gc_unbx_r1_entry, 1/*BITMAP*/,
0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/,
- RET_SMALL, const, EF_, 0, 0);
+ RET_SMALL,, EF_, 0, 0);
/* the 1 is a bitmap - i.e. 1 non-pointer word on the stack. */
EXTFUN(stg_gc_unbx_r1_entry)
INFO_TABLE_SRT_BITMAP(stg_gc_f1_info, stg_gc_f1_entry, 1/*BITMAP*/,
0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/,
- RET_SMALL, const, EF_, 0, 0);
+ RET_SMALL,, EF_, 0, 0);
EXTFUN(stg_gc_f1_entry)
{
INFO_TABLE_SRT_BITMAP(stg_gc_d1_info, stg_gc_d1_entry, DBL_BITMAP,
0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/,
- RET_SMALL, const, EF_, 0, 0);
+ RET_SMALL,, EF_, 0, 0);
EXTFUN(stg_gc_d1_entry)
{
INFO_TABLE_SRT_BITMAP(stg_gc_ut_1_0_info, stg_gc_ut_1_0_entry, 1/*BITMAP*/,
0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/,
- RET_SMALL, const, EF_, 0, 0);
+ RET_SMALL,, EF_, 0, 0);
EXTFUN(stg_gc_ut_1_0_entry)
{
FB_
R1.w = Sp[1];
Sp += 2;
- JMP_(Sp[-2]);
+ JMP_(ENTRY_CODE(Sp[-2]));
FE_
}
INFO_TABLE_SRT_BITMAP(stg_gc_ut_0_1_info, stg_gc_ut_0_1_entry, 3/*BITMAP*/,
0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/,
- RET_SMALL, const, EF_, 0, 0);
+ RET_SMALL,, EF_, 0, 0);
EXTFUN(stg_gc_ut_0_1_entry)
{
FB_
R1.w = Sp[1];
Sp += 2;
- JMP_(Sp[-2]);
+ JMP_(ENTRY_CODE(Sp[-2]));
FE_
}
INFO_TABLE_SRT_BITMAP(stg_gen_chk_info, stg_gen_chk_ret, 0,
0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/,
- RET_DYN, const, EF_, 0, 0);
+ RET_DYN,, EF_, 0, 0);
/* bitmap in the above info table is unused, the real one is on the stack.
*/
{
FB_
RESTORE_EVERYTHING;
- JMP_(Sp[RET_OFFSET]);
+ JMP_(Sp[RET_OFFSET]); /* NO ENTRY_CODE() - this is a direct ret address */
FE_
}
INFO_TABLE_SRT_BITMAP(stg_yield_noregs_info, stg_yield_noregs_ret, 0/*BITMAP*/,
0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/,
- RET_SMALL, const, EF_, 0, 0);
+ RET_SMALL,, EF_, 0, 0);
FN_(stg_yield_noregs_ret)
{
/* -----------------------------------------------------------------------------
- * $Id: PrimOps.hc,v 1.26 1999/05/07 11:10:45 simonm Exp $
+ * $Id: PrimOps.hc,v 1.27 1999/05/13 17:31:11 simonm Exp $
*
* (c) The GHC Team, 1998-1999
*
# define RET_NP(a,b) PUSH_N(3,a); PUSH_P(1,b); PUSHED(3)
# define RET_PPP(a,b,c) PUSH_P(3,a); PUSH_P(2,b); PUSH_P(1,c); PUSHED(3)
-# define RET_NNP(a,b,c) PUSH_N(6,a); PUSH_N(4,b); PUSH_N(2,c); PUSHED(6)
+# define RET_NNP(a,b,c) PUSH_N(5,a); PUSH_N(3,b); PUSH_P(1,c); PUSHED(5)
# define RET_NNNP(a,b,c,d) PUSH_N(7,a); PUSH_N(5,b); PUSH_N(3,c); PUSH_P(1,d); PUSHED(7)
# define RET_NPNP(a,b,c,d) PUSH_N(6,a); PUSH_P(4,b); PUSH_N(3,c); PUSH_P(1,d); PUSHED(6)
/* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.hc,v 1.22 1999/05/11 16:47:58 keithw Exp $
+ * $Id: StgMiscClosures.hc,v 1.23 1999/05/13 17:31:12 simonm Exp $
*
* (c) The GHC Team, 1998-1999
*
This code assumes R1 is in a register for now.
-------------------------------------------------------------------------- */
-INFO_TABLE(IND_info,IND_entry,1,0,IND,const,EF_,0,0);
+INFO_TABLE(IND_info,IND_entry,1,0,IND,,EF_,0,0);
STGFUN(IND_entry)
{
FB_
R1.p = (P_) ((StgInd*)R1.p)->indirectee;
TICK_ENT_VIA_NODE();
- JMP_(*R1.p);
+ JMP_(ENTRY_CODE(*R1.p));
FE_
}
-INFO_TABLE(IND_STATIC_info,IND_STATIC_entry,1,0,IND_STATIC,const,EF_,0,0);
+INFO_TABLE(IND_STATIC_info,IND_STATIC_entry,1,0,IND_STATIC,,EF_,0,0);
STGFUN(IND_STATIC_entry)
{
FB_
R1.p = (P_) ((StgIndStatic*)R1.p)->indirectee;
TICK_ENT_VIA_NODE();
- JMP_(*R1.p);
+ JMP_(ENTRY_CODE(*R1.p));
FE_
}
-INFO_TABLE(IND_PERM_info,IND_PERM_entry,1,1,IND_PERM,const,EF_,0,0);
+INFO_TABLE(IND_PERM_info,IND_PERM_entry,1,1,IND_PERM,,EF_,0,0);
STGFUN(IND_PERM_entry)
{
FB_
TICK_ENT_VIA_NODE();
#endif
- JMP_(*R1.p);
+ JMP_(ENTRY_CODE(*R1.p));
FE_
}
-INFO_TABLE(IND_OLDGEN_info,IND_OLDGEN_entry,1,1,IND_OLDGEN,const,EF_,0,0);
+INFO_TABLE(IND_OLDGEN_info,IND_OLDGEN_entry,1,1,IND_OLDGEN,,EF_,0,0);
STGFUN(IND_OLDGEN_entry)
{
FB_
R1.p = (P_) ((StgInd*)R1.p)->indirectee;
TICK_ENT_VIA_NODE();
- JMP_(*R1.p);
+ JMP_(ENTRY_CODE(*R1.p));
FE_
}
-INFO_TABLE(IND_OLDGEN_PERM_info,IND_OLDGEN_PERM_entry,1,1,IND_OLDGEN_PERM,const,EF_,0,0);
+INFO_TABLE(IND_OLDGEN_PERM_info,IND_OLDGEN_PERM_entry,1,1,IND_OLDGEN_PERM,,EF_,0,0);
STGFUN(IND_OLDGEN_PERM_entry)
{
FB_
R1.p = (P_) ((StgInd*)R1.p)->indirectee;
TICK_ENT_VIA_NODE();
- JMP_(*R1.p);
+ JMP_(ENTRY_CODE(*R1.p));
FE_
}
This code assumes R1 is in a register for now.
-------------------------------------------------------------------------- */
-INFO_TABLE(CAF_UNENTERED_info,CAF_UNENTERED_entry,1,3,CAF_UNENTERED,const,EF_,0,0);
+INFO_TABLE(CAF_UNENTERED_info,CAF_UNENTERED_entry,1,3,CAF_UNENTERED,,EF_,0,0);
STGFUN(CAF_UNENTERED_entry)
{
FB_
}
/* 0,4 is entirely bogus; _do not_ rely on this info */
-INFO_TABLE(CAF_ENTERED_info,CAF_ENTERED_entry,0,4,CAF_ENTERED,const,EF_,0,0);
+INFO_TABLE(CAF_ENTERED_info,CAF_ENTERED_entry,0,4,CAF_ENTERED,,EF_,0,0);
STGFUN(CAF_ENTERED_entry)
{
FB_
* should be big enough for an old-generation indirection.
*/
-INFO_TABLE(BLACKHOLE_info, BLACKHOLE_entry,0,2,BLACKHOLE,const,EF_,0,0);
+INFO_TABLE(BLACKHOLE_info, BLACKHOLE_entry,0,2,BLACKHOLE,,EF_,0,0);
STGFUN(BLACKHOLE_entry)
{
FB_
FE_
}
-INFO_TABLE(BLACKHOLE_BQ_info, BLACKHOLE_BQ_entry,1,1,BLACKHOLE_BQ,const,EF_,0,0);
+INFO_TABLE(BLACKHOLE_BQ_info, BLACKHOLE_BQ_entry,1,1,BLACKHOLE_BQ,,EF_,0,0);
STGFUN(BLACKHOLE_BQ_entry)
{
FB_
}
/* identical to BLACKHOLEs except for the infotag */
-INFO_TABLE(CAF_BLACKHOLE_info, CAF_BLACKHOLE_entry,0,2,CAF_BLACKHOLE,const,EF_,0,0);
+INFO_TABLE(CAF_BLACKHOLE_info, CAF_BLACKHOLE_entry,0,2,CAF_BLACKHOLE,,EF_,0,0);
STGFUN(CAF_BLACKHOLE_entry)
{
FB_
}
#ifdef TICKY_TICKY
-INFO_TABLE(SE_BLACKHOLE_info, SE_BLACKHOLE_entry,0,2,SE_BLACKHOLE,const,EF_,0,0);
+INFO_TABLE(SE_BLACKHOLE_info, SE_BLACKHOLE_entry,0,2,SE_BLACKHOLE,,EF_,0,0);
STGFUN(SE_BLACKHOLE_entry)
{
FB_
FE_
}
-INFO_TABLE(SE_CAF_BLACKHOLE_info, SE_CAF_BLACKHOLE_entry,0,2,SE_CAF_BLACKHOLE,const,EF_,0,0);
+INFO_TABLE(SE_CAF_BLACKHOLE_info, SE_CAF_BLACKHOLE_entry,0,2,SE_CAF_BLACKHOLE,,EF_,0,0);
STGFUN(SE_CAF_BLACKHOLE_entry)
{
FB_
/* -----------------------------------------------------------------------------
The code for a BCO returns to the scheduler
-------------------------------------------------------------------------- */
-INFO_TABLE(BCO_info,BCO_entry,0,0,BCO,const,EF_,0,0);
+INFO_TABLE(BCO_info,BCO_entry,0,0,BCO,,EF_,0,0);
EF_(BCO_entry) {
FB_
Sp -= 1;
FE_ \
}
-INFO_TABLE(TSO_info, TSO_entry, 0,0,TSO,const,EF_,0,0);
+INFO_TABLE(TSO_info, TSO_entry, 0,0,TSO,,EF_,0,0);
NON_ENTERABLE_ENTRY_CODE(TSO);
/* -----------------------------------------------------------------------------
one is a real bug.
-------------------------------------------------------------------------- */
-INFO_TABLE(EVACUATED_info,EVACUATED_entry,1,0,EVACUATED,const,EF_,0,0);
+INFO_TABLE(EVACUATED_info,EVACUATED_entry,1,0,EVACUATED,,EF_,0,0);
NON_ENTERABLE_ENTRY_CODE(EVACUATED);
/* -----------------------------------------------------------------------------
live weak pointers with dead ones).
-------------------------------------------------------------------------- */
-INFO_TABLE(WEAK_info,WEAK_entry,0,4,WEAK,const,EF_,0,0);
+INFO_TABLE(WEAK_info,WEAK_entry,0,4,WEAK,,EF_,0,0);
NON_ENTERABLE_ENTRY_CODE(WEAK);
-INFO_TABLE_CONSTR(DEAD_WEAK_info,DEAD_WEAK_entry,0,1,0,CONSTR,const,EF_,0,0);
+INFO_TABLE_CONSTR(DEAD_WEAK_info,DEAD_WEAK_entry,0,1,0,CONSTR,,EF_,0,0);
NON_ENTERABLE_ENTRY_CODE(DEAD_WEAK);
/* -----------------------------------------------------------------------------
finalizer in a weak pointer object.
-------------------------------------------------------------------------- */
-INFO_TABLE_CONSTR(NO_FINALIZER_info,NO_FINALIZER_entry,0,0,0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
+INFO_TABLE_CONSTR(NO_FINALIZER_info,NO_FINALIZER_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
NON_ENTERABLE_ENTRY_CODE(NO_FINALIZER);
SET_STATIC_HDR(NO_FINALIZER_closure,NO_FINALIZER_info,0/*CC*/,,EI_)
Foreign Objects are unlifted and therefore never entered.
-------------------------------------------------------------------------- */
-INFO_TABLE(FOREIGN_info,FOREIGN_entry,0,1,FOREIGN,const,EF_,0,0);
+INFO_TABLE(FOREIGN_info,FOREIGN_entry,0,1,FOREIGN,,EF_,0,0);
NON_ENTERABLE_ENTRY_CODE(FOREIGN);
/* -----------------------------------------------------------------------------
Stable Names are unlifted too.
-------------------------------------------------------------------------- */
-INFO_TABLE(STABLE_NAME_info,STABLE_NAME_entry,0,1,STABLE_NAME,const,EF_,0,0);
+INFO_TABLE(STABLE_NAME_info,STABLE_NAME_entry,0,1,STABLE_NAME,,EF_,0,0);
NON_ENTERABLE_ENTRY_CODE(STABLE_NAME);
/* -----------------------------------------------------------------------------
and entry code for each type.
-------------------------------------------------------------------------- */
-INFO_TABLE(FULL_MVAR_info,FULL_MVAR_entry,4,0,MVAR,const,EF_,0,0);
+INFO_TABLE(FULL_MVAR_info,FULL_MVAR_entry,4,0,MVAR,,EF_,0,0);
NON_ENTERABLE_ENTRY_CODE(FULL_MVAR);
-INFO_TABLE(EMPTY_MVAR_info,EMPTY_MVAR_entry,4,0,MVAR,const,EF_,0,0);
+INFO_TABLE(EMPTY_MVAR_info,EMPTY_MVAR_entry,4,0,MVAR,,EF_,0,0);
NON_ENTERABLE_ENTRY_CODE(EMPTY_MVAR);
/* -----------------------------------------------------------------------------
end of a linked TSO queue.
-------------------------------------------------------------------------- */
-INFO_TABLE_CONSTR(END_TSO_QUEUE_info,END_TSO_QUEUE_entry,0,0,0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
+INFO_TABLE_CONSTR(END_TSO_QUEUE_info,END_TSO_QUEUE_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
NON_ENTERABLE_ENTRY_CODE(END_TSO_QUEUE);
SET_STATIC_HDR(END_TSO_QUEUE_closure,END_TSO_QUEUE_info,0/*CC*/,,EI_)
an END_MUT_LIST closure.
-------------------------------------------------------------------------- */
-INFO_TABLE_CONSTR(END_MUT_LIST_info,END_MUT_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
+INFO_TABLE_CONSTR(END_MUT_LIST_info,END_MUT_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
NON_ENTERABLE_ENTRY_CODE(END_MUT_LIST);
SET_STATIC_HDR(END_MUT_LIST_closure,END_MUT_LIST_info,0/*CC*/,,EI_)
};
-INFO_TABLE(MUT_CONS_info, MUT_CONS_entry, 1, 1, MUT_VAR, const, EF_, 0, 0);
+INFO_TABLE(MUT_CONS_info, MUT_CONS_entry, 1, 1, MUT_VAR, , EF_, 0, 0);
NON_ENTERABLE_ENTRY_CODE(MUT_CONS);
/* -----------------------------------------------------------------------------
-------------------------------------------------------------------------- */
#define ArrayInfo(type) \
-INFO_TABLE(type##_info, type##_entry, 0, 0, type, const, EF_,0,0);
+INFO_TABLE(type##_info, type##_entry, 0, 0, type, , EF_,0,0);
ArrayInfo(ARR_WORDS);
NON_ENTERABLE_ENTRY_CODE(ARR_WORDS);
Mutable Variables
-------------------------------------------------------------------------- */
-INFO_TABLE(MUT_VAR_info, MUT_VAR_entry, 1, 1, MUT_VAR, const, EF_, 0, 0);
+INFO_TABLE(MUT_VAR_info, MUT_VAR_entry, 1, 1, MUT_VAR, , EF_, 0, 0);
NON_ENTERABLE_ENTRY_CODE(MUT_VAR);
/* -----------------------------------------------------------------------------
just enter the top stack word to start the thread. (see deleteThread)
* -------------------------------------------------------------------------- */
-INFO_TABLE(dummy_ret_info, dummy_ret_entry, 0, 0, CONSTR_NOCAF_STATIC, const, EF_, 0, 0);
+INFO_TABLE(dummy_ret_info, dummy_ret_entry, 0, 0, CONSTR_NOCAF_STATIC, , EF_, 0, 0);
FN_(dummy_ret_entry)
{
W_ ret_addr;
#ifndef COMPILER
-INFO_TABLE_CONSTR(Czh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgChar),0,CONSTR,const,EF_,0,0);
-INFO_TABLE_CONSTR(Izh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR,const,EF_,0,0);
-INFO_TABLE_CONSTR(I64zh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR,const,EF_,0,0);
-INFO_TABLE_CONSTR(Fzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR,const,EF_,0,0);
-INFO_TABLE_CONSTR(Dzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR,const,EF_,0,0);
-INFO_TABLE_CONSTR(Azh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR,const,EF_,0,0);
-INFO_TABLE_CONSTR(Wzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR,const,EF_,0,0);
-INFO_TABLE_CONSTR(StablePtr_con_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr),0,CONSTR,const,EF_,0,0);
+INFO_TABLE_CONSTR(Czh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgChar),0,CONSTR,,EF_,0,0);
+INFO_TABLE_CONSTR(Izh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR,,EF_,0,0);
+INFO_TABLE_CONSTR(I64zh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR,,EF_,0,0);
+INFO_TABLE_CONSTR(Fzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR,,EF_,0,0);
+INFO_TABLE_CONSTR(Dzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR,,EF_,0,0);
+INFO_TABLE_CONSTR(Azh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR,,EF_,0,0);
+INFO_TABLE_CONSTR(Wzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR,,EF_,0,0);
+INFO_TABLE_CONSTR(StablePtr_con_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr),0,CONSTR,,EF_,0,0);
/* These might seem redundant but {I,C}zh_static_info are used in
* {INT,CHAR}LIKE and the rest are used in RtsAPI.c
*/
-INFO_TABLE_CONSTR(Czh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgChar),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
-INFO_TABLE_CONSTR(Izh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
-INFO_TABLE_CONSTR(I64zh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
-INFO_TABLE_CONSTR(Fzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
-INFO_TABLE_CONSTR(Dzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
-INFO_TABLE_CONSTR(Azh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
-INFO_TABLE_CONSTR(Wzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
-INFO_TABLE_CONSTR(StablePtr_static_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
+INFO_TABLE_CONSTR(Czh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgChar),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
+INFO_TABLE_CONSTR(Izh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
+INFO_TABLE_CONSTR(I64zh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
+INFO_TABLE_CONSTR(Fzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
+INFO_TABLE_CONSTR(Dzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
+INFO_TABLE_CONSTR(Azh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
+INFO_TABLE_CONSTR(Wzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
+INFO_TABLE_CONSTR(StablePtr_static_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
#endif /* !defined(COMPILER) */
* when we've got the real addresses to the C# and I# closures.
*
*/
-static const StgInfoTable czh_static_info;
-static const StgInfoTable izh_static_info;
+static INFO_TBL_CONST StgInfoTable czh_static_info;
+static INFO_TBL_CONST StgInfoTable izh_static_info;
#define Char_hash_static_info czh_static_info
#define Int_hash_static_info izh_static_info
#else
/* -----------------------------------------------------------------------------
- * $Id: StgStartup.hc,v 1.4 1999/03/15 17:11:27 simonm Exp $
+ * $Id: StgStartup.hc,v 1.5 1999/05/13 17:31:13 simonm Exp $
*
* (c) The GHC Team, 1998-1999
*
#define stg_stop_thread_6_entry stg_stop_thread_entry
#define stg_stop_thread_7_entry stg_stop_thread_entry
-VEC_POLY_INFO_TABLE(stg_stop_thread,STOP_THREAD_BITMAP,0,0,0,STOP_FRAME);
+VEC_POLY_INFO_TABLE(stg_stop_thread,STOP_THREAD_BITMAP,0,0,0,STOP_FRAME,,EF_);
STGFUN(stg_stop_thread_entry)
{
LoadThreadState();
CHECK_SENSIBLE_REGS();
Sp++;
- JMP_(Sp[-1]);
+ JMP_(ENTRY_CODE(Sp[-1]));
FE_
}
/* -----------------------------------------------------------------------------
- * $Id: StgStdThunks.hc,v 1.5 1999/04/23 09:45:27 simonm Exp $
+ * $Id: StgStdThunks.hc,v 1.6 1999/05/13 17:31:13 simonm Exp $
*
* (c) The GHC Team, 1998-1999
*
#define SELECTOR_CODE_UPD(offset) \
IF_(__sel_ret_##offset##_upd_ret); \
- INFO_TABLE_SRT_BITMAP(__sel_ret_##offset##_upd_info,__sel_ret_##offset##_upd_ret, RET_BITMAP, 0, 0, 0, RET_SMALL, static const, IF_, 0, 0); \
+ INFO_TABLE_SRT_BITMAP(__sel_ret_##offset##_upd_info,__sel_ret_##offset##_upd_ret, RET_BITMAP, 0, 0, 0, RET_SMALL, static, IF_, 0, 0); \
IF_(__sel_ret_##offset##_upd_ret) { \
FB_ \
R1.p=(P_)R1.cl->payload[offset]; \
} \
\
EF_(__sel_##offset##_upd_entry); \
- INFO_TABLE_SELECTOR(__sel_##offset##_upd_info, __sel_##offset##_upd_entry, offset, const, EF_, 0,0);\
+ INFO_TABLE_SELECTOR(__sel_##offset##_upd_info, __sel_##offset##_upd_entry, offset,, EF_, 0,0);\
EF_(__sel_##offset##_upd_entry) { \
FB_ \
STK_CHK_NP(UPD_FRAME_SIZE,1,); \
PUSH_UPD_FRAME(R1.p,0); \
ENTER_CCS(R1.p); \
SAVE_CCCS(UPD_FRAME_SIZE); \
- Sp[-UPD_FRAME_SIZE]=(W_)__sel_ret_##offset##_upd_ret; \
+ Sp[-UPD_FRAME_SIZE]=(W_)&__sel_ret_##offset##_upd_info; \
R1.p = (P_)R1.cl->payload[0]; \
Sp=Sp-UPD_FRAME_SIZE; \
JMP_(ENTRY_CODE(*R1.p)); \
#define SELECTOR_CODE_NOUPD(offset) \
IF_(__sel_ret_##offset##_noupd_ret); \
- INFO_TABLE_SRT_BITMAP(__sel_ret_##offset##_noupd_info, __sel_ret_##offset##_noupd_ret, RET_BITMAP, 0, 0, 0, RET_SMALL, static const, IF_, 0, 0); \
+ INFO_TABLE_SRT_BITMAP(__sel_ret_##offset##_noupd_info, __sel_ret_##offset##_noupd_ret, RET_BITMAP, 0, 0, 0, RET_SMALL, static, IF_, 0, 0); \
IF_(__sel_ret_##offset##_noupd_ret) { \
FB_ \
R1.p=(P_)R1.cl->payload[offset]; \
} \
\
EF_(__sel_##offset##_noupd_entry); \
- INFO_TABLE_SELECTOR(__sel_##offset##_noupd_info, __sel_##offset##_noupd_entry, offset, const, EF_, 0,0);\
+ INFO_TABLE_SELECTOR(__sel_##offset##_noupd_info, __sel_##offset##_noupd_entry, offset,, EF_, 0,0);\
EF_(__sel_##offset##_noupd_entry) { \
FB_ \
STK_CHK_NP(NOUPD_FRAME_SIZE,1,) \
* in the compiler that means __ap_1 is generated occasionally (ToDo)
*/
-INFO_TABLE_SRT(__ap_1_upd_info,__ap_1_upd_entry,1,0,0,0,0,THUNK, const,EF_,0,0);
+INFO_TABLE_SRT(__ap_1_upd_info,__ap_1_upd_entry,1,0,0,0,0,THUNK,,EF_,0,0);
FN_(__ap_1_upd_entry) {
FB_
STK_CHK_NP(sizeofW(StgUpdateFrame),1,);
FE_
}
-INFO_TABLE_SRT(__ap_2_upd_info,__ap_2_upd_entry,2,0,0,0,0,THUNK, const,EF_,0,0);
+INFO_TABLE_SRT(__ap_2_upd_info,__ap_2_upd_entry,2,0,0,0,0,THUNK,,EF_,0,0);
FN_(__ap_2_upd_entry) {
FB_
STK_CHK_NP(sizeofW(StgUpdateFrame)+1,1,);
FE_
}
-INFO_TABLE_SRT(__ap_3_upd_info,__ap_3_upd_entry,3,0,0,0,0,THUNK, const,EF_,0,0);
+INFO_TABLE_SRT(__ap_3_upd_info,__ap_3_upd_entry,3,0,0,0,0,THUNK,,EF_,0,0);
FN_(__ap_3_upd_entry) {
FB_
STK_CHK_NP(sizeofW(StgUpdateFrame)+2,1,);
FE_
}
-INFO_TABLE_SRT(__ap_4_upd_info,__ap_4_upd_entry,4,0,0,0,0,THUNK, const,EF_,0,0);
+INFO_TABLE_SRT(__ap_4_upd_info,__ap_4_upd_entry,4,0,0,0,0,THUNK,,EF_,0,0);
FN_(__ap_4_upd_entry) {
FB_
STK_CHK_NP(sizeofW(StgUpdateFrame)+3,1,);
FE_
}
-INFO_TABLE_SRT(__ap_5_upd_info,__ap_5_upd_entry,5,0,0,0,0,THUNK, const,EF_,0,0);
+INFO_TABLE_SRT(__ap_5_upd_info,__ap_5_upd_entry,5,0,0,0,0,THUNK,,EF_,0,0);
FN_(__ap_5_upd_entry) {
FB_
STK_CHK_NP(sizeofW(StgUpdateFrame)+4,1,);
FE_
}
-INFO_TABLE_SRT(__ap_6_upd_info,__ap_6_upd_entry,6,0,0,0,0,THUNK, const,EF_,0,0);
+INFO_TABLE_SRT(__ap_6_upd_info,__ap_6_upd_entry,6,0,0,0,0,THUNK,,EF_,0,0);
FN_(__ap_6_upd_entry) {
FB_
STK_CHK_NP(sizeofW(StgUpdateFrame)+5,1,);
FE_
}
-INFO_TABLE_SRT(__ap_7_upd_info,__ap_7_upd_entry,7,0,0,0,0,THUNK, const,EF_,0,0);
+INFO_TABLE_SRT(__ap_7_upd_info,__ap_7_upd_entry,7,0,0,0,0,THUNK,,EF_,0,0);
FN_(__ap_7_upd_entry) {
FB_
STK_CHK_NP(sizeofW(StgUpdateFrame)+6,1,);
FE_
}
-INFO_TABLE_SRT(__ap_8_upd_info,__ap_8_upd_entry,8,0,0,0,0,THUNK, const,EF_,0,0);
+INFO_TABLE_SRT(__ap_8_upd_info,__ap_8_upd_entry,8,0,0,0,0,THUNK,,EF_,0,0);
FN_(__ap_8_upd_entry) {
FB_
STK_CHK_NP(sizeofW(StgUpdateFrame)+7,1,);
/* -----------------------------------------------------------------------------
- * $Id: Updates.hc,v 1.16 1999/05/11 16:48:00 keithw Exp $
+ * $Id: Updates.hc,v 1.17 1999/05/13 17:31:14 simonm Exp $
*
* (c) The GHC Team, 1998-1999
*
* there's a cost-centre-stack in there too).
*/
-VEC_POLY_INFO_TABLE(Upd_frame,UPD_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, UPDATE_FRAME);
+VEC_POLY_INFO_TABLE(Upd_frame,UPD_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, UPDATE_FRAME,, EF_);
/* -----------------------------------------------------------------------------
Entry Code for a PAP.
really an optimisation? --SDM)
-------------------------------------------------------------------------- */
-INFO_TABLE(PAP_info,PAP_entry,/*special layout*/0,0,PAP,const,EF_,0,0);
+INFO_TABLE(PAP_info,PAP_entry,/*special layout*/0,0,PAP,,EF_,0,0);
STGFUN(PAP_entry)
{
nat Words;
-------------------------------------------------------------------------- */
-INFO_TABLE(AP_UPD_info,AP_UPD_entry,/*special layout*/0,0,AP_UPD,const,EF_,0,0);
+INFO_TABLE(AP_UPD_info,AP_UPD_entry,/*special layout*/0,0,AP_UPD,,EF_,0,0);
STGFUN(AP_UPD_entry)
{
nat Words;
SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_6_entry,ENTRY_CODE(Sp[0]));
SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_7_entry,ENTRY_CODE(Sp[0]));
-VEC_POLY_INFO_TABLE(seq_frame, UPD_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, SEQ_FRAME);
+VEC_POLY_INFO_TABLE(seq_frame, UPD_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, SEQ_FRAME,, EF_);
/* -----------------------------------------------------------------------------
* The seq infotable
* It is used in deleteThread when reverting blackholes.
* -------------------------------------------------------------------------- */
-INFO_TABLE(seq_info,seq_entry,1,0,FUN,const,EF_,0,0);
+INFO_TABLE(seq_info,seq_entry,1,0,FUN,,EF_,0,0);
STGFUN(seq_entry)
{
FB_
* kind of return to the activation record underneath us on the stack.
*/
-VEC_POLY_INFO_TABLE(catch_frame, CATCH_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, CATCH_FRAME);
+VEC_POLY_INFO_TABLE(catch_frame, CATCH_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, CATCH_FRAME,, EF_);
/* -----------------------------------------------------------------------------
* The catch infotable
* It is used in deleteThread when reverting blackholes.
* -------------------------------------------------------------------------- */
-INFO_TABLE(catch_info,catch_entry,2,0,FUN,const,EF_,0,0);
+INFO_TABLE(catch_info,catch_entry,2,0,FUN,,EF_,0,0);
STGFUN(catch_entry)
{
FB_
* It is used in raisezh_fast to update thunks on the update list
* -------------------------------------------------------------------------- */
-INFO_TABLE(raise_info,raise_entry,1,0,FUN,const,EF_,0,0);
+INFO_TABLE(raise_info,raise_entry,1,0,FUN,,EF_,0,0);
STGFUN(raise_entry)
{
FB_
projects / ghc-hetmet.git / commitdiff