;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*- ;;; Patch file for System version 121.33 ;;; Reason: ;;; Various patches from MIT. See beginning of patch file if your interested in more details. ;;; Reason: ;;; Avoid consing NIL into directory component list in case of certain TOPS-20 pathnames. Also ITS. ;;; Reason: ;;; Gross hack to allow dired of AI:*;  to work! ;;; Reason: ;;; Avoid probing TOPS-20 structure as host at various times. ;;; Reason: ;;; Increment count of packets received on EXPLORER. ;;; Reason: ;;; Somewhat marginal fix to crash reporting stuff on explorer. ;;; Reason: ;;; Avoid spurious attempt to treat host name as package name when reading file property lists. ;;; Written 14-Feb-87 12:45:34 by RG at site LMI Cambridge ;;; while running on Explorer One from band 1 ;;; with Experimental System 121.32, 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 NVRAM 4.0, Experimental Tape 16.0, microcode 1739, Explorer. ; From modified file DJ: L.NETWORK.CHAOS; QFILE.LISP#376 at 14-Feb-87 12:45:34 #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 &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) )) ; From modified file DJ: L.IO.FILE; PATHNM.LISP#572 at 14-Feb-87 13:10:52 #8R FILE-SYSTEM#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM"))) (COMPILER::PATCH-SOURCE-FILE "SYS: IO; FILE; PATHNM  " (DEFMETHOD (PATHNAME :PATHNAME-AS-DIRECTORY) () (SEND SELF :NEW-PATHNAME :RAW-DIRECTORY (cond ((null name) directory) ;TOPS-20 sometimes sends back a directory-form ;pathname where a file-form pathname was expected, causing this. ;Also, this cause c-u m-x dired ai:*; to win. In any case, appending a ;NIL into the directory list isnt going to get us anywhere. ((EQ DIRECTORY :ROOT) NAME) (t (APPEND (IF (CONSP DIRECTORY) DIRECTORY (NCONS DIRECTORY)) (NCONS NAME)))) :NAME :UNSPECIFIC :TYPE :UNSPECIFIC :VERSION :UNSPECIFIC)) )) ; From modified file DJ: L.NETWORK.CHAOS; QFILE.LISP#376 at 14-Feb-87 13:10:56 #8R FILE-SYSTEM#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM"))) (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; CHAOS; QFILE  " (DEFMETHOD (BASIC-QFILE-ACCESS :READ-DIRECTORY-STREAM-ENTRY) (STREAM DEFAULT-PATHNAME &optional options) (FS:READ-DIRECTORY-STREAM-ENTRY STREAM DEFAULT-PATHNAME options)) ;;; PATHNAME is supplied as an argument here so that the :PATHNAME message to the stream ;;; will return a logical pathname, if that is what was OPEN'ed. )) ; From modified file DJ: L.ZWEI; DIRED.LISP#327 at 14-Feb-87 13:10:59 #8R ZWEI#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "ZWEI"))) (COMPILER::PATCH-SOURCE-FILE "SYS: ZWEI; DIRED  " (DEFCOM COM-DIRED "Edit a directory. For documentation on the Dired commands, enter Dired and type question-mark. With arg, dired on subdirectories only." () (KILL-NEW-BUFFER-ON-ABORT (*INTERVAL*) (DIRECTORY-EDIT (READ-DIRECTORY-NAME "Edit directory" (DEFAULT-PATHNAME)) t (if (NOT *NUMERIC-ARG-P*) nil '(:directories-only))))) )) ; From modified file DJ: L.ZWEI; DIRED.LISP#327 at 14-Feb-87 13:11:01 #8R ZWEI#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "ZWEI"))) (COMPILER::PATCH-SOURCE-FILE "SYS: ZWEI; DIRED  " (DEFUN DIRECTORY-EDIT (PATHNAME &OPTIONAL (SELECTP T) directory-list-options) "Create a ZMACS buffer editing the directory PATHNAME, and select it unless inhibited. The buffer is selected unless SELECTP is NIL." (LET* ((DIRNAME (SEND PATHNAME :STRING-FOR-DIRECTORY)) (INTERVAL ;; We do not use :FIND-SPECIAL-BUFFER because we can be called ;; while not inside ZMACS, and there may not even be a good way to ;; pick which ZMACS window to call. (MAKE-INSTANCE 'ZMACS-BUFFER :NAME (LOOP FOR I FROM 1 AS BUFNAM = (FORMAT NIL "*Dired-~A-~D*" DIRNAME I) UNLESS (FIND-BUFFER-NAMED BUFNAM) RETURN BUFNAM)))) (if directory-list-options (putprop interval directory-list-options 'directory-list-options)) (MAKE-BUFFER-READ-ONLY INTERVAL) (SETF (NODE-SPECIAL-TYPE INTERVAL) :DIRED) (SETF (BUFFER-SAVED-MAJOR-MODE INTERVAL) 'DIRED-MODE) (SEND INTERVAL :ACTIVATE) (IF SELECTP (SEND INTERVAL :SELECT)) (SETF (GET INTERVAL 'PATHNAME-LIST) (LIST PATHNAME)) (LET ((*INTERVAL* NIL)) (DIRECTORY-EDIT-REVERT INTERVAL)) (IF SELECTP (SETQ *DIRED-PATHNAME-NAME* (SEND (BUFFER-PATHNAME INTERVAL) :STRING-FOR-PRINTING))) DIS-TEXT)) )) ; From modified file DJ: L.ZWEI; DIRED.LISP#327 at 14-Feb-87 13:11:03 #8R ZWEI#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "ZWEI"))) (COMPILER::PATCH-SOURCE-FILE "SYS: ZWEI; DIRED  " (DEFUN DIRECTORY-EDIT-REVERT (BUFFER &OPTIONAL IGNORE IGNORE SELECT-FLAG QUIETLY-FLAG &AUX DIRECTORY (PATHNAME-LIST (OR (GET BUFFER 'PATHNAME-LIST) (LIST (BUFFER-PATHNAME BUFFER))))) (DECLARE (IGNORE QUIETLY-FLAG)) (WITH-READ-ONLY-SUPPRESSED (BUFFER) (LET ((*BATCH-UNDO-SAVE* T) OLD-POSITION-PATHNAME OLD-POSITION-INDEX (SELECTED-P (EQ BUFFER *INTERVAL*)) (OPEN-SUBDIRS (DIRED-ALL-OPEN-SUBDIRECTORIES BUFFER)) (*INTERVAL* BUFFER)) (WHEN (NOT (BP-= (INTERVAL-FIRST-BP BUFFER) (INTERVAL-LAST-BP BUFFER))) (SETQ OLD-POSITION-PATHNAME (DIRED-LINE-PATHNAME (BP-LINE (POINT)))) (SETQ OLD-POSITION-INDEX (BP-INDEX (POINT)))) (DELETE-INTERVAL BUFFER) (DISCARD-UNDO-INFORMATION BUFFER) (UNLESS (= (LENGTH PATHNAME-LIST) 1) (SETF (BUFFER-PATHNAME BUFFER) NIL) (SETQ *DIRED-PATHNAME-NAME* NIL)) (DO ((REST PATHNAME-LIST (CDR REST)) (FIRST T NIL)) ((NULL REST)) (LET ((PATHNAME (CAR REST))) (FILE-RETRY-NEW-PATHNAME (PATHNAME FS:FILE-ERROR) (SETQ DIRECTORY (apply 'FS:DIRECTORY-LIST PATHNAME :DELETED :SORTED (get buffer 'directory-list-options)))) (SETQ PATHNAME (SEND PATHNAME :TRANSLATED-PATHNAME)) (WHEN (= (LENGTH PATHNAME-LIST) 1) (AND SELECTED-P (SETQ *DIRED-PATHNAME-NAME* (SEND PATHNAME :STRING-FOR-PRINTING))) (SEND-IF-HANDLES BUFFER :SET-PATHNAME PATHNAME) (SEND-IF-HANDLES BUFFER :SET-FILE-ID (LIST PATHNAME))) (LET ((STREAM (INTERVAL-STREAM-INTO-BP (INTERVAL-LAST-BP BUFFER)))) (UNLESS FIRST (TERPRI STREAM)) (SEND STREAM :STRING-OUT (SEND PATHNAME :STRING-FOR-PRINTING)) (SEND STREAM :LINE-PUT ':DIRECTORY PATHNAME) (TERPRI STREAM) (FUNCALL *DIRECTORY-SINGLE-FILE-LISTER* (ASSQ NIL DIRECTORY) STREAM) ;; Insert the subfiles, and maybe move point (LET ((FIRST-FILE-LINE (DIRED-INSERT-DIRECTORY DIRECTORY STREAM 0))) (AND FIRST FIRST-FILE-LINE (MOVE-BP (SEND BUFFER :POINT) FIRST-FILE-LINE 0)))))) ;; Bring back the files of any subdirs whose files were included before. (MAPCAR #'DIRED-OPEN-SUBDIRECTORY OPEN-SUBDIRS) (SEND-IF-HANDLES BUFFER :SET-FILE-READ-TICK *TICK*) (SEND-IF-HANDLES BUFFER :SET-FILE-TICK *TICK*) ;; "Restore" buffer position by finding where the same pathname would go now. (WHEN OLD-POSITION-PATHNAME (LET ((BP (DIRED-PATHNAME-INSERTION-BP OLD-POSITION-PATHNAME))) (WHEN BP (MOVE-BP (POINT) BP) (IF (EQ (DIRED-LINE-PATHNAME (BP-LINE (POINT))) OLD-POSITION-PATHNAME) (SETF (BP-INDEX (POINT)) OLD-POSITION-INDEX))))))) (IF SELECT-FLAG (MAKE-BUFFER-CURRENT BUFFER))) )) ; From modified file DJ: L.ZWEI; DIRED.LISP#327 at 14-Feb-87 13:11:05 #8R ZWEI#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "ZWEI"))) (COMPILER::PATCH-SOURCE-FILE "SYS: ZWEI; DIRED  " (DEFUN DIRED-INSERT-DIRECTORY (DIRECTORY STREAM LEVEL) "Insert into a DIRED buffer lines describing the files in DIRECTORY. DIRECTORY is a value returned by FS:DIRECTORY-LIST. STREAM is a stream outputting into the DIRED buffer. LEVEL is the depth in subdirectories of these files. Returns the first inserted line that describes a file." ;; Mark all files that are the newest (DIRED-COMPUTE-GREATER-THANS (CDR DIRECTORY)) (DO ((FILES DIRECTORY (CDR FILES)) (FILE) (LINE) (FIRST-FILE-LINE)) ((NULL FILES) FIRST-FILE-LINE) (SETQ FILE (CAR FILES)) (UNLESS (NULL (CAR FILE)) (IF (GET FILE ':DIRECTORY) (LET ((STR (SEND (SEND (SEND (CAR FILE) :NEW-PATHNAME :DEVICE NIL ;; Get rid of the version iff ;; this is the newest one. :VERSION (IF (GET FILE :NEWEST) NIL (SEND (CAR FILE) :VERSION))) :PATHNAME-AS-DIRECTORY) :STRING-FOR-DIRECTORY))) ;; STR has the string we want to print instead of the filename. ;; Replace (CAR FILE) with a phony "pathname" that will print as that string. (WITH-STACK-LIST* (FILE1 (LAMBDA (&REST IGNORE) STR) (CDR FILE)) (FUNCALL *DIRECTORY-SINGLE-FILE-LISTER* FILE1 STREAM))) (FUNCALL *DIRECTORY-SINGLE-FILE-LISTER* FILE STREAM)) (SETQ LINE (LINE-PREVIOUS (BP-LINE (SEND STREAM :READ-BP)))) (INSERT-CHARS (CREATE-BP LINE 5) #/SPACE (* *DIRED-SUBDIRECTORY-INDENTATION* LEVEL)) ;; Use lower-case "d" to mark already-deleted files. (IF (GET FILE ':DELETED) (SETF (CHAR LINE 0) #/d)) (OR FIRST-FILE-LINE (SETQ FIRST-FILE-LINE LINE)) (SETF (GETF (LINE-PLIST LINE) 'LEVEL) LEVEL) (LOOP FOR (PROP VAL) ON (CDR FILE) BY 'CDDR DO (SETF (GETF (LINE-PLIST LINE) PROP) VAL)) (SETF (GETF (LINE-PLIST LINE) ':PATHNAME) (CAR FILE))))) )) ; From modified file DJ: L.IO.FILE; OPEN.LISP#203 at 14-Feb-87 13:11:07 #8R FILE-SYSTEM#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM"))) (COMPILER::PATCH-SOURCE-FILE "SYS: IO; FILE; OPEN  " (DEFUN READ-DIRECTORY-STREAM-ENTRY (STREAM DEFAULTING-PATHNAME options &AUX PATH EOF IND FUN (DEFAULT-FUN (SEND DEFAULTING-PATHNAME ':DIRECTORY-STREAM-DEFAULT-PARSER))) ;options is options to DIRECTORY-LIST. See below. (MULTIPLE-VALUE (PATH EOF) (SEND STREAM ':LINE-IN)) (IF EOF NIL (IF (ZEROP (ARRAY-ACTIVE-LENGTH PATH)) (SETQ PATH NIL) (MULTIPLE-VALUE-BIND (DEV DIR NAM TYP VER) (SEND DEFAULTING-PATHNAME ':PARSE-NAMESTRING NIL PATH) (SETQ PATH (MAKE-PATHNAME-INTERNAL (PATHNAME-HOST DEFAULTING-PATHNAME) (OR DEV (PATHNAME-DEVICE DEFAULTING-PATHNAME)) (OR DIR (PATHNAME-DIRECTORY DEFAULTING-PATHNAME)) NAM (OR TYP ':UNSPECIFIC) VER)))) ;; This is a little hairy to try to avoid page faults when interning. (LOOP AS LINE = (SEND STREAM ':LINE-IN) AS LEN = (ARRAY-ACTIVE-LENGTH LINE) UNTIL (ZEROP LEN) AS I = (%STRING-SEARCH-CHAR #/SPACE LINE 0 LEN) DO (LOOP NAMED FOO FOR X IN (CDR (ASSQ (AREF LINE 0) *TRANSFORMED-DIRECTORY-PROPERTIES*)) WHEN (%STRING-EQUAL LINE 0 (CAR X) 0 I) DO (RETURN (SETQ IND (CADR X) FUN (CADDR X))) FINALLY (SETQ IND (INTERN (SUBSTRING LINE 0 I) SI:PKG-KEYWORD-PACKAGE) FUN DEFAULT-FUN)) NCONC (LIST* IND (OR (NULL I) (SEND FUN LINE (1+ I))) NIL) INTO PLIST FINALLY (progn (if (and (memq :directories-only options) ;this allows c-u m-x dired on "ai:*;" to work! (not (get-from-alternating-list plist :directory))) (setq plist (list* :directory t plist))) (RETURN (CONS PATH (IF PATH PLIST (LIST* ':PATHNAME DEFAULTING-PATHNAME PLIST)))))))) ;;; Nifty, handy function for adding new ones )) ; From modified file DJ: L.IO.FILE; ACCESS.LISP#35 at 14-Feb-87 13:11:10 #10R FILE-SYSTEM#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM"))) (COMPILER::PATCH-SOURCE-FILE "SYS: IO; FILE; ACCESS  " (DEFMETHOD (DIRECTORY-STREAM-ACCESS-MIXIN :DIRECTORY-LIST) (PATHNAME OPTIONS &AUX DIR-LIST) (WITH-OPEN-STREAM (STREAM (SEND SELF :DIRECTORY-STREAM PATHNAME (REMQ ':SORTED OPTIONS))) (IF (ERRORP STREAM) STREAM (SETQ DIR-LIST (LET ((PATHNAME (SEND STREAM :PATHNAME))) (LOOP AS ENTRY = (SEND SELF :READ-DIRECTORY-STREAM-ENTRY STREAM PATHNAME options) UNTIL (NULL ENTRY) COLLECTING ENTRY))) (IF (MEMQ :SORTED OPTIONS) (LET ((NULL-ELEM (ASSQ NIL DIR-LIST))) (AND NULL-ELEM (SETQ DIR-LIST (DELQ NULL-ELEM DIR-LIST))) (SETQ DIR-LIST (SORTCAR DIR-LIST #'PATHNAME-LESSP)) (AND NULL-ELEM (PUSH NULL-ELEM DIR-LIST)))) DIR-LIST))) ;; This tells READ-DIRECTORY-STREAM-ENTRY how to parse most lines of directory stream data. )) ; From modified file DJ: L.IO.FILE; PATHST.LISP#210 at 14-Feb-87 13:11:17 #8R FILE-SYSTEM#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM"))) (COMPILER::PATCH-SOURCE-FILE "SYS: IO; FILE; PATHST  " (DEFMETHOD (ITS-PATHNAME-MIXIN :PARSE-NAMESTRING) (HOST-SPECIFIED NAMESTRING &OPTIONAL (START 0) END) (OR END (SETQ END (STRING-LENGTH NAMESTRING))) (DO ((I START) (J START (1+ J)) (CH) (TEM) (DEV (AND HOST-SPECIFIED "DSK")) (DIR) (FN1) (FN1P) (FN2) (TYP) (VERS)) ((> J END) (COND ((NULL FN2)) ((SETQ TEM (NUMERIC-P FN2)) (SETQ VERS TEM TYP :UNSPECIFIC)) ((EQUAL FN2 ">") (SETQ VERS :NEWEST TYP :UNSPECIFIC)) ((EQUAL FN2 "<") (SETQ VERS :OLDEST TYP :UNSPECIFIC)) ((EQUAL FN2 "*") (SETQ TYP :WILD VERS :WILD)) ; ((SI:MEMBER-EQUAL FN2 *ITS-UNINTERESTING-TYPES*) ; (SETQ TYP FN2 VERS :UNSPECIFIC)) (T ;; Used to use :NEWEST here. (SETQ TYP FN2 VERS :UNSPECIFIC))) (VALUES DEV DIR FN1 TYP VERS)) (SETQ CH (IF (= J END) #/SP (AREF NAMESTRING J))) (COND ((MEMQ CH '(#/ #/)) (SETQ J (1+ J))) ((MEMQ CH '(#/: #/; #/ #/SP #/TAB)) (COND (( I J) (SETQ TEM (cond ((and (= (1+ i) j) (= (aref namestring i) #/)) :unspecific) (t (SIX-SIXBIT-CHARACTERS NAMESTRING T I J)))) (SELECTQ CH (#/: (SETQ DEV TEM)) (#/; (SETQ DIR (COND ((EQUAL TEM "*") :WILD) (T TEM)))) (OTHERWISE (COND (FN2) (FN1P (SETQ FN2 TEM)) (T (SETQ FN1 TEM FN1P T))))))) (IF (EQ CH #/) (SETQ FN1P T)) (SETQ I (1+ J)))))) ;;; Truncate to six characters )) ; From modified file DJ: L.IO.FILE; PATHST.LISP#210 at 14-Feb-87 13:11:20 #8R FILE-SYSTEM#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM"))) (COMPILER::PATCH-SOURCE-FILE "SYS: IO; FILE; PATHST  " (DEFMETHOD (TOPS20-PATHNAME-MIXIN :PARSE-TRUENAME) (STRING) ;Since pathname is definitely for this host, avoid probing "structure" as host. ;easiest way to do this is to prefix real host name before string if there is only one ;apparent host in string. (parse-pathname (tops20-local-pathstring string host) host)) )) ; From modified file DJ: L.IO.FILE; PATHST.LISP#210 at 14-Feb-87 13:11:21 #8R FILE-SYSTEM#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM"))) (COMPILER::PATCH-SOURCE-FILE "SYS: IO; FILE; PATHST  " (defun tops20-local-pathstring (string host) "Parse a tops20 pathstring which may not contain the : without risk of interpreting the structure as a host" (cond ((stringp string) (multiple-value-bind (host1 idx1) (tops20-find-host string 0) (cond ((and host1 (null (tops20-find-host string idx1))) (string-append (send host :name-as-file-computer) ":" string)) (t string)))) (t string))) )) ; From modified file DJ: L.IO.FILE; PATHST.LISP#210 at 14-Feb-87 13:11:22 #8R FILE-SYSTEM#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM"))) (COMPILER::PATCH-SOURCE-FILE "SYS: IO; FILE; PATHST  " (defun tops20-find-host (string start) (DO ((IDX start (1+ IDX)) (HOST-START start) (ONLY-WHITESPACE-P T) (CHAR)) (( IDX (string-length string))) (COND ((= (SETQ CHAR (AREF STRING IDX)) #/:) ;; The first atom ends with a colon, take the host from that, and ;; parse from the end of that. (RETURN (values (SUBSTRING STRING HOST-START IDX) (1+ IDX)))) ((AND (= CHAR #/SP) ONLY-WHITESPACE-P) ;Skip leading spaces (SETQ HOST-START (1+ IDX))) (T (SETQ ONLY-WHITESPACE-P NIL) (OR (ALPHANUMERICP CHAR) (= CHAR #/.) (= CHAR #/-) ;; If we get to non-alphabetic or -numeric, ;; then no interesting colon (RETURN NIL)))))) ;;;; Tenex support )) ; From modified file DJ: L.NETWORK; HOST.LISP#156 at 14-Feb-87 13:11:24 #8R SYSTEM-INTERNALS#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS"))) (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; HOST  " (DEFMETHOD (HOST-TOPS20-MIXIN :HSNAME-PATHNAME) (STRING HOST) (LET ((PN (FS:PARSE-PATHNAME (FS:TOPS20-LOCAL-PATHSTRING STRING HOST) HOST))) (IF (NULL (SEND PN :DEVICE)) (SEND PN :NEW-DEVICE (SEND HOST :PRIMARY-DEVICE)) PN))) )) ; From modified file DJ: L.NETWORK.CHAOS; CHSNCP.LISP#378 at 14-Feb-87 13:11:27 #8R CHAOS#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "CHAOS"))) (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; CHAOS; CHSNCP  " (defun explorer-hack-receiver (&aux (inhibit-scheduling-flag t)) (declare (special si::controller)) (do-forever (process-wait "pkt" 'explorer-hack-wait-function) (cond ((null fake-receive-list) (let ((int-pkt (allocate-int-pkt))) (multiple-value-bind (ignore ignore type) (si:receive-frame si:controller int-pkt) (selectq type (incf pkts-received) (#x408 (receive-chaos-ethernet-type int-pkt) ) (#x608 (receive-addr-ethernet-type int-pkt) ) (t (free-int-pkt int-pkt)) )))) (t (let ((int-pkt fake-receive-list)) (setq fake-receive-list (int-pkt-thread int-pkt)) (setf (int-pkt-thread int-pkt) nil) (receive-chaos-ethernet-type int-pkt)))))) )) ; From modified file DJ: L.NVRAM; CRASH-RECORD.LISP#61 at 14-Feb-87 13:11:30 #8R SYSTEM-INTERNALS#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS"))) (COMPILER::PATCH-SOURCE-FILE "SYS: NVRAM; CRASH-RECORD  " (Defun Describe-Ucode-Crash (crec) "Gets the text string from the microcode error table describing the crash cause. This string is found using the halt address in the CREC." (Eh:Assure-Table-Loaded) (Let* ((error-table-entry (Cdr (Assq (1- (Read-Crash-Record-16B crec CRO-HALT-ADDR)) EH:ERROR-TABLE))) (crash-description (Cadr error-table-entry))) (Cond ((Or (Null error-table-entry) ;(Neq (car error-table-entry) 'EH:CRASH) ) "Crash description not found in error table") ((Stringp crash-description) crash-description) (t (format nil "~a" error-table-entry)) ;(t (Format nil "Bad crash description")) ))) ))