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
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
|
; Part of Scheme 48 1.9. See file COPYING for notices and license.
; Authors: Richard Kelsey, Jonathan Rees, Mike Sperber, Martin Gasbichler
(define (fake-it name)
(lambda args
(display "Call to ")
(display (cons name args))
(newline)
0))
(define extended-vm (fake-it 'extended-vm))
(define external-call (fake-it 'call-external-value))
(define external-call-2 (fake-it 'call-external-value-2))
(define schedule-interrupt (fake-it 'schedule-interrupt))
(define dequeue-external-event! (fake-it 'dequeue-external-event!))
(define-syntax document-it
(syntax-rules
()
((document-it name op)
(define (name . args)
(display "Call to ")
(display (cons name args))
(newline)
(apply op args)))))
(document-it external-bignum-make-cached-constants (lambda () #f))
(document-it external-bignum-make-zero (lambda () #f))
(document-it external-bignum-make-one (lambda (x) #f))
(document-it external-bignum-add +)
(document-it external-bignum-subtract -)
(document-it external-bignum-multiply *)
(document-it external-bignum-quotient quotient)
(document-it external-bignum-remainder remainder)
(document-it external-bignum-divide /)
(document-it external-bignum-equal? =)
(document-it external-bignum-compare (lambda (x y)
(if (< x y)
-1
(if (= x y)
0
1))))
(document-it external-bignum-test (lambda (x)
(if (< x 0) -1
(if (= x 0) 0
1))))
(document-it external-bignum-negate (lambda (x) (- x)))
(document-it external-bignum-from-long (lambda (x) x))
(document-it external-bignum-from-unsigned-long (lambda (x) x))
(document-it external-bignum-fits-in-word?
(lambda (bignum word-length two-compl?)
(and (>= bignum -134217728)
(<= bignum 134217727))))
(document-it external-bignum->long (lambda (x) x))
(document-it external-bignum-bitwise-and bitwise-and)
(document-it external-bignum-bitwise-xor bitwise-xor)
(document-it external-bignum-bitwise-ior bitwise-ior)
(document-it external-bignum-bitwise-not bitwise-not)
(document-it external-bignum-bit-count bit-count)
(document-it external-bignum-arithmetic-shift arithmetic-shift)
(define (trace-external-calls)
(fake-it 'trace-external-calls))
(define (real-time) 0)
(define (run-time) 0)
(define (cheap-time) 0)
(define s48-call-native-procedure (fake-it 's48-call-native-code))
(define s48-invoke-native-continuation (fake-it 's48-call-native-code))
(define s48-native-return 0)
(define s48-jump-native (fake-it 's48-jump-native))
(define get-proposal-lock! (fake-it 'get-proposal-lock!))
(define release-proposal-lock! (fake-it 'release-proposal-lock!))
(define (shared-ref x) x)
(define-syntax shared-set!
(syntax-rules ()
((shared-set! x v)
(set! x v))))
(define (get-os-string-encoding)
"UTF-8")
(define host-architecture "s48")
(define (argument-type-violation val)
(fake-it 'argument-type-violation))
(define (range-violation val min max)
(fake-it 'range-violation))
|
