Factored frame-size adustment for jumps into a function

gambit · Aug 8, 2012 · eeef52f · eeef52f
1 parent 76367d3
commit eeef52f
Showing 1 changed file with 19 additions and 21 deletions.
diff --git a/gsc/_t-x86.scm b/gsc/_t-x86.scm
@@ -1,8 +1,8 @@
 ;;;============================================================================
 
 ;; TODO
-;; - Clean up creation of global labels and their insertion into the global table.
 ;; - Fix nargs (%cl) + %ecx
+;; - Primitives
 
 ;;; File: "_t-x86.scm"
 
@@ -546,20 +546,17 @@
     (x86-lea  cgc (vector-ref (nat-target-gvm-reg-map targ) 1) (x86-mem (* (nat-target-word-width targ) (- nat-heap-fudge nat-heap-size)) (nat-target-heap-ptr-reg targ)))
     (x86-mov  cgc (x86-mem (* (nat-target-word-width targ) nat-heap-limit-slot) (nat-target-pstate-ptr-reg targ)) (vector-ref (nat-target-gvm-reg-map targ) 1))
 
+    (let ((mem-loc (nat-global-ref targ 'println))
+          (mem-opnd (nat-label-ref cgc 'println)))
+      (x86-mov cgc (vector-ref (nat-target-gvm-reg-map targ) 1) (x86-imm-lbl (nat-label-ref cgc 'println)))
+      (x86-mov cgc mem-loc (vector-ref (nat-target-gvm-reg-map targ) 1)))
+
     (x86-mov  cgc (vector-ref (nat-target-gvm-reg-map targ) 0) (x86-imm-lbl exit-lbl))
     (x86-mov  cgc (vector-ref (nat-target-gvm-reg-map targ) 1) (x86-imm-int 0))
     (x86-mov  cgc (vector-ref (nat-target-gvm-reg-map targ) 2) (x86-imm-int 0))
     (x86-mov  cgc (vector-ref (nat-target-gvm-reg-map targ) 3) (x86-imm-int 0))
     (x86-mov  cgc (vector-ref (nat-target-gvm-reg-map targ) 4) (x86-imm-int 0))
 
-    (let ((mem-loc (nat-global-ref targ 'println))
-          (mem-opnd (nat-label-ref cgc 'println)))
-      (x86-push cgc (vector-ref (nat-target-gvm-reg-map targ) 1))
-      (x86-mov cgc (vector-ref (nat-target-gvm-reg-map targ) 1) (x86-imm-lbl (nat-label-ref cgc 'println)))
-      (x86-mov cgc mem-loc (vector-ref (nat-target-gvm-reg-map targ) 1))
-      (x86-pop cgc (vector-ref (nat-target-gvm-reg-map targ) 1)))
-      ;;(x86-mov cgc mem-loc (x86-imm-lbl (nat-label-ref cgc 'println))))
-
     (x86-jmp  cgc entry-lbl)
 
     (x86-label cgc exit-lbl)
@@ -664,12 +661,8 @@
               (scan-opnd opnd)
               ;; (if nargs
               ;;     (x86-mov cgc (nat-target-nb-arg-gvm-reg targ) (x86-imm-int nargs)))
-              (let ((offset (* (nat-target-word-width targ)
-                               (- (codegen-context-frame-size cgc)
-                                  jump-size))))
-                (if (not (= offset 0))
-                    (x86-add cgc (nat-target-stack-ptr-reg targ) (x86-imm-int offset)))
-                (x86-jmp cgc (nat-opnd cgc ctx opnd)))))
+              (adjust-frame-size cgc jump-size)
+              (x86-jmp cgc (nat-opnd cgc ctx opnd))))
 
            ((apply)
             (let ((prim  (apply-prim gvm-instr))
@@ -691,12 +684,8 @@
                    (test-proc (proc-obj-test test)))
               ;;(pp ctx)
               (if test-proc
-                  (let ((offset (* (nat-target-word-width targ)
-                                   (- (codegen-context-frame-size cgc)
-                                      jump-size))))
-                    (if (not (= offset 0))
-                        (x86-add cgc (nat-target-stack-ptr-reg targ) (x86-imm-int offset)))
-
+                  (begin
+                    (adjust-frame-size cgc jump-size)
                     (nat-if-then-else cgc ctx test-proc opnds true false))
                   (compiler-internal-error "test is not a procedure"))))
 
@@ -706,6 +695,15 @@
        ))
      lst)))
 
+(define (adjust-frame-size cgc jump-size)
+  (let* ((targ (codegen-context-target cgc))
+         (offset (* (nat-target-word-width targ)
+                   (- (codegen-context-frame-size cgc)
+                      jump-size))))
+    (if (not (= offset 0))
+        (x86-add cgc (nat-target-stack-ptr-reg targ) (x86-imm-int offset)))))
+
+
 (define (nat-if-then-else cgc ctx test opnds true* false*)
   (let* ((targ (codegen-context-target cgc))
          (true-lbl (nat-label-ref cgc (lbl->id true* (ctx-ns ctx))))