LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760032440. :SYSTEM-TYPE :LOGICAL :VERSION 1. :TYPE "LISP" :NAME "FASUPD" :DIRECTORY ("REL3-SOURCE" "ZMACS") :SOURCE-PATTERN "( :DIRECTORY (\"REL3-SOURCE\") :NAME :WILD :TYPE :WILD :VERSION :NEWEST)" :VERSION-LIMIT 0. :CHARACTERS T :NOT-BACKED-UP T :CREATION-DATE 2758738806. :AUTHOR "REL3" :LENGTH-IN-BYTES 4714. :LENGTH-IN-BLOCKS 5. :BYTE-SIZE 8.)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  ;; -*- Mode:Common-Lisp; Package:ZWEI; Base:8 -*-;;;                           RESTRICTED RIGHTS LEGEND;;;Use, duplication, or disclosure by the Government is subject to;;;restrictions as set forth in subdivision (b)(3)(ii) of the Rights in;;;Technical Data and Computer Software clause at 52.227-7013.;;;;;;                     TEXAS INSTRUMENTS INCORPORATED.;;;                              P.O. BOX 2909;;;                           AUSTIN, TEXAS 78769;;;                                 MS 2151;;;;;; Copyright (C) 1985, 1987 Texas Instruments Incorporated. All rights reserved.;;; Copyright (C) 1980, Massachusetts Institute of Technology(DEFCOM COM-FASL-UPDATE "Update the fasl file of the file you are visiting.Uses the function definitions present in the environment,offering to compile them if they have changed." ()  ;;  1/02/87 DNG - Bind FDEFINE-FILE-PATHNAME; move FASL-UPDATE call inside the warnings context.  (LET ((BUFFER (READ-BUFFER-NAME "Update fasl file of buffer:"  *INTERVAL*;Default is current buffer.  NIL)))    (UNLESS (BUFFER-FILE-ID BUFFER)      (BARF "This buffer is not associated with a file"))    (LET ((SYS:FDEFINE-FILE-PATHNAME (SEND (SEND BUFFER :GENERIC-PATHNAME) :GENERIC-PATHNAME)))      (SYSTEM:FILE-OPERATION-WITH-WARNINGS (SYS:FDEFINE-FILE-PATHNAME :COMPILE NIL)(COMPILER:COMPILER-WARNINGS-CONTEXT-BIND  (COMPILE-BUFFER-CHANGED-FUNCTIONS BUFFER T)  (FASL-UPDATE BUFFER)))))  DIS-NONE) ;; Write out the compilations of the functions whose sources are in BUFFER.;; We assume that the user has compiled all the functions he has changed.;; The fasl file name is formed from the name of the buffer.;; We don't actually do any compilation or evaluation of the buffer,;; though we do expand the macros.;; Normally, we read each form from the buffer and process it.;; For forms starting with DEFUN and DEFMETHOD, we read only the;; function name, which is enough to use to dump the function,;; and then we skip the rest of the form and cons up a dummy DEFUN or DEFMETHOD;; with no body or arglist to use in doing the dumping.(DEFUN FASL-UPDATE (BUFFER &OPTIONAL OUTFILE &AUX INFILE)  (SETQ INFILE (BUFFER-PATHNAME BUFFER))  (SETQ OUTFILE (IF OUTFILE    (FS:MERGE-PATHNAME-DEFAULTS OUTFILEINFILE(SI:LOCAL-BINARY-FILE-TYPE))    (SEND INFILE :NEW-TYPE (SI:LOCAL-BINARY-FILE-TYPE))))  (COMPILER:FASL-UPDATE-STREAM INFILE OUTFILE (INTERVAL-STREAM BUFFER)       'FASL-UPDATE-BUFFER-READ-FUNCTION)) ;;; This function acts like READ, but it doesn't always really do a READ.;;; It can examine the form coming up and skip it, returning a dummy form.;;;  1/02/87 DNG - Put current definition into a FDEFINE form instead of returning a dummy DEFUN.;;;  1/07/87 DNG - Don't skip functions that use the SELF-MAPPING-TABLE -- they;;;have to be recompiled because instructions with SELF-MAP addresses cannot;;;be safely dumped since the mapping table might change.(DEFUN FASL-UPDATE-BUFFER-READ-FUNCTION (INPUT-STREAM EOF-OPTION)  ;; Find next interesting object in buffer.  (LET ((BP (SKIP-OVER-BLANK-LINES-AND-COMMENTS (SEND INPUT-STREAM :READ-BP))))    (IF (NULL BP)EOF-OPTION;; This is intended to look at the form that follows,;; decide whether it is a defun, and if so;; just create a dummy, since we will not look at the body anyway.(MULTIPLE-VALUE-BIND (DEFTYPE FNNAME)    (FASL-UPDATE-CHECK-DEFUN BP)  (LET (DEFN)    (COND ((AND DEFTYPE(SETQ DEFN (SYS:FDEFINITION-SAFE (IF (EQ DEFTYPE 'DEFMETHOD)     (SETQ FNNAME (CONS :METHOD FNNAME))     FNNAME) T))(NULL (SI:FEF-FLAVOR-NAME DEFN)))   (SEND INPUT-STREAM :SET-BP ;; The memo-izing lisp parser can cons permanent information (LET ((DEFAULT-CONS-AREA SYSTEM:BACKGROUND-CONS-AREA))   (FORWARD-SEXP BP)))   `(FDEFINE ',FNNAME (FUNCTION ,DEFN) T))   (T     (SEND INPUT-STREAM :SET-BP BP)     (READ INPUT-STREAM () EOF-OPTION))))))));; This is the list of types of form that we don't even need to read.(PROCLAIM '(SPECIAL FASL-UPDATE-DEFTYPES-ALIST)) (SETQ FASL-UPDATE-DEFTYPES-ALIST      '(("DEFUN" DEFUN) ("DEFMETHOD" DEFMETHOD))) (DEFUN FASL-UPDATE-CHECK-DEFUN (BP &AUX BP1 DEFTYPE FNNAME)  ;; Now get the second word after BP.  (AND (CHAR= (BP-CH-CHAR BP) #\()       (SETQ BP (FORWARD-CHAR BP))       (SETQ BP1 (FORWARD-ATOM BP))       (SETQ DEFTYPE     (CADR (ASSOC (STRING-INTERVAL BP BP1)  FASL-UPDATE-DEFTYPES-ALIST  :TEST 'EQUALP)))       (SETQ BP (FORWARD-OVER *BLANKS* BP1))       (SETQ BP1 (FORWARD-SEXP BP))       (SETQ FNNAME (STRING-REMOVE-FONTS (STRING-INTERVAL BP BP1)))       (VALUES DEFTYPE (READ-FROM-STRING FNNAME T)))) a DOCUMENTATION property, whose value is the;;; string which is the full documentation.  If short documentation;;; (the one-line kind produced by List Commands) is needed, it is just;;; the first line of the full documentation.;;; A command with "smart" handling is detected by the presence of;;; a DOCUMENTATION-FUNCTION property.  The value of this property;;; should be a function, which is calle