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
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
|
;;;; x86-vm.lisp -- VOP definitions for SBCL
(cl:in-package :sb-vm)
(define-vop (%check-bound)
(:translate nibbles::%check-bound)
(:policy :fast-safe)
(:args (array :scs (descriptor-reg))
(bound :scs (any-reg))
(index :scs (any-reg)))
(:arg-types simple-array-unsigned-byte-8 positive-fixnum tagged-num
(:constant (member 2 4 8 16)))
(:info offset)
(:temporary (:sc any-reg) temp)
(:results (result :scs (any-reg)))
(:result-types positive-fixnum)
(:vop-var vop)
(:generator 5
(let ((error (generate-error-code vop 'invalid-array-index-error
array bound index)))
;; We want to check the conditions:
;;
;; 0 <= INDEX
;; INDEX < BOUND
;; 0 <= INDEX + OFFSET
;; (INDEX + OFFSET) < BOUND
;;
;; We can do this naively with two unsigned checks:
;;
;; INDEX <_u BOUND
;; INDEX + OFFSET <_u BOUND
;;
;; If INDEX + OFFSET <_u BOUND, though, INDEX must be less than
;; BOUND. We *do* need to check for 0 <= INDEX, but that has
;; already been assured by higher-level machinery.
(inst lea temp (make-ea :dword :index index :disp (fixnumize offset)))
(inst cmp temp bound)
(inst jmp :a error)
(move result index))))
#.(flet ((frob (setterp signedp big-endian-p)
(let* ((name (funcall (if setterp
#'nibbles::byte-set-fun-name
#'nibbles::byte-ref-fun-name)
16 signedp big-endian-p))
(internal-name (nibbles::internalify name))
(result-sc (if signedp 'signed-reg 'unsigned-reg))
(result-type (if signedp 'signed-num 'unsigned-num)))
`(define-vop (,name)
(:translate ,internal-name)
(:policy :fast-safe)
(:args (vector :scs (descriptor-reg))
(index :scs (immediate unsigned-reg))
,@(when setterp
`((value :scs (,result-sc) :target result))))
(:arg-types simple-array-unsigned-byte-8
positive-fixnum
,@(when setterp
`(,result-type)))
,@(when (or setterp big-endian-p)
`((:temporary (:sc unsigned-reg :offset eax-offset
:from ,(if setterp
'(:load 0)
'(:argument 2))
:to (:result 0)) eax)))
(:results (result :scs (,result-sc)))
(:result-types ,result-type)
(:generator 3
(let* ((base-disp (- (* vector-data-offset n-word-bytes)
other-pointer-lowtag))
(memref (sc-case index
(immediate
(make-ea :word :base vector
:disp (+ (tn-value index) base-disp)))
(t
(make-ea :word :base vector
:index index
:disp base-disp)))))
,(when setterp
'(move eax value))
,(when (and setterp big-endian-p)
'(inst rol ax-tn 8))
,(if setterp
'(inst mov memref ax-tn)
`(inst ,(if big-endian-p
'mov
(if signedp
'movsx
'movzx))
,(if big-endian-p
'ax-tn
'result)
memref))
,@(if setterp
'((move result value))
(when big-endian-p
`(eax ; hack so that it looks used
(inst rol ax-tn 8)
(inst ,(if signedp 'movsx 'movzx)
result ax-tn))))))))))
(loop for i from 0 upto #b111
for setterp = (logbitp 2 i)
for signedp = (logbitp 1 i)
for big-endian-p = (logbitp 0 i)
collect (frob setterp signedp big-endian-p) into forms
finally (return `(progn ,@forms))))
#.(flet ((frob (setterp signedp big-endian-p)
(let* ((name (funcall (if setterp
#'nibbles::byte-set-fun-name
#'nibbles::byte-ref-fun-name)
32 signedp big-endian-p))
(internal-name (nibbles::internalify name))
(result-sc (if signedp 'signed-reg 'unsigned-reg))
(result-type (if signedp 'signed-num 'unsigned-num)))
`(define-vop (,name)
(:translate ,internal-name)
(:policy :fast-safe)
(:args (vector :scs (descriptor-reg))
(index :scs (immediate unsigned-reg))
,@(when setterp
`((value :scs (,result-sc) :target result))))
(:arg-types simple-array-unsigned-byte-8
positive-fixnum
,@(when setterp
`(,result-type)))
,@(when (and setterp big-endian-p)
`((:temporary (:sc unsigned-reg
:from (:load 0)
:to (:result 0)) temp)))
(:results (result :scs (,result-sc)))
(:result-types ,result-type)
(:generator 3
(let* ((base-disp (- (* vector-data-offset n-word-bytes)
other-pointer-lowtag))
(memref (sc-case index
(immediate
(make-ea :dword :base vector
:disp (+ (tn-value index) base-disp)))
(t
(make-ea :dword :base vector :index index
:disp base-disp)))))
,@(when (and setterp big-endian-p)
`((inst mov temp value)
(inst bswap temp)))
,(if setterp
`(inst mov memref ,(if big-endian-p
'temp
'value))
'(inst mov result memref))
,(if setterp
'(move result value)
(when big-endian-p
'(inst bswap result)))))))))
(loop for i from 0 upto #b111
for setterp = (logbitp 2 i)
for signedp = (logbitp 1 i)
for big-endian-p = (logbitp 0 i)
collect (frob setterp signedp big-endian-p) into forms
finally (return `(progn ,@forms))))
|
