[project @ 2002-02-06 15:54:23 by simonpj]

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

diff --git a/ghc/compiler/nativeGen/AbsCStixGen.lhs b/ghc/compiler/nativeGen/AbsCStixGen.lhs
index 2445f57..b3ac35b 100644 (file)
--- a/ghc/compiler/nativeGen/AbsCStixGen.lhs
+++ b/ghc/compiler/nativeGen/AbsCStixGen.lhs
@@ -26,13 +26,12 @@ import CLabel           ( CLabel, mkReturnInfoLabel, mkReturnPtLabel,
                           mkClosureTblLabel, mkClosureLabel,
                          labelDynamic, mkSplitMarkerLabel )
 import ClosureInfo     ( infoTableLabelFromCI, entryLabelFromCI,
-                         fastLabelFromCI, closureUpdReqd,
-                         staticClosureNeedsLink
+                         closureLabelFromCI, fastLabelFromCI
                        )
 import Literal         ( Literal(..), word2IntLit )
 import Maybes          ( maybeToBool )
 import StgSyn          ( StgOp(..) )
-import MachOp          ( MachOp(..), resultRepsOfMachOp )
+import MachOp          ( MachOp(..), resultRepOfMachOp )
 import PrimRep         ( isFloatingRep, is64BitRep, 
                          PrimRep(..), getPrimRepArrayElemSize )
 import StixInfo                ( genCodeInfoTable, genBitmapInfoTable,
@@ -89,7 +88,7 @@ Here we handle top-level things, like @CCodeBlock@s and
   = gencode absC                               `thenUs` \ code ->
     returnUs (StSegment TextSegment : StFunBegin lbl : code [StFunEnd lbl])
 
- gentopcode stmt@(CStaticClosure lbl _ _ _)
+ gentopcode stmt@(CStaticClosure closure_info _ _)
   = genCodeStaticClosure stmt                  `thenUs` \ code ->
     returnUs (
        if   opt_Static
@@ -99,6 +98,8 @@ Here we handle top-level things, like @CCodeBlock@s and
             : StData PtrRep [StInt 0] -- DLLised world, need extra zero word
             : StLabel lbl : code []
     )
+  where
+       lbl = closureLabelFromCI closure_info
 
  gentopcode stmt@(CRetVector lbl _ _ _)
   = genCodeVecTbl stmt                         `thenUs` \ code ->
@@ -110,8 +111,8 @@ Here we handle top-level things, like @CCodeBlock@s and
        -- for ensuring the GC works correctly, although GC crashes due to
        -- misclassification are much more likely to show up in the interactive 
        -- system than in compile code.  For details see comment near line 1164 
-       -- of ghc/driver/mangler/ghc-asm.lprl, which contains an analogous fix for 
-       -- the mangled via-C route.
+       -- of ghc/driver/mangler/ghc-asm.lprl, which contains an analogous fix
+       -- for the mangled via-C route.
        vtbl_post_label_word = StData PtrRep [StInt 0]
 
  gentopcode stmt@(CRetDirect uniq absC srt liveness)
@@ -226,12 +227,11 @@ Here we handle top-level things, like @CCodeBlock@s and
     :: AbstractC
     -> UniqSM StixTreeList
  -}
- genCodeStaticClosure (CStaticClosure _ cl_info cost_centre amodes)
+ genCodeStaticClosure (CStaticClosure cl_info cost_centre amodes)
   = returnUs (\xs -> table ++ xs)
   where
     table = StData PtrRep [StCLbl (infoTableLabelFromCI cl_info)] : 
-           map do_one_amode amodes ++
-           [StData PtrRep (padding_wds ++ static_link)]
+           map do_one_amode amodes
 
     do_one_amode amode 
        = StData (promote_to_word (getAmodeRep amode)) [a2stix amode]
@@ -240,25 +240,6 @@ Here we handle top-level things, like @CCodeBlock@s and
     promote_to_word pk 
        | getPrimRepArrayElemSize pk >= getPrimRepArrayElemSize IntRep  = pk
        | otherwise                                                     = IntRep
-
-    upd_reqd = closureUpdReqd cl_info
-
-    padding_wds
-       | upd_reqd  = take (max 0 (mIN_UPD_SIZE - length amodes)) zeros
-       | otherwise = []
-
-    static_link | upd_reqd || staticClosureNeedsLink cl_info = [StInt 0]
-               | otherwise                                  = []
-
-    zeros = StInt 0 : zeros
-
-    {- needed??? --SDM
-       -- Watch out for VoidKinds...cf. PprAbsC
-    amodeZeroVoid item
-      | getAmodeRep item == VoidRep = StInt 0
-      | otherwise = a2stix item
-    -}
-
 \end{code}
 
 Now the individual AbstractC statements.
@@ -411,39 +392,10 @@ Now the PrimOps, some of which may need caller-saves register wrappers.
  gencode (COpStmt results (StgPrimOp op) args vols)
   = panic "AbsCStixGen.gencode: un-translated PrimOp"
 
- -- Translate out array indexing primops right here, so that
- -- individual targets don't have to deal with them
-
- gencode (CMachOpStmt (Just r1) (MO_ReadOSBI off_w rep) [base,index] vols) 
-  = returnUs (\xs ->
-       mkStAssign 
-          rep 
-          (a2stix r1) 
-          (StInd rep (StMachOp MO_Nat_Add 
-                               [StIndex rep (a2stix base) (a2stix index), 
-                                StInt (toInteger (off_w * wORD_SIZE))]))
-       : xs
-    )
-
- -- Ordinary MachOps are passed through unchanged.
- gencode (CMachOpStmt Nothing (MO_WriteOSBI off_w rep) [base,index,val] vols) 
-  = returnUs (\xs ->
-       StAssignMem 
-          rep 
-          (StMachOp MO_Nat_Add 
-                    [StIndex rep (a2stix base) (a2stix index), 
-                     StInt (toInteger (off_w * wORD_SIZE))])
-          (a2stix val)
-       : xs
-    )
-
- gencode (CMachOpStmt (Just r1) mop args vols)
-  = case resultRepsOfMachOp mop of
-       Just rep 
-          -> returnUs (\xs ->
-                mkStAssign rep (a2stix r1) 
-                               (StMachOp mop (map a2stix args))
-                : xs
+ gencode (CMachOpStmt res mop args vols)
+  = returnUs (\xs -> mkStAssign (resultRepOfMachOp mop) (a2stix res) 
+                                (StMachOp mop (map a2stix args))
+                     : xs
              )
 \end{code}