[project @ 2000-05-15 14:49:47 by simonmar]

[ghc-hetmet.git] / ghc / compiler / nativeGen / AbsCStixGen.lhs

diff --git a/ghc/compiler/nativeGen/AbsCStixGen.lhs b/ghc/compiler/nativeGen/AbsCStixGen.lhs
index 4c7553f..36cb457 100644 (file)
--- a/ghc/compiler/nativeGen/AbsCStixGen.lhs
+++ b/ghc/compiler/nativeGen/AbsCStixGen.lhs
@@ -16,31 +16,35 @@ import MachMisc
 import AbsCUtils       ( getAmodeRep, mixedTypeLocn,
                          nonemptyAbsC, mkAbsCStmts, mkAbsCStmtList
                        )
+import PprAbsC          ( dumpRealC )
 import SMRep           ( fixedItblSize, 
                          rET_SMALL, rET_BIG, 
                          rET_VEC_SMALL, rET_VEC_BIG 
                        )
 import Constants       ( mIN_UPD_SIZE )
-import CLabel           ( CLabel, mkReturnInfoLabel, mkReturnPtLabel )
+import CLabel           ( CLabel, mkReturnInfoLabel, mkReturnPtLabel,
+                          mkClosureTblLabel, mkClosureLabel,
+                         moduleRegdLabel )
 import ClosureInfo     ( infoTableLabelFromCI, entryLabelFromCI,
                          fastLabelFromCI, closureUpdReqd,
                          staticClosureNeedsLink
                        )
-import Const           ( Literal(..) )
+import Literal         ( Literal(..), word2IntLit )
 import Maybes          ( maybeToBool )
 import PrimOp          ( primOpNeedsWrapper, PrimOp(..) )
 import PrimRep         ( isFloatingRep, PrimRep(..) )
 import StixInfo                ( genCodeInfoTable, genBitmapInfoTable )
 import StixMacro       ( macroCode, checkCode )
 import StixPrim                ( primCode, amodeToStix, amodeToStix' )
+import Outputable       ( pprPanic, ppr )
 import UniqSupply      ( returnUs, thenUs, mapUs, getUniqueUs, UniqSM )
 import Util            ( naturalMergeSortLe )
 import Panic           ( panic )
+import TyCon           ( tyConDataCons )
+import DataCon         ( dataConWrapId )
 import BitSet          ( intBS )
-
-#ifdef REALLY_HASKELL_1_3
-ord = fromEnum :: Char -> Int
-#endif
+import Name             ( NamedThing(..) )
+import Char            ( ord )
 \end{code}
 
 For each independent chunk of AbstractC code, we generate a list of
@@ -138,10 +142,34 @@ Here we handle top-level things, like @CCodeBlock@s and
                                map  (StInt . toInteger . intBS) mask)
             ]
 
+ gentopcode stmt@(CClosureTbl tycon)
+  = returnUs [ StSegment TextSegment
+             , StLabel (mkClosureTblLabel tycon)
+             , StData DataPtrRep (map (StCLbl . mkClosureLabel . getName . dataConWrapId) 
+                                      (tyConDataCons tycon) )
+             ]
+
+ gentopcode stmt@(CModuleInitBlock lbl absC)
+  = gencode absC                       `thenUs` \ code ->
+    getUniqLabelNCG                    `thenUs` \ tmp_lbl ->
+    returnUs ( StSegment DataSegment
+            : StLabel moduleRegdLabel
+            : StData IntRep [StInt 0]
+            : StSegment TextSegment
+            : StLabel lbl
+            : StCondJump tmp_lbl (StPrim IntNeOp       
+                                    [StInd IntRep (StCLbl moduleRegdLabel),
+                                     StInt 0])
+            : StAssign IntRep (StInd IntRep (StCLbl moduleRegdLabel)) (StInt 1)
+            : code 
+            [ StLabel tmp_lbl
+            , StAssign PtrRep stgSp (StPrim IntSubOp [stgSp, StInt 4])
+            , StJump (StInd WordRep stgSp)
+            ])
+
  gentopcode absC
   = gencode absC                               `thenUs` \ code ->
     returnUs (StSegment TextSegment : code [])
-
 \end{code}
 
 \begin{code}
@@ -362,8 +390,8 @@ Now the if statement.  Almost *all* flow of control are of this form.
                                Nothing -> gencode alt_code
                                Just dc -> mkIfThenElse discrim tag alt_code dc
 
-      [(tag1@(MachInt i1 _), alt_code1),
-       (tag2@(MachInt i2 _), alt_code2)]
+      [(tag1@(MachInt i1), alt_code1),
+       (tag2@(MachInt i2), alt_code2)]
        | deflt_is_empty && i1 == 0 && i2 == 1
        -> mkIfThenElse discrim tag1 alt_code1 alt_code2
        | deflt_is_empty && i1 == 1 && i2 == 0
@@ -406,6 +434,8 @@ Finally, all of the disgusting AbstractC macros.
  gencode (CCallProfCCMacro macro _)
   = returnUs (\xs -> StComment macro : xs)
 
+ gencode other
+  = pprPanic "AbsCStixGen.gencode" (dumpRealC other)
 \end{code}
 
 Here, we generate a jump table if there are more than four (integer)
@@ -416,15 +446,16 @@ be tuned.)
 \begin{code}
 
  intTag :: Literal -> Integer
- intTag (MachChar c)  = fromInt (ord c)
- intTag (MachInt i _) = i
- intTag _ = panic "intTag"
+ intTag (MachChar c)  = toInteger (ord c)
+ intTag (MachInt i)   = i
+ intTag (MachWord w)  = intTag (word2IntLit (MachWord w))
+ intTag _             = panic "intTag"
 
  fltTag :: Literal -> Rational
 
- fltTag (MachFloat f) = f
+ fltTag (MachFloat f)  = f
  fltTag (MachDouble d) = d
- fltTag _ = panic "fltTag"
+ fltTag x              = pprPanic "fltTag" (ppr x)
 
  {-
  mkSimpleSwitches
@@ -462,7 +493,8 @@ be tuned.)
        choices = length alts
 
        (x@(MachChar _),_)  `leAlt` (y,_) = intTag x <= intTag y
-       (x@(MachInt _ _),_) `leAlt` (y,_) = intTag x <= intTag y
+       (x@(MachInt _), _)  `leAlt` (y,_) = intTag x <= intTag y
+       (x@(MachWord _), _) `leAlt` (y,_) = intTag x <= intTag y
        (x,_)               `leAlt` (y,_) = fltTag x <= fltTag y
 
 \end{code}