;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 129.3
;;; Reason:
;;;  Fix QFILE bug causing OPEN to return an 8-bit stream for all QFASL files.
;;; Written 10-Nov-88 15:56:01 by keith (Keith Corbett) at site Gigamos Cambridge
;;; while running on Breaking Glass from band 3
;;; with Experimental ZWEI 126.29, Experimental ZMail 74.17, Experimental Local-File 76.0, Experimental File-Server 25.0, Obsolete Lambda-Diag 18.1, Experimental Unix-Interface 15.0, Experimental Tape 26.4, Experimental System 129.1, Microcode 1762, SDU Boot Tape 3.14, SDU ROM 103, 11/04.



; From modified file DJ: L.NETWORK.CHAOS; QFILE.LISP#388 at 10-Nov-88 15:56:02
#8R FILE-SYSTEM#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; CHAOS; QFILE  "

(DEFUN READ-FILE-PROPERTY-LIST-STRING (STRING OPERATION PATHNAME
					;; PATHNAME is only used to get the
					;; host with respect to which to parse
				       &OPTIONAL (PROPERTIES-TO-READ
   ;properties are in order as expected in reply from file-computer.
   ; T is a special kludge to group time and date into one field for :CREATION-DATE.
   ;   it turns out not to be really general enuf, see other part of kludge in :LENGTH below.
						   '((:CREATION-DATE) (:CREATION-TIME)
						     (:LENGTH T) (:QFASLP T)
						     (:CHARACTERS T) (:AUTHOR T)
						     (:byte-size t)))
				       &AUX PATHNAME-ORIGIN PROPERTY-LIST
					    (DEFAULT-CONS-AREA SYS:BACKGROUND-CONS-AREA))
  (OR (SETQ PATHNAME-ORIGIN (STRING-SEARCH-CHAR #/NEWLINE STRING))
      (FERROR NIL "Illegally formatted string ~S." STRING))
  (DO ((I (QFILE-CHECK-COMMAND OPERATION STRING))
       (PROP PROPERTIES-TO-READ (CDR PROP))
       (*READ-BASE* 10.) (*READTABLE* SI:INITIAL-READTABLE)
       (TYPE) (DATE-START))
      ((OR (NULL I) (> I PATHNAME-ORIGIN) (NULL PROP)))
    (SETQ TYPE (CAAR PROP))
    (CASE TYPE
      (:CREATION-DATE (SETQ DATE-START I))
      (:LENGTH (PUSH (OR (FS:PARSE-DIRECTORY-DATE-PROPERTY STRING DATE-START I)
			 ;; When bootstrapping, dates are recorded as strings.
			 (SUBSTRING STRING DATE-START I))
		     PROPERTY-LIST)
	       (PUSH :CREATION-DATE PROPERTY-LIST)))
    (COND ((CADAR PROP)
	   (MULTIPLE-VALUE-BIND (PROPVAL ENDPOS)
	       (CL:READ-FROM-STRING STRING NIL NIL :START I :end pathname-origin)
	     (SETQ I ENDPOS)
	     (PUSH PROPVAL PROPERTY-LIST)
	     (PUSH TYPE PROPERTY-LIST)))
	  (T (SETQ I (STRING-SEARCH-CHAR #/SPACE STRING (1+ I))))))
  (PUSH (SEND PATHNAME :PARSE-TRUENAME
	      (SUBSTRING STRING (SETQ PATHNAME-ORIGIN (1+ PATHNAME-ORIGIN))
			 (STRING-SEARCH-CHAR #/NEWLINE STRING PATHNAME-ORIGIN)))
	PROPERTY-LIST)
  (PUSH :TRUENAME PROPERTY-LIST)
  PROPERTY-LIST)

))