-\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}
-
-\begin{code}
---primCode lhs (CCallOp fn is_asm may_gc) rhs
-primCode lhs (CCallOp (CCall (StaticTarget fn) is_asm may_gc cconv)) rhs
- | is_asm = error "ERROR: Native code generator can't handle casm"
- | may_gc = error "ERROR: Native code generator can't handle _ccall_GC_\n"