[project @ 2000-07-06 14:08:31 by simonmar]

New form of literal: MachLabel, for addresses of labels.  Used by
foreign label instead of MachLitLit now.

Real lit-lits now cause the NCG to panic.

Also: removed CLitLit from AbsCSyn; it was only used in one place for
a purpose it shouldn't have been used for in the first place.

ghc/compiler/absCSyn/AbsCSyn.lhs

 %
 % (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}
 

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}

ghc/compiler/absCSyn/Costs.lhs

 %
 % (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)
 

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)

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,

ghc/compiler/codeGen/CgClosure.lhs

 %
 % (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 ->

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

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),

ghc/compiler/parser/Parser.y

 {-
 -----------------------------------------------------------------------------
-$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 $$ }

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 }