Skip to content

GitLab

Commit 5d42ac16 authored by simonmar's avatar simonmar
Browse files

[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.
parent f7e174ea
Hide whitespace changes
Inline Side-by-side
ghc/compiler/absCSyn/AbsCSyn.lhs
View file @ 5d42ac16
%
% (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
View file @ 5d42ac16
......@@ -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
View file @ 5d42ac16
%
% (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
View file @ 5d42ac16
......@@ -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
View file @ 5d42ac16
......@@ -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
View file @ 5d42ac16
%
% (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
View file @ 5d42ac16
......@@ -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
View file @ 5d42ac16
......@@ -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
View file @ 5d42ac16
{-
-----------------------------------------------------------------------------
$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
View file @ 5d42ac16
......@@ -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 }
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment