From a83ec8c549e0487dd641793b74dc540c40ddb416 Mon Sep 17 00:00:00 2001
From: simonmar <unknown>
Date: Mon, 22 May 2000 17:05:57 +0000
Subject: [PATCH] [project @ 2000-05-22 17:05:57 by simonmar] Re-instate
 foreign label and foreign export dynamic support in the NCG
 (which both end up emitting a CLitLit into the abstract C)
 using a new mkForeignLabel interface to CLabel.

This won't work if the foreign label is in a different DLL yet, but
Julian is on the case.
---
 ghc/compiler/absCSyn/CLabel.lhs     |   18 +++++++++++++++++-
 ghc/compiler/nativeGen/StixPrim.lhs |    9 ++++++---
 2 files changed, 23 insertions(+), 4 deletions(-)

diff --git a/ghc/compiler/absCSyn/CLabel.lhs b/ghc/compiler/absCSyn/CLabel.lhs
index 94dfc39..5f87c09 100644
--- a/ghc/compiler/absCSyn/CLabel.lhs
+++ b/ghc/compiler/absCSyn/CLabel.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CLabel.lhs,v 1.35 2000/05/18 13:55:36 sewardj Exp $
+% $Id: CLabel.lhs,v 1.36 2000/05/22 17:05:57 simonmar Exp $
 %
 \section[CLabel]{@CLabel@: Information to make C Labels}
 
@@ -61,6 +61,8 @@ module CLabel (
 	mkSelectorInfoLabel,
 	mkSelectorEntryLabel,
 
+	mkForeignLabel,
+
 	mkCC_Label, mkCCS_Label,
 	
 	needsCDecl, isAsmTemp, externallyVisibleCLabel,
@@ -127,6 +129,9 @@ data CLabel
 
   | RtsLabel	    RtsLabelInfo
 
+  | ForeignLabel FAST_STRING Bool  -- a 'C' (or otherwise foreign) label
+				   -- Bool <=> is dynamic
+
   | CC_Label CostCentre
   | CCS_Label CostCentreStack
 
@@ -269,6 +274,11 @@ mkSelectorEntryLabel upd off	= RtsLabel (RtsSelectorEntry   upd off)
 mkApInfoTableLabel  upd off	= RtsLabel (RtsApInfoTbl upd off)
 mkApEntryLabel upd off		= RtsLabel (RtsApEntry   upd off)
 
+	-- Foreign labels
+
+mkForeignLabel :: FAST_STRING -> Bool -> CLabel
+mkForeignLabel str is_dynamic	= ForeignLabel str is_dynamic
+
 	-- Cost centres etc.
 
 mkCC_Label	cc		= CC_Label cc
@@ -303,6 +313,7 @@ needsCDecl (TyConLabel _)		= True
 needsCDecl (AsmTempLabel _)		= False
 needsCDecl (ModuleInitLabel _)		= False
 needsCDecl (RtsLabel _)			= False
+needsCDecl (ForeignLabel _ _)		= False
 needsCDecl (CC_Label _)			= False
 needsCDecl (CCS_Label _)		= False
 \end{code}
@@ -327,6 +338,7 @@ externallyVisibleCLabel (AsmTempLabel _)   = False
 externallyVisibleCLabel (ModuleInitLabel _)= True
 externallyVisibleCLabel (RtsLabel RtsModuleRegd) = False --hack
 externallyVisibleCLabel (RtsLabel _)	   = True
+externallyVisibleCLabel (ForeignLabel _ _) = True
 externallyVisibleCLabel (IdLabel id _)     = isExternallyVisibleName id
 externallyVisibleCLabel (CC_Label _)	   = False -- not strictly true
 externallyVisibleCLabel (CCS_Label _)	   = False -- not strictly true
@@ -373,6 +385,7 @@ labelDynamic lbl =
    IdLabel n k      -> isDllName n
    DataConLabel n k -> isDllName n
    TyConLabel tc    -> isDllName (getName tc)
+   ForeignLabel _ d -> d
    _ 		    -> False
 \end{code}
 
@@ -496,6 +509,9 @@ pprCLbl (RtsLabel (RtsPrimOp primop))
 pprCLbl (RtsLabel RtsModuleRegd)
   = ptext SLIT("module_registered")
 
+pprCLbl (ForeignLabel str _)
+  = ptext str
+
 pprCLbl (TyConLabel tc)
   = hcat [ppr tc, pp_cSEP, ptext SLIT("closure_tbl")]
 
diff --git a/ghc/compiler/nativeGen/StixPrim.lhs b/ghc/compiler/nativeGen/StixPrim.lhs
index 5bbd329..e48e1f4 100644
--- a/ghc/compiler/nativeGen/StixPrim.lhs
+++ b/ghc/compiler/nativeGen/StixPrim.lhs
@@ -23,7 +23,7 @@ import UniqSupply	( returnUs, thenUs, getUniqueUs, UniqSM )
 import Constants	( mIN_INTLIKE, uF_UPDATEE, bLOCK_SIZE )
 import CLabel		( mkIntlikeClosureLabel, mkCharlikeClosureLabel,
 			  mkTopClosureLabel, mkErrorIO_innardsLabel,
-			  mkMAP_FROZEN_infoLabel )
+			  mkMAP_FROZEN_infoLabel, mkForeignLabel )
 import Outputable
 
 import Char	       	( ord, isAlphaNum )
@@ -461,8 +461,11 @@ amodeToStix (CMacroExpr _ macro [arg])
          -> StInd PtrRep (StIndex PtrRep (amodeToStix arg) 
                                          (StInt (toInteger uF_UPDATEE)))
 litLitToStix nm
-  = error ("\nlitLitToStix: can't handle `" ++ nm ++ "'\n" 
-            ++ "suggested workaround: use flag -fvia-C\n")
+  | 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 = isAlphaNum c || c == '_'
 \end{code}
 
 Sizes of the CharLike and IntLike closures that are arranged as arrays
-- 
1.7.10.4