module PprAbsC (
writeRealC,
dumpRealC
-#if defined(DEBUG)
+#ifdef DEBUG
, pprAmode -- otherwise, not exported
#endif
) where
-import Ubiq{-uitous-}
-import AbsCLoop -- break its dependence on ClosureInfo
+IMP_Ubiq(){-uitous-}
+IMPORT_DELOOPER(AbsCLoop) -- break its dependence on ClosureInfo
+IMPORT_1_3(IO(Handle))
+IMPORT_1_3(Char(isDigit,isPrint))
+IMPORT_1_3(GHCbase(Addr(..)) ) -- to see innards
import AbsCSyn
import CostCentre ( uppCostCentre, uppCostCentreDecl )
import Costs ( costs, addrModeCosts, CostRes(..), Side(..) )
import CStrings ( stringToC )
-import FiniteMap ( addToFM, emptyFM, lookupFM )
+import FiniteMap ( addToFM, emptyFM, lookupFM, FiniteMap )
import HeapOffs ( isZeroOff, subOff, pprHeapOffset )
import Literal ( showLiteral, Literal(..) )
import Maybes ( maybeToBool, catMaybes )
)
import Unique ( pprUnique, Unique{-instance NamedThing-} )
import UniqSet ( emptyUniqSet, elementOfUniqSet,
- addOneToUniqSet, UniqSet(..)
+ addOneToUniqSet, SYN_IE(UniqSet)
)
import Unpretty -- ********** NOTE **********
import Util ( nOfThem, panic, assertPanic )
@pprAbsC@ has a new ``costs'' argument. %% HWL
\begin{code}
-writeRealC :: _FILE -> AbstractC -> IO ()
+writeRealC :: Handle -> AbstractC -> IO ()
-writeRealC file absC
- = uppAppendFile file 80 (
+writeRealC handle absC
+ = uppPutStr handle 80 (
uppAbove (pprAbsC PprForC absC (costs absC)) (uppChar '\n')
)
\begin{code}
emitMacro :: CostRes -> Unpretty
-#ifndef GRAN
-emitMacro _ = uppNil
-#else
+-- ToDo: Check a compile time flag to decide whether a macro should be emitted
emitMacro (Cost (i,b,l,s,f))
= uppBesides [ uppStr "GRAN_EXEC(",
- uppInt i, uppComma, uppInt b, uppComma, uppInt l, uppComma,
- uppInt s, uppComma, uppInt f, pp_paren_semi ]
-#endif {-GRAN-}
+ uppInt i, uppComma, uppInt b, uppComma, uppInt l, uppComma,
+ uppInt s, uppComma, uppInt f, pp_paren_semi ]
\end{code}
\begin{code}
(This happens after restoration of essential registers because we
might need the @Base@ register to access all the others correctly.)
+{- Doesn't apply anymore with ForeignObj, structure create via primop.
+ makeForeignObj (ForeignObj is not CReturnable)
7) If returning Malloc Pointer, build a closure containing the
appropriate value.
-
+-}
Otherwise, copy local variable into result register.
8) If ccall (not casm), declare the function being called as extern so
basic_restores;
restores;
- #if MallocPtr
- constructMallocPtr(liveness, return_reg, _ccall_result);
- #else
- return_reg = _ccall_result;
- #end
+ return_reg = _ccall_result;
}
\end{pseudocode}
can get at them.
* be sure that there are no live registers or we're in trouble.
(This can cause problems if you try something foolish like passing
- an array or mallocptr to a _ccall_GC_ thing.)
+ an array or foreign obj to a _ccall_GC_ thing.)
* increment/decrement the @inCCallGC@ counter before/after the call so
that the runtime check that PerformGC is being used sensibly will work.
If the argument is a heap object, we need to reach inside and pull out
the bit the C world wants to see. The only heap objects which can be
-passed are @Array@s, @ByteArray@s and @MallocPtr@s.
+passed are @Array@s, @ByteArray@s and @ForeignObj@s.
\begin{code}
ppr_casm_arg :: PprStyle -> CAddrMode -> Int -> (Unpretty, Unpretty)
ByteArrayRep -> (pp_kind,
uppBesides [uppStr "BYTE_ARR_CTS(", pp_amode, uppRparen])
- -- for Malloc Pointers, use MALLOC_PTR_DATA to fish out the contents.
- MallocPtrRep -> (uppPStr SLIT("StgMallocPtr"),
- uppBesides [uppStr "MallocPtr_CLOSURE_DATA(", pp_amode, uppStr")"])
+ -- for ForeignObj, use FOREIGN_OBJ_DATA to fish out the contents.
+ ForeignObjRep -> (uppPStr SLIT("StgForeignObj"),
+ uppBesides [uppStr "ForeignObj_CLOSURE_DATA(", pp_amode, uppStr")"])
other -> (pp_kind, pp_amode)
declare_local_var
We only allow zero or one results.
-2) Is the result is a mallocptr?
+{- With the introduction of ForeignObj (MallocPtr++), no longer necess.
+2) Is the result is a foreign obj?
The mallocptr must be encapsulated immediately in a heap object.
-
+-}
\begin{code}
ppr_casm_results ::
PprStyle -- style
(result_type, assign_result)
= case r_kind of
- MallocPtrRep ->
- (uppPStr SLIT("StgMallocPtr"),
- uppBesides [ uppStr "constructMallocPtr(",
+{- @ForeignObj@s replaces MallocPtrs and are *not* CReturnable.
+ Instead, external references have to be turned into ForeignObjs
+ using the primop makeForeignObj#. Benefit: Multiple finalisation
+ routines can be accommodated and the below special case is not needed.
+ Price is, of course, that you have to explicitly wrap `foreign objects'
+ with makeForeignObj#.
++
+ ForeignObjRep ->
+ (uppPStr SLIT("StgForeignObj"),
+ uppBesides [ uppStr "constructForeignObj(",
liveness, uppComma,
result_reg, uppComma,
local_var,
- pp_paren_semi ])
+ pp_paren_semi ]) -}
_ ->
(pprPrimKind sty r_kind,
uppBesides [ result_reg, uppEquals, local_var, uppSemi ])
_ -> panic ("process_casm: casm with many results while processing _casm_ \"" ++ string ++ "\".\n")
other ->
- case readDec other of
+ let
+ read_int :: ReadS Int
+ read_int = reads
+ in
+ case (read_int other) of
[(num,css)] ->
if 0 <= num && num < length args
then uppBeside (uppParens (args !! num))
pprAssign :: PprStyle -> PrimRep -> CAddrMode -> CAddrMode -> Unpretty
pprAssign sty VoidRep dest src = uppNil
-
-#if 0
-pprAssign sty kind dest src
- | (kind /= getAmodeRep dest) || (kind /= getAmodeRep src)
- = uppCat [uppStr "Bad kind:", pprPrimKind sty kind,
- pprPrimKind sty (getAmodeRep dest), pprAmode sty dest,
- pprPrimKind sty (getAmodeRep src), pprAmode sty src]
-#endif
\end{code}
Special treatment for floats and doubles, to avoid unwanted conversions.
pprUnionTag DoubleRep = panic "pprUnionTag:Double?"
pprUnionTag StablePtrRep = uppChar 'i'
-pprUnionTag MallocPtrRep = uppChar 'p'
+pprUnionTag ForeignObjRep = uppChar 'p'
pprUnionTag ArrayRep = uppChar 'p'
pprUnionTag ByteArrayRep = uppChar 'b'
projects / ghc-hetmet.git / blobdiff