Ajout de pseudo-registres supplementaires pour le passage de plus de 6 arguments

xavierleroy · xavierleroy · commit af9b98fcbbe6 · 2004-08-12T13:37:12.000Z
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@6593 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
diff --git a/asmcomp/i386/emit.mlp b/asmcomp/i386/emit.mlp
@@ -37,12 +37,16 @@ let frame_size () =                     (* includes return address *)
 
 let slot_offset loc cl =
   match loc with
-    Incoming n -> frame_size() + n
+    Incoming n ->
+      assert (n >= 0);
+      frame_size() + n
   | Local n ->
       if cl = 0
       then !stack_offset + n * 4
       else !stack_offset + num_stack_slots.(0) * 4 + n * 8
-  | Outgoing n -> n
+  | Outgoing n ->
+      assert (n >= 0);
+      n
 
 (* Prefixing of symbols with "_" *)
 
@@ -107,6 +111,8 @@ let emit_Llabel fallthrough lbl =
 let emit_reg = function
     { loc = Reg r } ->
       emit_string (register_name r)
+  | { loc = Stack(Incoming n | Outgoing n) } when n < 0 ->
+      `caml_extra_params + {emit_int (n + 64)}`
   | { loc = Stack s } as r ->
       let ofs = slot_offset s (register_class r) in
       `{emit_int ofs}(%esp)`
diff --git a/asmcomp/i386/proc.ml b/asmcomp/i386/proc.ml
@@ -88,12 +88,23 @@ let word_addressed = false
 
 (* Calling conventions *)
 
+(* To supplement the processor's meagre supply of registers, we also
+   use some global memory locations to pass arguments beyond the 6th.
+   These globals are denoted by Incoming and Outgoing stack locations
+   with negative offsets, starting at -64.
+   Unlike arguments passed on stack, arguments passed in globals
+   do not prevent tail-call elimination.  The caller stores arguments
+   in these globals immediately before the call, and the first thing the 
+   callee does is copy them to registers or stack locations.
+   Neither GC nor thread context switches can occur between these two
+   times. *)
+
 let calling_conventions first_int last_int first_float last_float make_stack
                         arg =
   let loc = Array.create (Array.length arg) Reg.dummy in
   let int = ref first_int in
   let float = ref first_float in
-  let ofs = ref 0 in
+  let ofs = ref (-64) in
   for i = 0 to Array.length arg - 1 do
     match arg.(i).typ with
       Int | Addr as ty ->
@@ -113,7 +124,7 @@ let calling_conventions first_int last_int first_float last_float make_stack
           ofs := !ofs + size_float
         end
   done;
-  (loc, !ofs)
+  (loc, max 0 !ofs)
 
 let incoming ofs = Incoming ofs
 let outgoing ofs = Outgoing ofs
diff --git a/asmrun/i386.S b/asmrun/i386.S
@@ -324,3 +324,11 @@ G(caml_system__frametable):
         .value  -1              /* negative frame size => use callback link */
         .value  0               /* no roots here */
 #endif
+
+        .globl  G(caml_extra_params)
+G(caml_extra_params):
+#ifndef SYS_solaris
+        .space  64
+#else
+        .zero   64
+#endif
