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
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
|
; Part of Scheme 48 1.9. See file COPYING for notices and license.
; Authors: Richard Kelsey, Jonathan Rees, Marcus Crestani, Mike Sperber,
; Martin Gasbichler
(define-structures ((vm-utilities vm-utilities-interface))
(open prescheme)
(files (util vm-utilities))
(begin
(define-syntax assert
(lambda (exp rename compare)
0))
))
(define-structures ((external external-interface))
(open prescheme)
(begin
(define extended-vm
(external "s48_extended_vm" (=> (integer integer) integer)))
(define external-call
(external "s48_external_call" (=> (integer integer integer address)
integer)))
(define external-call-2
(external "s48_external_call_2" (=> (integer integer integer address)
integer)))
(define schedule-interrupt
(external "s48_schedule_alarm_interrupt" (=> (integer) integer)))
;; implemented in C, wrapper around s48-dequeue-external-event/unsafe!
(define dequeue-external-event!
(external "s48_dequeue_external_event" (=> () integer boolean)))
(define cheap-time
(external "CHEAP_TIME" (=> () integer)))
(define real-time
(external "s48_real_time" (=> () integer integer)))
(define run-time
(external "s48_run_time" (=> () integer integer)))
(define get-os-string-encoding
(external "s48_get_os_string_encoding" (=> () (^ char))))
(define host-architecture
(external "S48_HOST_ARCHITECTURE" (^ char)))
(define s48-call-native-procedure
(external "s48_call_native_procedure" (=> (integer integer) integer)))
(define s48-invoke-native-continuation
(external "s48_invoke_native_continuation" (=> (integer integer) integer)))
(define s48-jump-native
(external "s48_jump_to_native_address" (=> (integer integer) integer)))
(define s48-native-return
(external "((long)&s48_native_return)" integer))
(define get-proposal-lock!
(external "GET_PROPOSAL_LOCK" (=> () null)))
(define release-proposal-lock!
(external "RELEASE_PROPOSAL_LOCK" (=> () null)))
(define shared-ref
(external "SHARED_REF" (=> (integer) integer)))
(define real-shared-set!
(external "SHARED_SETB" (=> (integer integer) null)))
(define-syntax shared-set!
(syntax-rules ()
((shared-set! x v)
(real-shared-set! x v))))
; for use in C functions usable from external code, defined as
; PreScheme procedures
(define argument-type-violation
;; value
(external "s48_argument_type_violation" (=> (integer) null)))
(define range-violation
;; value, min, max
(external "s48_range_violation" (=> (integer integer integer) null)))
; Lots of bignum stuff. This should be moved to its own interface.
(define export-key
(external "s48_export_key" (=> (integer) integer)))
(define external-bignum-make-cached-constants
(external "s48_bignum_make_cached_constants" (=> () null)))
(define external-bignum-add
(external "(char *)s48_bignum_add" (=> (address address) address)))
(define external-bignum-subtract
(external "(char *)s48_bignum_subtract" (=> (address address) address)))
(define external-bignum-multiply
(external "(char *)s48_bignum_multiply" (=> (address address) address)))
(define external-bignum-quotient
(external "(char *)s48_bignum_quotient" (=> (address address) address)))
(define external-bignum-remainder
(external "(char *)s48_bignum_remainder" (=> (address address) address)))
(define external-bignum-divide
(external "s48_bignum_divide" (=> (address address)
boolean address address)))
(define external-bignum-equal?
(external "s48_bignum_equal_p" (=> (address address) boolean)))
(define external-bignum-compare
(external "s48_bignum_compare" (=> (address address) integer)))
(define external-bignum-test
(external "s48_bignum_test" (=> (address) integer)))
(define external-bignum-negate
(external "(char *) s48_bignum_negate" (=> (address) address)))
(define external-bignum-arithmetic-shift
(external "(char *) s48_bignum_arithmetic_shift"
(=> (address integer) address)))
(define external-bignum-bitwise-not
(external "(char *) s48_bignum_bitwise_not"
(=> (address) address)))
(define external-bignum-bit-count
(external "s48_bignum_bit_count"
(=> (address) integer)))
(define external-bignum-bitwise-and
(external "(char *) s48_bignum_bitwise_and"
(=> (address address) address)))
(define external-bignum-bitwise-ior
(external "(char *) s48_bignum_bitwise_ior"
(=> (address address) address)))
(define external-bignum-bitwise-xor
(external "(char *) s48_bignum_bitwise_xor"
(=> (address address) address)))
(define external-bignum-from-long
(external "(char *) s48_long_to_bignum" (=> (integer) address)))
(define external-bignum-from-unsigned-long
(external "(char *) s48_ulong_to_bignum" (=> (unsigned-integer) address)))
(define external-bignum->long
(external "s48_bignum_to_long" (=> (address) integer)))
(define external-bignum-fits-in-word?
(external "s48_bignum_fits_in_word_p" (=> (address integer boolean)
boolean)))
;; external call interface
(define trace-external-calls
(external "s48_trace_external_calls" (=> () null)))
))
(define-structures ((channel-io channel-interface)
(events event-interface))
(open prescheme)
(files (data ps-channel)))
|
