From 5adf2314bfe7329e57cc956f02d0e566ae9569c9 Mon Sep 17 00:00:00 2001
From: sewardj <unknown>
Date: Tue, 18 Jan 2000 11:12:57 +0000
Subject: [PATCH] [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).
---
ghc/compiler/nativeGen/MachCode.lhs | 26 --------------
ghc/compiler/nativeGen/MachMisc.lhs | 54 +++++++++++++++++------------
ghc/compiler/nativeGen/Stix.lhs | 3 +-
ghc/compiler/nativeGen/StixPrim.lhs | 15 ++++++--
4 files changed, 45 insertions(+), 53 deletions(-)
diff --git a/ghc/compiler/nativeGen/MachCode.lhs b/ghc/compiler/nativeGen/MachCode.lhs
index d59a3f5bd42e..77792bfbd540 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 ced547477f70..b6ba84fa0f5c 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 92761f2683f8..ea39abe1778c 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 0b4feb693dd6..11b6cd684736 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
--
GitLab