[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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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