experiments/little-smalltalk/jit-SmallWorld-2015.rkt
author Tony Garnock-Jones <tonygarnockjones@gmail.com>
Mon, 23 Jul 2018 20:38:31 +0100
changeset 415 3d1ae8f1b0d7
parent 414 5e5c61ed2e7d
child 416 9be895de88d6
permissions -rw-r--r--
Avoid passing around a literal stack length, when it's implicit
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
353
d4161a4117e8 Image loader and virtual machine for SmallWorld 2015 Smalltalk.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
     1
#lang racket/gui
d4161a4117e8 Image loader and virtual machine for SmallWorld 2015 Smalltalk.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
     2
;; Loader for images (version 1 format) from Russell Allen's 2015
d4161a4117e8 Image loader and virtual machine for SmallWorld 2015 Smalltalk.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
     3
;; variant of SmallWorld, a Tim Budd-authored Little Smalltalk
d4161a4117e8 Image loader and virtual machine for SmallWorld 2015 Smalltalk.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
     4
;; descendant.
d4161a4117e8 Image loader and virtual machine for SmallWorld 2015 Smalltalk.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
     5
369
3e1f84e6289d Image saving
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 368
diff changeset
     6
(require racket/bytes)
376
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
     7
(require (only-in sha bytes->hex-string))
403
5e81df1d79c4 Factor out object-memory.rkt and primitives.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 402
diff changeset
     8
(require "object-memory.rkt")
5e81df1d79c4 Factor out object-memory.rkt and primitives.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 402
diff changeset
     9
(require "primitives.rkt")
353
d4161a4117e8 Image loader and virtual machine for SmallWorld 2015 Smalltalk.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    10
d4161a4117e8 Image loader and virtual machine for SmallWorld 2015 Smalltalk.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    11
(define-logger vm)
376
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
    12
(define-logger vm/jit)
410
7e5d9e957c2f Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 409
diff changeset
    13
(define-logger vm/jit/code)
7e5d9e957c2f Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 409
diff changeset
    14
(define-logger vm/jit/recompile)
353
d4161a4117e8 Image loader and virtual machine for SmallWorld 2015 Smalltalk.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    15
413
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
    16
(define pic-reserved 0)
396
3bfb9afdbd9d Switch from mic to pic
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 395
diff changeset
    17
(define pic-entry-count 3)
413
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
    18
(define (pic)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
    19
  ;; pic-entry-count times three - one each for class, method, and count.
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
    20
  (vector #f #f 0
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
    21
          #f #f 0
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
    22
          #f #f 0))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
    23
(define (extended-pic c0 m0 c1 m1 c2 m2)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
    24
  (vector #f #f 0
410
7e5d9e957c2f Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 409
diff changeset
    25
          #f #f 0
7e5d9e957c2f Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 409
diff changeset
    26
          #f #f 0
413
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
    27
          c0 m0 0
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
    28
          c1 m1 0
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
    29
          c2 m2 0))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
    30
(define (pic-size pic) (quotient (- (vector-length pic) pic-reserved) pic-entry-count))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
    31
(define empty-pic-extension (for/list [(i (in-range pic-entry-count))] '(#f #f)))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
    32
(define (pic@ pic index offset) (vector-ref pic (+ pic-reserved offset (* index 3))))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
    33
(define (pic@! pic index offset v) (vector-set! pic (+ pic-reserved offset (* index 3)) v))
395
3979401d44c1 Introduce struct mic
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 394
diff changeset
    34
403
5e81df1d79c4 Factor out object-memory.rkt and primitives.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 402
diff changeset
    35
(struct jit-VM VM (cache image-filename)
5e81df1d79c4 Factor out object-memory.rkt and primitives.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 402
diff changeset
    36
  #:methods gen:vm-callback
5e81df1d79c4 Factor out object-memory.rkt and primitives.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 402
diff changeset
    37
  [(define (vm-block-callback vm action)
5e81df1d79c4 Factor out object-memory.rkt and primitives.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 402
diff changeset
    38
     ;; Runs action in a new thread
5e81df1d79c4 Factor out object-memory.rkt and primitives.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 402
diff changeset
    39
     (lambda args
5e81df1d79c4 Factor out object-memory.rkt and primitives.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 402
diff changeset
    40
       (thread (match action
5e81df1d79c4 Factor out object-memory.rkt and primitives.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 402
diff changeset
    41
                 [(unffiv block-proc)
5e81df1d79c4 Factor out object-memory.rkt and primitives.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 402
diff changeset
    42
                  (lambda () (apply block-proc vm (outermost-k vm) args))]
5e81df1d79c4 Factor out object-memory.rkt and primitives.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 402
diff changeset
    43
                 [_
5e81df1d79c4 Factor out object-memory.rkt and primitives.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 402
diff changeset
    44
                  (block->thunk vm action args)]))))])
353
d4161a4117e8 Image loader and virtual machine for SmallWorld 2015 Smalltalk.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    45
413
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
    46
(struct pic-info (name-bytes variable context extension) #:transparent)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
    47
(struct compilation-result (litmap [pic-list-rev #:mutable] old-picmap))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
    48
(struct compilation (outer outer-ip vm receiver-class method argnames labels state))
353
d4161a4117e8 Image loader and virtual machine for SmallWorld 2015 Smalltalk.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    49
413
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
    50
(struct compiled-method-info (bytecode-method pics stable?))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
    51
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
    52
(struct cached-method (class name-bytes [bytecode-method #:mutable] [proc #:mutable]))
410
7e5d9e957c2f Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 409
diff changeset
    53
415
3d1ae8f1b0d7 Avoid passing around a literal stack length, when it's implicit
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 414
diff changeset
    54
(define (build-jit-context vm previous-context args method ip temporaries stack)
413
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
    55
  ;; TODO: build block contexts instead of just pretending everything is a method...
376
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
    56
  (define max-stack (slotAt method 3))
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
    57
  (mkobj (VM-Context vm)
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
    58
         method
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
    59
         (obj (VM-Array vm) args)
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
    60
         (obj (VM-Array vm) temporaries)
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
    61
         (obj (VM-Array vm) (vector-append stack (make-vector (- max-stack (vector-length stack))
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
    62
                                                              (VM-nil vm))))
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
    63
         ip
415
3d1ae8f1b0d7 Avoid passing around a literal stack length, when it's implicit
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 414
diff changeset
    64
         (vector-length stack)
376
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
    65
         previous-context))
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
    66
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
    67
(define (selector-string-arity str)
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
    68
  (define colon-count (for/sum [(c str)] (if (eqv? c #\:) 1 0)))
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
    69
  (cond [(positive? colon-count) (+ colon-count 1)]
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
    70
        [(char-alphabetic? (string-ref str 0)) 1]
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
    71
        [else 2])) ;; assume binary operator
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
    72
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
    73
(define-namespace-anchor ns-anchor)
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
    74
(define ns (namespace-anchor->namespace ns-anchor))
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
    75
402
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
    76
(define (mksym fmt . args) (string->symbol (apply format fmt args)))
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
    77
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
    78
(define-syntax let@
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
    79
  (syntax-rules ()
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
    80
    [(_ [n n-code-exp] body-code-exp)
406
3a84d16cac19 Remove gratuitous layer of gensym
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 405
diff changeset
    81
     (let@ [n 'n n-code-exp] body-code-exp)]
402
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
    82
    [(_ [n n-exp n-code-exp] body-code-exp)
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
    83
     (let ((n (gensym n-exp)))
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
    84
       `(let ((,n ,n-code-exp))
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
    85
          ,body-code-exp))]))
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
    86
413
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
    87
(define (method-name method [class #f])
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
    88
  (if class
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
    89
      (format "~a >> ~a"
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
    90
              (bv->string (slotAt class 0))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
    91
              (bv->string (slotAt method 0)))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
    92
      (bv->string (slotAt method 0))))
376
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
    93
413
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
    94
(define (compilation-method-name c)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
    95
  (method-name (compilation-method c) (compilation-receiver-class c)))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
    96
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
    97
(define (compilation-depth c)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
    98
  (define o (compilation-outer c))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
    99
  (if o (+ 1 (compilation-depth o)) 0))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   100
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   101
(define (compilation* outer outer-ip compile-time-vm receiver-class method state)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   102
  (define arity (selector-string-arity (method-name method)))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   103
  (define literals (slotAt method 2))
376
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   104
408
aa5e38d54ab0 Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 406
diff changeset
   105
  (define litmap (compilation-result-litmap state))
aa5e38d54ab0 Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 406
diff changeset
   106
  (for [(lit (obj-slots literals))] (gen-lit* litmap lit))
aa5e38d54ab0 Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 406
diff changeset
   107
376
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   108
  (define argnames (for/vector [(i arity)] (if (zero? i) 'self (mksym "arg~a" (- i 1)))))
408
aa5e38d54ab0 Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 406
diff changeset
   109
413
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   110
  (define c (compilation outer
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   111
                         outer-ip
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   112
                         compile-time-vm
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   113
                         receiver-class
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   114
                         method
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   115
                         argnames
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   116
                         (make-hash)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   117
                         state))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   118
  (log-vm/jit/code-info
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   119
   "Compiling ~a defined in ~v (depth ~a), arity ~a, literals ~a, bytecode ~a, text:\n----\n~a\n----"
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   120
   (method-name method receiver-class)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   121
   (slotAt method 5)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   122
   (compilation-depth c)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   123
   arity
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   124
   literals
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   125
   (bytes->hex-string (bv-bytes (slotAt method 1)))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   126
   (bv->string (slotAt method 6)))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   127
  c)
408
aa5e38d54ab0 Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 406
diff changeset
   128
413
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   129
(define (top-compilation vm receiver-class method old-picmap)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   130
  (compilation* #f #f vm receiver-class method (compilation-result (make-hasheq) '() old-picmap)))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   131
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   132
(define (inline-compilation c c-ip receiver-class method)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   133
  (compilation* c c-ip (compilation-vm c) receiver-class method (compilation-state c)))
408
aa5e38d54ab0 Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 406
diff changeset
   134
aa5e38d54ab0 Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 406
diff changeset
   135
(define (gen-lit* litmap lit)
aa5e38d54ab0 Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 406
diff changeset
   136
  (hash-ref! litmap lit (lambda ()
aa5e38d54ab0 Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 406
diff changeset
   137
                          (define n (hash-count litmap))
aa5e38d54ab0 Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 406
diff changeset
   138
                          (if (bv? lit)
aa5e38d54ab0 Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 406
diff changeset
   139
                              (mksym "lit~a-~a" n (bv->string lit))
aa5e38d54ab0 Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 406
diff changeset
   140
                              (mksym "lit~a" n)))))
376
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   141
402
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   142
(define (gen-jump-to-label c ip stack)
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   143
  (define labels (compilation-labels c))
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   144
  (when (not (hash-has-key? labels ip))
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   145
    (hash-set! labels ip 'placeholder)
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   146
    (define actual-label
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   147
      (let ((newstack (for/list [(i (length stack))] (mksym "stack~a" i))))
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   148
        `(lambda (k ,@newstack) ,(gen-code c ip newstack))))
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   149
    (hash-set! labels ip actual-label))
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   150
  `(,(mksym "label~a" ip) k ,@stack))
376
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   151
402
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   152
(define (gen-build-jit-context c ip stack)
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   153
  `(build-jit-context vm
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   154
                      (k)
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   155
                      (vector ,@(vector->list (compilation-argnames c)))
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   156
                      method
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   157
                      ,ip
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   158
                      temporaries
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   159
                      (vector ,@(reverse stack))))
376
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   160
402
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   161
(define (gen-send-k c ip stack)
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   162
  (define result (gensym 'result))
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   163
  `(case-lambda [() ,(gen-build-jit-context c ip stack)]
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   164
                [(,result) ,(gen-jump-to-label c ip (cons result stack))]))
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   165
408
aa5e38d54ab0 Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 406
diff changeset
   166
(define (gen-fresh-temps method)
aa5e38d54ab0 Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 406
diff changeset
   167
  (match (slotAt method 4)
aa5e38d54ab0 Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 406
diff changeset
   168
    [0 `'#()]
aa5e38d54ab0 Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 406
diff changeset
   169
    [temp-count `(make-vector ,temp-count NIL)]))
aa5e38d54ab0 Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 406
diff changeset
   170
413
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   171
(define (inlineable-self-send? method)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   172
  (define bytecode (bv-bytes (slotAt method 1)))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   173
  (<= (bytes-length bytecode) 32))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   174
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   175
(define (compilation-context c ip)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   176
  (if (not c)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   177
      '()
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   178
      (cons (list (compilation-receiver-class c) (compilation-method c) ip)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   179
            (compilation-context (compilation-outer c) (compilation-outer-ip c)))))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   180
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   181
(define (gen-pic c name-bytes send-ip extension)
410
7e5d9e957c2f Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 409
diff changeset
   182
  (define old-pics (compilation-result-pic-list-rev (compilation-state c)))
7e5d9e957c2f Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 409
diff changeset
   183
  (define pic-index (length old-pics))
402
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   184
  (define m (mksym "pic~a" pic-index))
413
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   185
  (define pi (pic-info name-bytes m (compilation-context c send-ip) extension))
410
7e5d9e957c2f Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 409
diff changeset
   186
  (set-compilation-result-pic-list-rev! (compilation-state c) (cons pi old-pics))
413
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   187
  (log-vm/jit/recompile-debug "Produced pic at ip ~a for send of ~a in method ~a"
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   188
                              send-ip
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   189
                              name-bytes
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   190
                              (compilation-method-name c))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   191
  m)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   192
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   193
(define (gen-inline-send c c-ip class method k-exp arg-exps)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   194
  (log-vm/jit/code-info "Inlining send of ~a into method ~a"
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   195
                        (method-name method class)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   196
                        (compilation-method-name c))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   197
  (define ic (inline-compilation c c-ip class method))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   198
  (define body-code (gen-jump-to-label ic 0 '()))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   199
  (define defining-class (slotAt method 5))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   200
  (define litmap (compilation-result-litmap (compilation-state ic)))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   201
  (define inner-code
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   202
    `(let ((k ,k-exp)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   203
           (method ,(gen-lit* litmap method))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   204
           (super ,(gen-lit* litmap (slotAt defining-class 1))))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   205
       (let ,(for/list [(formal (vector->list (compilation-argnames ic)))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   206
                        (actual (in-list arg-exps))]
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   207
               `(,formal ,actual))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   208
         (let ((outer-k k)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   209
               (temporaries ,(gen-fresh-temps method)))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   210
           ,(gen-label-definitions ic body-code)))))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   211
  (log-vm/jit/code-debug "INLINED:\n~a" (pretty-format inner-code))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   212
  inner-code)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   213
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   214
(define (analyse-pic c pic)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   215
  (define vm (compilation-vm c))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   216
  (define unsorted (for/list [(i (in-range (pic-size pic))) #:when (pic@ pic i 0)]
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   217
                     (list (pic@ pic i 2) (pic@ pic i 0) (pic@ pic i 1))))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   218
  (define descending-by-call-count (map cdr (sort unsorted > #:key car)))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   219
  (for [(entry descending-by-call-count)]
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   220
    (unwrap-cached-method vm (cadr entry))) ;; fills cache entry
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   221
  descending-by-call-count)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   222
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   223
(define (already-compiling? c class method)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   224
  (let check ((c c))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   225
    (cond [(not c) #f]
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   226
          [(and (eq? (compilation-receiver-class c) class) (eq? (compilation-method c) method)) #t]
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   227
          [else (check (compilation-outer c))])))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   228
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   229
(define (gen-send c send-ip class-exp name-bytes selector-exp k-exp arg-exps)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   230
  (define receiver-class (compilation-receiver-class c))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   231
  (define method (lookup-method (compilation-vm c) receiver-class name-bytes))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   232
  (cond
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   233
    [(and (equal? class-exp `(obj-class* vm self)) ;; self send
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   234
          (< (compilation-depth c) 2)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   235
          method
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   236
          (inlineable-self-send? method))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   237
     (gen-inline-send c send-ip receiver-class method k-exp arg-exps)]
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   238
    [else
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   239
     (define old-picmap (compilation-result-old-picmap (compilation-state c)))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   240
     (define old-entry
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   241
       (and old-picmap (hash-ref old-picmap (compilation-context c send-ip) #f)))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   242
     (define previous-pic-entries (if old-entry (analyse-pic c (cdr old-entry)) '()))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   243
     (define litmap (compilation-result-litmap (compilation-state c)))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   244
     (define pic-m (gen-pic c name-bytes send-ip previous-pic-entries))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   245
     `(let ((actual-class ,class-exp)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   246
            (k-send ,k-exp))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   247
        ,(let loop ((predictions previous-pic-entries) (counter pic-entry-count))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   248
           (match predictions
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   249
             ['()
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   250
              `((lookup-message/jit vm ,pic-m actual-class ,selector-exp) vm k-send ,@arg-exps)]
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   251
             [(cons (list predicted-class predicted-cm) more-predictions)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   252
              (define predicted-bmethod (cached-method-bytecode-method predicted-cm))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   253
              `(if (eq? actual-class ,(gen-lit* litmap predicted-class))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   254
                   (begin
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   255
                     (pic@! ,pic-m ,counter 2 (+ 1 (pic@ ,pic-m ,counter 2)))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   256
                     ,(if (already-compiling? c predicted-class predicted-bmethod)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   257
                          `((unwrap-cached-method vm ,(gen-lit* litmap predicted-cm))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   258
                            vm k-send ,@arg-exps)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   259
                          (gen-inline-send c send-ip predicted-class predicted-bmethod 'k-send arg-exps)))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   260
                   ,(loop more-predictions (+ counter 1)))])))]))
376
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   261
402
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   262
(define (gen-block c argument-location ip)
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   263
  (define temp-count (slotAt (compilation-method c) 4))
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   264
  `(lambda (vm k . block-arguments)
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   265
     ,(let loop ((i argument-location))
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   266
        (if (>= i temp-count)
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   267
            `(void)
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   268
            `(when (pair? block-arguments)
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   269
               (vector-set! temporaries ,i (car block-arguments))
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   270
               (let ((block-arguments (cdr block-arguments)))
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   271
                 ,(loop (+ i 1))))))
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   272
     ,(gen-code c ip '())))
379
e5e063ac93ef Proper direct sends (and MICs); inline primitive definitions
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 378
diff changeset
   273
408
aa5e38d54ab0 Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 406
diff changeset
   274
(define (compilation-litname c literal)
aa5e38d54ab0 Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 406
diff changeset
   275
  (hash-ref (compilation-result-litmap (compilation-state c)) literal))
aa5e38d54ab0 Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 406
diff changeset
   276
413
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   277
(define (has-blocks? method)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   278
  (define bytecode (bv-bytes (slotAt method 1)))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   279
  (define max-ip (bytes-length bytecode))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   280
  (define ip 0)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   281
  (define (next-byte!)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   282
    (begin0 (bytes-ref bytecode ip)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   283
      (set! ip (+ ip 1))))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   284
  (define (decode!)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   285
    (define byte (next-byte!))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   286
    (define low (bitwise-and byte #x0f))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   287
    (define high (bitwise-and (arithmetic-shift byte -4) #x0f))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   288
    (if (zero? high)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   289
        (values low (next-byte!))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   290
        (values high low)))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   291
  (let search ()
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   292
    (if (>= ip max-ip)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   293
        #f
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   294
        (let-values (((opcode arg) (decode!)))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   295
          (match opcode
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   296
            [12 #t]
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   297
            [13 (next-byte!) (search)]
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   298
            [15 (match arg
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   299
                  [6 (next-byte!) (search)]
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   300
                  [7 (next-byte!) (search)]
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   301
                  [8 (next-byte!) (search)]
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   302
                  [11 (next-byte!) (search)]
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   303
                  [_ (search)])]
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   304
            [_ (search)])))))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   305
402
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   306
(define (gen-code c ip stack)
408
aa5e38d54ab0 Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 406
diff changeset
   307
  (define method (compilation-method c))
aa5e38d54ab0 Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 406
diff changeset
   308
  (define bytecode (bv-bytes (slotAt method 1)))
aa5e38d54ab0 Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 406
diff changeset
   309
  (define literals (slotAt method 2))
402
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   310
  (let translate ((ip ip) (stack stack))
376
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   311
    (define (next-byte!)
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   312
      (begin0 (bytes-ref bytecode ip)
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   313
        (set! ip (+ ip 1))))
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   314
    (define (decode!)
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   315
      (define byte (next-byte!))
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   316
      (define low (bitwise-and byte #x0f))
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   317
      (define high (bitwise-and (arithmetic-shift byte -4) #x0f))
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   318
      (if (zero? high)
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   319
          (values low (next-byte!))
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   320
          (values high low)))
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   321
    (define ip0 ip)
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   322
    (define-values (opcode arg) (decode!))
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   323
    (log-vm/jit-debug " ~a: ~a ~a" ip0 opcode arg)
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   324
    (match opcode
386
552736e4616c Preserve abstraction (!)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 385
diff changeset
   325
      [1 (let@ [n (mksym "slot~a_" arg) `(slotAt self ,arg)]
376
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   326
               (translate ip (cons n stack)))]
408
aa5e38d54ab0 Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 406
diff changeset
   327
      [2 (translate ip (cons (vector-ref (compilation-argnames c) arg) stack))]
402
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   328
      [3 (let@ [n (mksym "tmp~a_" arg) `(vector-ref temporaries ,arg)]
376
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   329
               (translate ip (cons n stack)))]
408
aa5e38d54ab0 Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 406
diff changeset
   330
      [4 (let ((name (compilation-litname c (slotAt literals arg))))
aa5e38d54ab0 Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 406
diff changeset
   331
           (translate ip (cons name stack)))]
376
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   332
      [5 (match arg
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   333
           [(or 0 1 2 3 4 5 6 7 8 9) (translate ip (cons arg stack))]
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   334
           [10 (translate ip (cons `NIL stack))]
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   335
           [11 (translate ip (cons `TRUE stack))]
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   336
           [12 (translate ip (cons `FALSE stack))])]
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   337
      [6 `(begin (slotAtPut self ,arg ,(car stack)) ,(translate ip stack))]
402
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   338
      [7 `(begin (vector-set! temporaries ,arg ,(car stack)) ,(translate ip stack))]
379
e5e063ac93ef Proper direct sends (and MICs); inline primitive definitions
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 378
diff changeset
   339
      [8 (let* ((arg-count arg)
e5e063ac93ef Proper direct sends (and MICs); inline primitive definitions
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 378
diff changeset
   340
                (args (reverse (take stack arg-count)))
387
9af7f893128d Factor out gen-send
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 386
diff changeset
   341
                (stack (drop stack arg-count)))
379
e5e063ac93ef Proper direct sends (and MICs); inline primitive definitions
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 378
diff changeset
   342
           (define-values (selector-literal-index class-exp)
e5e063ac93ef Proper direct sends (and MICs); inline primitive definitions
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 378
diff changeset
   343
             (match/values (decode!)
e5e063ac93ef Proper direct sends (and MICs); inline primitive definitions
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 378
diff changeset
   344
               [(9 selector-literal-index)
e5e063ac93ef Proper direct sends (and MICs); inline primitive definitions
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 378
diff changeset
   345
                (values selector-literal-index `(obj-class* vm ,(car args)))]
e5e063ac93ef Proper direct sends (and MICs); inline primitive definitions
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 378
diff changeset
   346
               [(15 11)
e5e063ac93ef Proper direct sends (and MICs); inline primitive definitions
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 378
diff changeset
   347
                (values (next-byte!) `super)]))
402
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   348
           (define k (gen-send-k c ip stack))
408
aa5e38d54ab0 Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 406
diff changeset
   349
           (define selector (slotAt literals selector-literal-index))
aa5e38d54ab0 Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 406
diff changeset
   350
           (define selector-exp (compilation-litname c selector))
410
7e5d9e957c2f Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 409
diff changeset
   351
           (gen-send c ip0 class-exp (bv-bytes selector) selector-exp k args))]
389
befaa2a55f7b Clean out comments & obsoleted code
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 388
diff changeset
   352
      ;; 9 inlined in the processing of bytecode 8
376
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   353
      [10 (match arg
385
0d3839af02db Tighten let@ definition
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 383
diff changeset
   354
            [0 (let@ [isNil `(boolean->obj vm (eq? NIL ,(car stack)))]
0d3839af02db Tighten let@ definition
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 383
diff changeset
   355
                     (translate ip (cons isNil (cdr stack))))]
0d3839af02db Tighten let@ definition
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 383
diff changeset
   356
            [1 (let@ [notNil `(boolean->obj vm (not (eq? NIL ,(car stack))))]
0d3839af02db Tighten let@ definition
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 383
diff changeset
   357
                     (translate ip (cons notNil (cdr stack))))])]
376
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   358
      [11 (match stack
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   359
            [(list* j i stack)
402
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   360
             (let@ [binop-k (gen-send-k c ip stack)]
376
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   361
                   `(if (and (number? ,i) (number? ,j))
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   362
                        ,(match arg
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   363
                           [0 `(,binop-k (boolean->obj vm (< ,i ,j)))]
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   364
                           [1 `(,binop-k (boolean->obj vm (<= ,i ,j)))]
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   365
                           [2 `(,binop-k (+ ,i ,j))])
408
aa5e38d54ab0 Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 406
diff changeset
   366
                        ,(let ((name-bytes (match arg [0 #"<"] [1 #"<="] [2 #"+"])))
aa5e38d54ab0 Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 406
diff changeset
   367
                           (gen-send c
410
7e5d9e957c2f Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 409
diff changeset
   368
                                     ip0
408
aa5e38d54ab0 Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 406
diff changeset
   369
                                     `(obj-class* vm ,i)
aa5e38d54ab0 Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 406
diff changeset
   370
                                     name-bytes
aa5e38d54ab0 Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 406
diff changeset
   371
                                     `(mkbv NIL ,name-bytes)
aa5e38d54ab0 Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 406
diff changeset
   372
                                     binop-k
aa5e38d54ab0 Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 406
diff changeset
   373
                                     (list i j)))))])]
376
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   374
      [12 (let ((target (next-byte!)))
402
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   375
            (let@ [block `(mkffiv BLOCK ,(gen-block c arg ip))]
376
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   376
                  (translate target (cons block stack))))]
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   377
      [13 (define primitive-number (next-byte!))
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   378
          (match primitive-number
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   379
            [8 (let ((v (gensym 'blockresult))
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   380
                     (block (car stack))
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   381
                     (argc (- arg 1))
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   382
                     (stack (cdr stack)))
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   383
                 `(match ,block
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   384
                    [(unffiv block-proc)
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   385
                     (block-proc vm
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   386
                                 ;; TODO vvv : use case-lambda to translate the context chain
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   387
                                 k ;; not (lambda (,v) ,(translate ip (cons v (drop stack argc))))
402
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   388
                                 ;; ^ reason being the image BUGGILY (?!?) relies on primitive 8
376
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   389
                                 ;; immediately returning to the surrounding context!!
377
8accd6d3f51d Extract and make use of block->thunk, to support image-produced block calls.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 376
diff changeset
   390
                                 ,@(reverse (take stack argc)))]
8accd6d3f51d Extract and make use of block->thunk, to support image-produced block calls.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 376
diff changeset
   391
                    [(obj (== BLOCK) _)
8accd6d3f51d Extract and make use of block->thunk, to support image-produced block calls.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 376
diff changeset
   392
                     (k ((block->thunk vm ,block (list ,@(reverse (take stack argc))))))]))]
376
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   393
            [34 'NIL]
402
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   394
            [35 (let@ [ctxref (gen-build-jit-context c ip stack)]
385
0d3839af02db Tighten let@ definition
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 383
diff changeset
   395
                      (translate ip (cons ctxref stack)))]
0d3839af02db Tighten let@ definition
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 383
diff changeset
   396
            [36 (let@ [arr `(mkobj ARRAY ,@(reverse (take stack arg)))]
0d3839af02db Tighten let@ definition
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 383
diff changeset
   397
                      (translate ip (cons arr (drop stack arg))))]
388
ae8b1d7fd6a2 Cosmetic
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 387
diff changeset
   398
            [_ (let ((generator (hash-ref *primitive-code-snippets*
ae8b1d7fd6a2 Cosmetic
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 387
diff changeset
   399
                                          primitive-number
405
5a019affe985 Plumbing preparation for method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 404
diff changeset
   400
                                          (lambda () (error 'gen-code
388
ae8b1d7fd6a2 Cosmetic
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 387
diff changeset
   401
                                                            "Unknown primitive: ~a"
ae8b1d7fd6a2 Cosmetic
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 387
diff changeset
   402
                                                            primitive-number)))))
ae8b1d7fd6a2 Cosmetic
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 387
diff changeset
   403
                 (let@ [primresult (generator 'vm (reverse (take stack arg)))]
ae8b1d7fd6a2 Cosmetic
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 387
diff changeset
   404
                       (translate ip (cons primresult (drop stack arg)))))])]
385
0d3839af02db Tighten let@ definition
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 383
diff changeset
   405
      [14 (let@ [clsvar `(slotAt (obj-class* vm self) ,(+ arg 5))]
0d3839af02db Tighten let@ definition
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 383
diff changeset
   406
                (translate ip (cons clsvar stack)))]
376
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   407
      [15 (match arg
378
2a35e7fcba59 Remove resume-jit-context
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 377
diff changeset
   408
            [1 `(k self)]
2a35e7fcba59 Remove resume-jit-context
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 377
diff changeset
   409
            [2 `(k ,(car stack))]
2a35e7fcba59 Remove resume-jit-context
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 377
diff changeset
   410
            [3 `(outer-k ,(car stack))]
376
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   411
            [5 (translate ip (cdr stack))]
402
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   412
            [6 (gen-jump-to-label c (next-byte!) stack)]
376
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   413
            [7 (let ((target (next-byte!)))
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   414
                 (log-vm/jit-debug "if ~a true jump to ~a, else continue at ~a" (car stack) target ip)
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   415
                 `(if (eq? ,(car stack) TRUE)
402
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   416
                      ,(gen-jump-to-label c target (cdr stack))
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   417
                      ,(gen-jump-to-label c ip (cdr stack))))]
376
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   418
            [8 (let ((target (next-byte!)))
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   419
                 (log-vm/jit-debug "if ~a false jump to ~a, else continue at ~a" (car stack) target ip)
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   420
                 `(if (eq? ,(car stack) FALSE)
402
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   421
                      ,(gen-jump-to-label c target (cdr stack))
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   422
                      ,(gen-jump-to-label c ip (cdr stack))))]
389
befaa2a55f7b Clean out comments & obsoleted code
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 388
diff changeset
   423
            ;; 11 inlined in the processing of bytecode 8
405
5a019affe985 Plumbing preparation for method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 404
diff changeset
   424
            [_ (error 'gen-code "Unhandled do-special case ~v" arg)])]
5a019affe985 Plumbing preparation for method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 404
diff changeset
   425
      [_ (error 'gen-code "Method ~v - unhandled opcode ~v, arg ~v"
402
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   426
                (slotAt (compilation-method c) 0) ;; selector
376
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   427
                opcode
402
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   428
                arg)])))
376
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   429
404
158def14bb15 Pull out gen-label-definitions
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 403
diff changeset
   430
(define (gen-label-definitions c body-exp)
414
5e5c61ed2e7d It's weird, but consistent: sorting the letrec entries slows it down! Why?
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 413
diff changeset
   431
  `(letrec (,@(for/list [((ip label) (in-hash (compilation-labels c)))]
404
158def14bb15 Pull out gen-label-definitions
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 403
diff changeset
   432
                `(,(mksym "label~a" ip) ,label)))
158def14bb15 Pull out gen-label-definitions
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 403
diff changeset
   433
     ,body-exp))
158def14bb15 Pull out gen-label-definitions
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 403
diff changeset
   434
402
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   435
(define (finish-compilation c compile-time-vm inner-code)
413
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   436
  (define litmap (compilation-result-litmap (compilation-state c)))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   437
  (define pic-definitions
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   438
    (for/list [(pi (reverse (compilation-result-pic-list-rev (compilation-state c))))]
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   439
      (define extension (pic-info-extension pi))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   440
      `(define ,(pic-info-variable pi)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   441
         ,(if (null? extension)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   442
              `(pic)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   443
              `(extended-pic
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   444
                ,@(append-map (lambda (entry)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   445
                                (list (and (car entry) (gen-lit* litmap (car entry)))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   446
                                      (and (cadr entry) (gen-lit* litmap (cadr entry)))))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   447
                              (take (append extension empty-pic-extension) pic-entry-count)))))))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   448
  (define litmap-list (hash->list litmap))
376
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   449
  (define code
408
aa5e38d54ab0 Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 406
diff changeset
   450
    `(lambda (method super NIL TRUE FALSE ARRAY BLOCK ,@(map cdr litmap-list))
413
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   451
       ,@pic-definitions
402
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   452
       ,inner-code))
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   453
413
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   454
  (log-vm/jit/code-debug "Resulting code for ~a:\n~a"
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   455
                         (compilation-method-name c)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   456
                         (pretty-format code))
402
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   457
  (define literals (slotAt (compilation-method c) 2))
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   458
  (define defining-class (slotAt (compilation-method c) 5))
403
5e81df1d79c4 Factor out object-memory.rkt and primitives.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 402
diff changeset
   459
  (apply (eval code ns)
5e81df1d79c4 Factor out object-memory.rkt and primitives.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 402
diff changeset
   460
         (compilation-method c)
5e81df1d79c4 Factor out object-memory.rkt and primitives.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 402
diff changeset
   461
         (slotAt defining-class 1) ;; defining class's superclass
5e81df1d79c4 Factor out object-memory.rkt and primitives.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 402
diff changeset
   462
         (VM-nil compile-time-vm) ;; assuming this VM is the one that will be used at call time!
5e81df1d79c4 Factor out object-memory.rkt and primitives.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 402
diff changeset
   463
         (VM-true compile-time-vm)
5e81df1d79c4 Factor out object-memory.rkt and primitives.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 402
diff changeset
   464
         (VM-false compile-time-vm)
5e81df1d79c4 Factor out object-memory.rkt and primitives.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 402
diff changeset
   465
         (VM-Array compile-time-vm)
5e81df1d79c4 Factor out object-memory.rkt and primitives.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 402
diff changeset
   466
         (VM-Block compile-time-vm)
408
aa5e38d54ab0 Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 406
diff changeset
   467
         (map car litmap-list)))
376
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   468
402
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   469
(define (compile-block-proc compile-time-vm
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   470
                            method
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   471
                            outer-args
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   472
                            actual-temporaries
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   473
                            argument-location
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   474
                            initial-ip)
405
5a019affe985 Plumbing preparation for method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 404
diff changeset
   475
  (define class (obj-class* compile-time-vm (car outer-args)))
413
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   476
  (define c (top-compilation compile-time-vm class method #f))
402
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   477
  (define body-code (gen-block c argument-location initial-ip)) ;; imperative!
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   478
  (define inner-code
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   479
    `(lambda (temporaries ,@(vector->list (compilation-argnames c)))
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   480
       (let ((outer-k (outermost-k vm)))
404
158def14bb15 Pull out gen-label-definitions
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 403
diff changeset
   481
         ,(gen-label-definitions c body-code))))
402
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   482
  (apply (finish-compilation c compile-time-vm inner-code)
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   483
         actual-temporaries
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   484
         outer-args))
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   485
413
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   486
(define (bytecode->cached-compiled vm class method)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   487
  (lookup-method/cache vm class (bv-bytes (slotAt method 0))))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   488
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   489
(define (compiled->bytecode cmethod)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   490
  (compiled-method-info-bytecode-method (cmethod)))
410
7e5d9e957c2f Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 409
diff changeset
   491
413
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   492
(define (recompilation-candidate vm ctx)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   493
  (let search ((ctx ctx) (candidate #f) (candidate-class #f) (candidate-hotness 0))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   494
    (cond
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   495
      [(eq? (VM-nil vm) ctx) (values candidate candidate-class)]
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   496
      [else (define method (slotAt ctx 0))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   497
            (define receiver (slotAt (slotAt ctx 1) 0))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   498
            (define receiver-class (obj-class* vm receiver))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   499
            (define next-ctx (slotAt ctx 6))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   500
            (log-vm/jit/recompile-debug "  ~a" (method-name method receiver-class))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   501
            (define cached-method (bytecode->cached-compiled vm receiver-class method))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   502
            (define compiled-method (unwrap-cached-method vm cached-method))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   503
            (cond
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   504
              [(not compiled-method) (search next-ctx candidate candidate-class candidate-hotness)]
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   505
              [else
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   506
               (match-define (compiled-method-info bytecode-method pics stable?) (compiled-method))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   507
               (log-vm/jit/recompile-debug "    has ~a bytes of bytecode; ~a; ~a"
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   508
                                           (bytes-length (bv-bytes (slotAt bytecode-method 1)))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   509
                                           (if (has-blocks? bytecode-method)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   510
                                               "HAS SOME BLOCKS"
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   511
                                               "no blocks")
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   512
                                           (if stable? "stable" "not yet stable"))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   513
               (define (pic-entry-has-any-calls? entry)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   514
                 (define pic (cdr entry))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   515
                 (for/or [(i (in-range (pic-size pic)))] (positive? (pic@ pic i 2))))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   516
               (define used-pics (filter pic-entry-has-any-calls? pics))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   517
               (define hotness
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   518
                 (for/sum [(entry used-pics)]
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   519
                   (match-define (cons pi pic) entry)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   520
                   (for/sum [(i (in-range (pic-size pic)))]
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   521
                     (match (pic@ pic i 0)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   522
                       [#f 0]
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   523
                       [slot-class
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   524
                        (define slot-cm (pic@ pic i 1))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   525
                        (unwrap-cached-method vm slot-cm) ;; fills cache entry
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   526
                        (define slot-bmethod (cached-method-bytecode-method slot-cm))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   527
                        (define slot-count (pic@ pic i 2))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   528
                        (define bytecode-count (bytes-length (bv-bytes (slotAt slot-bmethod 1))))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   529
                        (define weight (/ 40.0 bytecode-count))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   530
                        (log-vm/jit/recompile-debug
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   531
                         "      ~a context ~a class ~a count ~a length ~a weight ~a"
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   532
                         (pic-info-name-bytes pi)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   533
                         (pic-info-context pi)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   534
                         (bv->string (slotAt slot-class 0))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   535
                         slot-count
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   536
                         bytecode-count
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   537
                         weight)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   538
                        (* slot-count weight)]))))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   539
               (log-vm/jit/recompile-debug "    hotness: ~a" hotness)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   540
               (if (and (> hotness candidate-hotness) (not stable?))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   541
                   (search next-ctx method receiver-class hotness)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   542
                   (search next-ctx candidate candidate-class candidate-hotness))])])))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   543
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   544
(define (format-compilation-context x)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   545
  (string-join (reverse
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   546
                (map (match-lambda [(list c m ip) (format "~a @~a" (method-name m c) ip)]) x))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   547
               ","
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   548
               #:before-first "["
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   549
               #:after-last "]"))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   550
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   551
(define (recompile-method! vm class method)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   552
  (log-vm/jit/recompile-info "Recompiling ~a" (method-name method class))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   553
  (define cached-method (bytecode->cached-compiled vm class method))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   554
  (define old-proc (cached-method-proc cached-method))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   555
  (define old-picmap
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   556
    (for/hash [(entry (in-list (if old-proc (compiled-method-info-pics (old-proc)) '())))]
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   557
      (define pi (car entry))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   558
      (values (pic-info-context pi) entry)))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   559
  (when (not (hash-empty? old-picmap))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   560
    (log-vm/jit/recompile-info "Retrieved old pics for method ~a" (method-name method class))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   561
    (for [((i p) (in-hash old-picmap))]
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   562
      (log-vm/jit/recompile-info "   ~a --> ~v" (format-compilation-context i) p)))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   563
  (define recompiled-proc (compile-method-proc vm class method old-picmap))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   564
  (log-vm/jit/recompile-info "Updating cached compiled method for ~a" (method-name method class))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   565
  (set-cached-method-proc! cached-method recompiled-proc))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   566
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   567
(define (recompile-something vm ctx)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   568
  (define-values (candidate candidate-class) (recompilation-candidate vm ctx))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   569
  (if candidate
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   570
      (recompile-method! vm candidate-class candidate)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   571
      (log-vm/jit/recompile-info "No recompilation candidate available?")))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   572
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   573
(define (compile-method-proc compile-time-vm class method old-picmap)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   574
  (define c (top-compilation compile-time-vm class method old-picmap))
402
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   575
  (define body-code (gen-jump-to-label c 0 '())) ;; imperative!
413
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   576
  (define pic-infos (reverse (compilation-result-pic-list-rev (compilation-state c))))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   577
  (define pic-infos-exp (gen-lit* (compilation-result-litmap (compilation-state c)) pic-infos))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   578
  (define stable? (equal? (if old-picmap (list->set (hash-keys old-picmap)) 'unknown)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   579
                          (list->set (map pic-info-context pic-infos))))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   580
  (when stable?
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   581
    (log-vm/jit/recompile-info "Compilation of ~a is now stable." (method-name method class)))
402
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   582
  (define inner-code
413
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   583
    `(let ((call-counter 0)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   584
           (cmi #f))
410
7e5d9e957c2f Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 409
diff changeset
   585
       (case-lambda
7e5d9e957c2f Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 409
diff changeset
   586
         [()
413
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   587
          (when (not cmi)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   588
            (set! cmi
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   589
                  (compiled-method-info
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   590
                   method
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   591
                   (for/list [(pi (in-list ,pic-infos-exp))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   592
                              (pic (in-list (list ,@(map pic-info-variable pic-infos))))]
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   593
                     (cons pi pic))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   594
                   ,stable?)))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   595
          cmi]
410
7e5d9e957c2f Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 409
diff changeset
   596
         [(vm k ,@(vector->list (compilation-argnames c)))
7e5d9e957c2f Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 409
diff changeset
   597
          (set! call-counter (+ call-counter 1))
413
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   598
          ;; TODO: aging of call-counter by right-shifting at most once every few seconds, or so
410
7e5d9e957c2f Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 409
diff changeset
   599
          (when (= call-counter 1000)
413
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   600
            (log-vm/jit/recompile-info "Method ~a is hot" ,(method-name method class))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   601
            (recompile-something vm (k))
410
7e5d9e957c2f Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 409
diff changeset
   602
            ;; (set! call-counter 0)
7e5d9e957c2f Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 409
diff changeset
   603
            )
7e5d9e957c2f Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 409
diff changeset
   604
          (let ((outer-k k)
7e5d9e957c2f Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 409
diff changeset
   605
                (temporaries ,(gen-fresh-temps method)))
7e5d9e957c2f Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 409
diff changeset
   606
            ,(gen-label-definitions c body-code))])))
402
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   607
  (finish-compilation c compile-time-vm inner-code))
376
6944f882b052 First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 375
diff changeset
   608
411
ba74f97d2ba9 Indirection to allow invalidation of cached compiled method
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 410
diff changeset
   609
(define (unwrap-cached-method vm cm)
ba74f97d2ba9 Indirection to allow invalidation of cached compiled method
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 410
diff changeset
   610
  (or (cached-method-proc cm)
ba74f97d2ba9 Indirection to allow invalidation of cached compiled method
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 410
diff changeset
   611
      (match cm
ba74f97d2ba9 Indirection to allow invalidation of cached compiled method
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 410
diff changeset
   612
        [(cached-method class name-bytes _bcm _proc)
ba74f97d2ba9 Indirection to allow invalidation of cached compiled method
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 410
diff changeset
   613
         (define bcm (lookup-method vm class name-bytes))
413
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   614
         (define proc (and bcm (compile-method-proc vm class bcm #f)))
411
ba74f97d2ba9 Indirection to allow invalidation of cached compiled method
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 410
diff changeset
   615
         (set-cached-method-bytecode-method! cm bcm)
ba74f97d2ba9 Indirection to allow invalidation of cached compiled method
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 410
diff changeset
   616
         (set-cached-method-proc! cm proc)
ba74f97d2ba9 Indirection to allow invalidation of cached compiled method
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 410
diff changeset
   617
         proc])))
ba74f97d2ba9 Indirection to allow invalidation of cached compiled method
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 410
diff changeset
   618
413
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   619
(define (invalidate-cached-method! cm)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   620
  (set-cached-method-bytecode-method! cm #f)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   621
  (set-cached-method-proc! cm #f))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   622
392
618244a1ee07 Small change toward avoiding consing selectors unnecessarily.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 389
diff changeset
   623
(define (lookup-method/cache vm class name-bytes)
403
5e81df1d79c4 Factor out object-memory.rkt and primitives.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 402
diff changeset
   624
  (define class-cache (hash-ref! (jit-VM-cache vm) class make-weak-hash))
402
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   625
  (hash-ref! class-cache
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   626
             name-bytes
411
ba74f97d2ba9 Indirection to allow invalidation of cached compiled method
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 410
diff changeset
   627
             (lambda () (cached-method class name-bytes #f #f))))
368
bd33c8691bba Simplest possible method cache. hop: 411861 bytecodes/sec; 65707 sends/sec --> 859845 bytecodes/sec; 106388 sends/sec
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 367
diff changeset
   628
396
3bfb9afdbd9d Switch from mic to pic
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 395
diff changeset
   629
(define (lookup-message/jit vm pic class selector)
3bfb9afdbd9d Switch from mic to pic
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 395
diff changeset
   630
  (let search-pic ((slot-index 0))
413
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   631
    (define this-class (pic@ pic slot-index 0))
396
3bfb9afdbd9d Switch from mic to pic
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 395
diff changeset
   632
    (if (eq? this-class class)
413
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   633
        (begin (pic@! pic slot-index 2 (+ 1 (pic@ pic slot-index 2)))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   634
               (or (unwrap-cached-method vm (pic@ pic slot-index 1))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   635
                   (send-dnu class selector)))
396
3bfb9afdbd9d Switch from mic to pic
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 395
diff changeset
   636
        (let* ((next-slot-index (+ slot-index 1))
409
f19c9ff9d0d3 Repair pic fill-in code: it had been filling in only the final slot (!). ~7% speed boost
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 408
diff changeset
   637
               (more-slots-to-check? (and this-class (< next-slot-index pic-entry-count))))
396
3bfb9afdbd9d Switch from mic to pic
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 395
diff changeset
   638
          (if more-slots-to-check?
3bfb9afdbd9d Switch from mic to pic
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 395
diff changeset
   639
              (search-pic next-slot-index)
413
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   640
              (let* ((cm (lookup-method/cache vm class (bv-bytes selector))))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   641
                (when (not this-class)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   642
                  (pic@! pic slot-index 0 class)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   643
                  (pic@! pic slot-index 1 cm)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   644
                  (pic@! pic slot-index 2 1))
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   645
                (or (unwrap-cached-method vm cm)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   646
                    (send-dnu class selector))))))))
379
e5e063ac93ef Proper direct sends (and MICs); inline primitive definitions
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 378
diff changeset
   647
413
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   648
(define ((send-dnu class selector) vm ctx . args)
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   649
  (define arguments (obj (VM-Array vm) (list->vector args)))
392
618244a1ee07 Small change toward avoiding consing selectors unnecessarily.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 389
diff changeset
   650
  (define dnu-name-bytes #"doesNotUnderstand:")
411
ba74f97d2ba9 Indirection to allow invalidation of cached compiled method
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 410
diff changeset
   651
  (match (unwrap-cached-method vm (lookup-method/cache vm class dnu-name-bytes))
379
e5e063ac93ef Proper direct sends (and MICs); inline primitive definitions
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 378
diff changeset
   652
    [#f (error 'send-message* "Unhandled selector ~a at class ~a" selector class)]
e5e063ac93ef Proper direct sends (and MICs); inline primitive definitions
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 378
diff changeset
   653
    [dnu-method
e5e063ac93ef Proper direct sends (and MICs); inline primitive definitions
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 378
diff changeset
   654
     (log-vm-warning "DNU -- arguments ~a class ~a selector ~a" arguments class selector)
403
5e81df1d79c4 Factor out object-memory.rkt and primitives.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 402
diff changeset
   655
     (dnu-method vm ctx (slotAt arguments 0) (mkobj (VM-Array vm) selector arguments))]))
353
d4161a4117e8 Image loader and virtual machine for SmallWorld 2015 Smalltalk.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
   656
402
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   657
(define (block->thunk vm block args) ;; Expects a real bytecode block, not an ffiv one
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   658
  (lambda ()
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   659
    (define method (slotAt block 0))
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   660
    (define outer-args (vector->list (obj-slots (slotAt block 1))))
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   661
    (define temporaries (obj-slots (slotAt block 2)))
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   662
    (define argument-location (slotAt block 7))
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   663
    (define block-ip (slotAt block 9))
403
5e81df1d79c4 Factor out object-memory.rkt and primitives.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 402
diff changeset
   664
    (define f (compile-block-proc vm method outer-args temporaries argument-location block-ip))
5e81df1d79c4 Factor out object-memory.rkt and primitives.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 402
diff changeset
   665
    (apply f vm (outermost-k vm) args)))
353
d4161a4117e8 Image loader and virtual machine for SmallWorld 2015 Smalltalk.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
   666
402
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   667
(define (outermost-k vm)
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   668
  (case-lambda [() (VM-nil vm)]
dc1bd2065cd1 Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 396
diff changeset
   669
               [(result) result]))
377
8accd6d3f51d Extract and make use of block->thunk, to support image-produced block calls.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 376
diff changeset
   670
379
e5e063ac93ef Proper direct sends (and MICs); inline primitive definitions
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 378
diff changeset
   671
;;===========================================================================
375
c090edeff4c5 Split out most primitives into a separate routine.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 373
diff changeset
   672
379
e5e063ac93ef Proper direct sends (and MICs); inline primitive definitions
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 378
diff changeset
   673
(define-primitive vm [6 inner-ctx] ;; "new context execute"
403
5e81df1d79c4 Factor out object-memory.rkt and primitives.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 402
diff changeset
   674
  (when (not (zero? (slotAt inner-ctx 5))) (error 'execute "Cannot execute from nonempty stack"))
5e81df1d79c4 Factor out object-memory.rkt and primitives.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 402
diff changeset
   675
  (when (not (zero? (slotAt inner-ctx 4))) (error 'execute "Cannot execute from nonzero IP"))
405
5a019affe985 Plumbing preparation for method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 404
diff changeset
   676
  (define args (slotAt inner-ctx 1))
413
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   677
  (define f (compile-method-proc vm (obj-class* vm (slotAt args 0)) (slotAt inner-ctx 0) #f))
405
5a019affe985 Plumbing preparation for method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 404
diff changeset
   678
  (apply f vm (outermost-k vm) (vector->list (obj-slots args))))
379
e5e063ac93ef Proper direct sends (and MICs); inline primitive definitions
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 378
diff changeset
   679
e5e063ac93ef Proper direct sends (and MICs); inline primitive definitions
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 378
diff changeset
   680
(define-primitive vm [116]
e5e063ac93ef Proper direct sends (and MICs); inline primitive definitions
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 378
diff changeset
   681
  (let ((image-bytes (serialize-image vm)))
403
5e81df1d79c4 Factor out object-memory.rkt and primitives.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 402
diff changeset
   682
    (display-to-file image-bytes (jit-VM-image-filename vm) #:exists 'replace)))
375
c090edeff4c5 Split out most primitives into a separate routine.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 373
diff changeset
   683
379
e5e063ac93ef Proper direct sends (and MICs); inline primitive definitions
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 378
diff changeset
   684
;;===========================================================================
375
c090edeff4c5 Split out most primitives into a separate routine.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 373
diff changeset
   685
413
99a706eaf2cf Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 411
diff changeset
   686
(pretty-print-columns 132)
369
3e1f84e6289d Image saving
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 368
diff changeset
   687
(let* ((image-filename "SmallWorld/src/image")
403
5e81df1d79c4 Factor out object-memory.rkt and primitives.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 402
diff changeset
   688
       (vm (call-with-input-file image-filename
5e81df1d79c4 Factor out object-memory.rkt and primitives.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 402
diff changeset
   689
             (lambda (fh)
5e81df1d79c4 Factor out object-memory.rkt and primitives.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 402
diff changeset
   690
               (read-image fh jit-VM (list (make-weak-hasheq) image-filename))))))
5e81df1d79c4 Factor out object-memory.rkt and primitives.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 402
diff changeset
   691
  (boot-image vm
5e81df1d79c4 Factor out object-memory.rkt and primitives.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 402
diff changeset
   692
              (lambda (vm source)
411
ba74f97d2ba9 Indirection to allow invalidation of cached compiled method
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 410
diff changeset
   693
                (define compiled-method
ba74f97d2ba9 Indirection to allow invalidation of cached compiled method
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 410
diff changeset
   694
                  (unwrap-cached-method vm (lookup-method/cache vm (obj-class source) #"doIt")))
ba74f97d2ba9 Indirection to allow invalidation of cached compiled method
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 410
diff changeset
   695
                (compiled-method vm (outermost-k vm) source))
403
5e81df1d79c4 Factor out object-memory.rkt and primitives.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents: 402
diff changeset
   696
              (current-command-line-arguments)))