1;;; -*- *cold-load:t; 1Mode:Common-Lisp; Package:SYSTEM-INTERNALS; Fonts:(CPTFONT CPTFONTB); Base:10. -*-


;;;                           RESTRICTED RIGHTS LEGEND

;;;Use, duplication, or disclosure by the Government is subject to
;;;restrictions as set forth in subdivision (c)(1)(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) 1986-1989 Texas Instruments Incorporated.  All rights reserved.*

(DEFMACRO PSETQ (&REST REST)
1  "Like SETQ, but no variable value is changed until all the values are computed.
The returned value is NIL."
  ;; To improve the efficiency of do-stepping, by using the SETE-CDR, SETE-CDDR,
  ;; SETE-1+, and SETE-1- instructions, we try to do such operations with SETQ
  ;; rather than PSETQ.  To avoid having to do full code analysis, never rearrange
  ;; the order of any code when doing this, and only do it when there are no
  ;; variable name duplications.*
  (LOOP FOR (VAL VAR) ON (REVERSE REST) BY 'CDDR
	WITH SETQS = NIL WITH PSETQS = NIL
	DO (UNLESS (EQ VAR VAL)
	     (IF (AND (NULL PSETQS)
		      (OR (AND (CONSP VAL)
			       (MEMBER (CAR VAL) '(1+ 1- CDR CDDR) :TEST #'EQ)
			       (EQ (CADR VAL) VAR))
			  (EQ VAR VAL))
		      (NOT (MEMBER VAR SETQS :TEST #'EQ)))
		 (SETQ SETQS (CONS VAR (CONS VAL SETQS)))
	       (SETQ PSETQS (CONS VAR (CONS VAL PSETQS)))))
	FINALLY
	  (SETQ PSETQS (PSETQ-PROG1IFY PSETQS))
	  (RETURN (COND ((NULL SETQS) `(PROGN ,PSETQS NIL))
			((NULL PSETQS) `(PROGN ,(CONS 'SETQ SETQS) NIL))
			(T `(PROGN ,PSETQS (SETQ . ,SETQS) NIL))))))