Integration du mini-GC.

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@65 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

3 files changed, 15 insertions, 99 deletions

diff --git a/asmrun/Makefile b/asmrun/Makefile
index 09f4f7821..ac74661b3 100644
--- a/asmrun/Makefile
+++ b/asmrun/Makefile
@@ -1,10 +1,11 @@
 ARCH=alpha
 CC=gcc
-CFLAGS=-g
+CFLAGS=-O2 -Wall
+#CFLAGS=-g -DDEBUG -Wall
 AS=as
 ASFLAGS=-O2 -g
 
-OBJS=runtime.o $(ARCH).o
+OBJS=runtime.o gc.o debug.o compare.o $(ARCH).o
 
 librun.a: $(OBJS)
 	rm -f librun.a
@@ -18,3 +19,5 @@ librun.a: $(OBJS)
 
 clean::
 	rm -f *.o *.s *.a *~
+
+runtime.o gc.o compare.o debug.o: mlvalues.h misc.h
diff --git a/asmrun/alpha.asm b/asmrun/alpha.asm
index f64a4db93..d3de22d26 100644
--- a/asmrun/alpha.asm
+++ b/asmrun/alpha.asm
@@ -100,6 +100,8 @@ $103:   ldgp    $gp, 0($26)
         stq     $24, caml_last_return_address
         lda     $24, 16($sp)
         stq     $24, caml_bottom_of_stack
+    /* Save current allocation pointer for debugging purposes */
+        stq     $13, young_ptr
     /* Save all regs used by the code generator in the arrays
     /* gc_entry_regs and gc_entry_float_regs. */
         SAVE_ALL_REGS
@@ -200,6 +202,7 @@ caml_c_call:
 /* Start the Caml program */
 
         .globl  caml_start_program
+        .globl  stray_exn_handler
         .ent    caml_start_program
         .align  3
 caml_start_program:
@@ -273,6 +276,6 @@ raise_caml_exception:
         ldq     $15, 0($sp)
         ldq     $27, 8($sp)
         lda     $sp, 16($sp)
-        jmp     ($27)
+        jmp     $26, ($27)      /* Keep retaddr in $26 to help debugging */
 
         .end    raise_caml_exception
diff --git a/asmrun/runtime.c b/asmrun/runtime.c
index 8d20c103f..2285413ea 100644
--- a/asmrun/runtime.c
+++ b/asmrun/runtime.c
@@ -2,34 +2,10 @@
 
 #include <stdio.h>
 #include <stdlib.h>
-
-int heapsize = 1024 * 1024;     /* 1M */
-char * young_start, * young_ptr, * young_end;
-char * remembered_set[4096];
-char ** remembered_ptr = remembered_set;
-char ** remembered_end = remembered_set + 4096;
-
-void garbage_collection(request)
-     int request;
-{
-  young_start = malloc(heapsize);
-  if (young_start == NULL) {
-    fprintf(stderr, "Out of heap size\n");
-    exit(2);
-  }
-  young_end = young_start + heapsize;
-  young_ptr = young_end - request;
-}
-
-void realloc_remembered()
-{
-  remembered_ptr = remembered_set;
-}
+#include "mlvalues.h"
 
 extern int caml_start_program();
 
-typedef long value;
-
 value print_int(n)
      value n;
 {
@@ -44,79 +20,13 @@ value print_string(s)
   return 1;
 }
 
-value equal(v1, v2)
-     value v1, v2;
-{
-  value * p1, * p2;
-  value hdr1, hdr2, size, i;
-
- tailcall:
-  if (v1 == v2) return 3;       /* true */
-  if (v1 & 1) return 1;         /* false */
-  if (v1 & 1) return 1;         /* false */
-  p1 = (value *) v1;
-  p2 = (value *) v2;
-  hdr1 = p1[-1];
-  hdr2 = p2[-1];
-  if (hdr1 != hdr2) return 1;   /* false */
-  size = hdr1 >> 10;
-  switch(hdr1 & 0xFF) {
-  case 251:
-    fprintf(stderr, "equal between functions\n");
-    exit(2);
-  case 253:
-    for (i = 0; i < size; i++)
-      if (p1[i] != p2[i]) return 1;
-    return 3;
-  case 254:
-    if (*((double *) v1) = *((double *) v2)) return 3; else return 1;
-  default:
-    for (i = 0; i < size-1; i++)
-      if (equal(p1[i], p2[i]) == 1) return 1;
-    v1 = p1[i];
-    v2 = p2[i];
-    goto tailcall;
-  }
-}
-
-value notequal(v1, v2)
-     value v1, v2;
-{
-  return (4 - equal(v1, v2));
-}
-
-#define COMPARISON(name) \
-value name(v1, v2) \
-     value v1, v2; \
-{ \
-  fprintf(stderr, "%s not implemented.\n", #name); \
-  exit(2); \
-}
-
-COMPARISON(greaterequal)
-COMPARISON(lessequal)
-COMPARISON(greaterthan)
-COMPARISON(lessthan)
-
-value alloc_dummy(size)
-     int size;
-{
-  value * block;
-  int bsize, i;
-
-  bsize = (size + 1) * sizeof(value);
-  young_ptr -= bsize;
-  if (young_ptr < young_start) garbage_collection(bsize);
-  block = (value *) young_ptr + 1;
-  block[-1] = size << 10;
-  for (i = 0; i < size; i++) block[i] = 0;
-  return (value) block;
-}
-
 static struct {
   value header;
   char data[16];
-} match_failure_id = { 0, "Match_failure" }; /* to be revised */
+} match_failure_id = {
+  ((16 / sizeof(value)) << 11) + 0xFC,
+  "Match_failure\0\0\2"
+};
 
 char * Match_failure = match_failure_id.data;
 
@@ -124,7 +34,7 @@ int main(argc, argv)
      int argc;
      char ** argv;
 {
-  garbage_collection(0);
+  init_heap();
   if (caml_start_program() != 0) {
     fprintf(stderr, "Uncaught exception\n");
     exit(2);