;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 124.81
;;; Reason:
;;;  Define new setf method for (fill-pointer).  If you wish to reference
;;;  the fill-pointer as (array-leader 0), you can store what you want in
;;;  it, but if you reference it via (fill-pointer ...) there is now
;;;  stricter checking of the new value.
;;; Written 20-Jun-88 18:15:42 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; SETF.LISP#127 at 20-Jun-88 18:15:43
#10R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; SETF  "

(defun set-fill-pointer (array value)
  (cond ((not (arrayp array))
	 (ferror "Argument ~S must be an array" array))
	((not (array-has-fill-pointer-p array))
	 (ferror "Array ~S has no fill-pointer" array))
	((not (fixnump value))
	 (ferror "New fill-pointer must be a fixnum"))
	((or (minusp value) (> value (array-length array)))
	 (ferror "New fill pointer ~A out of range for array ~A" value array))
	(t
	 (setf (array-leader array 0) value))))
(defsetf fill-pointer set-fill-pointer)
))