;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 126.36
;;; Reason:
;;;  Minor fix to new define-setf-method for getf.
;;; Written 10-Aug-88 17:14:54 by smh at site Gigamos Cambridge
;;; while running on Harpo from band 3
;;; with Experimental System 126.32, ZWEI 125.14, ZMail 73.2, Local-File 75.2, File-Server 24.1, Unix-Interface 13.0, Tape 24.2, Lambda-Diag 17.0, microcode 1762, SDU Boot Tape 3.12, SDU ROM 102, kold 4aug88.



; From modified file DJ: L.SYS2; SETF.LISP#135 at 10-Aug-88 17:15:06
#10R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; SETF  "

(define-setf-method getf (&environment environment place indicator &optional default)
  (if (symbolp place)				; An important optimization.
      (let ((new (gensym "NEW-")))
	(values nil
		nil
		(list new)
		`(setpropf ,place ,indicator ,new)
		place))
    (let ((indicator-temp (gensym "INDICATOR-"))
	  (default-temp (gensym "DEFAULT-"))
	  (plloc (gensym "PLLOC-"))
	  (store-temp (gensym "STORE-")))
      (multiple-value-bind (tempvars tempargs storevars storeform refform)
	  (get-setf-method place environment)
	(values (list* indicator-temp default-temp tempvars)
		(list* indicator      default      tempargs)
		(list store-temp)
		`(let ((,(car storevars) ,refform))
		   (do ((,plloc ,(car storevars) (cddr ,plloc)))
		       ((null ,plloc)
			(setq ,(car storevars) (list* ,indicator-temp ,store-temp ,(car storevars)))
			,storeform)
		     (when (eq (car ,plloc) ,indicator-temp)
		       (setf (cadr ,plloc) ,store-temp)
		       (return)))
		   ,store-temp)
		`(getf ,refform ,indicator-temp))))))

))