-genPrimCode target lhs (IndexByteArrayOp pk) args =
- genPrimCode target lhs (ReadByteArrayOp pk) args
-
-genPrimCode target [lhs] (ReadByteArrayOp pk) [obj, ix] =
- let lhs' = amodeToStix target lhs
- obj' = amodeToStix target obj
- ix' = amodeToStix target ix
- base = StIndex IntKind obj' (dataHS target)
- assign = StAssign pk lhs' (StInd pk (StIndex CharKind base ix'))
- in
- returnSUs (\xs -> assign : xs)
-
-genPrimCode target [] (WriteByteArrayOp pk) [obj, ix, v] =
- let obj' = amodeToStix target obj
- ix' = amodeToStix target ix
- v' = amodeToStix target v
- base = StIndex IntKind obj' (dataHS target)
- assign = StAssign pk (StInd pk (StIndex CharKind base ix')) v'
- in
- returnSUs (\xs -> assign : xs)
-
-genPrimCode target [lhs] (IndexOffAddrOp pk) [obj, ix] =
- let lhs' = amodeToStix target lhs
- obj' = amodeToStix target obj
- ix' = amodeToStix target ix
- assign = StAssign pk lhs' (StInd pk (StIndex CharKind obj' ix'))
- in
- returnSUs (\xs -> assign : xs)
-
-\end{code}
-
-Stable pointer operations.
-
-First the easy one.
-
-\begin{code}
-
-genPrimCode target [lhs] DeRefStablePtrOp [sp] =
- let lhs' = amodeToStix target lhs
- pk = getAmodeKind lhs
- sp' = amodeToStix target sp
- call = StCall SLIT("deRefStablePointer") pk [sp', smStablePtrTable]
- assign = StAssign pk lhs' call
- in
- returnSUs (\xs -> assign : xs)
-
-\end{code}
-
-Now the hard one. For comparison, here's the code from StgMacros:
-
-\begin{verbatim}
-#define makeStablePtrZh(stablePtr,liveness,unstablePtr) \
-do { \
- EXTDATA(MK_INFO_LBL(StablePointerTable)); \
- EXTDATA(UnusedSP); \
- StgStablePtr newSP; \
- \
- if (SPT_EMPTY(StorageMgrInfo.StablePointerTable)) { /* free stack is empty */ \
- I_ OldNoPtrs = SPT_NoPTRS(StorageMgrInfo.StablePointerTable); \
- \
- /* any strictly increasing expression will do here */ \
- I_ NewNoPtrs = OldNoPtrs * 2 + 100; \
- \
- I_ NewSize = DYN_VHS + NewNoPtrs + 1 + NewNoPtrs; \
- P_ SPTable; \
- \
- HEAP_CHK(NO_LIVENESS, _FHS+NewSize, 0); \
- CC_ALLOC(CCC, _FHS+NewSize, SPT_K); /* cc prof */ \
- \
- SPTable = Hp + 1 - (_FHS + NewSize); \
- SET_DYN_HDR(SPTable,StablePointerTable,CCC,NewSize,NewNoPtrs); \
- SAFESTGCALL2(void, (void *, P_, P_), enlargeSPTable, SPTable, StorageMgrInfo.StablePointerTable); \
- StorageMgrInfo.StablePointerTable = SPTable; \
- } \
- \
- newSP = SPT_POP(StorageMgrInfo.StablePointerTable); \
- SPT_SPTR(StorageMgrInfo.StablePointerTable, newSP) = unstablePtr; \
- stablePtr = newSP; \
-} while (0)
-\end{verbatim}
-
-ToDo ADR: finish this. (Boy, this is hard work!)
-
-Notes for ADR:
- trMumbles are now just StMumbles.
- StInt 1 is how to write ``1''
- temporaries are allocated at the end of the heap (see notes in StixInteger)
- Good luck!
-
- --JSM
-
-\begin{pseudocode}
-genPrimCode sty md [lhs] MakeStablePtrOp args =
- let
- -- some useful abbreviations (I'm sure these must exist already)
- add = trPrim . IntAddOp
- sub = trPrim . IntSubOp
- one = trInt [1]
- dec x = trAssign IntKind [x, sub [x, one]]
- inc x = trAssign IntKind [x, add [x, one]]
-
- -- tedious hardwiring in of closure layout offsets (from SMClosures)
- dynHS = 2 + fixedHeaderSize md sty + varHeaderSize md sty DynamicRep
- spt_SIZE c = trIndex PtrKind [c, trInt [fhs + gc_reserved] ]
- spt_NoPTRS c = trIndex PtrKind [c, trInt [fhs + gc_reserved + 1] ]
- spt_SPTR c i = trIndex PtrKind [c, add [trInt [dynHS], i]]
- spt_TOP c = trIndex PtrKind [c, add [trInt [dynHS], spt_NoPTRS c]]
- spt_FREE c i = trIndex PtrKind [c, add [trInt [dynHS], spt_NoPTRS c]]
-
- -- tedious hardwiring in of stack manipulation macros (from SMClosures)
- spt_FULL c lbl =
- trCondJump lbl [trPrim IntEqOp [spt_TOP c, spt_NoPTRS c]]
- spt_EMPTY c lbl =
- trCondJump lbl [trPrim IntEqOp [spt_TOP c, trInt [0]]]
- spt_PUSH c f = [
- trAssign PtrKind [spt_FREE c (spt_TOP c), f],
- inc (spt_TOP c),
- spt_POP c x = [
- dec (spt_TOP c),
- trAssign PtrKind [x, spt_FREE c (spt_TOP c)]
- ]
-
- -- now to get down to business
- lhs' = amodeCode sty md lhs
- [liveness, unstable] = map (amodeCode sty md) args
-
- spt = smStablePtrTable
-
- newSPT = -- a temporary (don't know how to allocate it)
- newSP = -- another temporary
-
- allocNewTable = -- some sort fo heap allocation needed
- copyOldTable = trCall "enlargeSPTable" PtrKind [newSPT, spt]
-
- enlarge =
- allocNewTable ++ [
- copyOldTable,
- trAssign PtrKind [spt, newSPT]
- allocate = [
- spt_POP spt newSP,
- trAssign PtrKind [spt_SPTR spt newSP, unstable],
- trAssign StablePtrKind [lhs', newSP]
- ]
-
- in
- getUniqLabelCTS `thenCTS` \ oklbl ->
- returnCodes sty md
- (spt_EMPTY spt oklbl : (enlarge ++ (trLabel [oklbl] : allocate)))
-\end{pseudocode}
-
-
-Now the more mundane operations.
-
-\begin{code}
-
-genPrimCode target lhs op rhs =
- let lhs' = map (amodeToStix target) lhs
- rhs' = map (amodeToStix' target) rhs
- in
- returnSUs (\ xs -> simplePrim target lhs' op rhs' : xs)
-
-simpleCoercion
- :: Target
- -> PrimKind
- -> [CAddrMode]
- -> [CAddrMode]
- -> SUniqSM StixTreeList
-
-simpleCoercion target pk [lhs] [rhs] =
- returnSUs (\xs -> StAssign pk (amodeToStix target lhs) (amodeToStix target rhs) : xs)
-
-\end{code}
-
-Here we try to rewrite primitives into a form the code generator
-can understand. Any primitives not handled here must be handled
-at the level of the specific code generator.
-
-\begin{code}
-
-simplePrim
- :: Target
- -> [StixTree]
- -> PrimOp
- -> [StixTree]
- -> StixTree
-
-\end{code}
-
-Now look for something more conventional.
-
-\begin{code}
-
-simplePrim target [lhs] op rest = StAssign pk lhs (StPrim op rest)
- where pk = if isCompareOp op then IntKind
- else case getPrimOpResultInfo op of
- ReturnsPrim pk -> pk
- _ -> simplePrim_error op
-
-simplePrim target _ op _ = simplePrim_error op
-
-simplePrim_error op
- = error ("ERROR: primitive operation `"++showPrimOp PprDebug op++"'cannot be handled\nby the native-code generator. Workaround: use -fvia-C.\n(Perhaps you should report it as a GHC bug, also.)\n")