250 [_ (error 'compile-method-proc "Method ~v - unhandled opcode ~v, arg ~v" |
250 [_ (error 'compile-method-proc "Method ~v - unhandled opcode ~v, arg ~v" |
251 (slotAt (compilation-method c) 0) ;; selector |
251 (slotAt (compilation-method c) 0) ;; selector |
252 opcode |
252 opcode |
253 arg)]))) |
253 arg)]))) |
254 |
254 |
|
255 (define (gen-label-definitions c body-exp) |
|
256 `(letrec (,@(for/list [((ip label) (in-hash (compilation-labels c)))] |
|
257 `(,(mksym "label~a" ip) ,label))) |
|
258 ,body-exp)) |
|
259 |
255 (define (finish-compilation c compile-time-vm inner-code) |
260 (define (finish-compilation c compile-time-vm inner-code) |
256 (define code |
261 (define code |
257 `(lambda (method super NIL TRUE FALSE ARRAY BLOCK ,@(vector->list (compilation-litnames c))) |
262 `(lambda (method super NIL TRUE FALSE ARRAY BLOCK ,@(vector->list (compilation-litnames c))) |
258 ,@(for/list [(i (compilation-pic-count c))] `(define ,(mksym "pic~a" i) (pic))) |
263 ,@(for/list [(i (compilation-pic-count c))] `(define ,(mksym "pic~a" i) (pic))) |
259 ,inner-code)) |
264 ,inner-code)) |
260 |
265 |
261 (log-vm/jit-debug "Resulting code:\n~a" (pretty-format code)) |
266 (log-vm/jit-debug "Resulting code:\n~a" (pretty-format code)) |
262 |
|
263 (define literals (slotAt (compilation-method c) 2)) |
267 (define literals (slotAt (compilation-method c) 2)) |
264 (define defining-class (slotAt (compilation-method c) 5)) |
268 (define defining-class (slotAt (compilation-method c) 5)) |
265 |
|
266 (apply (eval code ns) |
269 (apply (eval code ns) |
267 (compilation-method c) |
270 (compilation-method c) |
268 (slotAt defining-class 1) ;; defining class's superclass |
271 (slotAt defining-class 1) ;; defining class's superclass |
269 (VM-nil compile-time-vm) ;; assuming this VM is the one that will be used at call time! |
272 (VM-nil compile-time-vm) ;; assuming this VM is the one that will be used at call time! |
270 (VM-true compile-time-vm) |
273 (VM-true compile-time-vm) |
282 (define c (new-compilation method)) |
285 (define c (new-compilation method)) |
283 (define body-code (gen-block c argument-location initial-ip)) ;; imperative! |
286 (define body-code (gen-block c argument-location initial-ip)) ;; imperative! |
284 (define inner-code |
287 (define inner-code |
285 `(lambda (temporaries ,@(vector->list (compilation-argnames c))) |
288 `(lambda (temporaries ,@(vector->list (compilation-argnames c))) |
286 (let ((outer-k (outermost-k vm))) |
289 (let ((outer-k (outermost-k vm))) |
287 (letrec (,@(for/list [((ip label) (in-hash (compilation-labels c)))] |
290 ,(gen-label-definitions c body-code)))) |
288 `(,(mksym "label~a" ip) ,label))) |
|
289 ,body-code)))) |
|
290 (apply (finish-compilation c compile-time-vm inner-code) |
291 (apply (finish-compilation c compile-time-vm inner-code) |
291 actual-temporaries |
292 actual-temporaries |
292 outer-args)) |
293 outer-args)) |
293 |
294 |
294 (define (compile-method-proc compile-time-vm method) |
295 (define (compile-method-proc compile-time-vm method) |
297 (define temp-count (slotAt method 4)) |
298 (define temp-count (slotAt method 4)) |
298 (define inner-code |
299 (define inner-code |
299 `(lambda (vm k ,@(vector->list (compilation-argnames c))) |
300 `(lambda (vm k ,@(vector->list (compilation-argnames c))) |
300 (let ((outer-k k) |
301 (let ((outer-k k) |
301 (temporaries ,(if (zero? temp-count) `'#() `(make-vector ,temp-count NIL)))) |
302 (temporaries ,(if (zero? temp-count) `'#() `(make-vector ,temp-count NIL)))) |
302 (letrec (,@(for/list [((ip label) (in-hash (compilation-labels c)))] |
303 ,(gen-label-definitions c body-code)))) |
303 `(,(mksym "label~a" ip) ,label))) |
|
304 ,body-code)))) |
|
305 (finish-compilation c compile-time-vm inner-code)) |
304 (finish-compilation c compile-time-vm inner-code)) |
306 |
305 |
307 (define (lookup-method/cache vm class name-bytes) |
306 (define (lookup-method/cache vm class name-bytes) |
308 (define class-cache (hash-ref! (jit-VM-cache vm) class make-weak-hash)) |
307 (define class-cache (hash-ref! (jit-VM-cache vm) class make-weak-hash)) |
309 (hash-ref! class-cache |
308 (hash-ref! class-cache |