add stack roots scanning

runtime/Makefile

@@ -1,6 +1,12 @@
-all:
-	gcc -m32 -c runtime.c
+all: gc_runtime.o runtime.o
+	ar rc runtime.a gc_runtime.o runtime.o 
+
+gc_runtime.o: gc_runtime.s
+	gcc -g -m32 -c gc_runtime.s
+
+runtime.o: runtime.c
+	gcc -g -m32 -c runtime.c
 
 clean:
-	rm -f runtime.o *~
+	rm -f *.a *.o *~
 

runtime/gc_runtime.s

@@ -0,0 +1,68 @@
+			.data
+printf_format:		.string	"Stack root: %lx\n"
+printf_format2:		.string	"BOT: %lx\n"
+printf_format3:		.string	"TOP: %lx\n"
+printf_format4:		.string	"EAX: %lx\n"
+printf_format5:		.string	"LOL\n"
+__gc_stack_bottom:	.long	0
+__gc_stack_top:	        .long	0
+	
+			.globl L__gc_init
+			.globl __gc_root_scan_stack
+	
+			.text
+L__gc_init:		movl	%esp, __gc_stack_bottom
+			addl	$4, __gc_stack_bottom
+			ret
+
+__gc_root_scan_stack:
+			movl	%esp, __gc_stack_top
+			movl	%esp, %eax
+			jmp next
+
+loop:
+			movl	(%eax), %ebx
+
+	// check that it is not a pointer to code section
+	// i.e. the following is not true:
+	// __executable_start <= (%eax) <= __etext
+check11:	
+			leal	__executable_start, %edx
+			cmpl	%ebx, %edx
+			jna	check12
+			jmp	check21
+
+check12:	
+			leal	__etext, %edx
+			cmpl	%ebx, %edx
+			jnb	next
+
+	// check that it is not a pointer into the program stack
+	// i.e. the following is not true:
+	// __gc_stack_bottom <= (%eax) <= __gc_stack_top
+check21:	
+			cmpl	%ebx, __gc_stack_top
+			jna	check22
+			jmp	loop2
+
+check22:
+			cmpl	%ebx, __gc_stack_bottom
+			jnb	next
+
+	// check if it a valid pointer
+	// i.e. the lastest bit is set to zero
+loop2:
+			andl	$0x00000001, %ebx
+			jnz     next
+			pushl 	%eax
+			pushl	(%eax)
+        		pushl	$printf_format
+        		call	printf
+        		addl	$8, %esp
+			popl	%eax
+
+next:
+			addl	$4, %eax
+			cmpl	%eax, __gc_stack_bottom
+			jne	loop
+			ret

runtime/runtime.c

@@ -351,18 +351,24 @@ extern int Lwrite (int n) {
 /* GC starts here */
 
 extern const size_t __gc_data_end, __gc_data_start;
+extern size_t __gc_stack_bottom, __gc_stack_top;
+
+extern void L__gc_init ();
 
 extern void __gc_root_scan_data () {
   size_t * p = &__gc_data_start;
 
-  printf ("Start, end: %d, %d\n", &__gc_data_start, &__gc_data_end);
+  printf ("Start, end: %lx, %lx\n", &__gc_data_start, &__gc_data_end);
   
   while (p != &__gc_data_end) {
-    if (!UNBOXED(*p)) printf ("Root: %d\n", p);
+    if (!UNBOXED(*p)) printf ("Root: %lx\n", *p);
     p++;
   }
 }
 
+extern void __gc_root_scan_stack ();
+
+
 /* extern const void * __gc_data_end, * __gc_data_start; */
 
 /* extern void __gc_root_scan_data () { */
@@ -376,6 +382,17 @@ extern void __gc_root_scan_data () {
 /*   } */
 /* } */
 
+extern char __executable_start;
+extern char __etext;
+
 extern void Ltest () {
+  printf("\n");
+  printf("STA 0x%lx\n", (unsigned long)&__executable_start);
+  printf("END 0x%lx\n", (unsigned long)&__etext);
   __gc_root_scan_data ();
+  __gc_root_scan_stack ();
+
+  //  printf("STA 0x%lx\n", (unsigned long)&__executable_start);
+  //  printf("END 0x%lx\n", (unsigned long)&__etext);
+  //  printf("RET 0x%lx\n\n", __builtin_return_address(0));
 }

src/X86.ml

@@ -19,6 +19,8 @@ let word_size = 4;;
 | L of int     (* an immediate operand             *)
 with show
 
+let show_opnd = show(opnd)
+              
 (* For convenience we define the following synonyms for the registers: *)         
 let ebx = R 0
 let ecx = R 1
@@ -164,7 +166,7 @@ let compile env code =
              (env, Mov (M ("$" ^ s), l) :: call)
              
 	  | LD x ->
-             let s, env' = (env#global x)#allocate in
+             let s, env' = (env#variable x)#allocate in
              env',
 	     (match s with
 	      | S _ | M _ -> [Mov (env'#loc x, eax); Mov (eax, s)]
@@ -172,7 +174,7 @@ let compile env code =
 	     )
                
           | STA (x, n) ->
-             let s, env = (env#global x)#allocate in
+             let s, env = (env#variable x)#allocate in
              let push =
                match s with
                | S _ | M _ -> [Mov (env#loc x, eax); Mov (eax, s)]
@@ -182,7 +184,7 @@ let compile env code =
              env, push @ code
                            
 	  | ST x ->
-	     let s, env' = (env#global x)#pop in
+	     let s, env' = (env#variable x)#pop in
              env',
              (match s with
               | S _ | M _ -> [Mov (s, eax); Mov (eax, env'#loc x)]
@@ -425,13 +427,13 @@ class env =
     (* allocates a fresh position on a symbolic stack *)
     method allocate =    
       let x, n =
-	let rec allocate' = function
-	| []                            -> ebx          , 0
-	| (S n)::_                      -> S (n+1)      , n+2
-	| (R n)::_ when n < num_of_regs -> R (n+1)      , stack_slots
-	| _                             -> S static_size, static_size+1
-	in
-	allocate' stack
+        let rec allocate' = function
+        | []                            -> ebx          , 0
+        | (S n)::_                      -> S (n+1)      , n+2
+        | (R n)::_ when n < num_of_regs -> R (n+1)      , stack_slots
+        | _                             -> S static_size, static_size+1
+        in
+        allocate' stack
       in
       x, {< stack_slots = max n stack_slots; stack = x::stack >}
 
@@ -458,8 +460,11 @@ class env =
       done;
       !h      
              
-    (* registers a global variable in the environment *)
-    method global x  = {< globals = S.add ("global_" ^ x) globals >}
+    (* registers a variable in the environment *)
+    method variable x =
+      match self#loc x with
+      | M name -> {< globals = S.add name globals >}
+      | _      -> self
 
     (* registers a string constant *)
     method string x =
@@ -515,14 +520,24 @@ class env =
    the stack code, then generates x86 assember code, then prints the assembler file
 *)
 let genasm (ds, stmt) =
-  let stmt = Language.Stmt.Seq (stmt, Language.Stmt.Return (Some (Language.Expr.Call ("raw", [Language.Expr.Const 0])))) in
+  let stmt =
+    Language.Stmt.Seq (
+        Language.Stmt.Call ("__gc_init", []),
+        Language.Stmt.Seq (stmt, Language.Stmt.Return (Some (Language.Expr.Call ("raw", [Language.Expr.Const 0]))))
+      )
+  in
   let env, code =
     compile
       (new env)
       ((LABEL "main") :: (BEGIN ("main", [], [])) :: SM.compile (ds, stmt))
   in
-  let data = Meta "\t.data" :: (List.map (fun s      -> Meta (Printf.sprintf "%s:\t.int\t0"         s  )) env#globals) @
-                               (List.map (fun (s, v) -> Meta (Printf.sprintf "%s:\t.string\t\"%s\"" v s)) env#strings) in 
+  let gc_start, gc_end = "__gc_data_start", "__gc_data_end" in
+  let data = [Meta "\t.data"; Meta (Printf.sprintf "\t.globl\t%s" gc_start); Meta (Printf.sprintf "\t.globl\t%s" gc_end)] @
+             [Meta (Printf.sprintf "%s:" gc_start)] @
+             (List.map (fun s      -> Meta (Printf.sprintf "%s:\t.int\t1"         s  )) env#globals) @
+             [Meta (Printf.sprintf "%s:" gc_end)] @
+             (List.map (fun (s, v) -> Meta (Printf.sprintf "%s:\t.string\t\"%s\"" v s)) env#strings)
+  in 
   let asm = Buffer.create 1024 in
   List.iter
     (fun i -> Buffer.add_string asm (Printf.sprintf "%s\n" @@ show i))
@@ -535,5 +550,5 @@ let build prog name =
   Printf.fprintf outf "%s" (genasm prog);
   close_out outf;
   let inc = try Sys.getenv "RC_RUNTIME" with _ -> "../runtime" in
-  Sys.command (Printf.sprintf "gcc -m32 -o %s %s/runtime.o %s.s" name inc name)
+  Sys.command (Printf.sprintf "gcc -g -m32 -o %s %s/gc_runtime.o %s/runtime.o %s.s" name inc inc name)
  

src/testgc.expr

@@ -1,11 +1,22 @@
-x := 0;
-y := 0;
-z := 0;
-t := 0;
-test ();
+fun f () local b {
+  b := 7;
+  test ();
+  b := y;
+  test ();
+  b := 9;
+  test ();
+  return 0
+}
+
+--x := 0;
+--y := 0;
+--z := 0;
+--t := 0;
+--test ();
 y := "abc";
 test ();
 t := [];
 test ();
 t := 0;
-test ()
+test ();
+f ()