summaryrefslogtreecommitdiff
path: root/ghc/compiler/codeGen
diff options
context:
space:
mode:
Diffstat (limited to 'ghc/compiler/codeGen')
-rw-r--r--ghc/compiler/codeGen/CgCase.lhs10
-rw-r--r--ghc/compiler/codeGen/CgClosure.lhs14
-rw-r--r--ghc/compiler/codeGen/CgHeapery.lhs20
-rw-r--r--ghc/compiler/codeGen/CgLetNoEscape.lhs17
-rw-r--r--ghc/compiler/codeGen/CgMonad.lhs12
-rw-r--r--ghc/compiler/codeGen/CgRetConv.lhs17
-rw-r--r--ghc/compiler/codeGen/CgTailCall.lhs6
7 files changed, 57 insertions, 39 deletions
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
View Lorry Controller Status