84 |
(mapcar #'(lambda (range) |
(mapcar #'(lambda (range) |
85 |
(let ((lo (car range)) |
(let ((lo (car range)) |
86 |
(hi (cadr range))) |
(hi (cadr range))) |
87 |
(random-from-interval lo (1+ hi)))) |
(random-from-interval (1+ hi) lo))) |
88 |
var-ranges))) |
var-ranges))) |
89 |
(setq *int-form-vals* vals) |
(setq *int-form-vals* vals) |
90 |
(let ((opt-result (apply unoptimized-compiled-fn vals)) |
(let ((opt-result (apply unoptimized-compiled-fn vals)) |
130 |
(- (random r) (floor (/ r 2)))) |
(- (random r) (floor (/ r 2)))) |
131 |
(random-from-seq vars)) |
(random-from-seq vars)) |
132 |
;; (> size 1) |
;; (> size 1) |
133 |
(ecase (random 7) |
(ecase (random 9) |
134 |
;; Unary ops |
;; Unary ops |
135 |
((0 1) |
((0 1) |
136 |
(let ((op (random-from-seq '(- abs signum 1+ 1- identity |
(let ((op (random-from-seq '(- abs signum 1+ 1- identity |
141 |
(let* ((op (random-from-seq |
(let* ((op (random-from-seq |
142 |
'(+ - * logand min max ;; gcd lcm |
'(+ - * logand min max ;; gcd lcm |
143 |
logandc1 logandc2 logeqv logior lognand lognor logorc1 |
logandc1 logandc2 logeqv logior lognand lognor logorc1 |
144 |
logorc2 logxor))) |
logorc2 logxor)))) |
145 |
(leftsize (random size))) |
(destructuring-bind (leftsize rightsize) |
146 |
`(,op ,(make-random-integer-form leftsize vars) |
(random-partition (1- size) 2) |
147 |
,(make-random-integer-form (- size 1 leftsize) vars)))) |
`(,op ,(make-random-integer-form leftsize vars) |
148 |
|
,(make-random-integer-form rightsize vars))))) |
149 |
;; conditionals |
;; conditionals |
150 |
(6 |
(6 |
151 |
(let* ((cond-size (random (max 1 (floor size 2)))) |
(let* ((cond-size (random (max 1 (floor size 2)))) |
155 |
(then-part (make-random-integer-form then-size vars)) |
(then-part (make-random-integer-form then-size vars)) |
156 |
(else-part (make-random-integer-form else-size vars))) |
(else-part (make-random-integer-form else-size vars))) |
157 |
`(if ,pred ,then-part ,else-part))) |
`(if ,pred ,then-part ,else-part))) |
158 |
|
(7 |
159 |
|
(destructuring-bind (s1 s2 s3) (random-partition (1- size) 3) |
160 |
|
`(,(random-from-seq '(deposit-field dpb)) |
161 |
|
,(make-random-integer-form s1 vars) |
162 |
|
,(make-random-byte-spec-form s2 vars) |
163 |
|
,(make-random-integer-form s3 vars)))) |
164 |
|
(8 |
165 |
|
(destructuring-bind (s1 s2) (random-partition (1- size) 2) |
166 |
|
`(,(random-from-seq '(ldb mask-field)) |
167 |
|
,(make-random-byte-spec-form s1 vars) |
168 |
|
,(make-random-integer-form s2 vars)))) |
169 |
))) |
))) |
170 |
|
|
171 |
(defun make-random-pred-form (size vars) |
(defun make-random-pred-form (size vars) |
173 |
(ecase (random 3) |
(ecase (random 3) |
174 |
(0 (if (coin) t nil)) |
(0 (if (coin) t nil)) |
175 |
((1 2) |
((1 2) |
176 |
`(,(random-from-seq '(< <= = > >= /=)) |
`(,(random-from-seq '(< <= = > >= /= eql equal)) |
177 |
,(make-random-integer-form size vars) |
,(make-random-integer-form size vars) |
178 |
,(make-random-integer-form size vars)))) |
,(make-random-integer-form size vars)))) |
179 |
(ecase (random 5) |
(ecase (random 6) |
180 |
(0 (if (coin) t nil)) |
(0 (if (coin) t nil)) |
181 |
(1 `(not ,(make-random-pred-form (1- size) vars))) |
(1 `(not ,(make-random-pred-form (1- size) vars))) |
182 |
(2 (let* ((leftsize (random size)) |
(2 (destructuring-bind (leftsize rightsize) |
183 |
(rightsize (- size 1 leftsize))) |
(random-partition (1- size) 2) |
184 |
`(,(random-from-seq '(and or)) |
`(,(random-from-seq '(and or)) |
185 |
,(make-random-pred-form leftsize vars) |
,(make-random-pred-form leftsize vars) |
186 |
,(make-random-pred-form rightsize vars)))) |
,(make-random-pred-form rightsize vars)))) |
187 |
(3 (let* ((leftsize (random size)) |
(3 (destructuring-bind (leftsize rightsize) |
188 |
(rightsize (- size 1 leftsize))) |
(random-partition (1- size) 2) |
189 |
`(,(random-from-seq '(< <= > >= = /=)) |
`(,(random-from-seq '(< <= > >= = /= eql equal)) |
190 |
,(make-random-integer-form leftsize vars) |
,(make-random-integer-form leftsize vars) |
191 |
,(make-random-integer-form rightsize vars)))) |
,(make-random-integer-form rightsize vars)))) |
192 |
(4 (let* ((cond-size (random (max 1 (floor size 2)))) |
(4 (let* ((cond-size (random (max 1 (floor size 2)))) |
196 |
(then-part (make-random-pred-form then-size vars)) |
(then-part (make-random-pred-form then-size vars)) |
197 |
(else-part (make-random-pred-form else-size vars))) |
(else-part (make-random-pred-form else-size vars))) |
198 |
`(if ,pred ,then-part ,else-part))) |
`(if ,pred ,then-part ,else-part))) |
199 |
|
(5 (destructuring-bind (s1 s2) |
200 |
|
(random-partition (1- size) 2) |
201 |
|
`(ldb-test ,(make-random-byte-spec-form s1 vars) |
202 |
|
,(make-random-integer-form s2 vars)))) |
203 |
|
|
204 |
))) |
))) |
205 |
|
|
206 |
|
(defun make-random-byte-spec-form (size vars) |
207 |
|
(declare (ignore size vars)) |
208 |
|
(let* ((pform (random 33)) |
209 |
|
(sform (random 33))) |
210 |
|
`(byte ,sform ,pform))) |
211 |
|
|
212 |
|
(defun random-partition (n p) |
213 |
|
"Partition n into p numbers, each >= 1. Return list of numbers." |
214 |
|
(assert (<= 1 p)) |
215 |
|
(cond |
216 |
|
((= p 1) (list n)) |
217 |
|
((< n p) (make-list p :initial-element 1)) |
218 |
|
(t |
219 |
|
(let ((n1 (1+ (random (floor n p))))) |
220 |
|
(cons n1 (random-partition (- n n1) (1- p))))))) |