Premier jet d'un runtime pour le code natif.

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

4 files changed, 611 insertions, 0 deletions

diff --git a/asmrun/Makefile b/asmrun/Makefile
new file mode 100644
index 000000000..09f4f7821
--- /dev/null
+++ b/asmrun/Makefile
@@ -0,0 +1,20 @@
+ARCH=alpha
+CC=gcc
+CFLAGS=-g
+AS=as
+ASFLAGS=-O2 -g
+
+OBJS=runtime.o $(ARCH).o
+
+librun.a: $(OBJS)
+	rm -f librun.a
+	ar rc librun.a $(OBJS)
+	ranlib librun.a
+
+.SUFFIXES: .asm .o
+
+.asm.o:
+	$(AS) $(ASFLAGS) -o $*.o $*.asm
+
+clean::
+	rm -f *.o *.s *.a *~
diff --git a/asmrun/alpha.asm b/asmrun/alpha.asm
new file mode 100644
index 000000000..f64a4db93
--- /dev/null
+++ b/asmrun/alpha.asm
@@ -0,0 +1,278 @@
+/* Asm part of the runtime system, Alpha processor */
+
+        .comm   young_start 8
+        .comm   young_end 8
+        .comm   young_ptr 8
+        .comm   gc_entry_regs 8 * 32
+        .comm   gc_entry_float_regs 8 * 32
+        .comm   caml_top_of_stack 8
+        .comm   caml_bottom_of_stack 8
+        .comm   caml_last_return_address 8
+        .comm   caml_exception_pointer 8
+        .comm   remembered_ptr 8
+        .comm   remembered_end 8
+
+#define SAVE(r) stq $/**/r, r * 8 ($24)
+#define LOAD(r) ldq $/**/r, r * 8 ($24)
+#define FSAVE(r) stt $f/**/r, r * 8 ($24)
+#define FLOAD(r) ldt $f/**/r, r * 8 ($24)
+
+#define SAVE_ALL_REGS \
+    lda     $24, gc_entry_regs; \
+    SAVE(0); SAVE(1); SAVE(2); SAVE(3); SAVE(4); SAVE(5); SAVE(6); SAVE(7); \
+    SAVE(8); SAVE(9); SAVE(10); SAVE(11); SAVE(12); \
+    SAVE(16); SAVE(17); SAVE(18); SAVE(19); SAVE(20); SAVE(21); \
+    lda     $24, gc_entry_float_regs; \
+    FSAVE(0); FSAVE(1); FSAVE(10); FSAVE(11); FSAVE(12); FSAVE(13); \
+    FSAVE(14); FSAVE(15); FSAVE(16); FSAVE(17); FSAVE(18); FSAVE(19); \
+    FSAVE(20); FSAVE(21); FSAVE(22); FSAVE(23); FSAVE(24); FSAVE(25); \
+    FSAVE(26); FSAVE(27); FSAVE(28)
+
+#define LOAD_ALL_REGS \
+    lda     $24, gc_entry_regs; \
+    LOAD(0); LOAD(1); LOAD(2); LOAD(3); LOAD(4); LOAD(5); LOAD(6); LOAD(7); \
+    LOAD(8); LOAD(9); LOAD(10); LOAD(11); LOAD(12); \
+    LOAD(16); LOAD(17); LOAD(18); LOAD(19); LOAD(20); LOAD(21); \
+    lda     $24, gc_entry_float_regs; \
+    FLOAD(0); FLOAD(1); FLOAD(10); FLOAD(11); FLOAD(12); FLOAD(13); \
+    FLOAD(14); FLOAD(15); FLOAD(16); FLOAD(17); FLOAD(18); FLOAD(19); \
+    FLOAD(20); FLOAD(21); FLOAD(22); FLOAD(23); FLOAD(24); FLOAD(25); \
+    FLOAD(26); FLOAD(27); FLOAD(28)
+
+/* Allocation */
+
+        .text
+        .globl  caml_alloc1
+        .globl  caml_alloc2
+        .globl  caml_alloc3
+        .globl  caml_alloc
+        .globl  caml_call_gc
+        .ent    caml_alloc1
+
+/* caml_alloc* : all code generator registers preserved,
+   $gp preserved, $27 not valid on entry */
+
+        .align  3
+caml_alloc1:
+        subq    $13, 16, $13
+        cmpult  $13, $14, $25
+        bne     $25, $100
+        ret     ($26)
+$100:   ldiq    $25, 16
+        br      caml_call_gc
+
+        .align  3
+caml_alloc2:
+        subq    $13, 24, $13
+        cmpult  $13, $14, $25
+        bne     $25, $101
+        ret     ($26)
+$101:   ldiq    $25, 24
+        br      caml_call_gc
+
+        .align  3
+caml_alloc3:
+        subq    $13, 32, $13
+        cmpult  $13, $14, $25
+        bne     $25, $102
+        ret     ($26)
+$102:   ldiq    $25, 32
+        br      caml_call_gc
+
+        .align  3
+caml_alloc:
+        subq    $13, $25, $13
+        .set    noat
+        cmpult  $13, $14, $at
+        bne     $at, caml_call_gc
+        .set    at
+        ret     ($26)
+        
+caml_call_gc:
+        lda     $sp, -16($sp)
+        stq     $26, 0($sp)
+        stq     $gp, 8($sp)
+    /* Rebuild $gp */
+        br      $26, $103
+$103:   ldgp    $gp, 0($26)
+    /* Record lowest stack address and return address */
+        ldq     $24, 0($sp)
+        stq     $24, caml_last_return_address
+        lda     $24, 16($sp)
+        stq     $24, caml_bottom_of_stack
+    /* Save all regs used by the code generator in the arrays
+    /* gc_entry_regs and gc_entry_float_regs. */
+        SAVE_ALL_REGS
+    /* Pass the desired size as first argument */
+        mov     $25, $16
+    /* Call the garbage collector */
+        jsr     garbage_collection
+    /* Restore all regs used by the code generator */
+        ldgp    $gp, 0($26)
+        LOAD_ALL_REGS
+    /* Reload new allocation pointer and allocation limit */
+        ldq     $13, young_ptr
+        ldq     $14, young_start
+    /* Return to caller */
+        ldq     $26, 0($sp)
+        ldq     $gp, 8($sp)
+        lda     $sp, 16($sp)
+        ret     ($26)
+
+        .end    caml_alloc1
+
+/* Modification */
+
+        .globl  caml_modify
+        .globl  caml_fast_modify
+        .ent    caml_modify
+
+        .align  3
+caml_modify:
+    /* Pointer to block in $25 */
+        ldgp    $gp, 0($27)
+        ldq     $24, -8($25)
+        .set    noat
+        and     $24, 1024, $at
+        beq     $at, $104
+        .set    at
+        ret     ($26)
+
+        .align  3
+caml_fast_modify:
+    /* Pointer to block in $25, header in $24 */
+        ldgp    $gp, 0($27)
+    /* Set "modified" bit in header */
+$104:   or      $24, 1024, $24
+        stq     $24, -8($25)
+    /* Store address of object in remembered set */
+        ldq     $24, remembered_ptr
+        stq     $25, 0($24)
+        addq    $24, 8, $25
+        stq     $25, remembered_ptr
+        ldq     $24, remembered_end
+        cmplt   $25, $24, $25
+        beq     $25, caml_modify_realloc
+        ret     ($26)
+        .set    at
+
+    /* Reallocate the remembered set, while preserving all regs */
+caml_modify_realloc:
+        lda     $sp, -16($sp)
+        stq     $26, 0($sp)
+        SAVE_ALL_REGS
+        jsr     realloc_remembered
+        LOAD_ALL_REGS
+        ldq     $26, 0($sp)
+        lda     $sp, 16($sp)
+        ret     ($26)
+
+        .end    caml_modify
+
+/* Call a C function from Caml */
+
+        .globl  caml_c_call
+        .ent    caml_c_call
+
+        .align  3
+caml_c_call:
+    /* Function to call in $25 */
+        ldgp    $gp, 0($27)
+    /* Record lowest stack address and return address */
+        stq     $26, caml_last_return_address
+        stq     $sp, caml_bottom_of_stack
+    /* Make the exception handler and alloc ptr available to the C code */
+        stq     $13, young_ptr
+        stq     $15, caml_exception_pointer
+    /* Preserve return address */
+        mov     $26, $13
+    /* Call the function */
+        mov     $25, $27
+        jsr     ($25)
+    /* Restore return address and alloc ptr */
+        ldgp    $gp, 0($26)
+        mov     $13, $26
+        ldq     $13, young_ptr
+        ret     ($26)
+
+        .end    caml_c_call
+
+/* Start the Caml program */
+
+        .globl  caml_start_program
+        .ent    caml_start_program
+        .align  3
+caml_start_program:
+	lda	$sp, -128($sp)
+        stq     $26, 0($sp)
+    /* Save all callee-save registers */
+        stq     $9, 8($sp)
+        stq     $10, 16($sp)
+        stq     $11, 24($sp)
+        stq     $12, 32($sp)
+        stq     $13, 40($sp)
+        stq     $14, 48($sp)
+        stq     $15, 56($sp)
+        stt     $f2, 64($sp)
+        stt     $f3, 72($sp)
+        stt     $f4, 80($sp)
+        stt     $f5, 88($sp)
+        stt     $f6, 96($sp)
+        stt     $f7, 104($sp)
+        stt     $f8, 112($sp)
+        stt     $f9, 120($sp)
+    /* Build an exception handler */
+	lda	$sp, -16($sp)
+	lda	$0, stray_exn_handler
+	stq	$0, 8($sp)
+	mov	$sp, $15
+        stq     $sp, caml_top_of_stack
+    /* Initialize allocation registers */
+	ldq	$13, young_ptr
+	ldq	$14, young_start
+    /* Go for it */
+        jsr     caml_program
+    /* Pop handler */
+        lda     $sp, 16($sp)
+    /* Return with zero code */
+        clr     $0
+    /* Restore registers */
+stray_exn_handler:
+        ldq     $26, 0($sp)
+        ldq     $9, 8($sp)
+        ldq     $10, 16($sp)
+        ldq     $11, 24($sp)
+        ldq     $12, 32($sp)
+        ldq     $13, 40($sp)
+        ldq     $14, 48($sp)
+        ldq     $15, 56($sp)
+        ldt     $f2, 64($sp)
+        ldt     $f3, 72($sp)
+        ldt     $f4, 80($sp)
+        ldt     $f5, 88($sp)
+        ldt     $f6, 96($sp)
+        ldt     $f7, 104($sp)
+        ldt     $f8, 112($sp)
+        ldt     $f9, 120($sp)
+        lda     $sp, 128($sp)
+        ret     ($26)
+
+        .end    caml_start_program
+
+/* Raise an exception from C */
+
+        .globl  raise_caml_exception
+        .ent    raise_caml_exception
+        .align  3
+raise_caml_exception:
+        ldgp    $gp, 0($27)
+        mov     $16, $0
+        ldq     $13, young_ptr
+        ldq     $14, young_start
+        ldq     $sp, caml_exception_pointer
+        ldq     $15, 0($sp)
+        ldq     $27, 8($sp)
+        lda     $sp, 16($sp)
+        jmp     ($27)
+
+        .end    raise_caml_exception
diff --git a/asmrun/i386.asm b/asmrun/i386.asm
new file mode 100644
index 000000000..d69c7f78b
--- /dev/null
+++ b/asmrun/i386.asm
@@ -0,0 +1,179 @@
+# Asm part of the runtime system, Intel 386 processor
+
+        .comm   _young_start, 4
+        .comm   _young_ptr, 4
+        .comm   _gc_entry_regs, 4 * 7
+        .comm   _caml_bottom_of_stack, 4
+        .comm   _caml_last_return_address, 4
+        .comm   _remembered_ptr, 4
+        .comm   _remembered_end, 4
+        .comm   _caml_exception_pointer, 4
+
+# Allocation
+
+        .text
+        .globl  _caml_alloc1
+        .globl  _caml_alloc2
+        .globl  _caml_alloc3
+        .globl  _caml_alloc
+	.globl  _caml_call_gc
+
+        .align  4
+_caml_alloc1:
+        movl    _young_ptr, %eax
+        subl    $8, %eax
+        movl    %eax, _young_ptr
+        cmpl    _young_start, %eax
+        jb      L100
+        ret
+L100:   movl    $8, %eax
+        jmp     _caml_call_gc
+
+        .align  4
+_caml_alloc2:
+        movl    _young_ptr, %eax
+        subl    $12, %eax
+        movl    %eax, _young_ptr
+        cmpl    _young_start, %eax
+        jb      L101
+        ret
+L101:   movl    $12, %eax
+        jmp     _caml_call_gc
+
+        .align  4
+_caml_alloc3:
+        movl    _young_ptr, %eax
+        subl    $16, %eax
+        movl    %eax, _young_ptr
+        cmpl    _young_start, %eax
+        jb      L102
+        ret
+L102:   movl    $16, %eax
+        jmp     _caml_call_gc
+
+        .align  4
+_caml_alloc:
+        pushl   %eax
+        movl    _young_ptr, %eax
+        subl    (%esp), %eax
+        movl    %eax, _young_ptr
+        cmpl    _young_start, %eax
+        jb      L103
+        addl    $4, %esp
+        ret
+L103:   popl    %eax
+
+_caml_call_gc:
+    # Record lowest stack address and return address
+        popl    _caml_last_return_address
+        movl    %esp, _caml_bottom_of_stack
+    # Save all regs used by the code generator
+        movl    %ebx, _gc_entry_regs + 4
+        movl    %ecx, _gc_entry_regs + 8
+        movl    %edx, _gc_entry_regs + 12
+        movl    %esi, _gc_entry_regs + 16
+        movl    %edi, _gc_entry_regs + 20
+        movl    %ebp, _gc_entry_regs + 24
+    # Pass the desired size as first argument
+        pushl   %eax
+    # Call the garbage collector
+        call    _garbage_collection
+        add     $4, %esp
+    # Restore all regs used by the code generator
+        movl    _gc_entry_regs + 4, %ebx
+        movl    _gc_entry_regs + 8, %ecx
+        movl    _gc_entry_regs + 12, %edx
+        movl    _gc_entry_regs + 16, %esi
+        movl    _gc_entry_regs + 20, %edi
+        movl    _gc_entry_regs + 24, %ebp
+    # Reload result of allocation in %eax
+        movl    _young_ptr, %eax
+    # Return to caller
+        pushl   _caml_last_return_address
+        ret
+
+# Modification
+
+        .globl  _caml_modify
+        .globl  _caml_fast_modify
+
+        .align  4
+_caml_modify:
+        testb   $4, -3(%eax)
+        jz      _caml_fast_modify
+        ret
+
+_caml_fast_modify:
+    # Store address of object in remembered set
+        pushl   %eax
+        movl    _remembered_ptr, %eax
+        popl    (%eax)
+        addl    $4, %eax
+        movl    %eax, _remembered_ptr
+        cmpl    _remembered_end, %eax
+        ja      _caml_modify_realloc
+        ret
+
+_caml_modify_realloc:
+    # Reallocate the remembered set while preserving all regs
+        pushl   %ecx
+        pushl   %edx
+    # (%eax dead, %ebx, %esi, %edi, %ebp preserved by C)
+        call    _realloc_remembered
+        popl    %edx
+        popl    %ecx
+        ret
+
+# Call a C function from Caml
+
+        .globl  _caml_c_call
+
+        .align  4
+_caml_c_call:
+    # Record lowest stack address and return address
+        popl    _caml_last_return_address
+        movl    %esp, _caml_bottom_of_stack
+    # Call the function (address in %eax)
+        call    *%eax
+    # Return to caller
+        movl    _caml_last_return_address, %edx  #  %edx dead here
+        jmp     *%edx
+
+# Start the Caml program
+
+        .globl  _caml_start_program
+        .align  4
+_caml_start_program:
+    # Save callee-save registers
+        pushl   %ebx
+        pushl   %esi
+        pushl   %edi
+        pushl   %ebp
+    # Build an exception handler
+        pushl   $0
+        pushl   $L104
+        movl    %esp, _caml_exception_pointer
+    # Go for it
+        call    _caml_program
+    # Pop handler
+        addl    $8, %esp
+    # Zero return code
+        xorl    %eax, %eax
+L104:
+    # Restore registers and return
+        popl    %ebp
+        popl    %edi
+        popl    %esi
+        popl    %ebx
+        ret
+
+# Raise an exception from C
+
+        .globl  _raise_caml_exception
+        .align  4
+_raise_caml_exception:
+        movl    4(%esp), %eax
+        movl    _caml_exception_pointer, %esp
+        popl    %edx
+        popl    _caml_exception_pointer
+        jmp     *%edx
diff --git a/asmrun/runtime.c b/asmrun/runtime.c
new file mode 100644
index 000000000..8d20c103f
--- /dev/null
+++ b/asmrun/runtime.c
@@ -0,0 +1,134 @@
+/* A very simplified runtime system for the native code compiler */
+
+#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;
+}
+
+extern int caml_start_program();
+
+typedef long value;
+
+value print_int(n)
+     value n;
+{
+  printf("%d", n>>1);
+  return 1;
+}
+
+value print_string(s)
+     value s;
+{
+  printf("%s", (char *) 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 */
+
+char * Match_failure = match_failure_id.data;
+
+int main(argc, argv)
+     int argc;
+     char ** argv;
+{
+  garbage_collection(0);
+  if (caml_start_program() != 0) {
+    fprintf(stderr, "Uncaught exception\n");
+    exit(2);
+  }
+  return 0;
+}
+