(FILECREATED "19-Nov-84 12:47:38" {ERIS}<LISPCORE>SOURCES>1100DSKPATCH.;2 9875
changes to: (FNS \M44GENERATEFILES)
previous date: "17-Nov-84 16:22:22" {ERIS}<LISPCORE>SOURCES>1100DSKPATCH.;1)
(* Copyright (c) 1984 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT 1100DSKPATCHCOMS)
(RPAQQ 1100DSKPATCHCOMS ((FNS \M44GENERATEFILES \M44UNPACKFILENAME)))
(DEFINEQ
(\M44GENERATEFILES
[LAMBDA (FDEV PATTERN DESIREDPROPS OPTIONS) (* bvm: "19-Nov-84 12:18")
(* Returns a file-generator object that will generate AT LEAST all files in the sys-dir of FDEV whose names match
PATTERN. Clients might need to provide additional filtering. For M44, the generate state consists of the HOSTNAME
(DSK) followed by a "search state", a directory pointer and a character list of the sort that \SEARCHDIR1 expects.
DIRPTR is the position of the next file to be considered in the directory.)
(PROG ((DIRSTREAM (fetch (M44DEVICE SYSDIROFD) of FDEV))
(CASEBASE (.DISKCASEARRAY.))
HOSTNAME NAME EXT VERSION CHARLIST GENSTREAM FILTER DESIREDVERSION SEARCHSTATE HOSTPREFIX)
(OR DIRSTREAM (RETURN (\NULLFILEGENERATOR)))
[COND
((for TAIL on (UNPACKFILENAME.STRING PATTERN) by (CDDR TAIL)
do (SELECTQ (CAR TAIL)
(HOST (SETQ HOSTNAME (CADR TAIL)))
(NAME (SETQ NAME (CADR TAIL)))
(EXTENSION (SETQ EXT (CADR TAIL)))
[VERSION (SETQ VERSION (MKATOM (CADR TAIL)))
(COND
((AND (NEQ VERSION 0)
(SMALLP VERSION))
(* An actual specific version to look for)
(SETQ DESIREDVERSION VERSION]
(RETURN T))) (* Bad file name)
(RETURN (\NULLFILEGENERATOR]
[SETQ FILTER (DIRECTORY.MATCH.SETUP (CONCATLIST
(CONS NAME (NCONC (AND EXT (LIST (QUOTE %.)
EXT))
(LIST (QUOTE ;)
(OR VERSION
(PROGN
(* wants highest version only, but we can't supply
that, so go for all versions now)
(QUOTE *]
(SETQ CHARLIST (for C instring (COND
((OR (NULL EXT)
(EQ (CHCON1 EXT)
(CHARCODE *)))
NAME)
(T (CONCAT NAME (QUOTE %.)
EXT)))
until (SELCHARQ (SETQ C (\GETBASEBYTE CASEBASE C))
((# *)
(* \SEARCHDIR1 currently only checks prefixes, so we truncate at the first * or escape. Also ignore version
specifications, because of the alternative representations of version 1)
T)
NIL)
collect C))
(COND
(DESIREDPROPS (* Create a scratch stream for \M44FILEINFOFN to use)
(SETQ GENSTREAM (create M44STREAM))
(replace DEVICE of GENSTREAM with FDEV)))
(SETQ SEARCHSTATE (create M44DIRSEARCHSTATE
DIRPTR ← 0
CHARLIST ← CHARLIST))
(SETQ HOSTPREFIX (CONCAT (QUOTE {)
HOSTNAME
(QUOTE })))
(RETURN (COND
((EQMEMB (QUOTE SORT)
OPTIONS) (* Have to generate the matching files first, sort
them, then enumerate)
(create FILEGENOBJ
NEXTFILEFN ←(FUNCTION \M44SORTEDNEXTFILEFN)
FILEINFOFN ←(FUNCTION \M44FILEINFOFN)
GENFILESTATE ←(create M44GENFILESTATE
DIROFD ← DIRSTREAM
SEARCHSTATE ←(\M44SORTFILES DIRSTREAM SEARCHSTATE
FILTER DESIREDVERSION
HOSTPREFIX
(LENGTH CHARLIST))
GENSTREAM ← GENSTREAM)))
(T (* Order not important)
(create FILEGENOBJ
NEXTFILEFN ←(FUNCTION \M44NEXTFILEFN)
FILEINFOFN ←(FUNCTION \M44FILEINFOFN)
GENFILESTATE ←(create M44GENFILESTATE
DIROFD ← DIRSTREAM
SEARCHSTATE ← SEARCHSTATE
GENFILTER ← FILTER
GENVERSION ← DESIREDVERSION
HOSTNAME ← HOSTPREFIX
GENSTREAM ← GENSTREAM])
(\M44UNPACKFILENAME
[LAMBDA (NAME) (* bvm: "17-Nov-84 15:07")
(* Unpacks file name into a UNAME of the form ((VERSION PARTNUM . ESCFLAG) . CHARPAIRS) where VERSION is the version
indicator (either a positive integer or one of OLD, OLDEST, NEW) PARTNUM is the partion number
(NIL for current Partition) and ESCFLAG indicates that NAME terminated in escape, and the CHARPAIRS is a list of
pairs the first element of which is the char actually specified in name, and the second is the upper/lower case
alternative for alphabetics.)
(* changed to generate a file not found error in the
case that a directory is specified -
rrb.)
(PROG ((CASEBASE (.DISKCASEARRAY.))
J C END NEGATEDVERSION VERSION RESULT PARTNUM)
(COND
([OR (NOT NAME)
(EQ NAME T)
(NOT (OR (LITATOM NAME)
(STRINGP NAME)))
(NEQ (NTHCHARCODE NAME 1)
(CHARCODE {))
(NEQ (U-CASE (SUBATOM NAME 2 4))
(QUOTE DSK))
(NOT (SETQ J (STRPOS "}" NAME 5)))
(AND (NEQ J 5)
(NOT (FIXP (SETQ PARTNUM (SUBATOM NAME 5 (SUB1 J]
(RETURN)))
(SETQ END (SETQ RESULT (create UNAME
PARTNUM ← PARTNUM)))
(* End is the cell whose CDR can be smashed.)
(add J 1)
[COND
((EQ (NTHCHARCODE NAME J)
(CHARCODE <)) (* if directory name is included, generate file not
found error. If not, return NIL which will cause bad
file name error.)
(RETURN (COND
((STRPOS ">" NAME) (* pass back special error code.)
(QUOTE DIRECTORY]
COLLECTNAME
(COND
((NOT (SETQ C (NTHCHARCODE NAME J))) (* End of name)
(GO RET))
((ZEROP (SETQ C (\GETBASEBYTE CASEBASE C))) (* Illegal char)
(GO ERR))
(T [RPLACD END (SETQ END (LIST (SELCHARQ C
(; (GO SEMI))
((# *)
(* Wildcards not allowed)
(GO ERR))
(%. (* Omit trailing dots)
(SELCHARQ (NTHCHARCODE NAME (ADD1 J))
(NIL (GO RET))
((; !)
(add J 1)
(GO SEMI))
C))
C]
(add J 1)
(GO COLLECTNAME)))
(* * Parsing the stuff after the semicolon; loop to catch all the funny forms that could be after that instead of a
version. Perhaps should get rid of some of these, since no other device tolerates them)
SEMI(COND
([NULL (SETQ C (NTHCHARCODE NAME (add J 1]
(GO ERR))
((ZEROP (SETQ C (\GETBASEBYTE CASEBASE C))) (* Illegal char)
(GO ERR)))
[SELCHARQ C
(H (SETQQ VERSION OLD)
(SELCHARQ (SETQ C (NTHCHARCODE NAME (add J 1)))
(NIL (GO RET))
((; !)
(GO SEMI))
(GO ERR)))
(L (SETQQ VERSION OLDEST)
(SELCHARQ (SETQ C (NTHCHARCODE NAME (add J 1)))
(NIL (GO RET))
((; !)
(GO SEMI))
(GO ERR)))
(N (SETQQ VERSION NEW)
(SELCHARQ (SETQ C (NTHCHARCODE NAME (add J 1)))
(NIL (GO RET))
((; !)
(GO SEMI))
(GO ERR)))
[(T S A P) (* Various Tenex crocks. Not implemented, but don't
complain about them)
(PROG NIL
SKIP(SELCHARQ (NTHCHARCODE NAME (add J 1))
((; !)
(GO SEMI))
(NIL (GO RET))
(GO SKIP]
[- (COND
(VERSION (GO ERR))
(T (SETQ NEGATEDVERSION T)
(SETQ VERSION 0)
(SETQ C (NTHCHARCODE NAME (add J 1)))
(GO COLLECTVERSION]
(COND
(VERSION (GO ERR))
(T (SETQ VERSION 0)
(GO COLLECTVERSION]
COLLECTVERSION
(COND
((AND C (BETWEEN C (CHARCODE 0)
(CHARCODE 9)))
[SETQ VERSION (IPLUS (ITIMES VERSION 10)
(IDIFFERENCE C (CHARCODE 0]
(SETQ C (NTHCHARCODE NAME (add J 1)))
(GO COLLECTVERSION)))
(COND
[NEGATEDVERSION (SETQ VERSION (SELECTQ VERSION
(1 (QUOTE NEW))
(2 (QUOTE OLDEST))
(GO ERR]
((ZEROP VERSION)
(SETQQ VERSION OLD))
((IGREATERP VERSION 65535)
(GO ERR)))
TERM(SELCHARQ C
(NIL (GO RET))
((; !)
(GO SEMI))
(GO ERR))
ERR (* BAD FILE NAME)
(RETURN NIL)
RET (replace VERSION of RESULT with VERSION)
(RETURN RESULT])
)
(PUTPROPS 1100DSKPATCH COPYRIGHT ("Xerox Corporation" 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (394 9792 (\M44GENERATEFILES 404 . 4485) (\M44UNPACKFILENAME 4487 . 9790)))))
STOP