175 |
(cmpwarn "~A was proclaimed to have only one return value. ~%;But you appear to want multiple values." fname)))))) |
(cmpwarn "~A was proclaimed to have only one return value. ~%;But you appear to want multiple values." fname)))))) |
176 |
|
|
177 |
(defun c2multiple-value-setq (vrefs form &aux top-data) |
(defun c2multiple-value-setq (vrefs form &aux top-data) |
178 |
(multiple-value-check vrefs form) |
|
179 |
(let ((*value-to-go* 'top)*top-data*) |
(multiple-value-check vrefs form) |
180 |
(c2expr* form) (setq top-data *top-data*)) |
|
181 |
(and *record-call-info* (record-call-info nil (car top-data))) |
(let ((exit-label (next-label))) |
182 |
(do ((vs vrefs (cdr vs))) |
(let ((*multiple-value-exit-label* exit-label) |
183 |
((endp vs)) |
(*value-to-go* (or (mapcar (lambda (x) (list 'var (car x) nil)) vrefs) 'trash)) |
184 |
|
*top-data*) |
185 |
|
(c2expr* form) (setq top-data *top-data*)) |
186 |
|
(and *record-call-info* (record-call-info nil (car top-data))) |
187 |
|
(do ((vs vrefs (cdr vs))) |
188 |
|
((endp vs)) |
189 |
(declare (object vs)) |
(declare (object vs)) |
190 |
(let ((vref (car vs))) |
(let ((vref (car vs))) |
191 |
(declare (object vref)) |
(declare (object vref)) |
192 |
(wt-nl "if(vs_base<vs_top){") |
(wt-nl "if(vs_base<vs_top){") |
193 |
(set-var 'fun-val (car vref) (cadr vref)) |
(set-var 'fun-val (car vref) (cadr vref)) |
194 |
(unless (endp (cdr vs)) (wt-nl "vs_base++;")) |
(unless (endp (cdr vs)) (wt-nl "vs_base++;")) |
195 |
(wt-nl "}else{") (set-var nil (car vref) (cadr vref)) |
(wt-nl "}else{") (set-var nil (car vref) (cadr vref)) |
196 |
(wt "}")) |
(wt "}"))) |
197 |
) |
|
198 |
|
(wt-label exit-label)) |
199 |
|
|
200 |
(cond ((null vrefs) |
(cond ((null vrefs) |
201 |
(wt-nl "if(vs_base=vs_top){vs_base[0]=Cnil;vs_top=vs_base+1;}") |
(wt-nl "if(vs_base==vs_top){vs_base[0]=Cnil;vs_top=vs_base+1;}") |
202 |
(unwind-exit 'fun-val)) |
(unwind-exit 'fun-val)) |
203 |
(t (unless (eq *exit* 'return) (wt-nl) (reset-top)) |
(t (unless (eq *exit* 'return) (wt-nl) (reset-top)) |
204 |
(unwind-exit (cons 'var (car vrefs))))) |
(unwind-exit (cons 'var (car vrefs)))))) |
|
) |
|
205 |
|
|
206 |
(defun c1multiple-value-bind (args &aux (info (make-info)) |
(defun c1multiple-value-bind (args &aux (info (make-info)) |
207 |
(vars nil) (vnames nil) init-form |
(vars nil) (vnames nil) init-form |
257 |
) |
) |
258 |
(setf (var-ref var) (vs-push))))) |
(setf (var-ref var) (vs-push))))) |
259 |
|
|
260 |
(let ((*value-to-go* 'top) *top-data*) |
(dotimes (i (1+ (length vars))) (push (next-label) labels)) |
261 |
|
|
262 |
|
(let* ((*multiple-value-exit-label* (car labels)) |
263 |
|
(*value-to-go* (or (mapcar (lambda (x) (list 'var x nil)) vars) 'trash)) |
264 |
|
*top-data*) |
265 |
(c2expr* init-form) (setq top-data *top-data*)) |
(c2expr* init-form) (setq top-data *top-data*)) |
266 |
(and *record-call-info* (record-call-info nil (car top-data))) |
(and *record-call-info* (record-call-info nil (car top-data))) |
267 |
|
|
268 |
|
(setq labels (reverse labels)) |
269 |
|
|
270 |
(let ((*clink* *clink*) |
(let ((*clink* *clink*) |
271 |
(*unwind-exit* *unwind-exit*) |
(*unwind-exit* *unwind-exit*) |
272 |
(*ccb-vs* *ccb-vs*)) |
(*ccb-vs* *ccb-vs*)) |
273 |
(do ((vs vars (cdr vs))) |
(do ((vs vars (cdr vs)) (labels labels (cdr labels))) |
274 |
((endp vs)) |
((endp vs)(wt-nl)(reset-top)(wt-go (car labels))) |
275 |
(declare (object vs)) |
(declare (object vs)) |
|
(push (next-label) labels) |
|
276 |
(wt-nl "if(vs_base>=vs_top){") |
(wt-nl "if(vs_base>=vs_top){") |
277 |
(reset-top) |
(reset-top) |
278 |
(wt-go (car labels)) (wt "}") |
(wt-go (car labels)) (wt "}") |
279 |
(c2bind-loc (car vs) '(vs-base 0)) |
(c2bind-loc (car vs) '(vs-base 0)) |
280 |
(unless (endp (cdr vs)) (wt-nl "vs_base++;")))) |
(unless (endp (cdr vs)) (wt-nl "vs_base++;")))) |
281 |
|
|
282 |
(wt-nl) (reset-top) |
(dolist** (v vars) |
283 |
|
(wt-label (car labels)) |
284 |
(let ((label (next-label))) |
(pop labels) |
285 |
(wt-nl) (wt-go label) |
(c2bind-loc v nil)) |
286 |
|
|
287 |
(setq labels (reverse labels)) |
(wt-label (car labels)) |
288 |
|
|
|
(dolist** (v vars) |
|
|
(wt-label (car labels)) |
|
|
(pop labels) |
|
|
(c2bind-loc v nil)) |
|
|
|
|
|
(wt-label label)) |
|
|
|
|
289 |
(c2expr body) |
(c2expr body) |
290 |
(when block-p (wt "}")) |
(when block-p (wt "}"))) |
|
) |
|