diff --git a/ghc/compiler/absCSyn/AbsCSyn.lhs b/ghc/compiler/absCSyn/AbsCSyn.lhs
index d21f785588f6b81048685abb61bdd1b17ddf4f9e..4f4c114efceceaead01f527a4ffbf36c24a98a7a 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.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}
@@ -321,10 +321,6 @@ data CAddrMode
| 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
@@ -348,6 +344,7 @@ data CExprMacro
| ARG_TAG -- stack argument tagging
| GET_TAG -- get current constructor tag
| UPD_FRAME_UPDATEE
+ | CCS_HDR
\end{code}
diff --git a/ghc/compiler/absCSyn/AbsCUtils.lhs b/ghc/compiler/absCSyn/AbsCUtils.lhs
index 8e4d758545f3e3d90f112287ed81cfda2fab542a..7c7151af68f262f8784bfb44113a2156704a2389 100644
--- a/ghc/compiler/absCSyn/AbsCUtils.lhs
+++ b/ghc/compiler/absCSyn/AbsCUtils.lhs
@@ -158,7 +158,6 @@ getAmodeRep (CLbl _ kind) = kind
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}
diff --git a/ghc/compiler/absCSyn/Costs.lhs b/ghc/compiler/absCSyn/Costs.lhs
index e94ee6e9a79a3608716953b2447589ece88c4238..a0a6110fd0ab3d60899e1b21c8749852bca0839c 100644
--- a/ghc/compiler/absCSyn/Costs.lhs
+++ b/ghc/compiler/absCSyn/Costs.lhs
@@ -1,7 +1,7 @@
%
% (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
% ---------------------------------------------------------------------------
@@ -289,10 +289,6 @@ addrModeCosts addr_mode side =
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)
diff --git a/ghc/compiler/absCSyn/PprAbsC.lhs b/ghc/compiler/absCSyn/PprAbsC.lhs
index c7348719bbfc85f6436d49787c1f52cf39dae85b..ab2aa34acde5671d53d2be0346a7ca3809ddec46 100644
--- a/ghc/compiler/absCSyn/PprAbsC.lhs
+++ b/ghc/compiler/absCSyn/PprAbsC.lhs
@@ -26,7 +26,7 @@ import AbsCUtils ( getAmodeRep, nonemptyAbsC,
)
import Constants ( mIN_UPD_SIZE )
-import CallConv ( CallConv, callConvAttribute )
+import CallConv ( callConvAttribute )
import CLabel ( externallyVisibleCLabel, mkErrorStdEntryLabel,
needsCDecl, pprCLabel,
mkReturnInfoLabel, mkReturnPtLabel, mkClosureTblLabel,
@@ -34,7 +34,7 @@ import CLabel ( externallyVisibleCLabel, mkErrorStdEntryLabel,
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(..) )
@@ -57,7 +57,6 @@ import StgSyn ( SRT(..) )
import BitSet ( intBS )
import Outputable
import Util ( nOfThem )
-import Addr ( Addr )
import ST
import MutableArray
@@ -1145,8 +1144,6 @@ ppr_amode (CIntLike int)
ppr_amode (CLit lit) = pprBasicLit lit
-ppr_amode (CLitLit str _) = ptext str
-
ppr_amode (CJoinPoint _)
= panic "ppr_amode: CJoinPoint"
@@ -1161,6 +1158,7 @@ cExprMacroText ENTRY_CODE = SLIT("ENTRY_CODE")
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")
@@ -1540,7 +1538,6 @@ ppr_decls_Amode (CVal _ _) = returnTE (Nothing, Nothing)
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)
diff --git a/ghc/compiler/basicTypes/Literal.lhs b/ghc/compiler/basicTypes/Literal.lhs
index 907eba3ce04e302fa763834401652c69d86e9f3a..54af4732d8f437d665b20c035e0cc1daf4ffee10 100644
--- a/ghc/compiler/basicTypes/Literal.lhs
+++ b/ghc/compiler/basicTypes/Literal.lhs
@@ -24,12 +24,9 @@ module Literal
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
@@ -101,7 +98,15 @@ data Literal
| 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}
@@ -193,6 +198,7 @@ literalType (MachInt64 _) = int64PrimTy
literalType (MachWord64 _) = word64PrimTy
literalType (MachFloat _) = floatPrimTy
literalType (MachDouble _) = doublePrimTy
+literalType (MachLabel _) = addrPrimTy
literalType (MachLitLit _ ty) = ty
\end{code}
@@ -208,6 +214,7 @@ literalPrimRep (MachInt64 _) = Int64Rep
literalPrimRep (MachWord64 _) = Word64Rep
literalPrimRep (MachFloat _) = FloatRep
literalPrimRep (MachDouble _) = DoubleRep
+literalPrimRep (MachLabel _) = AddrRep
literalPrimRep (MachLitLit _ ty) = typePrimRep ty
\end{code}
@@ -224,6 +231,7 @@ cmpLit (MachInt64 a) (MachInt64 b) = a `compare` b
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
@@ -237,7 +245,8 @@ litTag (MachInt64 _) = ILIT(6)
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
@@ -284,6 +293,9 @@ pprLit lit
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,
diff --git a/ghc/compiler/codeGen/CgClosure.lhs b/ghc/compiler/codeGen/CgClosure.lhs
index 1b80beaf4090ae2e5de8cecb39e3ad7ca5acffb1..ae028d2a45ba6aea9b7fb01491bdf2d285b13387 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.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}
@@ -40,8 +40,7 @@ import CgUsages ( adjustSpAndHp, setRealAndVirtualSp, getVirtSp,
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 )
@@ -682,9 +681,8 @@ setupUpdate closure_info code
-- 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 ->
diff --git a/ghc/compiler/nativeGen/StixPrim.lhs b/ghc/compiler/nativeGen/StixPrim.lhs
index 62bf88251876df7f84c32b64ef620ebb5093839d..1de49fc7b4fde625a2bd6c20823a427284307441 100644
--- a/ghc/compiler/nativeGen/StixPrim.lhs
+++ b/ghc/compiler/nativeGen/StixPrim.lhs
@@ -8,7 +8,6 @@ module StixPrim ( primCode, amodeToStix, amodeToStix' ) where
#include "HsVersions.h"
import MachMisc
-import MachRegs
import Stix
import StixInteger
@@ -16,7 +15,6 @@ import AbsCSyn hiding ( spRel )
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 )
@@ -432,19 +430,12 @@ amodeToStix (CLit core)
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
@@ -464,12 +455,9 @@ amodeToStix (CMacroExpr _ macro [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
diff --git a/ghc/compiler/parser/Lex.lhs b/ghc/compiler/parser/Lex.lhs
index 1f8765c29160ff4c6d31de62082fe65373822b1d..9a2ab9c9c07f375e6bd163615236e1a5872e01ee 100644
--- a/ghc/compiler/parser/Lex.lhs
+++ b/ghc/compiler/parser/Lex.lhs
@@ -140,6 +140,7 @@ data Token
| ITint64_lit
| ITrational_lit
| ITaddr_lit
+ | ITlabel_lit
| ITlit_lit
| ITstring_lit
| ITtypeapp
@@ -309,6 +310,7 @@ ghcExtensionKeywordsFM = listToUFM $
("__word64", ITword64_lit),
("__rational", ITrational_lit),
("__addr", ITaddr_lit),
+ ("__label", ITlabel_lit),
("__litlit", ITlit_lit),
("__string", ITstring_lit),
("__a", ITtypeapp),
diff --git a/ghc/compiler/parser/Parser.y b/ghc/compiler/parser/Parser.y
index 9279e44f97aa80e0f0c5c011e1e967d1adcefa55..d8aef1601ac65367027d4386de934b26c58f32dc 100644
--- a/ghc/compiler/parser/Parser.y
+++ b/ghc/compiler/parser/Parser.y
@@ -1,6 +1,6 @@
{-
-----------------------------------------------------------------------------
-$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.
@@ -127,6 +127,7 @@ Conflicts: 14 shift/reduce
'__float' { ITfloat_lit }
'__rational' { ITrational_lit }
'__addr' { ITaddr_lit }
+ '__label' { ITlabel_lit }
'__litlit' { ITlit_lit }
'__string' { ITstring_lit }
'__ccall' { ITccall $$ }
diff --git a/ghc/compiler/rename/ParseIface.y b/ghc/compiler/rename/ParseIface.y
index e91ee02bfc5a4150b7b323ea80f0304b819f8cf8..674af459559897ffc20c233a11b1441240013c71 100644
--- a/ghc/compiler/rename/ParseIface.y
+++ b/ghc/compiler/rename/ParseIface.y
@@ -134,6 +134,7 @@ import Ratio ( (%) )
'__word64' { ITword64_lit }
'__rational' { ITrational_lit }
'__addr' { ITaddr_lit }
+ '__label' { ITlabel_lit }
'__litlit' { ITlit_lit }
'__string' { ITstring_lit }
'__ccall' { ITccall $$ }
@@ -856,6 +857,7 @@ core_lit : integer { mkMachInt $1 }
| '__int64' integer { mkMachInt64 $2 }
| '__float' rational { MachFloat $2 }
| '__addr' integer { MachAddr $2 }
+ | '__label' STRING { MachLabel $2 }
integer :: { Integer }
: INTEGER { $1 }