From: simonmar Date: Thu, 6 Jul 2000 14:08:32 +0000 (+0000) Subject: [project @ 2000-07-06 14:08:31 by simonmar] X-Git-Tag: Approximately_9120_patches~4071 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=5d42ac16b2e956c03455a1f8328d876b670d3635;p=ghc-hetmet.git [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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 }