diff options
| author | simonm <unknown> | 1999-05-13 17:31:14 +0000 |
|---|---|---|
| committer | simonm <unknown> | 1999-05-13 17:31:14 +0000 |
| commit | 589b7946b0847a47d1a5493dcec0976c84814312 (patch) | |
| tree | ea1e53441f19b22ce198c65f5fdf61fd756426b8 | |
| parent | 8997af62ca647b52a3eae314f45d86db346fab45 (diff) | |
| download | haskell-589b7946b0847a47d1a5493dcec0976c84814312.tar.gz | |
[project @ 1999-05-13 17:30:50 by simonm]
Support for "unregisterised" builds. An unregisterised build doesn't
use the assembly mangler, doesn't do tail jumping (uses the
mini-interpreter), and doesn't use global register variables.
Plenty of cleanups and bugfixes in the process.
Add way 'u' to GhcLibWays to get unregisterised libs & RTS.
[ note: not *quite* working fully yet... there's still a bug or two
lurking ]
26 files changed, 726 insertions, 489 deletions
diff --git a/ghc/compiler/Makefile b/ghc/compiler/Makefile index 6e84f3e923..82ae5a7e48 100644 --- a/ghc/compiler/Makefile +++ b/ghc/compiler/Makefile @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $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 @@ -185,6 +185,9 @@ parser/U_qid_HC_OPTS = -fvia-C '-\#include"hspincl.h"' 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 diff --git a/ghc/compiler/absCSyn/AbsCSyn.lhs b/ghc/compiler/absCSyn/AbsCSyn.lhs index a8445bb4ac..d88a523806 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.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} @@ -92,9 +92,9 @@ stored in a mixed type location.) -- (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 diff --git a/ghc/compiler/absCSyn/CLabel.lhs b/ghc/compiler/absCSyn/CLabel.lhs index 9161b280fd..ac0c3d223d 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.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} @@ -35,7 +35,7 @@ module CLabel ( mkAsmTempLabel, mkErrorStdEntryLabel, - mkUpdEntryLabel, + mkUpdInfoLabel, mkCAFBlackHoleInfoTableLabel, mkSECAFBlackHoleInfoTableLabel, mkRtsPrimOpLabel, @@ -45,7 +45,7 @@ module CLabel ( mkCC_Label, mkCCS_Label, - needsCDecl, isReadOnly, isAsmTemp, externallyVisibleCLabel, + needsCDecl, isAsmTemp, externallyVisibleCLabel, CLabelType(..), labelType, labelDynamic, @@ -156,7 +156,7 @@ data RtsLabelInfo | RtsBlackHoleInfoTbl FAST_STRING -- black hole with info table name - | RtsUpdEntry + | RtsUpdInfo | RtsSelectorInfoTbl Bool{-updatable-} Int{-offset-} -- Selector thunks | RtsSelectorEntry Bool{-updatable-} Int{-offset-} @@ -210,7 +210,7 @@ mkAsmTempLabel = AsmTempLabel -- 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")) @@ -232,7 +232,6 @@ mkCCS_Label ccs = CCS_Label ccs \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} @@ -262,21 +261,6 @@ needsCDecl (CC_Label _) = False 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} @@ -307,6 +291,7 @@ labelType :: CLabel -> CLabelType 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 @@ -418,7 +403,7 @@ pprCLbl (CaseLabel u CaseBitmap) 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 diff --git a/ghc/compiler/absCSyn/PprAbsC.lhs b/ghc/compiler/absCSyn/PprAbsC.lhs index b17536be87..cd634741b3 100644 --- a/ghc/compiler/absCSyn/PprAbsC.lhs +++ b/ghc/compiler/absCSyn/PprAbsC.lhs @@ -28,7 +28,7 @@ import AbsCUtils ( getAmodeRep, nonemptyAbsC, 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 @@ -143,7 +143,8 @@ pprAbsC (CReturn am return_info) c (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, @@ -498,32 +499,24 @@ pprAbsC stmt@(CRetDirect uniq code srt liveness) _ 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 @@ -538,14 +531,9 @@ pprAbsC (CCostCentreStackDecl ccs) _ = pprCostCentreStackDecl ccs \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). @@ -559,10 +547,7 @@ ppLocalnessMacro include_dyn_prefix clabel = 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 diff --git a/ghc/compiler/codeGen/CgCase.lhs b/ghc/compiler/codeGen/CgCase.lhs index a99a8fe754..aa09d5db6d 100644 --- a/ghc/compiler/codeGen/CgCase.lhs +++ b/ghc/compiler/codeGen/CgCase.lhs @@ -1,7 +1,7 @@ % % (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 $ % %******************************************************** %* * @@ -470,7 +470,7 @@ cgEvalAlts cc_slot bndr srt alts 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) @@ -515,7 +515,7 @@ cgEvalAlts cc_slot bndr srt alts (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} @@ -654,7 +654,7 @@ cgAlgAlt gc_flag uniq cc_slot must_label_branch 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 @@ -978,7 +978,7 @@ possibleHeapCheck -> 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 diff --git a/ghc/compiler/codeGen/CgClosure.lhs b/ghc/compiler/codeGen/CgClosure.lhs index 86f90af8ca..edcb089862 100644 --- a/ghc/compiler/codeGen/CgClosure.lhs +++ b/ghc/compiler/codeGen/CgClosure.lhs @@ -1,7 +1,7 @@ % % (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} @@ -41,7 +41,7 @@ import CgUsages ( setRealAndVirtualSp, getVirtSp, 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 ) @@ -401,7 +401,7 @@ closureCodeBody binder_info closure_info cc all_args body 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) @@ -429,7 +429,7 @@ closureCodeBody binder_info closure_info cc all_args body -- 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 @@ -572,10 +572,10 @@ thunkWrapper closure_info label thunk_code 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 @@ -587,7 +587,7 @@ funWrapper closure_info arg_regs stk_tags slow_label fun_body 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 diff --git a/ghc/compiler/codeGen/CgHeapery.lhs b/ghc/compiler/codeGen/CgHeapery.lhs index 6fa82c94f9..ba26f4d622 100644 --- a/ghc/compiler/codeGen/CgHeapery.lhs +++ b/ghc/compiler/codeGen/CgHeapery.lhs @@ -1,7 +1,7 @@ % % (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} @@ -31,6 +31,7 @@ import ClosureInfo ( closureSize, closureGoodStuffSize, closureSMRep ) import PrimRep ( PrimRep(..), isFollowableRep ) +import Unique ( Unique ) import CmdLineOpts ( opt_SccProfilingOn ) import GlaExts import Outputable @@ -226,7 +227,7 @@ altHeapCheck -> [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 @@ -251,6 +252,12 @@ altHeapCheck is_fun regs tags fail_code (Just ret_addr) 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)] @@ -258,14 +265,14 @@ altHeapCheck is_fun regs tags fail_code (Just ret_addr) code 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 -> @@ -274,7 +281,10 @@ altHeapCheck is_fun regs tags fail_code (Just ret_addr) code 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: diff --git a/ghc/compiler/codeGen/CgLetNoEscape.lhs b/ghc/compiler/codeGen/CgLetNoEscape.lhs index 6d5336c88c..f122b963b4 100644 --- a/ghc/compiler/codeGen/CgLetNoEscape.lhs +++ b/ghc/compiler/codeGen/CgLetNoEscape.lhs @@ -1,7 +1,7 @@ % % (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 $ % %******************************************************** %* * @@ -30,12 +30,13 @@ import CgRetConv ( assignRegs ) 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} @@ -160,7 +161,6 @@ cgLetNoEscapeClosure arity = length args lf_info = mkLFLetNoEscape arity uniq = idUnique binder - lbl = mkReturnPtLabel uniq in -- saveVolatileVarsAndRegs done earlier in cgExpr. @@ -173,7 +173,7 @@ cgLetNoEscapeClosure (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) @@ -188,10 +188,10 @@ cgLetNoEscapeBody :: Id -> 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 -> @@ -221,12 +221,13 @@ cgLetNoEscapeBody binder cc all_args body lbl -- 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 ) diff --git a/ghc/compiler/codeGen/CgMonad.lhs b/ghc/compiler/codeGen/CgMonad.lhs index c3e029516a..dea30bf33d 100644 --- a/ghc/compiler/codeGen/CgMonad.lhs +++ b/ghc/compiler/codeGen/CgMonad.lhs @@ -1,7 +1,7 @@ % % (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} @@ -49,7 +49,7 @@ import {-# SOURCE #-} CgUsages ( getSpRelOffset ) 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 ) @@ -163,13 +163,19 @@ type JoinDetails -- 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" diff --git a/ghc/compiler/codeGen/CgRetConv.lhs b/ghc/compiler/codeGen/CgRetConv.lhs index 07f07aba39..d4784b6aae 100644 --- a/ghc/compiler/codeGen/CgRetConv.lhs +++ b/ghc/compiler/codeGen/CgRetConv.lhs @@ -1,7 +1,7 @@ % % (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} @@ -21,9 +21,10 @@ module CgRetConv ( 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 ) @@ -182,10 +183,10 @@ that are guaranteed to map to machine registers. \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 diff --git a/ghc/compiler/codeGen/CgTailCall.lhs b/ghc/compiler/codeGen/CgTailCall.lhs index b6953b1ce0..168cde42ae 100644 --- a/ghc/compiler/codeGen/CgTailCall.lhs +++ b/ghc/compiler/codeGen/CgTailCall.lhs @@ -1,7 +1,7 @@ % % (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 $ % %******************************************************** %* * @@ -38,7 +38,7 @@ import CgRetConv ( dataReturnConvPrim, 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 @@ -168,7 +168,7 @@ mkStaticAlgReturnCode con sequel 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 diff --git a/ghc/compiler/main/CmdLineOpts.lhs b/ghc/compiler/main/CmdLineOpts.lhs index 97a1820287..bdc0bb6df3 100644 --- a/ghc/compiler/main/CmdLineOpts.lhs +++ b/ghc/compiler/main/CmdLineOpts.lhs @@ -14,21 +14,15 @@ module CmdLineOpts ( 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, @@ -38,84 +32,104 @@ module CmdLineOpts ( 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" @@ -285,28 +299,15 @@ unpacked_opts = \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") @@ -316,84 +317,114 @@ opt_D_dump_simpl_iterations = lookUp SLIT("-ddump-simpl-iterations") 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} diff --git a/ghc/driver/Makefile b/ghc/driver/Makefile index fe8e0b8d4b..e6b7fec6e9 100644 --- a/ghc/driver/Makefile +++ b/ghc/driver/Makefile @@ -28,8 +28,8 @@ INTERP=perl # 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) @@ -46,7 +46,7 @@ SCRIPT_SUBST_VARS := \ 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 @@ -115,45 +115,3 @@ install :: 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 diff --git a/ghc/driver/ghc.lprl b/ghc/driver/ghc.lprl index 8dbeef2e52..bef7b1531e 100644 --- a/ghc/driver/ghc.lprl +++ b/ghc/driver/ghc.lprl @@ -116,7 +116,7 @@ GHC_UNLIT GHC_HSCPP GHC_HSC GHC_SYSMAN CP RM CONTEXT_DIFF -WAY_*_NAME WAY_*_HC_OPTS +WAY_*_NAME WAY_*_REAL_OPTS LeadingUnderscore @@ -302,12 +302,12 @@ Prelude ({\em including} its interface file(s)). $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", @@ -331,30 +331,30 @@ $BuildTag = ''; # default is sequential build w/ Appel-style GC # %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} @@ -494,6 +494,7 @@ $UNPROFscc_auto = ''; # set to relevant hsc flag if forcing auto sccs without pr $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; @@ -1001,7 +1002,7 @@ if ( $OptLevel <= 0 ) { %************************************************************************ Sort out @$BuildTag@, @$PROFing@, @$PARing@, -@$GRANing@, @$TICKYing@: +@$GRANing@, @$TICKYing@, @UNREGing@: \begin{code} sub setupBuildFlags { @@ -1058,6 +1059,9 @@ sub setupBuildFlags { } elsif ( $TICKYing eq 't' ) { $BuildTag = '_t'; + + } elsif ( $UNREGing eq 'u' ) { + $BuildTag = '_u'; } \end{code} @@ -3203,6 +3207,8 @@ arg: while($_ = $Args[0]) { } 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; }; diff --git a/ghc/includes/ClosureMacros.h b/ghc/includes/ClosureMacros.h index 6d0bb6e480..6d7d159989 100644 --- a/ghc/includes/ClosureMacros.h +++ b/ghc/includes/ClosureMacros.h @@ -1,5 +1,5 @@ /* ---------------------------------------------------------------------------- - * $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 * @@ -63,20 +63,20 @@ #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 @@ -131,8 +131,8 @@ extern int is_heap_alloced(const void* x); #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 @@ -153,9 +153,13 @@ extern int is_heap_alloced(const void* x); 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 diff --git a/ghc/includes/InfoMacros.h b/ghc/includes/InfoMacros.h index 033ff90aa3..a503d4ad37 100644 --- a/ghc/includes/InfoMacros.h +++ b/ghc/includes/InfoMacros.h @@ -1,5 +1,5 @@ /* ---------------------------------------------------------------------------- - * $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 * @@ -20,6 +20,12 @@ srt_len : srt_len_, \ type : type_ +#ifdef USE_MINIINTERPRETER +#define INIT_VECTOR {} +#else +#define INIT_VECTOR +#endif + /* function/thunk info tables --------------------------------------------- */ #define \ @@ -31,61 +37,66 @@ INFO_TABLE_SRT(info, /* info-table label */ \ 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) @@ -99,6 +110,8 @@ INFO_TABLE_CONSTR(info, entry, ptrs, nptrs, tag_,type_,info_class, \ * layout field, so we only need one macro for these. */ +#ifndef USE_MINIINTERPRETER + typedef struct { StgFunPtr vec[2]; StgInfoTable i; @@ -134,59 +147,287 @@ typedef struct { 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) \ diff --git a/ghc/includes/InfoTables.h b/ghc/includes/InfoTables.h index 9873302fd9..92e957c4af 100644 --- a/ghc/includes/InfoTables.h +++ b/ghc/includes/InfoTables.h @@ -1,5 +1,5 @@ /* ---------------------------------------------------------------------------- - * $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 * @@ -174,11 +174,21 @@ typedef struct _StgInfoTable { 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 */ diff --git a/ghc/includes/StgMacros.h b/ghc/includes/StgMacros.h index 4c7be2bdca..419ad7df82 100644 --- a/ghc/includes/StgMacros.h +++ b/ghc/includes/StgMacros.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 * @@ -52,9 +52,9 @@ #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 @@ -321,6 +321,7 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; } #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); \ @@ -404,7 +405,7 @@ EDI_(stg_gen_chk_info); -------------------------------------------------------------------------- */ #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 diff --git a/ghc/includes/Updates.h b/ghc/includes/Updates.h index 1cad7b22b8..753da3c8d1 100644 --- a/ghc/includes/Updates.h +++ b/ghc/includes/Updates.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 * @@ -77,7 +77,7 @@ extern DLL_IMPORT_DATA const StgPolyInfoTable Upd_frame_info; #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; \ diff --git a/ghc/lib/std/Makefile b/ghc/lib/std/Makefile index 02e279cb8c..db136bfba4 100644 --- a/ghc/lib/std/Makefile +++ b/ghc/lib/std/Makefile @@ -38,11 +38,6 @@ SRC_HC_OPTS += -static 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)" "" diff --git a/ghc/rts/HeapStackCheck.hc b/ghc/rts/HeapStackCheck.hc index 7baf7aaf61..cf85fbebfd 100644 --- a/ghc/rts/HeapStackCheck.hc +++ b/ghc/rts/HeapStackCheck.hc @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 * @@ -306,7 +306,7 @@ EXTFUN(stg_gc_noregs) 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) { @@ -331,7 +331,7 @@ EXTFUN(stg_gc_unpt_r1) 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) @@ -357,7 +357,7 @@ EXTFUN(stg_gc_unbx_r1) 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) { @@ -390,7 +390,7 @@ EXTFUN(stg_gc_f1) 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) { @@ -443,14 +443,14 @@ EXTFUN(stg_gc_d1) 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_ } @@ -469,14 +469,14 @@ EXTFUN(stg_gc_ut_1_0) 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_ } @@ -764,7 +764,7 @@ EXTFUN(stg_chk_8) 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. */ @@ -773,7 +773,7 @@ FN_(stg_gen_chk_ret) { FB_ RESTORE_EVERYTHING; - JMP_(Sp[RET_OFFSET]); + JMP_(Sp[RET_OFFSET]); /* NO ENTRY_CODE() - this is a direct ret address */ FE_ } @@ -812,7 +812,7 @@ FN_(stg_gen_yield) 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) { diff --git a/ghc/rts/PrimOps.hc b/ghc/rts/PrimOps.hc index f006acae87..8d9be51ae4 100644 --- a/ghc/rts/PrimOps.hc +++ b/ghc/rts/PrimOps.hc @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 * @@ -168,7 +168,7 @@ W_ GHC_ZCCReturnable_static_info[0]; # 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) diff --git a/ghc/rts/StgMiscClosures.hc b/ghc/rts/StgMiscClosures.hc index d981f1991f..e371799572 100644 --- a/ghc/rts/StgMiscClosures.hc +++ b/ghc/rts/StgMiscClosures.hc @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 * @@ -25,7 +25,7 @@ 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_ @@ -33,11 +33,11 @@ STGFUN(IND_entry) 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_ @@ -45,11 +45,11 @@ STGFUN(IND_STATIC_entry) 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_ @@ -88,11 +88,11 @@ STGFUN(IND_PERM_entry) 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_ @@ -100,11 +100,11 @@ STGFUN(IND_OLDGEN_entry) 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_ @@ -128,7 +128,7 @@ STGFUN(IND_OLDGEN_PERM_entry) R1.p = (P_) ((StgInd*)R1.p)->indirectee; TICK_ENT_VIA_NODE(); - JMP_(*R1.p); + JMP_(ENTRY_CODE(*R1.p)); FE_ } @@ -138,7 +138,7 @@ STGFUN(IND_OLDGEN_PERM_entry) 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_ @@ -150,7 +150,7 @@ STGFUN(CAF_UNENTERED_entry) } /* 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_ @@ -175,7 +175,7 @@ STGFUN(CAF_ENTERED_entry) * 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_ @@ -194,7 +194,7 @@ STGFUN(BLACKHOLE_entry) 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_ @@ -211,7 +211,7 @@ STGFUN(BLACKHOLE_BQ_entry) } /* 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_ @@ -231,7 +231,7 @@ STGFUN(CAF_BLACKHOLE_entry) } #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_ @@ -242,7 +242,7 @@ STGFUN(SE_BLACKHOLE_entry) 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_ @@ -257,7 +257,7 @@ STGFUN(SE_CAF_BLACKHOLE_entry) /* ----------------------------------------------------------------------------- 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; @@ -282,7 +282,7 @@ STGFUN(type##_entry) \ 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); /* ----------------------------------------------------------------------------- @@ -290,7 +290,7 @@ 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); /* ----------------------------------------------------------------------------- @@ -301,10 +301,10 @@ 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); /* ----------------------------------------------------------------------------- @@ -314,7 +314,7 @@ 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_) @@ -324,14 +324,14 @@ 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); /* ----------------------------------------------------------------------------- @@ -341,10 +341,10 @@ 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); /* ----------------------------------------------------------------------------- @@ -354,7 +354,7 @@ 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_) @@ -368,13 +368,13 @@ 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); /* ----------------------------------------------------------------------------- @@ -393,7 +393,7 @@ 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); @@ -408,7 +408,7 @@ NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS_FROZEN); 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); /* ----------------------------------------------------------------------------- @@ -436,7 +436,7 @@ STGFUN(stg_error_entry) \ 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; @@ -489,26 +489,26 @@ VEC_POLY_INFO_TABLE(ret_bco,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO) #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) */ @@ -527,8 +527,8 @@ INFO_TABLE_CONSTR(StablePtr_static_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr * 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 diff --git a/ghc/rts/StgStartup.hc b/ghc/rts/StgStartup.hc index eae409b68c..b3591d1512 100644 --- a/ghc/rts/StgStartup.hc +++ b/ghc/rts/StgStartup.hc @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 * @@ -60,7 +60,7 @@ EXTFUN(stg_stop_thread_entry); #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) { @@ -105,7 +105,7 @@ STGFUN(stg_returnToStackTop) LoadThreadState(); CHECK_SENSIBLE_REGS(); Sp++; - JMP_(Sp[-1]); + JMP_(ENTRY_CODE(Sp[-1])); FE_ } diff --git a/ghc/rts/StgStdThunks.hc b/ghc/rts/StgStdThunks.hc index f5778b2428..35a75c1afe 100644 --- a/ghc/rts/StgStdThunks.hc +++ b/ghc/rts/StgStdThunks.hc @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 * @@ -40,7 +40,7 @@ #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]; \ @@ -51,7 +51,7 @@ } \ \ 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,); \ @@ -59,7 +59,7 @@ 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)); \ @@ -85,7 +85,7 @@ SELECTOR_CODE_UPD(15); #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]; \ @@ -96,7 +96,7 @@ SELECTOR_CODE_UPD(15); } \ \ 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,) \ @@ -155,7 +155,7 @@ FN_(__ap_8_upd_entry); * 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,); @@ -168,7 +168,7 @@ FN_(__ap_1_upd_entry) { 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,); @@ -182,7 +182,7 @@ FN_(__ap_2_upd_entry) { 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,); @@ -197,7 +197,7 @@ FN_(__ap_3_upd_entry) { 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,); @@ -213,7 +213,7 @@ FN_(__ap_4_upd_entry) { 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,); @@ -230,7 +230,7 @@ FN_(__ap_5_upd_entry) { 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,); @@ -248,7 +248,7 @@ FN_(__ap_6_upd_entry) { 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,); @@ -267,7 +267,7 @@ FN_(__ap_7_upd_entry) { 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,); diff --git a/ghc/rts/Updates.hc b/ghc/rts/Updates.hc index b6391648f9..e9ac61f1be 100644 --- a/ghc/rts/Updates.hc +++ b/ghc/rts/Updates.hc @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 * @@ -96,7 +96,7 @@ UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_7_entry,RET_VEC(Sp[0],7)); * 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. @@ -110,7 +110,7 @@ VEC_POLY_INFO_TABLE(Upd_frame,UPD_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/, 0/*sr 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; @@ -386,7 +386,7 @@ EXTFUN(stg_update_PAP) -------------------------------------------------------------------------- */ -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; @@ -461,7 +461,7 @@ SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_5_entry,ENTRY_CODE(Sp[0])); 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 @@ -474,7 +474,7 @@ VEC_POLY_INFO_TABLE(seq_frame, UPD_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/, 0/*s * 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_ @@ -526,7 +526,7 @@ CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_7_entry,RET_VEC(Sp[0],7)); * 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 @@ -538,7 +538,7 @@ VEC_POLY_INFO_TABLE(catch_frame, CATCH_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/, * 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_ @@ -578,7 +578,7 @@ FN_(catchzh_fast) * 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_ |