-btw Why not let programmer use casm to provide assembly code instead
-of C code? ADR
-
-The (MP) integer operations are a true nightmare. Since we don't have
-a convenient abstract way of allocating temporary variables on the (C)
-stack, we use the space just below HpLim for the @MP_INT@ structures,
-and modify our heap check accordingly.
-
-\begin{code}
--- NB: ordering of clauses somewhere driven by
--- the desire to getting sane patt-matching behavior
-primCode res@[sr,dr] IntegerNegOp arg@[sa,da]
- = gmpNegate (sr,dr) (sa,da)
-
-primCode [res] IntegerCmpOp args@[sa1,da1, sa2,da2]
- = gmpCompare res (sa1,da1, sa2,da2)
-
-primCode [res] IntegerCmpIntOp args@[sa1,da1,ai]
- = gmpCompareInt res (sa1,da1,ai)
-
-primCode [res] Integer2IntOp arg@[sa,da]
- = gmpInteger2Int res (sa,da)
-
-primCode [res] Integer2WordOp arg@[sa,da]
- = gmpInteger2Word res (sa,da)
-
-primCode [res] Int2AddrOp [arg]
- = simpleCoercion AddrRep res arg
-
-primCode [res] Addr2IntOp [arg]
- = simpleCoercion IntRep res arg
-
-primCode [res] Int2WordOp [arg]
- = simpleCoercion IntRep{-WordRep?-} res arg
-
-primCode [res] Word2IntOp [arg]
- = simpleCoercion IntRep res arg
-\end{code}
-
-\begin{code}
-primCode [res] SameMutableArrayOp args
- = let
- compare = StPrim AddrEqOp (map amodeToStix args)
- assign = StAssign IntRep (amodeToStix res) compare
- in
- returnUs (\xs -> assign : xs)
-
-primCode res@[_] SameMutableByteArrayOp args
- = primCode res SameMutableArrayOp args
-
-primCode res@[_] SameMutVarOp args
- = primCode res SameMutableArrayOp args
-
-primCode res@[_] SameMVarOp args
- = primCode res SameMutableArrayOp args
-\end{code}
-
-Freezing an array of pointers is a double assignment. We fix the
-header of the ``new'' closure because the lhs is probably a better
-addressing mode for the indirection (most likely, it's a VanillaReg).
-
-\begin{code}
-
-primCode [lhs] UnsafeFreezeArrayOp [rhs]
- = let
- lhs' = amodeToStix lhs
- rhs' = amodeToStix rhs
- header = StInd PtrRep lhs'
- assign = StAssign PtrRep lhs' rhs'
- freeze = StAssign PtrRep header mutArrPtrsFrozen_info
- in
- returnUs (\xs -> assign : freeze : xs)
-
-primCode [lhs] UnsafeFreezeByteArrayOp [rhs]
- = simpleCoercion PtrRep lhs rhs
-\end{code}
-
-Returning the size of (mutable) byte arrays is just
-an indexing operation.
-
-\begin{code}
-primCode [lhs] SizeofByteArrayOp [rhs]
- = let
- lhs' = amodeToStix lhs
- rhs' = amodeToStix rhs
- sz = StIndex IntRep rhs' fixedHS
- assign = StAssign IntRep lhs' (StInd IntRep sz)
- in
- returnUs (\xs -> assign : xs)
-
-primCode [lhs] SizeofMutableByteArrayOp [rhs]
- = let
- lhs' = amodeToStix lhs
- rhs' = amodeToStix rhs
- sz = StIndex IntRep rhs' fixedHS
- assign = StAssign IntRep lhs' (StInd IntRep sz)
- in
- returnUs (\xs -> assign : xs)
-
-\end{code}
-
-Most other array primitives translate to simple indexing.
-
-\begin{code}
-primCode lhs@[_] IndexArrayOp args
- = primCode lhs ReadArrayOp args
-
-primCode [lhs] ReadArrayOp [obj, ix]
- = let
- lhs' = amodeToStix lhs
- obj' = amodeToStix obj
- ix' = amodeToStix ix
- base = StIndex IntRep obj' arrPtrsHS
- assign = StAssign PtrRep lhs' (StInd PtrRep (StIndex PtrRep base ix'))
- in
- returnUs (\xs -> assign : xs)
-
-primCode [] WriteArrayOp [obj, ix, v]
- = let
- obj' = amodeToStix obj
- ix' = amodeToStix ix
- v' = amodeToStix v
- base = StIndex IntRep obj' arrPtrsHS
- assign = StAssign PtrRep (StInd PtrRep (StIndex PtrRep base ix')) v'
- in
- returnUs (\xs -> assign : xs)
-
-primCode lhs@[_] (IndexByteArrayOp pk) args
- = primCode lhs (ReadByteArrayOp pk) args
-
--- NB: indexing in "pk" units, *not* in bytes (WDP 95/09)
-
-primCode [lhs] (ReadByteArrayOp pk) [obj, ix]
- = let
- lhs' = amodeToStix lhs
- obj' = amodeToStix obj
- ix' = amodeToStix ix
- base = StIndex IntRep obj' arrWordsHS
- assign = StAssign pk lhs' (StInd pk (StIndex pk base ix'))
- in
- returnUs (\xs -> assign : xs)
-
-primCode lhs@[_] (ReadOffAddrOp pk) args
- = primCode lhs (IndexOffAddrOp pk) args
-
-primCode [lhs] (IndexOffAddrOp pk) [obj, ix]
- = let
- lhs' = amodeToStix lhs
- obj' = amodeToStix obj
- ix' = amodeToStix ix
- assign = StAssign pk lhs' (StInd pk (StIndex pk obj' ix'))
- in
- returnUs (\xs -> assign : xs)
-
-primCode [lhs] (IndexOffForeignObjOp pk) [obj, ix]
- = let
- lhs' = amodeToStix lhs
- obj' = amodeToStix obj
- ix' = amodeToStix ix
- obj'' = StIndex AddrRep obj' fixedHS
- assign = StAssign pk lhs' (StInd pk (StIndex pk obj'' ix'))
- in
- returnUs (\xs -> assign : xs)
-
-primCode [] (WriteOffAddrOp pk) [obj, ix, v]
- = let
- obj' = amodeToStix obj
- ix' = amodeToStix ix
- v' = amodeToStix v
- assign = StAssign pk (StInd pk (StIndex pk obj' ix')) v'
- in
- returnUs (\xs -> assign : xs)
-
-primCode [] (WriteByteArrayOp pk) [obj, ix, v]
- = let
- obj' = amodeToStix obj
- ix' = amodeToStix ix
- v' = amodeToStix v
- base = StIndex IntRep obj' arrWordsHS
- assign = StAssign pk (StInd pk (StIndex pk base ix')) v'
- in
- returnUs (\xs -> assign : xs)
-
-primCode [] WriteForeignObjOp [obj, v]
- = let
- obj' = amodeToStix obj
- v' = amodeToStix v
- obj'' = StIndex AddrRep obj' (StInt 4711) -- fixedHS
- assign = StAssign AddrRep (StInd AddrRep obj'') v'
- in
- returnUs (\xs -> assign : xs)
-\end{code}
-