Google
 

Trailing-Edge - PDP-10 Archives - -
There are no other files named in the archive.
(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