-import SMRep ( SMRep(..), SMSpecRepKind, SMUpdateKind )
-import Stix ( getUniqLabelNCG, sStLitLbl, stgHp, stgHpLim,
- StixTree(..), StixTreeList(..),
- CodeSegment, StixReg
- )
-import StixMacro ( macroCode, heapCheck )
-import UniqSupply ( returnUs, thenUs, SYN_IE(UniqSM) )
-import Util ( panic )
-\end{code}
-
-\begin{code}
-gmpTake1Return1
- :: (CAddrMode,CAddrMode,CAddrMode) -- result (3 parts)
- -> FAST_STRING -- function name
- -> (CAddrMode, CAddrMode,CAddrMode,CAddrMode)
- -- argument (4 parts)
- -> UniqSM StixTreeList
-
-argument1 = mpStruct 1 -- out here to avoid CAF (sigh)
-argument2 = mpStruct 2
-result2 = mpStruct 2
-result3 = mpStruct 3
-result4 = mpStruct 4
-init2 = StCall SLIT("mpz_init") VoidRep [result2]
-init3 = StCall SLIT("mpz_init") VoidRep [result3]
-init4 = StCall SLIT("mpz_init") VoidRep [result4]
-
-gmpTake1Return1 res@(car,csr,cdr) rtn arg@(clive,caa,csa,cda)
- = let
- ar = amodeToStix car
- sr = amodeToStix csr
- dr = amodeToStix cdr
- liveness= amodeToStix clive
- aa = amodeToStix caa
- sa = amodeToStix csa
- da = amodeToStix cda
-
- space = mpSpace 2 1 [sa]
- oldHp = StIndex PtrRep stgHp (StPrim IntNegOp [space])
- safeHp = saveLoc Hp
- save = StAssign PtrRep safeHp oldHp
- (a1,a2,a3) = toStruct argument1 (aa,sa,da)
- mpz_op = StCall rtn VoidRep [result2, argument1]
- restore = StAssign PtrRep stgHp safeHp
- (r1,r2,r3) = fromStruct result2 (ar,sr,dr)
- in
- heapCheck liveness space (StInt 0) `thenUs` \ heap_chk ->
-
- returnUs (heap_chk .
- (\xs -> a1 : a2 : a3 : save : init2 : mpz_op : r1 : r2 : r3 : restore : xs))
-
-gmpTake2Return1
- :: (CAddrMode,CAddrMode,CAddrMode) -- result (3 parts)
- -> FAST_STRING -- function name
- -> (CAddrMode,CAddrMode,CAddrMode,CAddrMode,CAddrMode,CAddrMode,CAddrMode)
- -- liveness + 2 arguments (3 parts each)
- -> UniqSM StixTreeList
-
-gmpTake2Return1 res@(car,csr,cdr) rtn args@(clive, caa1,csa1,cda1, caa2,csa2,cda2)
- = let
- ar = amodeToStix car
- sr = amodeToStix csr
- dr = amodeToStix cdr
- liveness= amodeToStix clive
- aa1 = amodeToStix caa1
- sa1 = amodeToStix csa1
- da1 = amodeToStix cda1
- aa2 = amodeToStix caa2
- sa2 = amodeToStix csa2
- da2 = amodeToStix cda2
-
- space = mpSpace 3 1 [sa1, sa2]
- oldHp = StIndex PtrRep stgHp (StPrim IntNegOp [space])
- safeHp = saveLoc Hp
- save = StAssign PtrRep safeHp oldHp
- (a1,a2,a3) = toStruct argument1 (aa1,sa1,da1)
- (a4,a5,a6) = toStruct argument2 (aa2,sa2,da2)
- mpz_op = StCall rtn VoidRep [result3, argument1, argument2]
- restore = StAssign PtrRep stgHp safeHp
- (r1,r2,r3) = fromStruct result3 (ar,sr,dr)
- in
- heapCheck liveness space (StInt 0) `thenUs` \ heap_chk ->
-
- returnUs (heap_chk .
- (\xs -> a1 : a2 : a3 : a4 : a5 : a6
- : save : init3 : mpz_op : r1 : r2 : r3 : restore : xs))
-
-gmpTake2Return2
- :: (CAddrMode,CAddrMode,CAddrMode,CAddrMode,CAddrMode,CAddrMode)
- -- 2 results (3 parts each)
- -> FAST_STRING -- function name
- -> (CAddrMode,CAddrMode,CAddrMode,CAddrMode,CAddrMode,CAddrMode,CAddrMode)
- -- liveness + 2 arguments (3 parts each)
- -> UniqSM StixTreeList
-
-gmpTake2Return2 res@(car1,csr1,cdr1, car2,csr2,cdr2)
- rtn args@(clive, caa1,csa1,cda1, caa2,csa2,cda2)
- = let
- ar1 = amodeToStix car1
- sr1 = amodeToStix csr1
- dr1 = amodeToStix cdr1
- ar2 = amodeToStix car2
- sr2 = amodeToStix csr2
- dr2 = amodeToStix cdr2
- liveness= amodeToStix clive
- aa1 = amodeToStix caa1
- sa1 = amodeToStix csa1
- da1 = amodeToStix cda1
- aa2 = amodeToStix caa2
- sa2 = amodeToStix csa2
- da2 = amodeToStix cda2
-
- space = StPrim IntMulOp [mpSpace 2 1 [sa1, sa2], StInt 2]
- oldHp = StIndex PtrRep stgHp (StPrim IntNegOp [space])
- safeHp = saveLoc Hp
- save = StAssign PtrRep safeHp oldHp
- (a1,a2,a3) = toStruct argument1 (aa1,sa1,da1)
- (a4,a5,a6) = toStruct argument2 (aa2,sa2,da2)
- mpz_op = StCall rtn VoidRep [result3, result4, argument1, argument2]
- restore = StAssign PtrRep stgHp safeHp
- (r1,r2,r3) = fromStruct result3 (ar1,sr1,dr1)
- (r4,r5,r6) = fromStruct result4 (ar2,sr2,dr2)
-
- in
- heapCheck liveness space (StInt 0) `thenUs` \ heap_chk ->
-
- returnUs (heap_chk .
- (\xs -> a1 : a2 : a3 : a4 : a5 : a6
- : save : init3 : init4 : mpz_op
- : r1 : r2 : r3 : r4 : r5 : r6 : restore : xs))