;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 126.23
;;; Reason:
;;;  Fixed setf-method for GETF.  Now this will work (gasp!):
;;;    (setf (getf (gethash symbol (structure-slot-accessor frob)) indicator) new)
;;; Written 9-Aug-88 17:27:32 by smh (Steve Haflich) at site Gigamos Cambridge
;;; while running on Harpo from band 3
;;; with Experimental System 126.21, 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#133 at 9-Aug-88 17:28:28
#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)
			   (,plloc (get-location-or-nil ,(car storevars) ,indicator-temp)))
		      (if ,plloc
			  (setf (car ,plloc) ,store-temp)
			(progn (setq ,(car storevars) (list* ,indicator-temp ,store-temp ,(car storevars)))
			       ,storeform))
		      ,store-temp)
		   `(getf ,refform ,indicator-temp))))))

))