LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760031358. :SYSTEM-TYPE :LOGICAL :VERSION 5. :TYPE "LISP" :NAME "ALTERNATE-MACRO-DEFINITIONS" :DIRECTORY ("REL3-SOURCE" "KERNEL") :SOURCE-PATTERN "( :DIRECTORY (\"REL3-SOURCE\") :NAME :WILD :TYPE :WILD :VERSION :NEWEST)" :VERSION-LIMIT 0. :CHARACTERS T :NOT-BACKED-UP T :CREATION-DATE 2758638246. :AUTHOR "REL3" :LENGTH-IN-BYTES 4727. :LENGTH-IN-BLOCKS 5. :BYTE-SIZE 8.)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            ;;; -*- Mode:Common-Lisp; Package:SYSTEM-INTERNALS; Base:10; Lowercase:T -*-;;;                           RESTRICTED RIGHTS LEGEND;;;Use, duplication, or disclosure by the Government is subject to;;;restrictions as set forth in subdivision (b)(3)(ii) of the Rights in;;;Technical Data and Computer Software clause at 52.227-7013.;;;                     TEXAS INSTRUMENTS INCORPORATED.;;;                              P.O. BOX 2909;;;                           AUSTIN, TEXAS 78769;;;                                 MS 2151;;; Copyright (C) 1985,1987 Texas Instruments Incorporated. All rights reserved.;; PHD 12/31/86 Removed alternate-macro-defintions for  macro, deff-macro, deff, defun ;;; this file contains macro definitions for zetalisp special forms;;; for use with the common-lisp MACRO-FUNCTION function.(defmacro (:property prog1 alternate-macro-definition) (&body forms &aux (var (gensym)))  `(let ((,var ,(first forms)))     ,@(cdr forms)     ,var))(defmacro (:property return alternate-macro-definition) (&rest values)  `(return-from () ,@values)) (defmacro (:property nth-value alternate-macro-definition) (value-number exp)  `(nth ,value-number (multiple-value-list ,exp))) (defmacro (:property multiple-value-setq  alternate-macro-definition) (vars exp)  `(multiple-value-call #'(lambda (&rest forms)    (prog1 ,@(loop for var in vars and j from 0 collect `(setq ,var (nth ,j forms))))),exp))(defmacro (:property multiple-value-list alternate-macro-definition) (exp)  `(multiple-value-call #'list ,exp)) (defmacro (:property multiple-value-bind alternate-macro-definition) (vars exp &body body)  `(let ,vars     (multiple-value-setq ,vars       ,exp)     ,@body)) (defmacro (:property multiple-value alternate-macro-definition) (vars exp)  `(multiple-value-setq ,vars     ,exp)) (defmacro (:property with-stack-list alternate-macro-definition) ((var . elts) &body body)  `(let ((,var (list . ,elts)))     ,@body)) (defmacro (:property with-stack-list* alternate-macro-definition) ((var . elts) &body body)  `(let ((,var (list* . ,elts)))     ,@body)) (defmacro (:property dont-optimize alternate-macro-definition) (&body body)  `(progn     . ,body)) (defmacro (:property do alternate-macro-definition) (vars (test . result) &body body)  (let ((tag (gensym)))    `(prog ,(mapcar #'(lambda (x)(if (atom x)  x  (list (car x) (cadr x))))    vars)       ,tag       (when ,test ,@result)       (progn . ,body)       (psetq. ,(loop for x in vars when (and (not (atom x)) (cddr x)) collect (car x) and collect      (caddr x)))       (go ,tag)))) (defmacro (:property do* alternate-macro-definition) (vars (test . result) &body body)  (let ((tag (gensym)))    `(prog* ,(mapcar #'(lambda (x) (if (atom x)   x   (list (car x) (cadr x))))     vars)       ,tag       (when ,test ,@result)       (progn . ,body)       (setq. ,(loop for x in vars when (and (not (atom x)) (cddr x)) collect (car x) and collect      (caddr x)))       (go ,tag)))) ;; ; (or a c b d) => (cond (a) (b) (c) (t d))(defmacro (:property or alternate-macro-definition) (&rest expressions)  (case (length expressions)    (0 nil)    (1 (car expressions))    (t     (do ((x expressions (cdr x))  (result (list 'cond) (cons (list (car x)) result))) ((null (cdr x))  (push (list t (car x)) result)  (nreverse result)))))) ;;;(and a b c d) => (if a (if b (if c d)))(defmacro (:property and alternate-macro-definition) (&rest expressions)  (case (length expressions)    (0 t)    (1 (car expressions))    (t     (do* ((foo (cdr (reverse expressions)) (cdr foo))   (result `(,(car (last expressions)))))  ((null foo)   (car result))       (setq result `((if ,(car foo),@result))))))) ;;;(cond (a b c) (d) (e f)) => (if a (progn b c) (let (d) (if d (if e f)))(defmacro (:property cond    alternate-macro-definition) (&rest clauses)  (do ((foo (reverse clauses) (cdr foo))       (result nil)       loser)      ((null foo)       (if loser `(let (,loser)    ,@result) (car result)))    (if (> (length (car foo)) 1)      (setq result `((if ,(caar foo)       (progn . ,(cdar foo))       ,@result)))      (progn(or loser (setq loser (make-symbol "LOSER" t)))(setq result `((if (setq ,loser ,(caar foo)) ,loser ,@result))))))) (defmacro (:property defprop alternate-macro-definition) (symbol value property)  `(progn     (putprop ',symbol ',value ',property)     ',symbol)) ;;PAD 1/21/87 added alternate-macro-definition for locally(defmacro (:property locally alternate-macro-definition) (&body body)  `(let () . ,body))       -1 (function-spec class name position forms)  ;(setq function-spec (dwimify-arg-package function-spec 'function))  (advise-init function-spec)  (setq forms (rename-within-new-definition-maybe function-spec forms))  (advise-update-list   (advise-find-slot (unencapsulate-function-spec function-spec 'advise) class) name position      forms)  (if compile-encapsulations-flag    (compil