Skip to content
Browse files

Added support for <, <=, =, >, >= for fixnums

  • Loading branch information...
1 parent 928e4f6 commit 767fdf35c78b4f36b5689a92200dc688be5e0dc6 @gnuvince gnuvince committed
Showing with 64 additions and 20 deletions.
  1. +64 −20 gsc/_t-x86.scm
View
84 gsc/_t-x86.scm
@@ -473,7 +473,7 @@
(x86-translate-procs cgc)
(entry-point cgc (list-ref procs 0))
- (let ((f (create-procedure cgc #f)))
+ (let ((f (create-procedure cgc #t)))
(f)))
#f)
@@ -1277,23 +1277,67 @@
-(x86-prim-define "##fx<" #f #f
- (lambda (cgc opnds loc)
- (x86-nop cgc))
- (lambda (cgc ctx opnds true-branch false-branch)
- (let* ((targ (codegen-context-target cgc))
- (true-lbl (nat-label-ref cgc (lbl->id true-branch (ctx-ns ctx))))
- (false-lbl (nat-label-ref cgc (lbl->id false-branch (ctx-ns ctx))))
- (r1 (vector-ref (nat-target-gvm-reg-map targ) 1))
- (opnd1 (nat-opnd cgc ctx (list-ref opnds 0)))
- (opnd2 (nat-opnd cgc ctx (list-ref opnds 1))))
- (if (or (x86-reg? opnd1) (x86-reg? opnd2))
- (x86-cmp cgc opnd1 opnd2)
- (begin
- (x86-push cgc r1)
- (x86-mov cgc r1 opnd1)
- (x86-cmp cgc r1 opnd2)
- (x86-pop cgc r1)))
- (x86-jl cgc true-lbl)
- (x86-jmp cgc false-lbl))))
+
+(define (define-fxcmp-primitive name jump-op)
+ (x86-prim-define name #f #f
+ (lambda (cgc opnds loc)
+ (let* ((targ (codegen-context-target cgc))
+ (r1 (vector-ref (nat-target-gvm-reg-map targ) 1))
+ (true-lbl (make-temp-label cgc))
+ (end-if-lbl (make-temp-label cgc))
+ (ctx (make-ctx targ #f))
+ (loc (nat-opnd cgc ctx loc))
+ (opnd1 (nat-opnd cgc ctx (list-ref opnds 0)))
+ (opnd2 (nat-opnd cgc ctx (list-ref opnds 1))))
+ (if (or (x86-reg? opnd1) (x86-reg? opnd2))
+ (x86-cmp cgc opnd1 opnd2)
+ (begin
+ (x86-push cgc r1)
+ (x86-mov cgc r1 opnd1)
+ (x86-cmp cgc r1 opnd2)
+ (x86-pop cgc r1)))
+
+ (jump-op cgc true-lbl)
+ (if (x86-reg? loc)
+ (x86-mov cgc loc false)
+ (begin
+ (x86-push cgc r1)
+ (x86-mov cgc r1 false)
+ (x86-mov cgc loc r1)
+ (x86-pop cgc r1)))
+ (x86-jmp cgc end-if-lbl)
+ (x86-label cgc true-lbl)
+ (if (x86-reg? loc)
+ (x86-mov cgc loc true)
+ (begin
+ (x86-push cgc r1)
+ (x86-mov cgc r1 true)
+ (x86-mov cgc loc r1)
+ (x86-pop cgc r1)))
+ (x86-label cgc end-if-lbl)))
+
+
+ (lambda (cgc ctx opnds true-branch false-branch)
+ (let* ((targ (codegen-context-target cgc))
+ (true-lbl (nat-label-ref cgc (lbl->id true-branch (ctx-ns ctx))))
+ (false-lbl (nat-label-ref cgc (lbl->id false-branch (ctx-ns ctx))))
+ (r1 (vector-ref (nat-target-gvm-reg-map targ) 1))
+ (opnd1 (nat-opnd cgc ctx (list-ref opnds 0)))
+ (opnd2 (nat-opnd cgc ctx (list-ref opnds 1))))
+ (if (or (x86-reg? opnd1) (x86-reg? opnd2))
+ (x86-cmp cgc opnd1 opnd2)
+ (begin
+ (x86-push cgc r1)
+ (x86-mov cgc r1 opnd1)
+ (x86-cmp cgc r1 opnd2)
+ (x86-pop cgc r1)))
+ (jump-op cgc true-lbl)
+ (x86-jmp cgc false-lbl)))))
+
+
+(define-fxcmp-primitive "##fx<" x86-jl)
+(define-fxcmp-primitive "##fx<=" x86-jle)
+(define-fxcmp-primitive "##fx>" x86-jg)
+(define-fxcmp-primitive "##fx>=" x86-jge)
+(define-fxcmp-primitive "##fx=" x86-je)

0 comments on commit 767fdf3

Please sign in to comment.
Something went wrong with that request. Please try again.