346 |
(defmacro lambda ( &rest l) `(function (lambda ,@l))) |
(defmacro lambda ( &rest l) `(function (lambda ,@l))) |
347 |
|
|
348 |
(defmacro memq (a b) `(member ,a ,b :test 'eq)) |
(defmacro memq (a b) `(member ,a ,b :test 'eq)) |
349 |
|
|
350 |
|
;;FIXME should come from DEFUNO_NEW |
351 |
|
(proclaim '(ftype (function (t fixnum) fixnum) si::select-read)) |
352 |
|
(proclaim '(ftype (function () t) si::fork)) |
353 |
|
(proclaim '(ftype (function (t) t) fib si::kill)) |
354 |
|
|
355 |
|
(defmacro background (form) |
356 |
|
(let ((x (gensym))) |
357 |
|
`(let ((,x (si::fork))) |
358 |
|
(if (eql 0 (car ,x)) |
359 |
|
(progn (prin1 ,form (cdr ,x))(bye)) |
360 |
|
,x)))) |
361 |
|
|
362 |
|
(defmacro with-read-values ((i r b) (forms timeout) &body body) |
363 |
|
(let* ((m (gensym)) |
364 |
|
(j (gensym)) |
365 |
|
(k (gensym)) |
366 |
|
(p (gensym)) |
367 |
|
(pbl (length forms)) |
368 |
|
(pbm (1- (ash 1 pbl)))) |
369 |
|
`(let* ((,m ,pbm) |
370 |
|
(,b (list ,@(mapcar (lambda (x) `(background ,x)) forms)))) |
371 |
|
(declare ((integer 0 ,pbm) ,m)) |
372 |
|
(do nil ((= ,m 0)) |
373 |
|
(let ((,p (si::select-read ,b ,timeout)));;FAILURE code here on 0 return |
374 |
|
(declare ((integer 0 ,pbm) ,p)) |
375 |
|
(do ((,i 0 (1+ ,i))(,j 1 (ash ,j 1)) (,k ,b (cdr ,k))) |
376 |
|
((= ,i ,pbl) (setq ,m (logandc2 ,m ,p))) |
377 |
|
(declare ((integer 0 ,pbl) ,i) ((integer 1 ,(1+ pbm)) ,j)) |
378 |
|
(when (/= 0 (logand ,j ,p)) |
379 |
|
(let ((,r (read (cdar ,k)))) |
380 |
|
(close (cdar ,k)) |
381 |
|
,@body)))))))) |
382 |
|
|
383 |
|
(defmacro p-let (bindings &body body) |
384 |
|
(let* ((i (gensym)) (r (gensym)) (c (gensym)) |
385 |
|
(pb (remove-if 'atom bindings))) |
386 |
|
`(let* (,@(mapcar 'car pb) ,@(remove-if 'consp bindings)) |
387 |
|
(with-read-values |
388 |
|
(,i ,r ,c) (,(mapcar 'cadr pb) -1) |
389 |
|
(case ,i |
390 |
|
,@(let ((g -1)) |
391 |
|
(mapcar (lambda (x) `(,(incf g) (setq ,(car x) ,r))) pb)))) |
392 |
|
,@body))) |
393 |
|
|
394 |
|
(defmacro p-and (&rest forms) |
395 |
|
(let* ((i (gensym)) (r (gensym)) (c (gensym)) (top (gensym))) |
396 |
|
`(block ,top |
397 |
|
(with-read-values |
398 |
|
(,i ,r ,c) (,forms -1) |
399 |
|
(unless ,r |
400 |
|
(dolist (,c ,c) (si::kill ,c)) |
401 |
|
(return-from ,top nil))) |
402 |
|
t))) |
403 |
|
|
404 |
|
(defmacro p-or (&rest forms) |
405 |
|
(let* ((i (gensym)) (r (gensym)) (c (gensym)) (top (gensym))) |
406 |
|
`(block ,top |
407 |
|
(with-read-values |
408 |
|
(,i ,r ,c) (,forms -1) |
409 |
|
(when ,r |
410 |
|
(dolist (,c ,c) (si::kill ,c)) |
411 |
|
(return-from ,top t))) |
412 |
|
nil))) |