;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 121.18
;;; Reason:
;;;  Add :CDR-CODED keyword arg to MAKE-LIST.  This defaults to T for now.
;;; Written 29-Jan-87 23:13:23 by RG at site LMI Cambridge
;;; while running on Alex from band 3
;;; with Experimental System 121.17, Experimental Lambda-Diag 15.0, Experimental ZMail 70.2, Experimental KERMIT 32.0, Experimental Unix-Interface 10.0, Experimental Local-File 72.0, Experimental FILE-Server 21.0, Experimental Tape 13.0, microcode 1730, SDU Boot Tape 3.12, SDU ROM 102.



; From file DJ: L.SYS; QRAND.LISP#494 at 29-Jan-87 23:13:24
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; QRAND  "

(defvar *MAKE-LIST-CDR-CODE-DEFAULT* t)  ;Someday, set this to NIL.  Note optimizer in QCOPT
		;which also looks at this.
(DEFUN MAKE-LIST (LENGTH &REST OPTIONS)
  "Create a list LENGTH long.  :AREA keyword says where, :INITIAL-ELEMENT sets each element.
CDR-CODED specifies whether to use CDR-NEXT, etc.  If not supplied, this default to T for now,
but someday will change to NIL."
  (DECLARE (ARGLIST LENGTH &KEY AREA INITIAL-ELEMENT CDR-CODED))
  (LET ((LENGTH-OF-OPTIONS (LENGTH OPTIONS))
	(AREA NIL) (INITIAL-ELEMENT NIL)
	(cdr-coded *make-list-cdr-code-default*))
    ;; Figure out whether it is old-style.
    ;;>> There is a compiler style-checker against this.  Flush it soon.
    (IF (= LENGTH-OF-OPTIONS 1)
	;; It is old-style.
	(SETQ AREA LENGTH
	      LENGTH (FIRST OPTIONS))
      ;; It is new-style.
      (IF (ODDP LENGTH-OF-OPTIONS)
	  (FERROR "Odd-length options list: ~S" OPTIONS))
      (DO ((OPTIONS OPTIONS (CDDR OPTIONS)))
	  ((NULL OPTIONS))
	(LET ((VALUE (SECOND OPTIONS)))
	  (CASE (FIRST OPTIONS)
	    (:AREA (SETQ AREA VALUE))
	    ((:INITIAL-ELEMENT :INITIAL-VALUE)
	     (SETQ INITIAL-ELEMENT VALUE))
	    (:CDR-CODED (setq cdr-coded value))
	    (OTHERWISE
	     (FERROR "~S is not a known keyword." (FIRST OPTIONS)))))))
    (if cdr-coded (%MAKE-LIST INITIAL-ELEMENT AREA LENGTH)
      (make-list-with-cons initial-element area length))))

(defun make-list-with-cons (initial-element area length)
  (let ((ans nil))
    (dotimes (c length)
      (setq ans (cons-in-area initial-element ans area)))
    ans))
))

; From file DJ: L.SYS; QCOPT.LISP#176 at 29-Jan-87 23:13:40
#8R COMPILER#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "COMPILER")))
  (PATCH-SOURCE-FILE "SYS: SYS; QCOPT  "

(defoptimizer make-list-%make-list make-list (form)
  (or (let ((length-of-form (length form)))
	(if (= length-of-form 3)
	    ;; It is old-style.
	    ;; there has been a style-checker against this for some time.
	    ;;  May be flushed for 105, probably
	    `(%make-list 'nil ,(second form) ,(third form))
	  ;; It is new-style.
	  (if (evenp length-of-form)
	      (let ((area-form nil) (initial-value-form nil)
		    (cdr-coded-form si:*make-list-cdr-code-default*))
		(do ((options (cddr form) (cddr options)))
		    ((null options)
		     `(,(if cdr-coded-form '%make-list 'si:make-list-with-cons)
			,initial-value-form ,area-form ,(second form)))
		  (let ((keyword-form (car options))
			(value-form (cadr options)))
		    (if (eq (car-safe keyword-form) 'quote) (pop keyword-form))
		    (case keyword-form
		      (:area (setq area-form value-form))
		      ((:initial-value :initial-element)
		       (setq initial-value-form value-form))
		      (:cdr-coded
		       (case value-form
			 ((t nil) (setq cdr-coded-form value-form))
			 (otherwise (return nil))))
		      (otherwise (return nil)))))))))
      form))

))