;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 124.84
;;; Reason:
;;;  Common Lisp defines the return value of PSETQ to be NIL;  Zetalisp
;;;  says it is undefined.  Conform....
;;; Written 21-Jun-88 15:10:13 by pld (Peter L. DeWolf) at site Gigamos Cambridge
;;; while running on Cthulhu from band 1
;;; with Experimental System 124.79, Experimental Local-File 74.2, Experimental File-Server 23.1, Experimental Unix-Interface 12.0, Experimental ZMail 72.1, Experimental Tape 23.6, Experimental Lambda-Diag 16.2, microcode 1760, SDU Boot Tape 3.14, SDU ROM 8, the old ones.



; From modified file DJ: L.SYS2; LMMAC.LISP#464 at 21-Jun-88 15:14:56
#10R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; LMMAC  "

(DEFMACRO PSETQ (&REST REST)
  "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)
			    (MEMQ (CAR VAL) '(1+ 1- CDR CDDR))
			    (EQ (CADR VAL) VAR))
		       (EQ VAR VAL))
		   (NOT (MEMQ VAR SETQS)))
	      (SETQ SETQS (CONS VAR (CONS VAL SETQS)))
	    (SETQ PSETQS (CONS VAR (CONS VAL PSETQS)))))
     FINALLY
        (LABELS ((PROG1IFY (X)
		   (COND ((NULL X) NIL)
			 ((NULL (CDDR X)) (CONS 'SETQ X))
			 (T `(SETQ ,(CAR X) (PROG1 ,(CADR X) ,(PROG1IFY (CDDR X))))))))
	  (SETQ PSETQS (PROG1IFY PSETQS))
	  (RETURN (COND ((NULL SETQS)
			 `(progn ,PSETQS nil))
			((NULL PSETQS)
			 `(progn (SETQ ,@SETQS) nil))
			(T
			 `(PROGN ,PSETQS (SETQ ,@SETQS) nil)))))))

))