[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.

diff --git a/ghc/compiler/absCSyn/AbsCSyn.lhs b/ghc/compiler/absCSyn/AbsCSyn.lhs
index d21f785..4f4c114 100644 (file)
--- 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 8e4d758..7c7151a 100644 (file)
--- 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 e94ee6e..a0a6110 100644 (file)
--- 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 c734871..ab2aa34 100644 (file)
--- 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 907eba3..54af473 100644 (file)
--- 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 1b80bea..ae028d2 100644 (file)
--- 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 62bf882..1de49fc 100644 (file)
--- 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 1f8765c..9a2ab9c 100644 (file)
--- 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 9279e44..d8aef16 100644 (file)
--- 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 e91ee02..674af45 100644 (file)
--- 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 }