Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/trunk/src/MLRISC/sparc/c-calls/sparc-c-calls.sml
ViewVC logotype

Diff of /sml/trunk/src/MLRISC/sparc/c-calls/sparc-c-calls.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1043, Mon Jan 28 21:26:03 2002 UTC revision 1552, Fri Jul 16 18:00:22 2004 UTC
# Line 68  Line 68 
68      val mem = T.Region.memory      val mem = T.Region.memory
69      val stack = T.Region.memory      val stack = T.Region.memory
70    
71        val maxRegArgs = 6
72      val paramAreaOffset = 68      val paramAreaOffset = 68
73    
74      fun LI i = T.LI (T.I.fromInt (32, i))      fun LI i = T.LI (T.I.fromInt (32, i))
# Line 77  Line 78 
78    
79      fun greg r = GP r      fun greg r = GP r
80      fun oreg r = GP (r + 8)      fun oreg r = GP (r + 8)
81        fun ireg r = GP (r + 24)
82      fun freg r = FP r      fun freg r = FP r
83    
84      fun reg32 r = T.REG (32, r)      fun reg32 r = T.REG (32, r)
# Line 135  Line 137 
137          in          in
138              pack (0, 1, l)              pack (0, 1, l)
139          end          end
140          | szal (Ty.C_UNION l) =
141            let (* m: current max size
142                 * a: current total alignment *)
143                fun overlay (m, a, []) = (roundup (m, a), a)
144                  | overlay (m, a, t :: tl) =
145                    let val (ts, ta) = szal t
146                    in
147                        overlay (Int.max (m, ts), Int.max (a, ta), tl)
148                    end
149            in
150                overlay (0, 1, l)
151            end
152    
153    (**** START NEW CODE ****)
154    
155      (* the location of arguments/parameters; offsets are given with respect to the
156       * low end of the parameter area (see paramAreaOffset above).
157       *)
158        datatype arg_location
159          = Reg of T.ty * T.reg * T.I.machine_int option
160                                            (* integer/pointer argument in register *)
161          | FReg of T.fty * T.reg * T.I.machine_int option
162                                            (* floating-point argument in register *)
163          | Stk of T.ty * T.I.machine_int   (* integer/pointer argument in parameter area *)
164          | FStk of T.fty * T.I.machine_int (* floating-point argument in parameter area *)
165          | Args of arg_location list
166    
167        fun layout {conv, retTy, paramTys} = let
168              in
169                raise Fail "layout not implemented yet"
170              end
171    
172      (* C callee-save registers *)
173        val calleeSaveRegs = (* %l0-%l7 and %i0-%i7 *)
174              List.tabulate (16, fn r => GP(r+16))
175        val calleeSaveFRegs = []
176    
177    (**** END NEW CODE ****)
178    
179      fun genCall { name, proto, paramAlloc, structRet, saveRestoreDedicated,      fun genCall { name, proto, paramAlloc, structRet, saveRestoreDedicated,
180                    callComment, args } = let                    callComment, args } = let
# Line 145  Line 185 
185                                          String.toString conv, "\""])                                          String.toString conv, "\""])
186          val res_szal =          val res_szal =
187              case retTy of              case retTy of
188                  (Ty.C_long_double | Ty.C_STRUCT _) => SOME (szal retTy)                  (Ty.C_long_double | Ty.C_STRUCT _ | Ty.C_UNION _) =>
189                      SOME (szal retTy)
190                | _ => NONE                | _ => NONE
191    
192          val nargwords = let          val nargwords = let
# Line 159  Line 200 
200              loop (paramTys, 0)              loop (paramTys, 0)
201          end          end
202    
203          val regargwords = Int.min (nargwords, 6)          val regargwords = Int.min (nargwords, maxRegArgs)
204          val stackargwords = Int.max (nargwords, 6) - 6          val stackargwords = Int.max (nargwords, maxRegArgs) - maxRegArgs
205    
206            val stackargsstart = paramAreaOffset + 4 * maxRegArgs
207    
208          val scratchstart = 92 + 4*stackargwords          val scratchstart = stackargsstart + 4 * stackargwords
209    
210          (* Copy struct or part thereof to designated area on the stack.          (* Copy struct or part thereof to designated area on the stack.
211           * An already properly aligned address (relative to %sp) is           * An already properly aligned address (relative to %sp) is
212           * in to_off. *)           * in to_off. *)
213          fun struct_copy (sz, al, ARG a, t, to_off, cpc) =          fun struct_copy (sz, al, ARG a, t, to_off, cpc) =
214              (* Two main cases here:              (* Two main cases here:
215               *   1. t is C_STRUCT _: in this case "a" computes the address               *   1. t is C_STRUCT _ or C_UNION _;
216                 *      in this case "a" computes the address
217               *      of the struct to be copied.               *      of the struct to be copied.
218               *   2. t is some other non-floating type; "a" computes the               *   2. t is some other non-floating type; "a" computes the
219               *      the corresponding value (i.e., not its address).               *      the corresponding value (i.e., not its address).
# Line 188  Line 232 
232                       Ty.C_unsigned Ty.I_long_long) => ldst 64                       Ty.C_unsigned Ty.I_long_long) => ldst 64
233                    | (Ty.C_ARRAY _) =>                    | (Ty.C_ARRAY _) =>
234                      error "ARRAY within gather/scatter struct"                      error "ARRAY within gather/scatter struct"
235                    | (Ty.C_STRUCT _) =>                    | (Ty.C_STRUCT _ | Ty.C_UNION _) =>
236                      (* Here we have to do the equivalent of a "memcpy". *)                      (* Here we have to do the equivalent of a "memcpy". *)
237                      let val from = a (* argument is address of struct *)                      let val from = a (* argument is address of struct *)
238                          fun cp (ty, incr) = let                          fun cp (ty, incr) = let
# Line 216  Line 260 
260                    | (Ty.C_float | Ty.C_double | Ty.C_long_double) =>                    | (Ty.C_float | Ty.C_double | Ty.C_long_double) =>
261                      error "floating point type does not match ARG"                      error "floating point type does not match ARG"
262              end              end
263    (*
264            | struct_copy (_, _, ARGS args, Ty.C_STRUCT tl, to_off, cpc) =            | struct_copy (_, _, ARGS args, Ty.C_STRUCT tl, to_off, cpc) =
265              (* gather/scatter case *)              (* gather/scatter case *)
266              let fun loop ([], [], _, cpc) = cpc              let fun loop ([], [], _, cpc) = cpc
# Line 231  Line 276 
276              in              in
277                  loop (tl, args, to_off, cpc)                  loop (tl, args, to_off, cpc)
278              end              end
279    *)
280            | struct_copy (_, _, ARGS _, _, _, _) =            | struct_copy (_, _, ARGS _, _, _, _) =
281              error "gather/scatter for non-struct"                error "gather/scatter (ARGS) not supported (obsolete)"
282            | struct_copy (sz, al, FARG a, t, to_off, cpc) =            | struct_copy (sz, al, FARG a, t, to_off, cpc) =
283              let fun fldst ty =              let fun fldst ty =
284                     T.FSTORE (ty, addli (spreg, to_off), a, stack) :: cpc                     T.FSTORE (ty, addli (spreg, to_off), a, stack) :: cpc
# Line 245  Line 291 
291              end              end
292    
293          val (stackdelta, argsetupcode, copycode) = let          val (stackdelta, argsetupcode, copycode) = let
294              fun loop ([], [], _, ss, asc, cpc) = (roundup (ss, 8), asc, cpc)              fun loop ([], [], _, ss, asc, cpc) =
295                    (roundup (Int.max (0, ss - stackargsstart), 8), asc, cpc)
296                | loop (t :: tl, a :: al, n, ss, asc, cpc) = let                | loop (t :: tl, a :: al, n, ss, asc, cpc) = let
297                      fun wordassign a =                      fun wordassign a =
298                          if n < 6 then T.MV (32, oreg n, a)                          if n < 6 then T.MV (32, oreg n, a)
# Line 340  Line 387 
387                                       T.FSTORE (128, ssaddr, a, stack) :: cpc,                                       T.FSTORE (128, ssaddr, a, stack) :: cpc,
388                                       ss' + 16)                                       ss' + 16)
389                          end                          end
390                        | (t as Ty.C_STRUCT _, a) => let                        | (t as (Ty.C_STRUCT _ | Ty.C_UNION _), a) => let
391                              (* copy entire struct into scratch space                              (* copy entire struct into scratch space
392                               * (aligned according to struct's alignment                               * (aligned according to struct's alignment
393                               * requirements).  The address of the scratch                               * requirements).  The address of the scratch
# Line 377  Line 424 
424    
425              val defs = g_regs @ a_regs @ l_reg :: f_regs              val defs = g_regs @ a_regs @ l_reg :: f_regs
426              (* A call instruction "uses" just the argument registers. *)              (* A call instruction "uses" just the argument registers. *)
427              val uses = List.take (a_regs, stackargwords)              val uses = List.take (a_regs, regargwords)
428          in          in
429              (defs, uses)              (defs, uses)
430          end          end
# Line 387  Line 434 
434                  Ty.C_float => [T.FPR (T.FREG (32, FP 0))]                  Ty.C_float => [T.FPR (T.FREG (32, FP 0))]
435                | Ty.C_double => [T.FPR (T.FREG (64, FP 0))] (* %f0/%f1 *)                | Ty.C_double => [T.FPR (T.FREG (64, FP 0))] (* %f0/%f1 *)
436                | Ty.C_long_double => []                | Ty.C_long_double => []
437                | Ty.C_STRUCT _ => []                | (Ty.C_STRUCT _ | Ty.C_UNION _) => []
438                | Ty.C_ARRAY _ => error "array return type"                | Ty.C_ARRAY _ => error "array return type"
439                | (Ty.C_PTR | Ty.C_void |                | (Ty.C_PTR | Ty.C_void |
440                   Ty.C_signed (Ty.I_int | Ty.I_long) |                   Ty.C_signed (Ty.I_int | Ty.I_long) |
# Line 422  Line 469 
469                | SOME c =>                | SOME c =>
470                  T.ANNOTATION (call, #create MLRiscAnnotations.COMMENT c)                  T.ANNOTATION (call, #create MLRiscAnnotations.COMMENT c)
471    
472            val (sp_sub, sp_add) =
473                if stackdelta = 0 then ([], []) else
474                if paramAlloc { szb = stackdelta, align = 4 } then ([], [])
475                else ([T.MV (32, sp, T.SUB (32, spreg, LI stackdelta))],
476                      [T.MV (32, sp, addli (spreg, stackdelta))])
477    
478          val callseq =          val callseq =
479              List.concat [[T.MV (32, sp, T.SUB (32, spreg, LI stackdelta))],              List.concat [sp_sub,
480                           copycode,                           copycode,
481                           argsetupcode,                           argsetupcode,
482                           sretsetup,                           sretsetup,
# Line 431  Line 484 
484                           [call],                           [call],
485                           srethandshake,                           srethandshake,
486                           restore,                           restore,
487                           [T.MV (32, sp, addli (spreg, stackdelta))]]                           sp_add]
488    
489      in      in
490          { callseq = callseq, result = result }          { callseq = callseq, result = result }

Legend:
Removed from v.1043  
changed lines
  Added in v.1552

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0