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
|
; Copyright (c) 1993-2008 by Richard Kelsey. See file COPYING.
(define-primitive allocate-memory ((positive-integer? type/integer)) type/address)
(define-primitive deallocate-memory ((address? type/address)) type/unit)
(define-load-time-primitive (address? #f) address?)
(define-primitive address+
((address? type/address)
(integer? type/integer))
type/address)
(define-semi-primitive (address- address? integer?) address-
(lambda (args node depth return?)
(check-arg-type args 0 type/address depth node)
(check-arg-type args 1 type/integer depth node)
type/address)
(lambda (x y) (address+ x (- 0 y))))
(define-primitive address-difference
((address? type/address)
(address? type/address))
type/integer)
(define-primitive address=
((address? type/address)
(address? type/address))
type/boolean)
(define-primitive address<
((address? type/address)
(address? type/address))
type/boolean)
(define-prescheme! 'null-address
(let ((location (make-undefined-location 'null-address)))
(set-contents! location (make-external-value "NULL" type/address))
location)
#f)
(define-semi-primitive (null-address? address?) null-address?
(lambda (args node depth return)
(check-arg-type args 0 type/address depth node)
type/boolean)
(lambda (x) (address= x null-address)))
(define (address-comparison-rule args node depth return?)
(check-arg-type args 0 type/address depth node)
(check-arg-type args 1 type/address depth node)
type/boolean)
(define-semi-primitive (address> address? address?) address>
address-comparison-rule
(lambda (x y) (address< y x)))
(define-semi-primitive (address<= address? address?) address<=
address-comparison-rule
(lambda (x y) (not (address< y x))))
(define-semi-primitive (address>= address? address?) address>=
address-comparison-rule
(lambda (x y) (not (address< x y))))
(define-primitive address->integer
((address? type/address))
type/integer)
(define-primitive integer->address
((integer? type/integer))
type/address)
(define-primitive copy-memory!
((address? type/address)
(address? type/address)
(positive-integer? type/integer))
type/unit)
(define-primitive memory-equal?
((address? type/address)
(address? type/address)
(positive-integer? type/integer))
type/boolean)
(define-primitive unsigned-byte-ref
((address? type/address))
type/integer
byte-ref)
(define-primitive unsigned-byte-set!
((address? type/address) (unsigned-byte? type/integer))
type/unit
byte-set!)
(define-primitive word-ref ((address? type/address)) type/integer)
(define-primitive word-set!
((address? type/address) (positive-integer? type/integer))
type/unit)
(define-primitive flonum-ref ((address? type/address)) type/float)
(define-primitive flonum-set!
((address? type/address) (floatnum? type/float))
type/unit)
(define-primitive char-pointer->string
((address? type/address)
(positive-integer? type/integer))
type/string)
(define-primitive char-pointer->nul-terminated-string
((address? type/address))
type/string)
(let ((read-block-return-type
(make-tuple-type (list type/integer type/boolean type/status))))
(define-primitive read-block
((input-port? type/input-port)
(address? type/address)
(positive-integer? type/integer))
read-block-return-type))
(define-primitive write-block
((output-port? type/output-port)
(address? type/address)
(positive-integer? type/integer))
type/status)
|
