;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 124.110
;;; Reason:
;;;  Malformed PSETQs generally get caught during expansion of the generated
;;;  SETQ form.  One exception: an odd number of arguments turned into things
;;;  like (SETQ ... NIL <value> ...) which generated a misleading error.
;;;  Now this error is caught during PSETQ expansion.
;;; Written 26-Jun-88 09:33:02 by keith (Keith Corbett) at site Gigamos Cambridge
;;; while running on Breaking Glass from band 2
;;; with Experimental System 124.109, Experimental Local-File 74.3, Experimental File-Server 23.1, Experimental Unix-Interface 12.0, Experimental ZMail 72.1, Experimental Tape 23.6, Experimental Lambda-Diag 16.2, Tiger 28.0, microcode 1761, SDU Boot Tape 3.14, SDU ROM 103, Beta 3 plus patches.



; From modified file DJ: L.SYS2; LMMAC.LISP#465 at 26-Jun-88 09:33:02
#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.
  (let ((len (length rest)))
    ;;We let SETQ handle all the weird cases but this, which
    ;;avoids expanding to and crapping out on a SETQ of NIL:
    (when (oddp len)
      (ferror "~S appears with an odd number of arguments; the last one is ~S"
	      'psetq (car (last rest)))))
  (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)))))))

))