%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: AbsCSyn.lhs,v 1.30 2000/05/15 15:03:36 simonmar Exp $
+% $Id: AbsCSyn.lhs,v 1.31 2000/07/06 14:08:31 simonmar Exp $
%
\section[AbstractC]{Abstract C: the last stop before machine code}
| CLit Literal
- | CLitLit FAST_STRING -- completely literal literal: just spit this String
- -- into the C output
- PrimRep
-
| CJoinPoint -- This is used as the amode of a let-no-escape-bound
-- variable.
VirtualSpOffset -- Sp value after any volatile free vars
| ARG_TAG -- stack argument tagging
| GET_TAG -- get current constructor tag
| UPD_FRAME_UPDATEE
+ | CCS_HDR
\end{code}
getAmodeRep (CCharLike _) = PtrRep
getAmodeRep (CIntLike _) = PtrRep
getAmodeRep (CLit lit) = literalPrimRep lit
-getAmodeRep (CLitLit _ kind) = kind
getAmodeRep (CMacroExpr kind _ _) = kind
getAmodeRep (CJoinPoint _) = panic "getAmodeRep:CJoinPoint"
\end{code}
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: Costs.lhs,v 1.23 2000/05/25 12:49:34 panne Exp $
+% $Id: Costs.lhs,v 1.24 2000/07/06 14:08:31 simonmar Exp $
%
% Only needed in a GranSim setup -- HWL
% ---------------------------------------------------------------------------
CLit _ -> if lhs then nullCosts -- should never occur
else Cost (1, 0, 0, 0, 0) -- typ.: mov lit,%reg
- CLitLit _ _ -> if lhs then nullCosts
- else Cost (1, 0, 0, 0, 0)
- -- same es CLit
-
CJoinPoint _ -> if lhs then Cost (0, 0, 0, 1, 0)
else Cost (0, 0, 1, 0, 0)
)
import Constants ( mIN_UPD_SIZE )
-import CallConv ( CallConv, callConvAttribute )
+import CallConv ( callConvAttribute )
import CLabel ( externallyVisibleCLabel, mkErrorStdEntryLabel,
needsCDecl, pprCLabel,
mkReturnInfoLabel, mkReturnPtLabel, mkClosureTblLabel,
CLabel, CLabelType(..), labelType, labelDynamic
)
-import CmdLineOpts ( opt_SccProfilingOn, opt_EmitCExternDecls, opt_GranMacros )
+import CmdLineOpts ( opt_SccProfilingOn, opt_GranMacros )
import CostCentre ( pprCostCentreDecl, pprCostCentreStackDecl )
import Costs ( costs, addrModeCosts, CostRes(..), Side(..) )
import BitSet ( intBS )
import Outputable
import Util ( nOfThem )
-import Addr ( Addr )
import ST
import MutableArray
ppr_amode (CLit lit) = pprBasicLit lit
-ppr_amode (CLitLit str _) = ptext str
-
ppr_amode (CJoinPoint _)
= panic "ppr_amode: CJoinPoint"
cExprMacroText ARG_TAG = SLIT("ARG_TAG")
cExprMacroText GET_TAG = SLIT("GET_TAG")
cExprMacroText UPD_FRAME_UPDATEE = SLIT("UPD_FRAME_UPDATEE")
+cExprMacroText CCS_HDR = SLIT("CCS_HDR")
cStmtMacroText ARGS_CHK = SLIT("ARGS_CHK")
cStmtMacroText ARGS_CHK_LOAD_NODE = SLIT("ARGS_CHK_LOAD_NODE")
ppr_decls_Amode (CAddr _) = returnTE (Nothing, Nothing)
ppr_decls_Amode (CReg _) = returnTE (Nothing, Nothing)
ppr_decls_Amode (CLit _) = returnTE (Nothing, Nothing)
-ppr_decls_Amode (CLitLit _ _) = returnTE (Nothing, Nothing)
-- CIntLike must be a literal -- no decls
ppr_decls_Amode (CIntLike int) = returnTE (Nothing, Nothing)
import TysPrim ( charPrimTy, addrPrimTy, floatPrimTy, doublePrimTy,
intPrimTy, wordPrimTy, int64PrimTy, word64PrimTy
)
-import Name ( hashName )
import PrimRep ( PrimRep(..) )
-import TyCon ( isNewTyCon )
import Type ( Type, typePrimRep )
import PprType ( pprParendType )
-import Demand ( Demand )
import CStrings ( charToC, charToEasyHaskell, pprFSInCStyle )
import Outputable
| MachFloat Rational
| MachDouble Rational
- | MachLitLit FAST_STRING Type -- Type might be Add# or Int# etc
+ -- string argument is the name of a symbol. This literal
+ -- refers to the *address* of the label.
+ | MachLabel FAST_STRING -- always an Addr#
+
+ -- lit-lits only work for via-C compilation, hence they
+ -- are deprecated. The string is emitted verbatim into
+ -- the C file, and can therefore be any C expression,
+ -- macro call, #defined constant etc.
+ | MachLitLit FAST_STRING Type -- Type might be Addr# or Int# etc
\end{code}
\begin{code}
literalType (MachWord64 _) = word64PrimTy
literalType (MachFloat _) = floatPrimTy
literalType (MachDouble _) = doublePrimTy
+literalType (MachLabel _) = addrPrimTy
literalType (MachLitLit _ ty) = ty
\end{code}
literalPrimRep (MachWord64 _) = Word64Rep
literalPrimRep (MachFloat _) = FloatRep
literalPrimRep (MachDouble _) = DoubleRep
+literalPrimRep (MachLabel _) = AddrRep
literalPrimRep (MachLitLit _ ty) = typePrimRep ty
\end{code}
cmpLit (MachWord64 a) (MachWord64 b) = a `compare` b
cmpLit (MachFloat a) (MachFloat b) = a `compare` b
cmpLit (MachDouble a) (MachDouble b) = a `compare` b
+cmpLit (MachLabel a) (MachLabel b) = a `compare` b
cmpLit (MachLitLit a b) (MachLitLit c d) = (a `compare` c) `thenCmp` (b `compare` d)
cmpLit lit1 lit2 | litTag lit1 _LT_ litTag lit2 = LT
| otherwise = GT
litTag (MachWord64 _) = ILIT(7)
litTag (MachFloat _) = ILIT(8)
litTag (MachDouble _) = ILIT(9)
-litTag (MachLitLit _ _) = ILIT(10)
+litTag (MachLabel _) = ILIT(10)
+litTag (MachLitLit _ _) = ILIT(11)
\end{code}
Printing
MachAddr p | code_style -> ptext SLIT("(void*)") <> integer p
| otherwise -> ptext SLIT("__addr") <+> integer p
+ MachLabel l | code_style -> ptext SLIT("(&") <> ptext l <> char ')'
+ | otherwise -> ptext SLIT("__label") <+> pprFSAsString l
+
MachLitLit s ty | code_style -> ptext s
| otherwise -> parens (hsep [ptext SLIT("__litlit"),
pprFSAsString s,
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: CgClosure.lhs,v 1.39 2000/01/13 14:33:58 hwloidl Exp $
+% $Id: CgClosure.lhs,v 1.40 2000/07/06 14:08:31 simonmar Exp $
%
\section[CgClosure]{Code generation for closures}
getSpRelOffset, getHpRelOffset
)
import CLabel ( CLabel, mkClosureLabel, mkFastEntryLabel,
- mkRednCountsLabel, mkInfoTableLabel,
- pprCLabel
+ mkRednCountsLabel, mkInfoTableLabel
)
import ClosureInfo -- lots and lots of stuff
import CmdLineOpts ( opt_GranMacros, opt_SccProfilingOn, opt_DoTickyProfiling )
-- updated with the new value when available.
-- Alloc black hole specifying CC_HDR(Node) as the cost centre
- -- Hack Warning: Using a CLitLit to get CAddrMode !
let
- use_cc = CLitLit SLIT("CCS_HDR(R1.p)") PtrRep
+ use_cc = CMacroExpr PtrRep CCS_HDR [nodeReg]
blame_cc = use_cc
in
allocDynClosure (bhCI closure_info) use_cc blame_cc [] `thenFC` \ heap_offset ->
#include "HsVersions.h"
import MachMisc
-import MachRegs
import Stix
import StixInteger
import AbsCUtils ( getAmodeRep, mixedTypeLocn )
import SMRep ( fixedHdrSize )
import Literal ( Literal(..), word2IntLit )
-import CallConv ( cCallConv )
import PrimOp ( PrimOp(..), CCall(..), CCallTarget(..) )
import PrimRep ( PrimRep(..), isFloatingRep )
import UniqSupply ( returnUs, thenUs, getUniqueUs, UniqSM )
MachAddr a -> StInt a
MachInt i -> StInt i
MachWord w -> case word2IntLit core of MachInt iw -> StInt iw
- MachLitLit s _ -> trace ("\nnativeGen WARNING: Reference to C entity `"
- ++ (_UNPK_ s) ++ "' cannot be reliably compiled."
- ++ "\n\t\t It may well crash your program."
- ++ "\n\t\t Workaround: compile via C (use -fvia-C).\n"
- )
- (litLitToStix (_UNPK_ s))
+ MachLitLit s _ -> litLitErr
+ MachLabel l -> StCLbl (mkForeignLabel l False{-ToDo: dynamic-})
MachFloat d -> StDouble d
MachDouble d -> StDouble d
_ -> panic "amodeToStix:core literal"
-amodeToStix (CLitLit s _)
- = litLitToStix (_UNPK_ s)
-
amodeToStix (CMacroExpr _ macro [arg])
= case macro of
ENTRY_CODE -> amodeToStix arg
UPD_FRAME_UPDATEE
-> StInd PtrRep (StIndex PtrRep (amodeToStix arg)
(StInt (toInteger uF_UPDATEE)))
-litLitToStix nm
- | all is_id nm = StCLbl (mkForeignLabel (_PK_ nm) False{-ToDo: dynamic-})
- | otherwise = error ("\nlitLitToStix: can't handle `" ++ nm ++ "'\n"
- ++ "suggested workaround: use flag -fvia-C\n")
- where is_id c = isAlpha c || isDigit c || c == '_'
+litLitErr =
+ panic "native code generator can't compile lit-lits, use -fvia-C"
\end{code}
Sizes of the CharLike and IntLike closures that are arranged as arrays
| ITint64_lit
| ITrational_lit
| ITaddr_lit
+ | ITlabel_lit
| ITlit_lit
| ITstring_lit
| ITtypeapp
("__word64", ITword64_lit),
("__rational", ITrational_lit),
("__addr", ITaddr_lit),
+ ("__label", ITlabel_lit),
("__litlit", ITlit_lit),
("__string", ITstring_lit),
("__a", ITtypeapp),
{-
-----------------------------------------------------------------------------
-$Id: Parser.y,v 1.32 2000/06/01 08:51:46 simonmar Exp $
+$Id: Parser.y,v 1.33 2000/07/06 14:08:31 simonmar Exp $
Haskell grammar.
'__float' { ITfloat_lit }
'__rational' { ITrational_lit }
'__addr' { ITaddr_lit }
+ '__label' { ITlabel_lit }
'__litlit' { ITlit_lit }
'__string' { ITstring_lit }
'__ccall' { ITccall $$ }
'__word64' { ITword64_lit }
'__rational' { ITrational_lit }
'__addr' { ITaddr_lit }
+ '__label' { ITlabel_lit }
'__litlit' { ITlit_lit }
'__string' { ITstring_lit }
'__ccall' { ITccall $$ }
| '__int64' integer { mkMachInt64 $2 }
| '__float' rational { MachFloat $2 }
| '__addr' integer { MachAddr $2 }
+ | '__label' STRING { MachLabel $2 }
integer :: { Integer }
: INTEGER { $1 }