[project @ 2000-01-19 11:05:36 by sewardj]

MachCode.stmt2Instrs, StFunBegin, x86 case only: for debugging,
generate trace code to print the name of each labelled code block.

ghc/compiler/nativeGen/MachCode.lhs

@@ -20,7 +20,7 @@ import MachRegs
 import AbsCSyn		( MagicId )
 import AbsCUtils	( magicIdPrimRep )
 import CallConv		( CallConv )
-import CLabel		( isAsmTemp, CLabel )
+import CLabel		( isAsmTemp, CLabel, pprCLabel_asm )
 import Maybes		( maybeToBool, expectJust )
 import OrdList		-- quite a bit of it
 import PrimRep		( isFloatingRep, PrimRep(..) )
@@ -43,7 +43,29 @@ stmt2Instrs :: StixTree {- a stix statement -} -> UniqSM InstrBlock
 stmt2Instrs stmt = case stmt of
     StComment s    -> returnInstr (COMMENT s)
     StSegment seg  -> returnInstr (SEGMENT seg)
+
+#if 1
+    -- StFunBegin, normal non-debugging code for all architectures
     StFunBegin lab -> returnInstr (IF_ARCH_alpha(FUNBEGIN lab,LABEL lab))
+#else
+    -- StFunBegin, special tracing code for x86-Linux only
+    StFunBegin lab -> getUniqLabelNCG `thenUs` \ str_lbl ->
+                      returnUs (mkSeqInstrs [
+                         LABEL lab,
+                         COMMENT SLIT("begin trace sequence"),
+                         SEGMENT DataSegment,
+                         LABEL str_lbl,
+                         ASCII True (showSDoc (pprCLabel_asm lab)),
+                         SEGMENT TextSegment,
+                         PUSHA,
+                         PUSH L (OpImm (ImmCLbl str_lbl)),
+                         CALL (ImmLit (text "native_trace")),
+		         ADD L (OpImm (ImmInt 4)) (OpReg esp),
+                         POPA,
+                         COMMENT SLIT("end trace sequence")
+                      ])
+#endif
+
     StFunEnd lab   -> IF_ARCH_alpha(returnInstr (FUNEND lab),returnUs id)
     StLabel lab	   -> returnInstr (LABEL lab)
 

ghc/compiler/nativeGen/MachMisc.lhs

@@ -529,6 +529,8 @@ data RI
 
 	      | PUSH          Size Operand
 	      | POP           Size Operand
+	      | PUSHA
+	      | POPA
 
 -- Jumping around.
 

ghc/compiler/nativeGen/PprMach.lhs

@@ -394,17 +394,18 @@ pprAddr (AddrRegImm r1 imm)
 \begin{code}
 pprInstr :: Instr -> SDoc
 
---pprInstr (COMMENT s) = (<>) (ptext SLIT("# "))   (ptext s)
-pprInstr (COMMENT s) = empty -- nuke 'em
---alpha:  = (<>) (ptext SLIT("\t# ")) (ptext s)
---i386 :  = (<>) (ptext SLIT("# "))   (ptext s)
---sparc:  = (<>) (ptext SLIT("! "))   (ptext s)
+--pprInstr (COMMENT s) = empty -- nuke 'em
+pprInstr (COMMENT s)
+   =  IF_ARCH_alpha( ((<>) (ptext SLIT("\t# ")) (ptext s))
+     ,IF_ARCH_sparc( ((<>) (ptext SLIT("! "))   (ptext s))
+     ,IF_ARCH_i386( ((<>) (ptext SLIT("# "))   (ptext s))
+     ,)))
 
 pprInstr (SEGMENT TextSegment)
     = ptext
 	 IF_ARCH_alpha(SLIT("\t.text\n\t.align 3") {-word boundary-}
 	,IF_ARCH_sparc(SLIT("\t.text\n\t.align 4") {-word boundary-}
-	,IF_ARCH_i386((_PK_ ".text\n\t.align 4") {-needs per-OS variation!-}
+	,IF_ARCH_i386(SLIT(".text\n\t.align 4") {-needs per-OS variation!-}
 	,)))
 
 pprInstr (SEGMENT DataSegment)
@@ -983,6 +984,8 @@ pprInstr (CMP size src dst) = pprSizeOpOp SLIT("cmp")  size src dst
 pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test")  size src dst
 pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op
 pprInstr (POP size op) = pprSizeOp SLIT("pop") size op
+pprInstr PUSHA = ptext SLIT("\tpushal")
+pprInstr POPA = ptext SLIT("\tpopal")
 
 pprInstr (NOP) = ptext SLIT("\tnop")
 pprInstr (CLTD) = ptext SLIT("\tcltd")