author  Tony GarnockJones <tonygarnockjones@gmail.com> 
Mon, 23 Jul 2018 20:38:31 +0100  
changeset 415  3d1ae8f1b0d7 
parent 414  5e5c61ed2e7d 
child 416  9be895de88d6 
permissions  rwrr 
353
d4161a4117e8
Image loader and virtual machine for SmallWorld 2015 Smalltalk.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

1 
#lang racket/gui 
d4161a4117e8
Image loader and virtual machine for SmallWorld 2015 Smalltalk.
Tony GarnockJones <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 GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

3 
;; variant of SmallWorld, a Tim Buddauthored Little Smalltalk 
d4161a4117e8
Image loader and virtual machine for SmallWorld 2015 Smalltalk.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

4 
;; descendant. 
d4161a4117e8
Image loader and virtual machine for SmallWorld 2015 Smalltalk.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

5 

369
3e1f84e6289d
Image saving
Tony GarnockJones <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 GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

7 
(require (onlyin sha bytes>hexstring)) 
403
5e81df1d79c4
Factor out objectmemory.rkt and primitives.rkt
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
402
diff
changeset

8 
(require "objectmemory.rkt") 
5e81df1d79c4
Factor out objectmemory.rkt and primitives.rkt
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
402
diff
changeset

9 
(require "primitives.rkt") 
353
d4161a4117e8
Image loader and virtual machine for SmallWorld 2015 Smalltalk.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

10 

d4161a4117e8
Image loader and virtual machine for SmallWorld 2015 Smalltalk.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

11 
(definelogger vm) 
376
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

12 
(definelogger vm/jit) 
410
7e5d9e957c2f
Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
409
diff
changeset

13 
(definelogger vm/jit/code) 
7e5d9e957c2f
Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
409
diff
changeset

14 
(definelogger vm/jit/recompile) 
353
d4161a4117e8
Image loader and virtual machine for SmallWorld 2015 Smalltalk.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

15 

413
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

16 
(define picreserved 0) 
396
3bfb9afdbd9d
Switch from mic to pic
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
395
diff
changeset

17 
(define picentrycount 3) 
413
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

18 
(define (pic) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

19 
;; picentrycount times three  one each for class, method, and count. 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

20 
(vector #f #f 0 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

21 
#f #f 0 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

22 
#f #f 0)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

23 
(define (extendedpic c0 m0 c1 m1 c2 m2) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <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 GarnockJones <tonygarnockjones@gmail.com>
parents:
409
diff
changeset

25 
#f #f 0 
7e5d9e957c2f
Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
409
diff
changeset

26 
#f #f 0 
413
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

27 
c0 m0 0 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

28 
c1 m1 0 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

29 
c2 m2 0)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

30 
(define (picsize pic) (quotient ( (vectorlength pic) picreserved) picentrycount)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

31 
(define emptypicextension (for/list [(i (inrange picentrycount))] '(#f #f))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

32 
(define (pic@ pic index offset) (vectorref pic (+ picreserved offset (* index 3)))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

33 
(define (pic@! pic index offset v) (vectorset! pic (+ picreserved offset (* index 3)) v)) 
395
3979401d44c1
Introduce struct mic
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
394
diff
changeset

34 

403
5e81df1d79c4
Factor out objectmemory.rkt and primitives.rkt
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
402
diff
changeset

35 
(struct jitVM VM (cache imagefilename) 
5e81df1d79c4
Factor out objectmemory.rkt and primitives.rkt
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
402
diff
changeset

36 
#:methods gen:vmcallback 
5e81df1d79c4
Factor out objectmemory.rkt and primitives.rkt
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
402
diff
changeset

37 
[(define (vmblockcallback vm action) 
5e81df1d79c4
Factor out objectmemory.rkt and primitives.rkt
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
402
diff
changeset

38 
;; Runs action in a new thread 
5e81df1d79c4
Factor out objectmemory.rkt and primitives.rkt
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
402
diff
changeset

39 
(lambda args 
5e81df1d79c4
Factor out objectmemory.rkt and primitives.rkt
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
402
diff
changeset

40 
(thread (match action 
5e81df1d79c4
Factor out objectmemory.rkt and primitives.rkt
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
402
diff
changeset

41 
[(unffiv blockproc) 
5e81df1d79c4
Factor out objectmemory.rkt and primitives.rkt
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
402
diff
changeset

42 
(lambda () (apply blockproc vm (outermostk vm) args))] 
5e81df1d79c4
Factor out objectmemory.rkt and primitives.rkt
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
402
diff
changeset

43 
[_ 
5e81df1d79c4
Factor out objectmemory.rkt and primitives.rkt
Tony GarnockJones <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 GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

45 

413
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

46 
(struct picinfo (namebytes variable context extension) #:transparent) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

47 
(struct compilationresult (litmap [piclistrev #:mutable] oldpicmap)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

48 
(struct compilation (outer outerip vm receiverclass method argnames labels state)) 
353
d4161a4117e8
Image loader and virtual machine for SmallWorld 2015 Smalltalk.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

49 

413
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

50 
(struct compiledmethodinfo (bytecodemethod pics stable?)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

51 

99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

52 
(struct cachedmethod (class namebytes [bytecodemethod #:mutable] [proc #:mutable])) 
410
7e5d9e957c2f
Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
409
diff
changeset

53 

415
3d1ae8f1b0d7
Avoid passing around a literal stack length, when it's implicit
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
414
diff
changeset

54 
(define (buildjitcontext vm previouscontext args method ip temporaries stack) 
413
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <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 GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

56 
(define maxstack (slotAt method 3)) 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

57 
(mkobj (VMContext vm) 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

58 
method 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

59 
(obj (VMArray vm) args) 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

60 
(obj (VMArray vm) temporaries) 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

61 
(obj (VMArray vm) (vectorappend stack (makevector ( maxstack (vectorlength stack)) 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

62 
(VMnil vm)))) 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

63 
ip 
415
3d1ae8f1b0d7
Avoid passing around a literal stack length, when it's implicit
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
414
diff
changeset

64 
(vectorlength stack) 
376
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

65 
previouscontext)) 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

66 

6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

67 
(define (selectorstringarity str) 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

68 
(define coloncount (for/sum [(c str)] (if (eqv? c #\:) 1 0))) 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

69 
(cond [(positive? coloncount) (+ coloncount 1)] 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

70 
[(charalphabetic? (stringref str 0)) 1] 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <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 GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

72 

6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

73 
(definenamespaceanchor nsanchor) 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

74 
(define ns (namespaceanchor>namespace nsanchor)) 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <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 GarnockJones <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 GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

77 

dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

78 
(definesyntax let@ 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

79 
(syntaxrules () 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

80 
[(_ [n ncodeexp] bodycodeexp) 
406
3a84d16cac19
Remove gratuitous layer of gensym
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
405
diff
changeset

81 
(let@ [n 'n ncodeexp] bodycodeexp)] 
402
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

82 
[(_ [n nexp ncodeexp] bodycodeexp) 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

83 
(let ((n (gensym nexp))) 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

84 
`(let ((,n ,ncodeexp)) 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

85 
,bodycodeexp))])) 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

86 

413
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

87 
(define (methodname method [class #f]) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

88 
(if class 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

89 
(format "~a >> ~a" 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

90 
(bv>string (slotAt class 0)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

91 
(bv>string (slotAt method 0))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <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 GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

93 

413
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

94 
(define (compilationmethodname c) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

95 
(methodname (compilationmethod c) (compilationreceiverclass c))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

96 

99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

97 
(define (compilationdepth c) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

98 
(define o (compilationouter c)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

99 
(if o (+ 1 (compilationdepth o)) 0)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

100 

99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

101 
(define (compilation* outer outerip compiletimevm receiverclass method state) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

102 
(define arity (selectorstringarity (methodname method))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <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 GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

104 

408
aa5e38d54ab0
Inline self sends  a kind of method customization
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset

105 
(define litmap (compilationresultlitmap state)) 
aa5e38d54ab0
Inline self sends  a kind of method customization
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset

106 
(for [(lit (objslots literals))] (genlit* litmap lit)) 
aa5e38d54ab0
Inline self sends  a kind of method customization
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset

107 

376
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <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 GarnockJones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset

109 

413
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

110 
(define c (compilation outer 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

111 
outerip 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

112 
compiletimevm 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

113 
receiverclass 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

114 
method 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

115 
argnames 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

116 
(makehash) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

117 
state)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

118 
(logvm/jit/codeinfo 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <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 picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

120 
(methodname method receiverclass) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

121 
(slotAt method 5) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

122 
(compilationdepth c) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

123 
arity 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

124 
literals 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

125 
(bytes>hexstring (bvbytes (slotAt method 1))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

126 
(bv>string (slotAt method 6))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

127 
c) 
408
aa5e38d54ab0
Inline self sends  a kind of method customization
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset

128 

413
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

129 
(define (topcompilation vm receiverclass method oldpicmap) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

130 
(compilation* #f #f vm receiverclass method (compilationresult (makehasheq) '() oldpicmap))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

131 

99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

132 
(define (inlinecompilation c cip receiverclass method) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

133 
(compilation* c cip (compilationvm c) receiverclass method (compilationstate c))) 
408
aa5e38d54ab0
Inline self sends  a kind of method customization
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset

134 

aa5e38d54ab0
Inline self sends  a kind of method customization
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset

135 
(define (genlit* litmap lit) 
aa5e38d54ab0
Inline self sends  a kind of method customization
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset

136 
(hashref! litmap lit (lambda () 
aa5e38d54ab0
Inline self sends  a kind of method customization
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset

137 
(define n (hashcount litmap)) 
aa5e38d54ab0
Inline self sends  a kind of method customization
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset

138 
(if (bv? lit) 
aa5e38d54ab0
Inline self sends  a kind of method customization
Tony GarnockJones <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 GarnockJones <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 GarnockJones <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 GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

142 
(define (genjumptolabel c ip stack) 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

143 
(define labels (compilationlabels c)) 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

144 
(when (not (hashhaskey? labels ip)) 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

145 
(hashset! labels ip 'placeholder) 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

146 
(define actuallabel 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <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 GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

148 
`(lambda (k ,@newstack) ,(gencode c ip newstack)))) 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

149 
(hashset! labels ip actuallabel)) 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <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 GarnockJones <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 GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

152 
(define (genbuildjitcontext c ip stack) 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

153 
`(buildjitcontext vm 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <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 GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

155 
(vector ,@(vector>list (compilationargnames c))) 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <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 GarnockJones <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 GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

158 
temporaries 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

159 
(vector ,@(reverse stack)))) 
376
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

160 

402
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

161 
(define (gensendk c ip stack) 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

162 
(define result (gensym 'result)) 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

163 
`(caselambda [() ,(genbuildjitcontext c ip stack)] 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

164 
[(,result) ,(genjumptolabel c ip (cons result stack))])) 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

165 

408
aa5e38d54ab0
Inline self sends  a kind of method customization
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset

166 
(define (genfreshtemps method) 
aa5e38d54ab0
Inline self sends  a kind of method customization
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset

167 
(match (slotAt method 4) 
aa5e38d54ab0
Inline self sends  a kind of method customization
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset

168 
[0 `'#()] 
aa5e38d54ab0
Inline self sends  a kind of method customization
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset

169 
[tempcount `(makevector ,tempcount NIL)])) 
aa5e38d54ab0
Inline self sends  a kind of method customization
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset

170 

413
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

171 
(define (inlineableselfsend? method) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

172 
(define bytecode (bvbytes (slotAt method 1))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

173 
(<= (byteslength bytecode) 32)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

174 

99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

175 
(define (compilationcontext c ip) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

176 
(if (not c) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

177 
'() 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

178 
(cons (list (compilationreceiverclass c) (compilationmethod c) ip) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

179 
(compilationcontext (compilationouter c) (compilationouterip c))))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

180 

99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

181 
(define (genpic c namebytes sendip extension) 
410
7e5d9e957c2f
Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
409
diff
changeset

182 
(define oldpics (compilationresultpiclistrev (compilationstate c))) 
7e5d9e957c2f
Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
409
diff
changeset

183 
(define picindex (length oldpics)) 
402
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

184 
(define m (mksym "pic~a" picindex)) 
413
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

185 
(define pi (picinfo namebytes m (compilationcontext c sendip) extension)) 
410
7e5d9e957c2f
Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
409
diff
changeset

186 
(setcompilationresultpiclistrev! (compilationstate c) (cons pi oldpics)) 
413
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

187 
(logvm/jit/recompiledebug "Produced pic at ip ~a for send of ~a in method ~a" 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

188 
sendip 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

189 
namebytes 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

190 
(compilationmethodname c)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

191 
m) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

192 

99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

193 
(define (geninlinesend c cip class method kexp argexps) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

194 
(logvm/jit/codeinfo "Inlining send of ~a into method ~a" 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

195 
(methodname method class) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

196 
(compilationmethodname c)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

197 
(define ic (inlinecompilation c cip class method)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

198 
(define bodycode (genjumptolabel ic 0 '())) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

199 
(define definingclass (slotAt method 5)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

200 
(define litmap (compilationresultlitmap (compilationstate ic))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

201 
(define innercode 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

202 
`(let ((k ,kexp) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

203 
(method ,(genlit* litmap method)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

204 
(super ,(genlit* litmap (slotAt definingclass 1)))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

205 
(let ,(for/list [(formal (vector>list (compilationargnames ic))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

206 
(actual (inlist argexps))] 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

207 
`(,formal ,actual)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

208 
(let ((outerk k) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

209 
(temporaries ,(genfreshtemps method))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

210 
,(genlabeldefinitions ic bodycode))))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

211 
(logvm/jit/codedebug "INLINED:\n~a" (prettyformat innercode)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

212 
innercode) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

213 

99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

214 
(define (analysepic c pic) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

215 
(define vm (compilationvm c)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

216 
(define unsorted (for/list [(i (inrange (picsize pic))) #:when (pic@ pic i 0)] 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

217 
(list (pic@ pic i 2) (pic@ pic i 0) (pic@ pic i 1)))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

218 
(define descendingbycallcount (map cdr (sort unsorted > #:key car))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

219 
(for [(entry descendingbycallcount)] 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

220 
(unwrapcachedmethod vm (cadr entry))) ;; fills cache entry 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

221 
descendingbycallcount) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

222 

99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

223 
(define (alreadycompiling? c class method) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

224 
(let check ((c c)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

225 
(cond [(not c) #f] 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

226 
[(and (eq? (compilationreceiverclass c) class) (eq? (compilationmethod c) method)) #t] 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

227 
[else (check (compilationouter c))]))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

228 

99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

229 
(define (gensend c sendip classexp namebytes selectorexp kexp argexps) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

230 
(define receiverclass (compilationreceiverclass c)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

231 
(define method (lookupmethod (compilationvm c) receiverclass namebytes)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

232 
(cond 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

233 
[(and (equal? classexp `(objclass* vm self)) ;; self send 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

234 
(< (compilationdepth c) 2) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

235 
method 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

236 
(inlineableselfsend? method)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

237 
(geninlinesend c sendip receiverclass method kexp argexps)] 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

238 
[else 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

239 
(define oldpicmap (compilationresultoldpicmap (compilationstate c))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

240 
(define oldentry 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

241 
(and oldpicmap (hashref oldpicmap (compilationcontext c sendip) #f))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

242 
(define previouspicentries (if oldentry (analysepic c (cdr oldentry)) '())) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

243 
(define litmap (compilationresultlitmap (compilationstate c))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

244 
(define picm (genpic c namebytes sendip previouspicentries)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

245 
`(let ((actualclass ,classexp) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

246 
(ksend ,kexp)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

247 
,(let loop ((predictions previouspicentries) (counter picentrycount)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

248 
(match predictions 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

249 
['() 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

250 
`((lookupmessage/jit vm ,picm actualclass ,selectorexp) vm ksend ,@argexps)] 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

251 
[(cons (list predictedclass predictedcm) morepredictions) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

252 
(define predictedbmethod (cachedmethodbytecodemethod predictedcm)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

253 
`(if (eq? actualclass ,(genlit* litmap predictedclass)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

254 
(begin 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

255 
(pic@! ,picm ,counter 2 (+ 1 (pic@ ,picm ,counter 2))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

256 
,(if (alreadycompiling? c predictedclass predictedbmethod) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

257 
`((unwrapcachedmethod vm ,(genlit* litmap predictedcm)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

258 
vm ksend ,@argexps) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

259 
(geninlinesend c sendip predictedclass predictedbmethod 'ksend argexps))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

260 
,(loop morepredictions (+ counter 1)))])))])) 
376
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

261 

402
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

262 
(define (genblock c argumentlocation ip) 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

263 
(define tempcount (slotAt (compilationmethod c) 4)) 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

264 
`(lambda (vm k . blockarguments) 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

265 
,(let loop ((i argumentlocation)) 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

266 
(if (>= i tempcount) 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

267 
`(void) 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

268 
`(when (pair? blockarguments) 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

269 
(vectorset! temporaries ,i (car blockarguments)) 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

270 
(let ((blockarguments (cdr blockarguments))) 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

271 
,(loop (+ i 1)))))) 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

272 
,(gencode c ip '()))) 
379
e5e063ac93ef
Proper direct sends (and MICs); inline primitive definitions
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
378
diff
changeset

273 

408
aa5e38d54ab0
Inline self sends  a kind of method customization
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset

274 
(define (compilationlitname c literal) 
aa5e38d54ab0
Inline self sends  a kind of method customization
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset

275 
(hashref (compilationresultlitmap (compilationstate c)) literal)) 
aa5e38d54ab0
Inline self sends  a kind of method customization
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset

276 

413
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

277 
(define (hasblocks? method) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

278 
(define bytecode (bvbytes (slotAt method 1))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

279 
(define maxip (byteslength bytecode)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

280 
(define ip 0) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

281 
(define (nextbyte!) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

282 
(begin0 (bytesref bytecode ip) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

283 
(set! ip (+ ip 1)))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

284 
(define (decode!) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

285 
(define byte (nextbyte!)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

286 
(define low (bitwiseand byte #x0f)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

287 
(define high (bitwiseand (arithmeticshift byte 4) #x0f)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

288 
(if (zero? high) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

289 
(values low (nextbyte!)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

290 
(values high low))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

291 
(let search () 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

292 
(if (>= ip maxip) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

293 
#f 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

294 
(letvalues (((opcode arg) (decode!))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

295 
(match opcode 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

296 
[12 #t] 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

297 
[13 (nextbyte!) (search)] 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

298 
[15 (match arg 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

299 
[6 (nextbyte!) (search)] 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

300 
[7 (nextbyte!) (search)] 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

301 
[8 (nextbyte!) (search)] 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

302 
[11 (nextbyte!) (search)] 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

303 
[_ (search)])] 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

304 
[_ (search)]))))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

305 

402
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

306 
(define (gencode c ip stack) 
408
aa5e38d54ab0
Inline self sends  a kind of method customization
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset

307 
(define method (compilationmethod c)) 
aa5e38d54ab0
Inline self sends  a kind of method customization
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset

308 
(define bytecode (bvbytes (slotAt method 1))) 
aa5e38d54ab0
Inline self sends  a kind of method customization
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset

309 
(define literals (slotAt method 2)) 
402
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

310 
(let translate ((ip ip) (stack stack)) 
376
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

311 
(define (nextbyte!) 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

312 
(begin0 (bytesref bytecode ip) 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

313 
(set! ip (+ ip 1)))) 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

314 
(define (decode!) 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

315 
(define byte (nextbyte!)) 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

316 
(define low (bitwiseand byte #x0f)) 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

317 
(define high (bitwiseand (arithmeticshift byte 4) #x0f)) 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

318 
(if (zero? high) 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

319 
(values low (nextbyte!)) 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

320 
(values high low))) 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

321 
(define ip0 ip) 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

322 
(definevalues (opcode arg) (decode!)) 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

323 
(logvm/jitdebug " ~a: ~a ~a" ip0 opcode arg) 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

324 
(match opcode 
386
552736e4616c
Preserve abstraction (!)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
385
diff
changeset

325 
[1 (let@ [n (mksym "slot~a_" arg) `(slotAt self ,arg)] 
376
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

326 
(translate ip (cons n stack)))] 
408
aa5e38d54ab0
Inline self sends  a kind of method customization
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset

327 
[2 (translate ip (cons (vectorref (compilationargnames c) arg) stack))] 
402
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

328 
[3 (let@ [n (mksym "tmp~a_" arg) `(vectorref temporaries ,arg)] 
376
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

329 
(translate ip (cons n stack)))] 
408
aa5e38d54ab0
Inline self sends  a kind of method customization
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset

330 
[4 (let ((name (compilationlitname c (slotAt literals arg)))) 
aa5e38d54ab0
Inline self sends  a kind of method customization
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset

331 
(translate ip (cons name stack)))] 
376
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

332 
[5 (match arg 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

333 
[(or 0 1 2 3 4 5 6 7 8 9) (translate ip (cons arg stack))] 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

334 
[10 (translate ip (cons `NIL stack))] 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

335 
[11 (translate ip (cons `TRUE stack))] 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

336 
[12 (translate ip (cons `FALSE stack))])] 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

337 
[6 `(begin (slotAtPut self ,arg ,(car stack)) ,(translate ip stack))] 
402
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

338 
[7 `(begin (vectorset! temporaries ,arg ,(car stack)) ,(translate ip stack))] 
379
e5e063ac93ef
Proper direct sends (and MICs); inline primitive definitions
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
378
diff
changeset

339 
[8 (let* ((argcount arg) 
e5e063ac93ef
Proper direct sends (and MICs); inline primitive definitions
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
378
diff
changeset

340 
(args (reverse (take stack argcount))) 
387
9af7f893128d
Factor out gensend
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
386
diff
changeset

341 
(stack (drop stack argcount))) 
379
e5e063ac93ef
Proper direct sends (and MICs); inline primitive definitions
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
378
diff
changeset

342 
(definevalues (selectorliteralindex classexp) 
e5e063ac93ef
Proper direct sends (and MICs); inline primitive definitions
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
378
diff
changeset

343 
(match/values (decode!) 
e5e063ac93ef
Proper direct sends (and MICs); inline primitive definitions
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
378
diff
changeset

344 
[(9 selectorliteralindex) 
e5e063ac93ef
Proper direct sends (and MICs); inline primitive definitions
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
378
diff
changeset

345 
(values selectorliteralindex `(objclass* vm ,(car args)))] 
e5e063ac93ef
Proper direct sends (and MICs); inline primitive definitions
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
378
diff
changeset

346 
[(15 11) 
e5e063ac93ef
Proper direct sends (and MICs); inline primitive definitions
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
378
diff
changeset

347 
(values (nextbyte!) `super)])) 
402
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

348 
(define k (gensendk c ip stack)) 
408
aa5e38d54ab0
Inline self sends  a kind of method customization
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset

349 
(define selector (slotAt literals selectorliteralindex)) 
aa5e38d54ab0
Inline self sends  a kind of method customization
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset

350 
(define selectorexp (compilationlitname c selector)) 
410
7e5d9e957c2f
Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
409
diff
changeset

351 
(gensend c ip0 classexp (bvbytes selector) selectorexp k args))] 
389
befaa2a55f7b
Clean out comments & obsoleted code
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
388
diff
changeset

352 
;; 9 inlined in the processing of bytecode 8 
376
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

353 
[10 (match arg 
385
0d3839af02db
Tighten let@ definition
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
383
diff
changeset

354 
[0 (let@ [isNil `(boolean>obj vm (eq? NIL ,(car stack)))] 
0d3839af02db
Tighten let@ definition
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
383
diff
changeset

355 
(translate ip (cons isNil (cdr stack))))] 
0d3839af02db
Tighten let@ definition
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
383
diff
changeset

356 
[1 (let@ [notNil `(boolean>obj vm (not (eq? NIL ,(car stack))))] 
0d3839af02db
Tighten let@ definition
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
383
diff
changeset

357 
(translate ip (cons notNil (cdr stack))))])] 
376
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

358 
[11 (match stack 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

359 
[(list* j i stack) 
402
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

360 
(let@ [binopk (gensendk c ip stack)] 
376
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

361 
`(if (and (number? ,i) (number? ,j)) 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

362 
,(match arg 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

363 
[0 `(,binopk (boolean>obj vm (< ,i ,j)))] 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

364 
[1 `(,binopk (boolean>obj vm (<= ,i ,j)))] 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

365 
[2 `(,binopk (+ ,i ,j))]) 
408
aa5e38d54ab0
Inline self sends  a kind of method customization
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset

366 
,(let ((namebytes (match arg [0 #"<"] [1 #"<="] [2 #"+"]))) 
aa5e38d54ab0
Inline self sends  a kind of method customization
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset

367 
(gensend c 
410
7e5d9e957c2f
Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
409
diff
changeset

368 
ip0 
408
aa5e38d54ab0
Inline self sends  a kind of method customization
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset

369 
`(objclass* vm ,i) 
aa5e38d54ab0
Inline self sends  a kind of method customization
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset

370 
namebytes 
aa5e38d54ab0
Inline self sends  a kind of method customization
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset

371 
`(mkbv NIL ,namebytes) 
aa5e38d54ab0
Inline self sends  a kind of method customization
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset

372 
binopk 
aa5e38d54ab0
Inline self sends  a kind of method customization
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset

373 
(list i j)))))])] 
376
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

374 
[12 (let ((target (nextbyte!))) 
402
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

375 
(let@ [block `(mkffiv BLOCK ,(genblock c arg ip))] 
376
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

376 
(translate target (cons block stack))))] 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

377 
[13 (define primitivenumber (nextbyte!)) 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

378 
(match primitivenumber 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

379 
[8 (let ((v (gensym 'blockresult)) 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

380 
(block (car stack)) 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

381 
(argc ( arg 1)) 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

382 
(stack (cdr stack))) 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

383 
`(match ,block 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

384 
[(unffiv blockproc) 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

385 
(blockproc vm 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

386 
;; TODO vvv : use caselambda to translate the context chain 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

387 
k ;; not (lambda (,v) ,(translate ip (cons v (drop stack argc)))) 
402
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

388 
;; ^ reason being the image BUGGILY (?!?) relies on primitive 8 
376
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

389 
;; immediately returning to the surrounding context!! 
377
8accd6d3f51d
Extract and make use of block>thunk, to support imageproduced block calls.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
376
diff
changeset

390 
,@(reverse (take stack argc)))] 
8accd6d3f51d
Extract and make use of block>thunk, to support imageproduced block calls.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
376
diff
changeset

391 
[(obj (== BLOCK) _) 
8accd6d3f51d
Extract and make use of block>thunk, to support imageproduced block calls.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
376
diff
changeset

392 
(k ((block>thunk vm ,block (list ,@(reverse (take stack argc))))))]))] 
376
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

393 
[34 'NIL] 
402
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

394 
[35 (let@ [ctxref (genbuildjitcontext c ip stack)] 
385
0d3839af02db
Tighten let@ definition
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
383
diff
changeset

395 
(translate ip (cons ctxref stack)))] 
0d3839af02db
Tighten let@ definition
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
383
diff
changeset

396 
[36 (let@ [arr `(mkobj ARRAY ,@(reverse (take stack arg)))] 
0d3839af02db
Tighten let@ definition
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
383
diff
changeset

397 
(translate ip (cons arr (drop stack arg))))] 
388  398 
[_ (let ((generator (hashref *primitivecodesnippets* 
399 
primitivenumber 

405
5a019affe985
Plumbing preparation for method customization
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
404
diff
changeset

400 
(lambda () (error 'gencode 
388  401 
"Unknown primitive: ~a" 
402 
primitivenumber))))) 

403 
(let@ [primresult (generator 'vm (reverse (take stack arg)))] 

404 
(translate ip (cons primresult (drop stack arg)))))])] 

385
0d3839af02db
Tighten let@ definition
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
383
diff
changeset

405 
[14 (let@ [clsvar `(slotAt (objclass* vm self) ,(+ arg 5))] 
0d3839af02db
Tighten let@ definition
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
383
diff
changeset

406 
(translate ip (cons clsvar stack)))] 
376
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

407 
[15 (match arg 
378
2a35e7fcba59
Remove resumejitcontext
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
377
diff
changeset

408 
[1 `(k self)] 
2a35e7fcba59
Remove resumejitcontext
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
377
diff
changeset

409 
[2 `(k ,(car stack))] 
2a35e7fcba59
Remove resumejitcontext
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
377
diff
changeset

410 
[3 `(outerk ,(car stack))] 
376
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

411 
[5 (translate ip (cdr stack))] 
402
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

412 
[6 (genjumptolabel c (nextbyte!) stack)] 
376
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

413 
[7 (let ((target (nextbyte!))) 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

414 
(logvm/jitdebug "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 GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

415 
`(if (eq? ,(car stack) TRUE) 
402
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

416 
,(genjumptolabel c target (cdr stack)) 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

417 
,(genjumptolabel c ip (cdr stack))))] 
376
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

418 
[8 (let ((target (nextbyte!))) 
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

419 
(logvm/jitdebug "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 GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

420 
`(if (eq? ,(car stack) FALSE) 
402
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

421 
,(genjumptolabel c target (cdr stack)) 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

422 
,(genjumptolabel c ip (cdr stack))))] 
389
befaa2a55f7b
Clean out comments & obsoleted code
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
388
diff
changeset

423 
;; 11 inlined in the processing of bytecode 8 
405
5a019affe985
Plumbing preparation for method customization
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
404
diff
changeset

424 
[_ (error 'gencode "Unhandled dospecial case ~v" arg)])] 
5a019affe985
Plumbing preparation for method customization
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
404
diff
changeset

425 
[_ (error 'gencode "Method ~v  unhandled opcode ~v, arg ~v" 
402
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

426 
(slotAt (compilationmethod c) 0) ;; selector 
376
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

427 
opcode 
402
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

428 
arg)]))) 
376
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

429 

404
158def14bb15
Pull out genlabeldefinitions
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
403
diff
changeset

430 
(define (genlabeldefinitions c bodyexp) 
414
5e5c61ed2e7d
It's weird, but consistent: sorting the letrec entries slows it down! Why?
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
413
diff
changeset

431 
`(letrec (,@(for/list [((ip label) (inhash (compilationlabels c)))] 
404
158def14bb15
Pull out genlabeldefinitions
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
403
diff
changeset

432 
`(,(mksym "label~a" ip) ,label))) 
158def14bb15
Pull out genlabeldefinitions
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
403
diff
changeset

433 
,bodyexp)) 
158def14bb15
Pull out genlabeldefinitions
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
403
diff
changeset

434 

402
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

435 
(define (finishcompilation c compiletimevm innercode) 
413
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

436 
(define litmap (compilationresultlitmap (compilationstate c))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

437 
(define picdefinitions 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

438 
(for/list [(pi (reverse (compilationresultpiclistrev (compilationstate c))))] 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

439 
(define extension (picinfoextension pi)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

440 
`(define ,(picinfovariable pi) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

441 
,(if (null? extension) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

442 
`(pic) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

443 
`(extendedpic 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

444 
,@(appendmap (lambda (entry) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

445 
(list (and (car entry) (genlit* litmap (car entry))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

446 
(and (cadr entry) (genlit* litmap (cadr entry))))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

447 
(take (append extension emptypicextension) picentrycount))))))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

448 
(define litmaplist (hash>list litmap)) 
376
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

449 
(define code 
408
aa5e38d54ab0
Inline self sends  a kind of method customization
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset

450 
`(lambda (method super NIL TRUE FALSE ARRAY BLOCK ,@(map cdr litmaplist)) 
413
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

451 
,@picdefinitions 
402
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

452 
,innercode)) 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

453 

413
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

454 
(logvm/jit/codedebug "Resulting code for ~a:\n~a" 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

455 
(compilationmethodname c) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

456 
(prettyformat code)) 
402
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

457 
(define literals (slotAt (compilationmethod c) 2)) 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

458 
(define definingclass (slotAt (compilationmethod c) 5)) 
403
5e81df1d79c4
Factor out objectmemory.rkt and primitives.rkt
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
402
diff
changeset

459 
(apply (eval code ns) 
5e81df1d79c4
Factor out objectmemory.rkt and primitives.rkt
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
402
diff
changeset

460 
(compilationmethod c) 
5e81df1d79c4
Factor out objectmemory.rkt and primitives.rkt
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
402
diff
changeset

461 
(slotAt definingclass 1) ;; defining class's superclass 
5e81df1d79c4
Factor out objectmemory.rkt and primitives.rkt
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
402
diff
changeset

462 
(VMnil compiletimevm) ;; assuming this VM is the one that will be used at call time! 
5e81df1d79c4
Factor out objectmemory.rkt and primitives.rkt
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
402
diff
changeset

463 
(VMtrue compiletimevm) 
5e81df1d79c4
Factor out objectmemory.rkt and primitives.rkt
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
402
diff
changeset

464 
(VMfalse compiletimevm) 
5e81df1d79c4
Factor out objectmemory.rkt and primitives.rkt
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
402
diff
changeset

465 
(VMArray compiletimevm) 
5e81df1d79c4
Factor out objectmemory.rkt and primitives.rkt
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
402
diff
changeset

466 
(VMBlock compiletimevm) 
408
aa5e38d54ab0
Inline self sends  a kind of method customization
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
406
diff
changeset

467 
(map car litmaplist))) 
376
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

468 

402
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

469 
(define (compileblockproc compiletimevm 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

470 
method 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

471 
outerargs 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

472 
actualtemporaries 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

473 
argumentlocation 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

474 
initialip) 
405
5a019affe985
Plumbing preparation for method customization
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
404
diff
changeset

475 
(define class (objclass* compiletimevm (car outerargs))) 
413
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

476 
(define c (topcompilation compiletimevm class method #f)) 
402
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

477 
(define bodycode (genblock c argumentlocation initialip)) ;; imperative! 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

478 
(define innercode 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

479 
`(lambda (temporaries ,@(vector>list (compilationargnames c))) 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

480 
(let ((outerk (outermostk vm))) 
404
158def14bb15
Pull out genlabeldefinitions
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
403
diff
changeset

481 
,(genlabeldefinitions c bodycode)))) 
402
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

482 
(apply (finishcompilation c compiletimevm innercode) 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

483 
actualtemporaries 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

484 
outerargs)) 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

485 

413
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

486 
(define (bytecode>cachedcompiled vm class method) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

487 
(lookupmethod/cache vm class (bvbytes (slotAt method 0)))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

488 

99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

489 
(define (compiled>bytecode cmethod) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

490 
(compiledmethodinfobytecodemethod (cmethod))) 
410
7e5d9e957c2f
Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
409
diff
changeset

491 

413
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

492 
(define (recompilationcandidate vm ctx) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

493 
(let search ((ctx ctx) (candidate #f) (candidateclass #f) (candidatehotness 0)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

494 
(cond 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

495 
[(eq? (VMnil vm) ctx) (values candidate candidateclass)] 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

496 
[else (define method (slotAt ctx 0)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

497 
(define receiver (slotAt (slotAt ctx 1) 0)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

498 
(define receiverclass (objclass* vm receiver)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

499 
(define nextctx (slotAt ctx 6)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

500 
(logvm/jit/recompiledebug " ~a" (methodname method receiverclass)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

501 
(define cachedmethod (bytecode>cachedcompiled vm receiverclass method)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

502 
(define compiledmethod (unwrapcachedmethod vm cachedmethod)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

503 
(cond 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

504 
[(not compiledmethod) (search nextctx candidate candidateclass candidatehotness)] 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

505 
[else 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

506 
(matchdefine (compiledmethodinfo bytecodemethod pics stable?) (compiledmethod)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

507 
(logvm/jit/recompiledebug " has ~a bytes of bytecode; ~a; ~a" 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

508 
(byteslength (bvbytes (slotAt bytecodemethod 1))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

509 
(if (hasblocks? bytecodemethod) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

510 
"HAS SOME BLOCKS" 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

511 
"no blocks") 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

512 
(if stable? "stable" "not yet stable")) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

513 
(define (picentryhasanycalls? entry) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

514 
(define pic (cdr entry)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

515 
(for/or [(i (inrange (picsize pic)))] (positive? (pic@ pic i 2)))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

516 
(define usedpics (filter picentryhasanycalls? pics)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

517 
(define hotness 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

518 
(for/sum [(entry usedpics)] 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

519 
(matchdefine (cons pi pic) entry) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

520 
(for/sum [(i (inrange (picsize pic)))] 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

521 
(match (pic@ pic i 0) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

522 
[#f 0] 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

523 
[slotclass 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

524 
(define slotcm (pic@ pic i 1)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

525 
(unwrapcachedmethod vm slotcm) ;; fills cache entry 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

526 
(define slotbmethod (cachedmethodbytecodemethod slotcm)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

527 
(define slotcount (pic@ pic i 2)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

528 
(define bytecodecount (byteslength (bvbytes (slotAt slotbmethod 1)))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

529 
(define weight (/ 40.0 bytecodecount)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

530 
(logvm/jit/recompiledebug 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

531 
" ~a context ~a class ~a count ~a length ~a weight ~a" 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

532 
(picinfonamebytes pi) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

533 
(picinfocontext pi) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

534 
(bv>string (slotAt slotclass 0)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

535 
slotcount 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

536 
bytecodecount 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

537 
weight) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

538 
(* slotcount weight)])))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

539 
(logvm/jit/recompiledebug " hotness: ~a" hotness) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

540 
(if (and (> hotness candidatehotness) (not stable?)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

541 
(search nextctx method receiverclass hotness) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

542 
(search nextctx candidate candidateclass candidatehotness))])]))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

543 

99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

544 
(define (formatcompilationcontext x) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

545 
(stringjoin (reverse 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

546 
(map (matchlambda [(list c m ip) (format "~a @~a" (methodname m c) ip)]) x)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

547 
"," 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

548 
#:beforefirst "[" 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

549 
#:afterlast "]")) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

550 

99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

551 
(define (recompilemethod! vm class method) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

552 
(logvm/jit/recompileinfo "Recompiling ~a" (methodname method class)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

553 
(define cachedmethod (bytecode>cachedcompiled vm class method)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

554 
(define oldproc (cachedmethodproc cachedmethod)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

555 
(define oldpicmap 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

556 
(for/hash [(entry (inlist (if oldproc (compiledmethodinfopics (oldproc)) '())))] 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

557 
(define pi (car entry)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

558 
(values (picinfocontext pi) entry))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

559 
(when (not (hashempty? oldpicmap)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

560 
(logvm/jit/recompileinfo "Retrieved old pics for method ~a" (methodname method class)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

561 
(for [((i p) (inhash oldpicmap))] 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

562 
(logvm/jit/recompileinfo " ~a > ~v" (formatcompilationcontext i) p))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

563 
(define recompiledproc (compilemethodproc vm class method oldpicmap)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

564 
(logvm/jit/recompileinfo "Updating cached compiled method for ~a" (methodname method class)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

565 
(setcachedmethodproc! cachedmethod recompiledproc)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

566 

99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

567 
(define (recompilesomething vm ctx) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

568 
(definevalues (candidate candidateclass) (recompilationcandidate vm ctx)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

569 
(if candidate 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

570 
(recompilemethod! vm candidateclass candidate) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

571 
(logvm/jit/recompileinfo "No recompilation candidate available?"))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

572 

99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

573 
(define (compilemethodproc compiletimevm class method oldpicmap) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

574 
(define c (topcompilation compiletimevm class method oldpicmap)) 
402
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

575 
(define bodycode (genjumptolabel c 0 '())) ;; imperative! 
413
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

576 
(define picinfos (reverse (compilationresultpiclistrev (compilationstate c)))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

577 
(define picinfosexp (genlit* (compilationresultlitmap (compilationstate c)) picinfos)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

578 
(define stable? (equal? (if oldpicmap (list>set (hashkeys oldpicmap)) 'unknown) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

579 
(list>set (map picinfocontext picinfos)))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

580 
(when stable? 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

581 
(logvm/jit/recompileinfo "Compilation of ~a is now stable." (methodname method class))) 
402
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

582 
(define innercode 
413
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

583 
`(let ((callcounter 0) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

584 
(cmi #f)) 
410
7e5d9e957c2f
Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
409
diff
changeset

585 
(caselambda 
7e5d9e957c2f
Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
409
diff
changeset

586 
[() 
413
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

587 
(when (not cmi) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

588 
(set! cmi 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

589 
(compiledmethodinfo 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

590 
method 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

591 
(for/list [(pi (inlist ,picinfosexp)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

592 
(pic (inlist (list ,@(map picinfovariable picinfos))))] 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

593 
(cons pi pic)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

594 
,stable?))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

595 
cmi] 
410
7e5d9e957c2f
Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
409
diff
changeset

596 
[(vm k ,@(vector>list (compilationargnames c))) 
7e5d9e957c2f
Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
409
diff
changeset

597 
(set! callcounter (+ callcounter 1)) 
413
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

598 
;; TODO: aging of callcounter by rightshifting at most once every few seconds, or so 
410
7e5d9e957c2f
Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
409
diff
changeset

599 
(when (= callcounter 1000) 
413
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

600 
(logvm/jit/recompileinfo "Method ~a is hot" ,(methodname method class)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

601 
(recompilesomething vm (k)) 
410
7e5d9e957c2f
Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
409
diff
changeset

602 
;; (set! callcounter 0) 
7e5d9e957c2f
Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
409
diff
changeset

603 
) 
7e5d9e957c2f
Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
409
diff
changeset

604 
(let ((outerk k) 
7e5d9e957c2f
Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
409
diff
changeset

605 
(temporaries ,(genfreshtemps method))) 
7e5d9e957c2f
Expose pics, collect call stats, preparing for dynamic type feedback / recompilation
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
409
diff
changeset

606 
,(genlabeldefinitions c bodycode))]))) 
402
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

607 
(finishcompilation c compiletimevm innercode)) 
376
6944f882b052
First measurable JIT for SmallWorld. Much obvious inefficiency remains to be removed
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
375
diff
changeset

608 

411
ba74f97d2ba9
Indirection to allow invalidation of cached compiled method
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
410
diff
changeset

609 
(define (unwrapcachedmethod vm cm) 
ba74f97d2ba9
Indirection to allow invalidation of cached compiled method
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
410
diff
changeset

610 
(or (cachedmethodproc cm) 
ba74f97d2ba9
Indirection to allow invalidation of cached compiled method
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
410
diff
changeset

611 
(match cm 
ba74f97d2ba9
Indirection to allow invalidation of cached compiled method
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
410
diff
changeset

612 
[(cachedmethod class namebytes _bcm _proc) 
ba74f97d2ba9
Indirection to allow invalidation of cached compiled method
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
410
diff
changeset

613 
(define bcm (lookupmethod vm class namebytes)) 
413
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

614 
(define proc (and bcm (compilemethodproc vm class bcm #f))) 
411
ba74f97d2ba9
Indirection to allow invalidation of cached compiled method
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
410
diff
changeset

615 
(setcachedmethodbytecodemethod! cm bcm) 
ba74f97d2ba9
Indirection to allow invalidation of cached compiled method
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
410
diff
changeset

616 
(setcachedmethodproc! cm proc) 
ba74f97d2ba9
Indirection to allow invalidation of cached compiled method
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
410
diff
changeset

617 
proc]))) 
ba74f97d2ba9
Indirection to allow invalidation of cached compiled method
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
410
diff
changeset

618 

413
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

619 
(define (invalidatecachedmethod! cm) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

620 
(setcachedmethodbytecodemethod! cm #f) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

621 
(setcachedmethodproc! cm #f)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

622 

392
618244a1ee07
Small change toward avoiding consing selectors unnecessarily.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
389
diff
changeset

623 
(define (lookupmethod/cache vm class namebytes) 
403
5e81df1d79c4
Factor out objectmemory.rkt and primitives.rkt
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
402
diff
changeset

624 
(define classcache (hashref! (jitVMcache vm) class makeweakhash)) 
402
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

625 
(hashref! classcache 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

626 
namebytes 
411
ba74f97d2ba9
Indirection to allow invalidation of cached compiled method
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
410
diff
changeset

627 
(lambda () (cachedmethod class namebytes #f #f)))) 
368
bd33c8691bba
Simplest possible method cache. hop: 411861 bytecodes/sec; 65707 sends/sec > 859845 bytecodes/sec; 106388 sends/sec
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
367
diff
changeset

628 

396
3bfb9afdbd9d
Switch from mic to pic
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
395
diff
changeset

629 
(define (lookupmessage/jit vm pic class selector) 
3bfb9afdbd9d
Switch from mic to pic
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
395
diff
changeset

630 
(let searchpic ((slotindex 0)) 
413
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

631 
(define thisclass (pic@ pic slotindex 0)) 
396
3bfb9afdbd9d
Switch from mic to pic
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
395
diff
changeset

632 
(if (eq? thisclass class) 
413
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

633 
(begin (pic@! pic slotindex 2 (+ 1 (pic@ pic slotindex 2))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

634 
(or (unwrapcachedmethod vm (pic@ pic slotindex 1)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

635 
(senddnu class selector))) 
396
3bfb9afdbd9d
Switch from mic to pic
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
395
diff
changeset

636 
(let* ((nextslotindex (+ slotindex 1)) 
409
f19c9ff9d0d3
Repair pic fillin code: it had been filling in only the final slot (!). ~7% speed boost
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
408
diff
changeset

637 
(moreslotstocheck? (and thisclass (< nextslotindex picentrycount)))) 
396
3bfb9afdbd9d
Switch from mic to pic
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
395
diff
changeset

638 
(if moreslotstocheck? 
3bfb9afdbd9d
Switch from mic to pic
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
395
diff
changeset

639 
(searchpic nextslotindex) 
413
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

640 
(let* ((cm (lookupmethod/cache vm class (bvbytes selector)))) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

641 
(when (not thisclass) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

642 
(pic@! pic slotindex 0 class) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

643 
(pic@! pic slotindex 1 cm) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

644 
(pic@! pic slotindex 2 1)) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

645 
(or (unwrapcachedmethod vm cm) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

646 
(senddnu class selector)))))))) 
379
e5e063ac93ef
Proper direct sends (and MICs); inline primitive definitions
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
378
diff
changeset

647 

413
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

648 
(define ((senddnu class selector) vm ctx . args) 
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

649 
(define arguments (obj (VMArray vm) (list>vector args))) 
392
618244a1ee07
Small change toward avoiding consing selectors unnecessarily.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
389
diff
changeset

650 
(define dnunamebytes #"doesNotUnderstand:") 
411
ba74f97d2ba9
Indirection to allow invalidation of cached compiled method
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
410
diff
changeset

651 
(match (unwrapcachedmethod vm (lookupmethod/cache vm class dnunamebytes)) 
379
e5e063ac93ef
Proper direct sends (and MICs); inline primitive definitions
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
378
diff
changeset

652 
[#f (error 'sendmessage* "Unhandled selector ~a at class ~a" selector class)] 
e5e063ac93ef
Proper direct sends (and MICs); inline primitive definitions
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
378
diff
changeset

653 
[dnumethod 
e5e063ac93ef
Proper direct sends (and MICs); inline primitive definitions
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
378
diff
changeset

654 
(logvmwarning "DNU  arguments ~a class ~a selector ~a" arguments class selector) 
403
5e81df1d79c4
Factor out objectmemory.rkt and primitives.rkt
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
402
diff
changeset

655 
(dnumethod vm ctx (slotAt arguments 0) (mkobj (VMArray vm) selector arguments))])) 
353
d4161a4117e8
Image loader and virtual machine for SmallWorld 2015 Smalltalk.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

656 

402
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

657 
(define (block>thunk vm block args) ;; Expects a real bytecode block, not an ffiv one 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

658 
(lambda () 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

659 
(define method (slotAt block 0)) 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

660 
(define outerargs (vector>list (objslots (slotAt block 1)))) 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

661 
(define temporaries (objslots (slotAt block 2))) 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

662 
(define argumentlocation (slotAt block 7)) 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

663 
(define blockip (slotAt block 9)) 
403
5e81df1d79c4
Factor out objectmemory.rkt and primitives.rkt
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
402
diff
changeset

664 
(define f (compileblockproc vm method outerargs temporaries argumentlocation blockip)) 
5e81df1d79c4
Factor out objectmemory.rkt and primitives.rkt
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
402
diff
changeset

665 
(apply f vm (outermostk vm) args))) 
353
d4161a4117e8
Image loader and virtual machine for SmallWorld 2015 Smalltalk.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

666 

402
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

667 
(define (outermostk vm) 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

668 
(caselambda [() (VMnil vm)] 
dc1bd2065cd1
Remove interpreter; refactor compiler to support block entry points (not needed by current image)
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
396
diff
changeset

669 
[(result) result])) 
377
8accd6d3f51d
Extract and make use of block>thunk, to support imageproduced block calls.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
376
diff
changeset

670 

379
e5e063ac93ef
Proper direct sends (and MICs); inline primitive definitions
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
378
diff
changeset

671 
;;=========================================================================== 
375
c090edeff4c5
Split out most primitives into a separate routine.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
373
diff
changeset

672 

379
e5e063ac93ef
Proper direct sends (and MICs); inline primitive definitions
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
378
diff
changeset

673 
(defineprimitive vm [6 innerctx] ;; "new context execute" 
403
5e81df1d79c4
Factor out objectmemory.rkt and primitives.rkt
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
402
diff
changeset

674 
(when (not (zero? (slotAt innerctx 5))) (error 'execute "Cannot execute from nonempty stack")) 
5e81df1d79c4
Factor out objectmemory.rkt and primitives.rkt
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
402
diff
changeset

675 
(when (not (zero? (slotAt innerctx 4))) (error 'execute "Cannot execute from nonzero IP")) 
405
5a019affe985
Plumbing preparation for method customization
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
404
diff
changeset

676 
(define args (slotAt innerctx 1)) 
413
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

677 
(define f (compilemethodproc vm (objclass* vm (slotAt args 0)) (slotAt innerctx 0) #f)) 
405
5a019affe985
Plumbing preparation for method customization
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
404
diff
changeset

678 
(apply f vm (outermostk vm) (vector>list (objslots args)))) 
379
e5e063ac93ef
Proper direct sends (and MICs); inline primitive definitions
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
378
diff
changeset

679 

e5e063ac93ef
Proper direct sends (and MICs); inline primitive definitions
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
378
diff
changeset

680 
(defineprimitive vm [116] 
e5e063ac93ef
Proper direct sends (and MICs); inline primitive definitions
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
378
diff
changeset

681 
(let ((imagebytes (serializeimage vm))) 
403
5e81df1d79c4
Factor out objectmemory.rkt and primitives.rkt
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
402
diff
changeset

682 
(displaytofile imagebytes (jitVMimagefilename vm) #:exists 'replace))) 
375
c090edeff4c5
Split out most primitives into a separate routine.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
373
diff
changeset

683 

379
e5e063ac93ef
Proper direct sends (and MICs); inline primitive definitions
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
378
diff
changeset

684 
;;=========================================================================== 
375
c090edeff4c5
Split out most primitives into a separate routine.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
373
diff
changeset

685 

413
99a706eaf2cf
Recompilation and picbased inlining. Slower than before!
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
411
diff
changeset

686 
(prettyprintcolumns 132) 
369
3e1f84e6289d
Image saving
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
368
diff
changeset

687 
(let* ((imagefilename "SmallWorld/src/image") 
403
5e81df1d79c4
Factor out objectmemory.rkt and primitives.rkt
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
402
diff
changeset

688 
(vm (callwithinputfile imagefilename 
5e81df1d79c4
Factor out objectmemory.rkt and primitives.rkt
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
402
diff
changeset

689 
(lambda (fh) 
5e81df1d79c4
Factor out objectmemory.rkt and primitives.rkt
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
402
diff
changeset

690 
(readimage fh jitVM (list (makeweakhasheq) imagefilename)))))) 
5e81df1d79c4
Factor out objectmemory.rkt and primitives.rkt
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
402
diff
changeset

691 
(bootimage vm 
5e81df1d79c4
Factor out objectmemory.rkt and primitives.rkt
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
402
diff
changeset

692 
(lambda (vm source) 
411
ba74f97d2ba9
Indirection to allow invalidation of cached compiled method
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
410
diff
changeset

693 
(define compiledmethod 
ba74f97d2ba9
Indirection to allow invalidation of cached compiled method
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
410
diff
changeset

694 
(unwrapcachedmethod vm (lookupmethod/cache vm (objclass source) #"doIt"))) 
ba74f97d2ba9
Indirection to allow invalidation of cached compiled method
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
410
diff
changeset

695 
(compiledmethod vm (outermostk vm) source)) 
403
5e81df1d79c4
Factor out objectmemory.rkt and primitives.rkt
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
402
diff
changeset

696 
(currentcommandlinearguments))) 