(FILECREATED " 1-SEP-78 20:55:52" <LISPUSERS>FASTNAMEFIELD.;2
 3526   

     changes to:  FASTNAMEFIELDCOMS

     previous date: "21-JUL-77 21:39:37" <LISPUSERS>FASTNAMEFIELD.;1)


(PRETTYCOMPRINT FASTNAMEFIELDCOMS)

(RPAQQ FASTNAMEFIELDCOMS
 ((* make NAMEFIELD, FILECOMS, etc faster)
			  (FNS NAMEFIELD FILENAMEFIELD NEWUNPACKFILENAME)
			  (VARS (NAMEFIELDARRAY (LIST (HARRAY 30)))
				(FILEFIELDARRAY (LIST (HARRAY 30)))
				(FILECOMSARRAY (LIST (HARRAY 30))))
			  (P (PROG (ADVISEDFNS)
				   (OR (GETP (QUOTE CLEARFILEPKG)
					     (QUOTE ADVISED))
				       (ADVISE (QUOTE CLEARFILEPKG)
					       (QUOTE BEFORE)
					       (QUOTE (PROGN (CLRHASH NAMEFIELDARRAY)
							     (CLRHASH FILEFIELDARRAY)
							     (CLRHASH FILECOMSARRAY)))))
				   (COND ((AND (NOT (GETD (QUOTE OLDUNPACKFILENAME)))
					       (GETD (QUOTE NEWUNPACKFILENAME)))
					  (MOVD (QUOTE UNPACKFILENAME)
						(QUOTE OLDUNPACKFILENAME))
					  (MOVD (QUOTE NEWUNPACKFILENAME)
						(QUOTE UNPACKFILENAME))
					  (ADVISE (QUOTE FILECOMS)
						  (QUOTE AROUND)
						  (QUOTE (COND ((AND X (NEQ X (QUOTE COMS)))
								*)
							       ((GETHASH FILE FILECOMSARRAY))
							       ((PUTHASH FILE * FILECOMSARRAY)))))))))
			  ))
[DECLARE: DONTEVAL@LOAD DONTCOPY
(* make NAMEFIELD, FILECOMS, etc faster)
  ]

(DEFINEQ

(NAMEFIELD

  [LAMBDA (FILE SUFFIXFLG DIRFLG)       (* lmm: " 4-APR-77 20:20")

                                        (* IF SUFFIXFLG is T, returns 

					name and suffix field, otherwise

					just NAMEFIELD)

    (COND
      ((EQ DIRFLG (QUOTE ONLY))
	(FILENAMEFIELD
 FILE (QUOTE DIRECTORY)))
      ((EQ SUFFIXFLG (QUOTE ONLY))
	(FILENAMEFIELD
 FILE (QUOTE EXTENSION)))
      [DIRFLG (PACKFILENAME (QUOTE DIRECTORY)
			    (FILENAMEFIELD
 FILE (QUOTE DIRECTORY))
			    (QUOTE NAME)
			    (FILENAMEFIELD
 FILE (QUOTE NAME))
			    (QUOTE EXTENSION)
			    (AND SUFFIXFLG (FILENAMEFIELD
 FILE
							  (QUOTE 
							  EXTENSION]
      (SUFFIXFLG (OR (GETHASH FILE NAMEFIELDARRAY)
		     (PUTHASH FILE (PACKFILENAME (QUOTE NAME)
						 (FILENAMEFIELD

						   FILE
						   (QUOTE NAME))
						 (QUOTE EXTENSION)
						 (FILENAMEFIELD

						   FILE
						   (QUOTE EXTENSION)))
			      NAMEFIELDARRAY)))
      (T (FILENAMEFIELD
 FILE (QUOTE NAME])

(FILENAMEFIELD

  [LAMBDA (FILE SPEC)
    (LISTGET (UNPACKFILENAME FILE)
	     SPEC])

(NEWUNPACKFILENAME

  [LAMBDA (FILE)                        (* lmm: "21-JUL-77 21:29")

    (APPEND (OR (GETHASH FILE FILEFIELDARRAY)
		(PUTHASH FILE (OLDUNPACKFILENAME FILE)
			 FILEFIELDARRAY])
)

(RPAQ NAMEFIELDARRAY
 (LIST (HARRAY 30)))

(RPAQ FILEFIELDARRAY
 (LIST (HARRAY 30)))

(RPAQ FILECOMSARRAY
 (LIST (HARRAY 30)))
(PROG (ADVISEDFNS)
      (OR (GETP (QUOTE CLEARFILEPKG)
		(QUOTE ADVISED))
	  (ADVISE (QUOTE CLEARFILEPKG)
		  (QUOTE BEFORE)
		  (QUOTE (PROGN (CLRHASH NAMEFIELDARRAY)
				(CLRHASH FILEFIELDARRAY)
				(CLRHASH FILECOMSARRAY)))))
      (COND ((AND (NOT (GETD (QUOTE OLDUNPACKFILENAME)))
		  (GETD (QUOTE NEWUNPACKFILENAME)))
	     (MOVD (QUOTE UNPACKFILENAME)
		   (QUOTE OLDUNPACKFILENAME))
	     (MOVD (QUOTE NEWUNPACKFILENAME)
		   (QUOTE UNPACKFILENAME))
	     (ADVISE (QUOTE FILECOMS)
		     (QUOTE AROUND)
		     (QUOTE (COND ((AND X (NEQ X (QUOTE COMS)))
				   *)
				  ((GETHASH FILE FILECOMSARRAY))
				  ((PUTHASH FILE * FILECOMSARRAY))))))))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1345 2685 (NAMEFIELD 1357 . 2378) (FILENAMEFIELD 2382 . 2473) (NEWUNPACKFILENAME 2477 .
 2682)))))
STOP