Hoist call to compile-native-proc into install-native-proc!.
authorTony Garnock-Jones <tonygarnockjones@gmail.com>
Tue, 17 Jul 2018 14:07:46 +0100
changeset 394 97ec29b53c47
parent 393 a8aa9b77e495
child 395 3979401d44c1
Hoist call to compile-native-proc into install-native-proc!.
experiments/little-smalltalk/jit-SmallWorld-2015.rkt
--- a/experiments/little-smalltalk/jit-SmallWorld-2015.rkt	Tue Jul 17 14:04:41 2018 +0100
+++ b/experiments/little-smalltalk/jit-SmallWorld-2015.rkt	Tue Jul 17 14:07:46 2018 +0100
@@ -456,7 +456,8 @@
   (log-vm/jit-info "Final proc: ~a" final-proc)
   final-proc)
 
-(define (install-native-proc! vm class name-bytes native-proc)
+(define (install-native-proc! vm class name-bytes method)
+  (define native-proc (compile-native-proc vm method))
   (define class-cache (hash-ref! (VM-cache vm) class make-weak-hash))
   (hash-set! class-cache name-bytes native-proc)
   native-proc)
@@ -482,10 +483,7 @@
     (set-box! mic-class class)
     (set! method (lookup-method/cache vm class (bv-bytes selector)))
     (when (and method (not (procedure? method)))
-      (set! method (install-native-proc! vm
-                                         class
-                                         (bv-bytes selector)
-                                         (compile-native-proc vm method))))
+      (set! method (install-native-proc! vm class (bv-bytes selector) method)))
     (set-box! mic-method method))
   (or method
       (lambda (vm ctx . args)
@@ -521,7 +519,7 @@
   (define native-proc
     (if (procedure? method)
         method
-        (install-native-proc! vm class (bv-bytes selector) (compile-native-proc vm method))))
+        (install-native-proc! vm class (bv-bytes selector) method)))
   (apply native-proc
          vm
          (if (procedure? ctx)