From: sewardj <unknown>
Date: Tue, 18 Jan 2000 11:12:57 +0000 (+0000)
Subject: [project @ 2000-01-18 11:12:57 by sewardj]
X-Git-Tag: Approximately_9120_patches~5269
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=5adf2314bfe7329e57cc956f02d0e566ae9569c9;p=ghc-hetmet.git

[project @ 2000-01-18 11:12:57 by sewardj]
Remove StLitLit, and clean up somewhat the handling of
stdout/stderr/stdin in CLitLits (in StixPrim.amodeToStix).
---

diff --git a/ghc/compiler/nativeGen/MachCode.lhs b/ghc/compiler/nativeGen/MachCode.lhs
index d59a3f5..77792bf 100644
--- a/ghc/compiler/nativeGen/MachCode.lhs
+++ b/ghc/compiler/nativeGen/MachCode.lhs
@@ -71,7 +71,6 @@ stmt2Instrs stmt = case stmt of
 	getData (StInt i)    = returnUs (id, ImmInteger i)
 	getData (StDouble d) = returnUs (id, dblImmLit d)
 	getData (StLitLbl s) = returnUs (id, ImmLab s)
-	getData (StLitLit s) = returnUs (id, strImmLit (cvtLitLit (_UNPK_ s)))
 	getData (StCLbl l)   = returnUs (id, ImmCLbl l)
 	getData (StString s) =
 	    getUniqLabelNCG 	    	    `thenUs` \ lbl ->
@@ -158,7 +157,6 @@ mangleIndexTree (StIndex pk base off) = StPrim IntAddOp [base, off]
 maybeImm :: StixTree -> Maybe Imm
 
 maybeImm (StLitLbl s) = Just (ImmLab s)
-maybeImm (StLitLit s) = Just (strImmLit (cvtLitLit (_UNPK_ s)))
 maybeImm (StCLbl   l) = Just (ImmCLbl l)
 
 maybeImm (StIndex rep (StCLbl l) (StInt off)) = 
@@ -252,31 +250,7 @@ getRegister (StString s)
     in
     returnUs (Any PtrRep code)
 
-getRegister (StLitLit s) | _HEAD_ s == '"' && last xs == '"'
-  = getUniqLabelNCG 	    	    `thenUs` \ lbl ->
-    let 
-	imm_lbl = ImmCLbl lbl
 
-	code dst = mkSeqInstrs [
-	    SEGMENT DataSegment,
-	    LABEL lbl,
-	    ASCII False (init xs),
-	    SEGMENT TextSegment,
-#if alpha_TARGET_ARCH
-	    LDA dst (AddrImm imm_lbl)
-#endif
-#if i386_TARGET_ARCH
-	    MOV L (OpImm imm_lbl) (OpReg dst)
-#endif
-#if sparc_TARGET_ARCH
-	    SETHI (HI imm_lbl) dst,
-	    OR False dst (RIImm (LO imm_lbl)) dst
-#endif
-	    ]
-    in
-    returnUs (Any PtrRep code)
-  where
-    xs = _UNPK_ (_TAIL_ s)
 
 -- end of machine-"independent" bit; here we go on the rest...
 
diff --git a/ghc/compiler/nativeGen/MachMisc.lhs b/ghc/compiler/nativeGen/MachMisc.lhs
index ced5474..b6ba84f 100644
--- a/ghc/compiler/nativeGen/MachMisc.lhs
+++ b/ghc/compiler/nativeGen/MachMisc.lhs
@@ -18,9 +18,10 @@ module MachMisc (
 
 	underscorePrefix,
 	fmtAsmLbl,
-	cvtLitLit,
 	exactLog2,
 
+        stixFor_stdout, stixFor_stderr, stixFor_stdin,
+
 	Instr(..),  IF_ARCH_i386(Operand(..) COMMA,)
 	Cond(..),
 	Size(..)
@@ -52,6 +53,7 @@ import Stix		( StixTree(..), StixReg(..), CodeSegment )
 import Panic		( panic )
 import Char		( isDigit )
 import GlaExts		( word2Int#, int2Word#, shiftRL#, and#, (/=#) )
+import Outputable	( text )
 \end{code}
 
 \begin{code}
@@ -78,6 +80,30 @@ fmtAsmLbl s
      )
 
 ---------------------------
+stixFor_stdout, stixFor_stderr, stixFor_stdin :: StixTree
+#if i386_TARGET_ARCH
+-- Linux glibc 2 / libc6
+stixFor_stdout  = StInd PtrRep (StLitLbl (text "stdout"))
+stixFor_stderr  = StInd PtrRep (StLitLbl (text "stderr"))
+stixFor_stdin   = StInd PtrRep (StLitLbl (text "stdin"))
+#endif
+
+#if alpha_TARGET_ARCH
+stixFor_stdout = error "stixFor_stdout: not implemented for Alpha"
+stixFor_stderr = error "stixFor_stderr: not implemented for Alpha"
+stixFor_stdin  = error "stixFor_stdin: not implemented for Alpha"
+#endif
+
+#if sparc_TARGET_ARCH
+stixFor_stdout = error "stixFor_stdout: not implemented for Sparc"
+stixFor_stderr = error "stixFor_stderr: not implemented for Sparc"
+stixFor_stdin  = error "stixFor_stdin: not implemented for Sparc"
+#endif
+
+#if 0
+Here's some old stuff from which it shouldn't be too hard to
+implement the above for Alpha/Sparc.
+
 cvtLitLit :: String -> String
 
 --
@@ -85,36 +111,20 @@ cvtLitLit :: String -> String
 -- _iob offsets.
 --
 cvtLitLit "stdin"  = IF_ARCH_alpha("_iob+0" {-probably OK...-}
-		    ,IF_ARCH_i386("_IO_stdin_"
+		    ,IF_ARCH_i386("stdin"
 		    ,IF_ARCH_sparc("__iob+0x0"{-probably OK...-}
 		    ,)))
 
 cvtLitLit "stdout" = IF_ARCH_alpha("_iob+"++show (``FILE_SIZE''::Int)
-		    ,IF_ARCH_i386("_IO_stdout_"
+		    ,IF_ARCH_i386("stdout"
 		    ,IF_ARCH_sparc("__iob+"++show (``FILE_SIZE''::Int)
 		    ,)))
 cvtLitLit "stderr" = IF_ARCH_alpha("_iob+"++show (2*(``FILE_SIZE''::Int))
-		    ,IF_ARCH_i386("_IO_stderr_"
+		    ,IF_ARCH_i386("stderr"
 		    ,IF_ARCH_sparc("__iob+"++show (2*(``FILE_SIZE''::Int))
 		    ,)))
-{-
-cvtLitLit "stdout" = IF_ARCH_alpha("_iob+56"{-dodgy *at best*...-}
-		    ,IF_ARCH_i386("_IO_stdout_"
-		    ,IF_ARCH_sparc("__iob+0x10"{-dodgy *at best*...-}
-		    ,)))
-cvtLitLit "stderr" = IF_ARCH_alpha("_iob+112"{-dodgy *at best*...-}
-		    ,IF_ARCH_i386("_IO_stderr_"
-		    ,IF_ARCH_sparc("__iob+0x20"{-dodgy *at best*...-}
-		    ,)))
--}
-cvtLitLit s
-  | isHex s   = s
-  | otherwise = error ("Native code generator can't handle ``" ++ s ++ "''")
-  where
-    isHex ('0':'x':xs) = all isHexDigit xs
-    isHex _ = False
-    -- Now, where have I seen this before?
-    isHexDigit c = isDigit c || c >= 'A' && c <= 'F' || c >= 'a' && c <= 'f'
+#endif
+
 \end{code}
 
 % ----------------------------------------------------------------
diff --git a/ghc/compiler/nativeGen/Stix.lhs b/ghc/compiler/nativeGen/Stix.lhs
index 92761f2..ea39abe 100644
--- a/ghc/compiler/nativeGen/Stix.lhs
+++ b/ghc/compiler/nativeGen/Stix.lhs
@@ -45,7 +45,7 @@ data StixTree
   | StString	FAST_STRING
   | StLitLbl	SDoc    -- literal labels
 			    -- (will be _-prefixed on some machines)
-  | StLitLit	FAST_STRING -- innards from CLitLit
+
   | StCLbl	CLabel	    -- labels that we might index into
 
     -- Abstract registers of various kinds
@@ -126,7 +126,6 @@ ppStixTree t
        StString str   -> paren (text "Str" <+> ptext str)
        StComment str  -> paren (text "Comment" <+> ptext str)
        StLitLbl sd    -> sd
-       StLitLit ll    -> paren (text "LitLit" <+> ptext ll)
        StCLbl lbl     -> pprCLabel lbl
        StReg reg      -> ppStixReg reg
        StIndex k b o  -> paren (ppStixTree b <+> char '+' <> 
diff --git a/ghc/compiler/nativeGen/StixPrim.lhs b/ghc/compiler/nativeGen/StixPrim.lhs
index 0b4feb6..11b6cd6 100644
--- a/ghc/compiler/nativeGen/StixPrim.lhs
+++ b/ghc/compiler/nativeGen/StixPrim.lhs
@@ -368,13 +368,13 @@ amodeToStix (CLit core)
       MachStr s	     -> StString s
       MachAddr a     -> StInt a
       MachInt i _    -> StInt (toInteger i)
-      MachLitLit s _ -> StLitLit s
+      MachLitLit s _ -> {-trace (_UNPK_ s ++ "\n")-} (litLitToStix (_UNPK_ s))
       MachFloat d    -> StDouble d
       MachDouble d   -> StDouble d
       _ -> panic "amodeToStix:core literal"
 
- -- A CLitLit is just a (CLit . MachLitLit)
-amodeToStix (CLitLit s _) = StLitLit s
+amodeToStix (CLitLit s _)
+   = litLitToStix (_UNPK_ s)
 
 amodeToStix (CMacroExpr _ macro [arg])
   = case macro of
@@ -390,6 +390,15 @@ amodeToStix (CMacroExpr _ macro [arg])
 -- XXX!!!
 -- GET_TAG(info_ptr) is supposed to be  get_itbl(info_ptr)->srt_len,
 -- which we've had to hand-code here.
+
+litLitToStix :: String -> StixTree
+litLitToStix nm
+   = case nm of
+        "stdout" -> stixFor_stdout
+        "stderr" -> stixFor_stderr
+        "stdin"  -> stixFor_stdin
+        other    -> error ("\nlitLitToStix: can't handle `" ++ nm ++ "'\n" 
+                           ++ "suggested workaround: use flag -fvia-C\n")
 \end{code}
 
 Sizes of the CharLike and IntLike closures that are arranged as arrays