*** empty log message ***

module/system/il/compile.scm

@@ -251,10 +251,10 @@
 	 ;; (set VARS)...
 	 ;; BODY
 	 (for-each comp-push vals)
-	 (for-each (lambda (var) (push-code! (make-glil-var 'set env var)))
-		   (reverse vars))
 	 (let ((vars (map (lambda (v) (list v.name v.kind v.index)) vars)))
 	   (if (not (null? vars)) (push-code! (<glil-bind> vars))))
+	 (for-each (lambda (var) (push-code! (make-glil-var 'set env var)))
+		   (reverse vars))
 	 (comp-tail body)
 	 (push-code! (<glil-unbind>)))
 

module/system/vm/trace.scm

@@ -45,11 +45,15 @@
 
 (define (trace-next vm)
   (define (puts x) (display #\tab) (write x))
+  (define (truncate! x n)
+    (if (> (length x) n)
+      (list-cdr-set! x (1- n) '(...))) x)
+  ;; main
   (format #t "0x~8X  ~16S" (vm:ip vm) (vm-fetch-code vm))
   (do ((opts (vm-option vm 'trace-options) (cdr opts)))
       ((null? opts) (newline))
     (case (car opts)
-      ((:s) (puts (vm-fetch-stack vm)))
+      ((:s) (puts (truncate! (vm-fetch-stack vm) 3)))
       ((:l) (puts (vm-fetch-locals vm)))
       ((:e) (puts (vm-fetch-externals vm))))))
 

src/vm.c

@@ -149,34 +149,28 @@ vm_fetch_length (scm_byte_t *ip, size_t *lenp)
 }
 
 static SCM
-vm_heapify_frames_1 (struct scm_vm *vp, SCM *fp, SCM *limit, SCM **basep)
+vm_heapify_frames_1 (struct scm_vm *vp, SCM *fp, SCM *sp, SCM **destp)
 {
-  SCM *base, frame;
+  SCM frame;
   SCM *dl = SCM_FRAME_DYNAMIC_LINK (fp);
-  SCM *sp = SCM_FRAME_UPPER_ADDRESS (fp);
+  SCM *src = SCM_FRAME_UPPER_ADDRESS (fp);
+  SCM *dest = SCM_FRAME_LOWER_ADDRESS (fp);
 
   if (!dl)
     {
       /* The top frame */
-      base  = vp->stack_base;
       frame = scm_c_make_heap_frame (fp);
       fp = SCM_HEAP_FRAME_POINTER (frame);
       SCM_FRAME_HEAP_LINK (fp) = SCM_BOOL_T;
     }
   else
     {
-      /* Other frames */
+      /* Child frames */
       SCM link = SCM_FRAME_HEAP_LINK (dl);
       if (!SCM_FALSEP (link))
-	{
 	link = SCM_FRAME_LOWER_ADDRESS (dl)[-1]; /* self link */
-	  base = SCM_FRAME_LOWER_ADDRESS (fp);
-	}
       else
-	{
+	link = vm_heapify_frames_1 (vp, dl, dest - 1, &dest);
-	  link = vm_heapify_frames_1 (vp, dl, SCM_FRAME_LOWER_ADDRESS (fp),
-				      &base);
-	}
       frame = scm_c_make_heap_frame (fp);
       fp = SCM_HEAP_FRAME_POINTER (frame);
       SCM_FRAME_HEAP_LINK (fp)    = link;
@@ -184,9 +178,9 @@ vm_heapify_frames_1 (struct scm_vm *vp, SCM *fp, SCM *limit, SCM **basep)
     }
 
   /* Move stack data */
-  for (; sp < limit; base++, sp++)
+  for (; src <= sp; src++, dest++)
-    *base = *sp;
+    *dest = *src;
-  *basep = base;
+  *destp = dest;
 
   return frame;
 }
@@ -197,10 +191,10 @@ vm_heapify_frames (SCM vm)
   struct scm_vm *vp = SCM_VM_DATA (vm);
   if (SCM_FALSEP (SCM_FRAME_HEAP_LINK (vp->fp)))
     {
-      SCM *base;
+      SCM *dest;
-      vp->this_frame = vm_heapify_frames_1 (vp, vp->fp, vp->sp + 1, &base);
+      vp->this_frame = vm_heapify_frames_1 (vp, vp->fp, vp->sp, &dest);
       vp->fp = SCM_HEAP_FRAME_POINTER (vp->this_frame);
-      vp->sp = base - 1;
+      vp->sp = dest - 1;
     }
   return vp->this_frame;
 }

src/vm_system.c

@@ -54,9 +54,10 @@ VM_DEFINE_INSTRUCTION (nop, "nop", 0, 0, 0)
 
 VM_DEFINE_INSTRUCTION (halt, "halt", 0, 0, 0)
 {
-  SCM ret = *sp;
+  SCM ret;
   vp->time += scm_c_get_internal_run_time () - start_time;
   HALT_HOOK ();
+  POP (ret);
   FREE_FRAME ();
   SYNC_ALL ();
   return ret;
@@ -490,9 +491,9 @@ VM_DEFINE_INSTRUCTION (return, "return", 0, 0, 1)
 {
   SCM ret;
  vm_return:
-  POP (ret);
   EXIT_HOOK ();
   RETURN_HOOK ();
+  POP (ret);
   FREE_FRAME ();
 
   /* Restore the last program */