author | Tony Garnock-Jones <tonygarnockjones@gmail.com> |
Mon, 23 Jul 2018 18:41:40 +0100 | |
changeset 413 | 99a706eaf2cf |
parent 411 | ba74f97d2ba9 |
child 414 | 5e5c61ed2e7d |
permissions | -rw-r--r-- |
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 |
|
376
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset
|
54 |
(define (build-jit-context vm previous-context args method ip stack-top 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 |
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset
|
64 |
stack-top |
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 |
,(length 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
|
159 |
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
|
160 |
(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
|
161 |
|
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
|
162 |
(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
|
163 |
(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
|
164 |
`(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
|
165 |
[(,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
|
166 |
|
408
aa5e38d54ab0
Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset
|
167 |
(define (gen-fresh-temps method) |
aa5e38d54ab0
Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset
|
168 |
(match (slotAt method 4) |
aa5e38d54ab0
Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset
|
169 |
[0 `'#()] |
aa5e38d54ab0
Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset
|
170 |
[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
|
171 |
|
413
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
172 |
(define (inlineable-self-send? method) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
173 |
(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
|
174 |
(<= (bytes-length bytecode) 32)) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
175 |
|
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
176 |
(define (compilation-context c ip) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
177 |
(if (not c) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
178 |
'() |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
179 |
(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
|
180 |
(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
|
181 |
|
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
182 |
(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
|
183 |
(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
|
184 |
(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
|
185 |
(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
|
186 |
(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
|
187 |
(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
|
188 |
(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
|
189 |
send-ip |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
190 |
name-bytes |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
191 |
(compilation-method-name c)) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
192 |
m) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
193 |
|
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
194 |
(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
|
195 |
(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
|
196 |
(method-name method class) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
197 |
(compilation-method-name c)) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
198 |
(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
|
199 |
(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
|
200 |
(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
|
201 |
(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
|
202 |
(define inner-code |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
203 |
`(let ((k ,k-exp) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
204 |
(method ,(gen-lit* litmap method)) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
205 |
(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
|
206 |
(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
|
207 |
(actual (in-list arg-exps))] |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
208 |
`(,formal ,actual)) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
209 |
(let ((outer-k k) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
210 |
(temporaries ,(gen-fresh-temps method))) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
211 |
,(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
|
212 |
(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
|
213 |
inner-code) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
214 |
|
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
215 |
(define (analyse-pic c pic) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
216 |
(define vm (compilation-vm c)) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
217 |
(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
|
218 |
(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
|
219 |
(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
|
220 |
(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
|
221 |
(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
|
222 |
descending-by-call-count) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
223 |
|
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
224 |
(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
|
225 |
(let check ((c c)) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
226 |
(cond [(not c) #f] |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
227 |
[(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
|
228 |
[else (check (compilation-outer c))]))) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
229 |
|
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
230 |
(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
|
231 |
(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
|
232 |
(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
|
233 |
(cond |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
234 |
[(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
|
235 |
(< (compilation-depth c) 2) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
236 |
method |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
237 |
(inlineable-self-send? method)) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
238 |
(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
|
239 |
[else |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
240 |
(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
|
241 |
(define old-entry |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
242 |
(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
|
243 |
(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
|
244 |
(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
|
245 |
(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
|
246 |
`(let ((actual-class ,class-exp) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
247 |
(k-send ,k-exp)) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
248 |
,(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
|
249 |
(match predictions |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
250 |
['() |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
251 |
`((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
|
252 |
[(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
|
253 |
(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
|
254 |
`(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
|
255 |
(begin |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
256 |
(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
|
257 |
,(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
|
258 |
`((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
|
259 |
vm k-send ,@arg-exps) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
260 |
(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
|
261 |
,(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
|
262 |
|
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
|
263 |
(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
|
264 |
(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
|
265 |
`(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
|
266 |
,(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
|
267 |
(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
|
268 |
`(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
|
269 |
`(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
|
270 |
(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
|
271 |
(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
|
272 |
,(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
|
273 |
,(gen-code c ip '()))) |
379
e5e063ac93ef
Proper direct sends (and MICs); inline primitive definitions
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
378
diff
changeset
|
274 |
|
408
aa5e38d54ab0
Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset
|
275 |
(define (compilation-litname c literal) |
aa5e38d54ab0
Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset
|
276 |
(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
|
277 |
|
413
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
278 |
(define (has-blocks? method) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
279 |
(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
|
280 |
(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
|
281 |
(define ip 0) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
282 |
(define (next-byte!) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
283 |
(begin0 (bytes-ref bytecode ip) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
284 |
(set! ip (+ ip 1)))) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
285 |
(define (decode!) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
286 |
(define byte (next-byte!)) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
287 |
(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
|
288 |
(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
|
289 |
(if (zero? high) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
290 |
(values low (next-byte!)) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
291 |
(values high low))) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
292 |
(let search () |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
293 |
(if (>= ip max-ip) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
294 |
#f |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
295 |
(let-values (((opcode arg) (decode!))) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
296 |
(match opcode |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
297 |
[12 #t] |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
298 |
[13 (next-byte!) (search)] |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
299 |
[15 (match arg |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
300 |
[6 (next-byte!) (search)] |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
301 |
[7 (next-byte!) (search)] |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
302 |
[8 (next-byte!) (search)] |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
303 |
[11 (next-byte!) (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 |
[_ (search)]))))) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
306 |
|
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
|
307 |
(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
|
308 |
(define method (compilation-method c)) |
aa5e38d54ab0
Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset
|
309 |
(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
|
310 |
(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
|
311 |
(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
|
312 |
(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
|
313 |
(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
|
314 |
(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
|
315 |
(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
|
316 |
(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
|
317 |
(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
|
318 |
(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
|
319 |
(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
|
320 |
(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
|
321 |
(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
|
322 |
(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
|
323 |
(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
|
324 |
(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
|
325 |
(match opcode |
386
552736e4616c
Preserve abstraction (!)
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
385
diff
changeset
|
326 |
[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
|
327 |
(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
|
328 |
[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
|
329 |
[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
|
330 |
(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
|
331 |
[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
|
332 |
(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
|
333 |
[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
|
334 |
[(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
|
335 |
[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
|
336 |
[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
|
337 |
[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
|
338 |
[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
|
339 |
[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
|
340 |
[8 (let* ((arg-count arg) |
e5e063ac93ef
Proper direct sends (and MICs); inline primitive definitions
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
378
diff
changeset
|
341 |
(args (reverse (take stack arg-count))) |
387
9af7f893128d
Factor out gen-send
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
386
diff
changeset
|
342 |
(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
|
343 |
(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
|
344 |
(match/values (decode!) |
e5e063ac93ef
Proper direct sends (and MICs); inline primitive definitions
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
378
diff
changeset
|
345 |
[(9 selector-literal-index) |
e5e063ac93ef
Proper direct sends (and MICs); inline primitive definitions
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
378
diff
changeset
|
346 |
(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
|
347 |
[(15 11) |
e5e063ac93ef
Proper direct sends (and MICs); inline primitive definitions
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
378
diff
changeset
|
348 |
(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
|
349 |
(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
|
350 |
(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
|
351 |
(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
|
352 |
(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
|
353 |
;; 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
|
354 |
[10 (match arg |
385
0d3839af02db
Tighten let@ definition
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
383
diff
changeset
|
355 |
[0 (let@ [isNil `(boolean->obj vm (eq? NIL ,(car stack)))] |
0d3839af02db
Tighten let@ definition
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
383
diff
changeset
|
356 |
(translate ip (cons isNil (cdr stack))))] |
0d3839af02db
Tighten let@ definition
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
383
diff
changeset
|
357 |
[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
|
358 |
(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
|
359 |
[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
|
360 |
[(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
|
361 |
(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
|
362 |
`(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
|
363 |
,(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
|
364 |
[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
|
365 |
[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
|
366 |
[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
|
367 |
,(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
|
368 |
(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
|
369 |
ip0 |
408
aa5e38d54ab0
Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset
|
370 |
`(obj-class* vm ,i) |
aa5e38d54ab0
Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset
|
371 |
name-bytes |
aa5e38d54ab0
Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset
|
372 |
`(mkbv NIL ,name-bytes) |
aa5e38d54ab0
Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset
|
373 |
binop-k |
aa5e38d54ab0
Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset
|
374 |
(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
|
375 |
[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
|
376 |
(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
|
377 |
(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
|
378 |
[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
|
379 |
(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
|
380 |
[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
|
381 |
(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
|
382 |
(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
|
383 |
(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
|
384 |
`(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
|
385 |
[(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
|
386 |
(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
|
387 |
;; 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
|
388 |
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
|
389 |
;; ^ 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
|
390 |
;; 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
|
391 |
,@(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
|
392 |
[(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
|
393 |
(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
|
394 |
[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
|
395 |
[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
|
396 |
(translate ip (cons ctxref stack)))] |
0d3839af02db
Tighten let@ definition
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
383
diff
changeset
|
397 |
[36 (let@ [arr `(mkobj ARRAY ,@(reverse (take stack arg)))] |
0d3839af02db
Tighten let@ definition
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
383
diff
changeset
|
398 |
(translate ip (cons arr (drop stack arg))))] |
388 | 399 |
[_ (let ((generator (hash-ref *primitive-code-snippets* |
400 |
primitive-number |
|
405
5a019affe985
Plumbing preparation for method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
404
diff
changeset
|
401 |
(lambda () (error 'gen-code |
388 | 402 |
"Unknown primitive: ~a" |
403 |
primitive-number))))) |
|
404 |
(let@ [primresult (generator 'vm (reverse (take stack arg)))] |
|
405 |
(translate ip (cons primresult (drop stack arg)))))])] |
|
385
0d3839af02db
Tighten let@ definition
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
383
diff
changeset
|
406 |
[14 (let@ [clsvar `(slotAt (obj-class* vm self) ,(+ arg 5))] |
0d3839af02db
Tighten let@ definition
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
383
diff
changeset
|
407 |
(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
|
408 |
[15 (match arg |
378
2a35e7fcba59
Remove resume-jit-context
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
377
diff
changeset
|
409 |
[1 `(k self)] |
2a35e7fcba59
Remove resume-jit-context
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
377
diff
changeset
|
410 |
[2 `(k ,(car stack))] |
2a35e7fcba59
Remove resume-jit-context
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
377
diff
changeset
|
411 |
[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
|
412 |
[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
|
413 |
[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
|
414 |
[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
|
415 |
(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
|
416 |
`(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
|
417 |
,(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
|
418 |
,(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
|
419 |
[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
|
420 |
(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
|
421 |
`(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
|
422 |
,(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
|
423 |
,(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
|
424 |
;; 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
|
425 |
[_ (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
|
426 |
[_ (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
|
427 |
(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
|
428 |
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
|
429 |
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
|
430 |
|
404
158def14bb15
Pull out gen-label-definitions
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
403
diff
changeset
|
431 |
(define (gen-label-definitions c body-exp) |
413
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
432 |
`(letrec (,@(for/list [(entry (in-list (sort (hash->list (compilation-labels c)) < #:key car)))] |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
433 |
(match-define (cons ip label) entry) |
404
158def14bb15
Pull out gen-label-definitions
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
403
diff
changeset
|
434 |
`(,(mksym "label~a" ip) ,label))) |
158def14bb15
Pull out gen-label-definitions
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
403
diff
changeset
|
435 |
,body-exp)) |
158def14bb15
Pull out gen-label-definitions
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
403
diff
changeset
|
436 |
|
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
|
437 |
(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
|
438 |
(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
|
439 |
(define pic-definitions |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
440 |
(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
|
441 |
(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
|
442 |
`(define ,(pic-info-variable pi) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
443 |
,(if (null? extension) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
444 |
`(pic) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
445 |
`(extended-pic |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
446 |
,@(append-map (lambda (entry) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
447 |
(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
|
448 |
(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
|
449 |
(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
|
450 |
(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
|
451 |
(define code |
408
aa5e38d54ab0
Inline self sends - a kind of method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset
|
452 |
`(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
|
453 |
,@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
|
454 |
,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
|
455 |
|
413
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
456 |
(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
|
457 |
(compilation-method-name c) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
458 |
(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
|
459 |
(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
|
460 |
(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
|
461 |
(apply (eval code ns) |
5e81df1d79c4
Factor out object-memory.rkt and primitives.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
402
diff
changeset
|
462 |
(compilation-method c) |
5e81df1d79c4
Factor out object-memory.rkt and primitives.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
402
diff
changeset
|
463 |
(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
|
464 |
(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
|
465 |
(VM-true compile-time-vm) |
5e81df1d79c4
Factor out object-memory.rkt and primitives.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
402
diff
changeset
|
466 |
(VM-false compile-time-vm) |
5e81df1d79c4
Factor out object-memory.rkt and primitives.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
402
diff
changeset
|
467 |
(VM-Array compile-time-vm) |
5e81df1d79c4
Factor out object-memory.rkt and primitives.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
402
diff
changeset
|
468 |
(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
|
469 |
(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
|
470 |
|
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
|
471 |
(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
|
472 |
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
|
473 |
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
|
474 |
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
|
475 |
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
|
476 |
initial-ip) |
405
5a019affe985
Plumbing preparation for method customization
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
404
diff
changeset
|
477 |
(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
|
478 |
(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
|
479 |
(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
|
480 |
(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
|
481 |
`(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
|
482 |
(let ((outer-k (outermost-k vm))) |
404
158def14bb15
Pull out gen-label-definitions
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
403
diff
changeset
|
483 |
,(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
|
484 |
(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
|
485 |
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
|
486 |
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
|
487 |
|
413
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
488 |
(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
|
489 |
(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
|
490 |
|
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
491 |
(define (compiled->bytecode cmethod) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
492 |
(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
|
493 |
|
413
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
494 |
(define (recompilation-candidate vm ctx) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
495 |
(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
|
496 |
(cond |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
497 |
[(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
|
498 |
[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
|
499 |
(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
|
500 |
(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
|
501 |
(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
|
502 |
(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
|
503 |
(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
|
504 |
(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
|
505 |
(cond |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
506 |
[(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
|
507 |
[else |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
508 |
(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
|
509 |
(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
|
510 |
(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
|
511 |
(if (has-blocks? bytecode-method) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
512 |
"HAS SOME BLOCKS" |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
513 |
"no blocks") |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
514 |
(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
|
515 |
(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
|
516 |
(define pic (cdr entry)) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
517 |
(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
|
518 |
(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
|
519 |
(define hotness |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
520 |
(for/sum [(entry used-pics)] |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
521 |
(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
|
522 |
(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
|
523 |
(match (pic@ pic i 0) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
524 |
[#f 0] |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
525 |
[slot-class |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
526 |
(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
|
527 |
(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
|
528 |
(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
|
529 |
(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
|
530 |
(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
|
531 |
(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
|
532 |
(log-vm/jit/recompile-debug |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
533 |
" ~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
|
534 |
(pic-info-name-bytes pi) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
535 |
(pic-info-context pi) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
536 |
(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
|
537 |
slot-count |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
538 |
bytecode-count |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
539 |
weight) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
540 |
(* slot-count weight)])))) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
541 |
(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
|
542 |
(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
|
543 |
(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
|
544 |
(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
|
545 |
|
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
546 |
(define (format-compilation-context x) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
547 |
(string-join (reverse |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
548 |
(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
|
549 |
"," |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
550 |
#:before-first "[" |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
551 |
#:after-last "]")) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
552 |
|
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
553 |
(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
|
554 |
(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
|
555 |
(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
|
556 |
(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
|
557 |
(define old-picmap |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
558 |
(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
|
559 |
(define pi (car entry)) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
560 |
(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
|
561 |
(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
|
562 |
(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
|
563 |
(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
|
564 |
(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
|
565 |
(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
|
566 |
(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
|
567 |
(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
|
568 |
|
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
569 |
(define (recompile-something vm ctx) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
570 |
(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
|
571 |
(if candidate |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
572 |
(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
|
573 |
(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
|
574 |
|
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
575 |
(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
|
576 |
(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
|
577 |
(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
|
578 |
(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
|
579 |
(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
|
580 |
(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
|
581 |
(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
|
582 |
(when stable? |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
583 |
(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
|
584 |
(define inner-code |
413
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
585 |
`(let ((call-counter 0) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
586 |
(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
|
587 |
(case-lambda |
7e5d9e957c2f
Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
409
diff
changeset
|
588 |
[() |
413
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
589 |
(when (not cmi) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
590 |
(set! cmi |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
591 |
(compiled-method-info |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
592 |
method |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
593 |
(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
|
594 |
(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
|
595 |
(cons pi pic)) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
596 |
,stable?))) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
597 |
cmi] |
410
7e5d9e957c2f
Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
409
diff
changeset
|
598 |
[(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
|
599 |
(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
|
600 |
;; 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
|
601 |
(when (= call-counter 1000) |
413
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
602 |
(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
|
603 |
(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
|
604 |
;; (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
|
605 |
) |
7e5d9e957c2f
Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
409
diff
changeset
|
606 |
(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
|
607 |
(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
|
608 |
,(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
|
609 |
(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
|
610 |
|
411
ba74f97d2ba9
Indirection to allow invalidation of cached compiled method
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
410
diff
changeset
|
611 |
(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
|
612 |
(or (cached-method-proc cm) |
ba74f97d2ba9
Indirection to allow invalidation of cached compiled method
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
410
diff
changeset
|
613 |
(match cm |
ba74f97d2ba9
Indirection to allow invalidation of cached compiled method
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
410
diff
changeset
|
614 |
[(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
|
615 |
(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
|
616 |
(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
|
617 |
(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
|
618 |
(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
|
619 |
proc]))) |
ba74f97d2ba9
Indirection to allow invalidation of cached compiled method
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
410
diff
changeset
|
620 |
|
413
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
621 |
(define (invalidate-cached-method! cm) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
622 |
(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
|
623 |
(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
|
624 |
|
392
618244a1ee07
Small change toward avoiding consing selectors unnecessarily.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
389
diff
changeset
|
625 |
(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
|
626 |
(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
|
627 |
(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
|
628 |
name-bytes |
411
ba74f97d2ba9
Indirection to allow invalidation of cached compiled method
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
410
diff
changeset
|
629 |
(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
|
630 |
|
396
3bfb9afdbd9d
Switch from mic to pic
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
395
diff
changeset
|
631 |
(define (lookup-message/jit vm pic class selector) |
3bfb9afdbd9d
Switch from mic to pic
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
395
diff
changeset
|
632 |
(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
|
633 |
(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
|
634 |
(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
|
635 |
(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
|
636 |
(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
|
637 |
(send-dnu class selector))) |
396
3bfb9afdbd9d
Switch from mic to pic
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
395
diff
changeset
|
638 |
(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
|
639 |
(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
|
640 |
(if more-slots-to-check? |
3bfb9afdbd9d
Switch from mic to pic
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
395
diff
changeset
|
641 |
(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
|
642 |
(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
|
643 |
(when (not this-class) |
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
644 |
(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
|
645 |
(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
|
646 |
(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
|
647 |
(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
|
648 |
(send-dnu class selector)))))))) |
379
e5e063ac93ef
Proper direct sends (and MICs); inline primitive definitions
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
378
diff
changeset
|
649 |
|
413
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
650 |
(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
|
651 |
(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
|
652 |
(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
|
653 |
(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
|
654 |
[#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
|
655 |
[dnu-method |
e5e063ac93ef
Proper direct sends (and MICs); inline primitive definitions
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
378
diff
changeset
|
656 |
(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
|
657 |
(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
|
658 |
|
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
|
659 |
(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
|
660 |
(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
|
661 |
(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
|
662 |
(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
|
663 |
(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
|
664 |
(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
|
665 |
(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
|
666 |
(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
|
667 |
(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
|
668 |
|
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
|
669 |
(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
|
670 |
(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
|
671 |
[(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
|
672 |
|
379
e5e063ac93ef
Proper direct sends (and MICs); inline primitive definitions
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
378
diff
changeset
|
673 |
;;=========================================================================== |
375
c090edeff4c5
Split out most primitives into a separate routine.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
373
diff
changeset
|
674 |
|
379
e5e063ac93ef
Proper direct sends (and MICs); inline primitive definitions
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
378
diff
changeset
|
675 |
(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
|
676 |
(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
|
677 |
(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
|
678 |
(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
|
679 |
(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
|
680 |
(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
|
681 |
|
e5e063ac93ef
Proper direct sends (and MICs); inline primitive definitions
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
378
diff
changeset
|
682 |
(define-primitive vm [116] |
e5e063ac93ef
Proper direct sends (and MICs); inline primitive definitions
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
378
diff
changeset
|
683 |
(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
|
684 |
(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
|
685 |
|
379
e5e063ac93ef
Proper direct sends (and MICs); inline primitive definitions
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
378
diff
changeset
|
686 |
;;=========================================================================== |
375
c090edeff4c5
Split out most primitives into a separate routine.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
373
diff
changeset
|
687 |
|
413
99a706eaf2cf
Recompilation and pic-based inlining. Slower than before!
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset
|
688 |
(pretty-print-columns 132) |
369
3e1f84e6289d
Image saving
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
368
diff
changeset
|
689 |
(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
|
690 |
(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
|
691 |
(lambda (fh) |
5e81df1d79c4
Factor out object-memory.rkt and primitives.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
402
diff
changeset
|
692 |
(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
|
693 |
(boot-image vm |
5e81df1d79c4
Factor out object-memory.rkt and primitives.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
402
diff
changeset
|
694 |
(lambda (vm source) |
411
ba74f97d2ba9
Indirection to allow invalidation of cached compiled method
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
410
diff
changeset
|
695 |
(define compiled-method |
ba74f97d2ba9
Indirection to allow invalidation of cached compiled method
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
410
diff
changeset
|
696 |
(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
|
697 |
(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
|
698 |
(current-command-line-arguments))) |