1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
|
; Part of Scheme 48 1.9. See file COPYING for notices and license.
; Authors: Richard Kelsey, Jonathan Rees
; Derived from
; (lambda (x y) (vector (car x) (cdr x) y))
(define annotate-procedure
(lap annotate-procedure ()
(protocol 2 (push template))
(stack-ref 2)
(stored-object-ref closure 0)
(push)
(stack-ref 3)
(stored-object-ref closure 1)
(push+stack-ref 3)
(make-stored-object 3 closure)
(return)))
; Derived from
; (lambda (x) (if (< 2 (vector-length x)) (vector-ref x 2) #f))
(define procedure-annotation
(lap procedure-anotation ()
(protocol 1 (push template))
(literal 2)
(push)
(stack-ref 2)
(stored-object-length closure)
(<)
(jump-if-false (=> no-annotation))
(stack-ref+push 1)
(literal 2)
(stored-object-indexed-ref closure 0)
(return)
no-annotation
(false)
(return)))
|
