Permalink
Browse files

Factored frame-size adustment for jumps into a function

  • Loading branch information...
gnuvince committed Aug 8, 2012
1 parent 76367d3 commit eeef52f6718cfd414b89ce95b9b4323e1a99e981
Showing with 19 additions and 21 deletions.
  1. +19 −21 gsc/_t-x86.scm
View
@@ -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))))

0 comments on commit eeef52f

Please sign in to comment.