- -- function names that begin with '.' are assumed to be special
- -- internally generated names like '.mul,' which don't get an
- -- underscore prefix
- -- ToDo:needed (WDP 96/03) ???
- fn__2 = case (_HEAD_ fn) of
- '.' -> ImmLit (ptext fn)
- _ -> ImmLab False (ptext fn)
-
- ------------------------------------
- {- Try to get a value into a specific register (or registers) for
- a call. The SPARC calling convention is an absolute
- nightmare. The first 6x32 bits of arguments are mapped into
- %o0 through %o5, and the remaining arguments are dumped to the
- stack, beginning at [%sp+92]. (Note that %o6 == %sp.) Our
- first argument is a pair of the list of remaining argument
- registers to be assigned for this call and the next stack
- offset to use for overflowing arguments. This way,
- @get_arg@ can be applied to all of a call's arguments using
- @mapAccumL@.
-
- If we have to put args on the stack, move %o6==%sp down by
- 8 x the number of args, to ensure there's enough space.
- -}
- get_arg
- :: ([Reg],Int) -- Argument registers and stack offset (accumulator)
- -> StixTree -- Current argument
- -> NatM (([Reg],Int), InstrBlock) -- Updated accumulator and code
-
- -- We have to use up all of our argument registers first...
-
- get_arg (dst:dsts, offset) arg
- = getRegister arg `thenNat` \ register ->
- getNewRegNCG (registerRep register)
- `thenNat` \ tmp ->
- let
- reg = if isFloatingRep pk then tmp else dst
- code = registerCode register reg
- src = registerName register reg
- pk = registerRep register
- in
- returnNat (
- case pk of
- DoubleRep ->
- case dsts of
- [] -> ( ([], offset + 1),
- code `snocOL`
- -- put the second part in the right stack
- -- and load the first part into %o5
- FMOV DF src f0 `snocOL`
- ST F f0 (spRel offset) `snocOL`
- LD W (spRel offset) dst `snocOL`
- ST F (fPair f0) (spRel offset)
- )
- (dst__2:dsts__2)
- -> ( (dsts__2, offset),
- code `snocOL`
- FMOV DF src f0 `snocOL`
- ST F f0 (spRel 16) `snocOL`
- LD W (spRel 16) dst `snocOL`
- ST F (fPair f0) (spRel 16) `snocOL`
- LD W (spRel 16) dst__2
- )
- FloatRep
- -> ( (dsts, offset),
- code `snocOL`
- ST F src (spRel 16) `snocOL`
- LD W (spRel 16) dst
- )
- _ -> ( (dsts, offset),
- if isFixed register
- then code `snocOL` OR False g0 (RIReg src) dst
- else code
- )
- )
- -- Once we have run out of argument registers, we move to the
- -- stack...
-
- get_arg ([], offset) arg
- = getRegister arg `thenNat` \ register ->
- getNewRegNCG (registerRep register)
- `thenNat` \ tmp ->
- let
- code = registerCode register tmp
- src = registerName register tmp
- pk = registerRep register
- sz = primRepToSize pk
- words = if pk == DoubleRep then 2 else 1
- in
- returnNat ( ([], offset + words),
- code `snocOL` ST sz src (spRel offset) )
-
+ -- function names that begin with '.' are assumed to be special
+ -- internally generated names like '.mul,' which don't get an
+ -- underscore prefix
+ -- ToDo:needed (WDP 96/03) ???
+ fn__2 = case (_HEAD_ fn) of
+ '.' -> ImmLit (ptext fn)
+ _ -> ImmLab False (ptext fn)
+
+ -- move args from the integer vregs into which they have been
+ -- marshalled, into %o0 .. %o5, and the rest onto the stack.
+ move_final :: [Reg] -> [Reg] -> Int -> [Instr]
+
+ move_final [] _ offset -- all args done
+ = []
+
+ move_final (v:vs) [] offset -- out of aregs; move to stack
+ = ST W v (spRel offset)
+ : move_final vs [] (offset+1)
+
+ move_final (v:vs) (a:az) offset -- move into an arg (%o[0..5]) reg
+ = OR False g0 (RIReg v) a
+ : move_final vs az offset
+
+ -- generate code to calculate an argument, and move it into one
+ -- or two integer vregs.
+ arg_to_int_vregs :: StixTree -> NatM (OrdList Instr, [Reg])
+ arg_to_int_vregs arg
+ = getRegister arg `thenNat` \ register ->
+ getNewRegNCG (registerRep register) `thenNat` \ tmp ->
+ let code = registerCode register tmp
+ src = registerName register tmp
+ pk = registerRep register
+ in
+ -- the value is in src. Get it into 1 or 2 int vregs.
+ case pk of
+ DoubleRep ->
+ getNewRegNCG WordRep `thenNat` \ v1 ->
+ getNewRegNCG WordRep `thenNat` \ v2 ->
+ returnNat (
+ code `snocOL`
+ FMOV DF src f0 `snocOL`
+ ST F f0 (spRel 16) `snocOL`
+ LD W (spRel 16) v1 `snocOL`
+ ST F (fPair f0) (spRel 16) `snocOL`
+ LD W (spRel 16) v2
+ ,
+ [v1,v2]
+ )
+ FloatRep ->
+ getNewRegNCG WordRep `thenNat` \ v1 ->
+ returnNat (
+ code `snocOL`
+ ST F src (spRel 16) `snocOL`
+ LD W (spRel 16) v1
+ ,
+ [v1]
+ )
+ other ->
+ getNewRegNCG WordRep `thenNat` \ v1 ->
+ returnNat (
+ code `snocOL` OR False g0 (RIReg src) v1
+ ,
+ [v1]
+ )