(FILECREATED "16-Feb-85 20:35:08" {PHYLUM}<STANSBURY>FASTLABEL>DSKTEST.;2 34681
changes to: (FNS RANDOMFILENAME)
previous date: "15-Jan-85 20:35:24" {PHYLUM}<STANSBURY>FASTLABEL>DSKTEST.;1)
(* Copyright (c) 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT DSKTESTCOMS)
(RPAQQ DSKTESTCOMS ((* * This version is for non-randaccessp hosts. Changes to
CHOOSERANDOMFILEOPERATION so it doesn't generate a changefile op, and to
CHECKLENGTHANDCONTENTS so it doesn't use setfileptr)
(FNS DSKTEST DELETETESTFILES)
(FNS CHECKCONSISTENCY CHECKLENGTHANDCONTENTS CHOOSERANDOMFILEOPERATION DEFAULT.DSKFREEPAGESFN
DEFAULT.DSKMINALLOCFN DEFAULT.DSKPAGESOVERHEADFN DOTESTFILEOP DSKFREEPAGES DSKMINALLOC
DSKPAGESOVERHEAD EXTENDTESTFILE FILEINFOFROMFILE GENERATEADDFILEOP GENERATECHANGEFILEOP
GENERATEDELETEFILEOP GENERATEDELETEALLFILEOP RANDOMELT RANDOMFILELENGTH RANDOMFILENAME
RANDOMSTR RANDOMTESTFILE SORTBYCAR TESTFILEP TRUNCATETESTFILE WORDIN WORDOUT
DOUBLEWORDIN DOUBLEWORDOUT WRITETESTFILE WRITETESTFILELENGTH)
(VARS (DSKFREEPAGESFN (FUNCTION DEFAULT.DSKFREEPAGESFN))
(DSKPAGESOVERHEADFN (FUNCTION DEFAULT.DSKPAGESOVERHEADFN))
(DSKMINALLOCFN (FUNCTION DEFAULT.DSKMINALLOCFN)))
[VARS (MINTESTFILELENGTH 10)
(FIRSTTESTWORD 48094)
(SECONDTESTWORD 56187)
(NUMBEROFTESTBYTES 5)
(EXHAUSTIVETESTFLG)
(DEFAULTREPLAYFILE (QUOTE {PHYLUM}<LISPCORE>DLIONFS>REPLAY.LOG))
(DONTCLOSEFILESFLG)
(LEGALFILENAMECHARS (QUOTE (A B C D E F G H I J K L M N O P Q R S T U V W X Y Z a b c d
e f g h i j k l m n o p q r s t u v w x y z 0 1 2 3 4 5 6
7 8 9)))
(LEGALFIRSTFILENAMECHARS (QUOTE (A B C D E F G H I J K L M N O P Q R S T U V W X Y Z a
b c d e f g h i j k l m n o p q r s t u v w x y z]
(VARS (MINFILENAMELENGTH 1)
(MAXFILENAMELENGTH 15)
(MINFILEEXTENSIONLENGTH 0)
(MAXFILEEXTENSIONLENGTH 6)
(MAXVERSION 64000)
TESTFILEPAGELENGTHS)
(GLOBALVARS FIRSTTESTWORD SECONDTESTWORD MINTESTFILELENGTH NUMBEROFTESTBYTES
EXHAUSTIVETESTFLG DSKFREEPAGESFN DSKPAGESOVERHEADFN)
(RECORDS TESTFILEINFO TESTFILEOP)))
(* * This version is for non-randaccessp hosts. Changes to CHOOSERANDOMFILEOPERATION so it
doesn't generate a changefile op, and to CHECKLENGTHANDCONTENTS so it doesn't use setfileptr)
(DEFINEQ
(DSKTEST
[LAMBDA (HOST/DIR KEEPREPLAYFILEFLG NUMOPERATIONS CURRENTFILES? DSKTESTBACKUP LOGFILE REPLAYFILE)
(* hts: " 5-Oct-84 13:29")
(* note: SOME OF THIS MAY NOT BE IMPLEMENTED)
(* this is a tester for file systems. Basically it adds, deletes, extends and truncates files of various names and
versions checking the consistency of the file system after each operation. A log is kept of the operations so that
it can be replayed to duplicate problems that may arise.)
(* the two variables DSKFREEPAGESFN and DSKPAGESOVERHEADFN should be set to functions that return the number of free
pages available and the overhead for a file with a given number of pages.)
(* CURRENTFILES? controls what the tester does with current files. NIL means that their existance will be checked
each time but not their contents. T means that the files will be copied into directory DSKTESTBACKUP {defaults is
CORE} and their contents will be checked. DELETE will delete all of the test files before the test starts but will
leave non test files on the directory. Files written by DSKTEST have a two word key plus length which marks them as
DSKTEST files. The rest of them is all the same byte.)
(* EXHAUSTIVEFLG if non-NIL indicates that every pass through, the entire contents of each file is checked.
Otherwise NUMBEROFTESTBYTES random bytes are examined each time.)
(* LOGFILE is where print of progress is put {default to T}. If KEEPREPLAYFILEFLG is T, REPLAYFILE is where the log
of event suitable for replaying is kept {default is DEFAULTREPLAYFILE }. If KEEPREPLAYFILEFLG is a file name, events
are taken from that file until the last one. Before the last event, BREAK1 is called.)
(* DONTCLOSEFILESFLG if non-NIL indicates that files
should be left open. This should be faster as it avoids
opening and closing files.)
(* TESTFILEPAGELENGTHS is a list of page lengths that
the files will be near.)
(SETQ HOST/DIR (DIRECTORYNAME HOST/DIR))
(RESETLST (PROG ((NUMBEROFOPERATIONSDONE 0)
FILESINFO FILEOP X FROMREPLAYFILE)
[COND
[LOGFILE (SETQ LOGFILE (OPENFILE LOGFILE (QUOTE OUTPUT]
(T (SETQ LOGFILE T)
(COND
([SETQ X (WFROMDS (GETSTREAM T (QUOTE OUTPUT]
(* stop page holding)
(RESETSAVE (WINDOWPROP X (QUOTE PAGEFULLFN)
(FUNCTION NILL))
(LIST (QUOTE WINDOWPROP)
X
(QUOTE PAGEFULLFN)
NIL]
(COND
((EQ KEEPREPLAYFILEFLG T)
(COND
[REPLAYFILE (SETQ REPLAYFILE (OPENFILE REPLAYFILE (QUOTE OUTPUT]
(T (SETQ REPLAYFILE DEFAULTREPLAYFILE)))
(* create a replay file and save its full name.)
(SETQ REPLAYFILE (OPENFILE REPLAYFILE (QUOTE OUTPUT)))
(CLOSEF REPLAYFILE))
(KEEPREPLAYFILEFLG (* use replay file)
(COND
((SETQ FROMREPLAYFILE (OPENFILE KEEPREPLAYFILEFLG
(QUOTE INPUT)))
(SETFILEPTR FROMREPLAYFILE 0))
(T (ERROR KEEPREPLAYFILEFLG "replay file not found")))
(* set so that no replay will be made of this run.)
(SETQ KEEPREPLAYFILEFLG)))
(* connect to the tested directory.)
(RESETSAVE (CNDIR HOST/DIR)
(LIST (QUOTE CNDIR)
(DIRECTORYNAME T T)))
(COND
((EQ CURRENTFILES? (QUOTE DELETE))
(printout LOGFILE "Deleting any test files ...." T)
(DELETETESTFILES HOST/DIR)
(printout LOGFILE T)))
[COND
[(AND CURRENTFILES? (NEQ CURRENTFILES? (QUOTE DELETE)))
(* check their contents after every sweep)
(printout T "Not implemented to check old file contents yet.")
(* this should copy each file into the backup directory and set the copy as the contents of the file information for
the non-test files.)
(SETQ FILESINFO (for FILE in (SORT (DIRECTORY HOST/DIR)) collect
(FILEINFOFROMFILE
FILE]
(T (SETQ FILESINFO (for FILE in (SORT (DIRECTORY HOST/DIR))
collect (FILEINFOFROMFILE FILE]
(printout LOGFILE "Beginning initial check ......")
(CHECKCONSISTENCY FILESINFO HOST/DIR)
(BLOCK)
(printout LOGFILE " done." T)
LP (SETQ NUMBEROFOPERATIONSDONE (ADD1 NUMBEROFOPERATIONSDONE))
[COND
((AND (NUMBERP NUMOPERATIONS)
(GREATERP NUMBEROFOPERATIONSDONE NUMOPERATIONS))
(RETURN (LIST (SUB1 NUMBEROFOPERATIONSDONE)
(QUOTE operations% done.]
(* choose a new file operation)
[COND
[FROMREPLAYFILE (* getting events from the replay file)
(SETQ FILEOP (READ FROMREPLAYFILE))
(SKIPSEPRS FROMREPLAYFILE)
(COND
((EOFP FROMREPLAYFILE)
(CLOSEF FROMREPLAYFILE)
(SETQ FROMREPLAYFILE)
(BREAK1 T T "Before last event on replay file"]
(T (SETQ FILEOP (CHOOSERANDOMFILEOPERATION FILESINFO HOST/DIR]
(COND
(KEEPREPLAYFILEFLG (* put op on REPLAYFILE and make sure it gets there.)
(OPENFILE REPLAYFILE (QUOTE APPEND))
(PRINT FILEOP REPLAYFILE)
(CLOSEF REPLAYFILE)))
(PRIN1 "..........
" LOGFILE)
(PRINT FILEOP LOGFILE)
(SETQ FILESINFO (DOTESTFILEOP FILEOP FILESINFO HOST/DIR))
(printout LOGFILE "Consistency check after operation " NUMBEROFOPERATIONSDONE
" .....")
(BLOCK)
(CHECKCONSISTENCY FILESINFO HOST/DIR)
(printout LOGFILE " done." T)
(GO LP])
(DELETETESTFILES
[LAMBDA (HOST/DIR CHECKENTIRECONTENTSFLG) (* hts: "22-Oct-84 16:27")
(* deletes any TEST files from directory HOST/DIR)
(for FILE in (DIRECTORY HOST/DIR) when (TESTFILEP FILE (NOT CHECKENTIRECONTENTSFLG))
do (if (OPENP FILE)
then (CLOSEF FILE))
(PRINT (DELFILE FILE)
T])
)
(DEFINEQ
(CHECKCONSISTENCY
[LAMBDA (FILESINFO HOST/DIR) (* jds " 1-Jun-84 19:40")
(* checks that the state of the currently connected
directory (or HOST/DIR, if given) is exactly the same
as FILESINFO.)
(PROG [(DIRFILES (SORT (DIRECTORY HOST/DIR]
(for DIRFILE in DIRFILES as FILEINFO in FILESINFO
do [COND
((NEQ (U-CASE DIRFILE)
(U-CASE (fetch (TESTFILEINFO TESTFILEFULLNAME) of FILEINFO)))
(* something is wrong with the directory.
Find out what)
(COND
((FASSOC (U-CASE DIRFILE)
(MEMB FILEINFO FILESINFO)) (* this file shows up later)
(ERROR "FILE MISSING .. " (fetch (TESTFILEINFO TESTFILEFULLNAME)
of FILEINFO)))
(T (ERROR "NEW FILE HAS APPEARED .. " DIRFILE]
(CHECKLENGTHANDCONTENTS FILEINFO])
(CHECKLENGTHANDCONTENTS
[LAMBDA (FILEINFO) (* hts: "22-Oct-84 16:34")
(* checks the length and contents of a file from its in
core representation.)
(PROG ((STRM (GETSTREAM (OPENFILE (fetch (TESTFILEINFO TESTFILEFULLNAME) of FILEINFO)
(QUOTE INPUT))
(QUOTE INPUT)))
(FILELENGTH (fetch (TESTFILEINFO FILELENGTH) of FILEINFO))
(STARTBYTE (fetch (TESTFILEINFO STARTBYTE) of FILEINFO))
(PERIOD (fetch (TESTFILEINFO PERIOD) of FILEINFO)))
(if [NOT (EQP FILELENGTH (GETFILEINFO STRM (QUOTE LENGTH]
then (ERROR "FILE has wrong length ... " FILEINFO))
(if (AND STARTBYTE PERIOD (IGEQ FILELENGTH MINTESTFILELENGTH))
then (* test files contain at least enough bytes to hold
keys and stuff. Maybe should have a special test for
zero length files.)
(if (OR (NEQ (WORDIN STRM)
FIRSTTESTWORD)
(NEQ (WORDIN STRM)
SECONDTESTWORD)
(NOT (EQP FILELENGTH (DOUBLEWORDIN STRM)))
(NEQ (BIN STRM)
STARTBYTE)
(NEQ (BIN STRM)
PERIOD))
then (ERROR "FIRST 10 bytes of file is wrong .. " FILEINFO))
(bind READBYTE for COMPUTEDBYTE from STARTBYTE to (IPLUS STARTBYTE FILELENGTH
(IMINUS MINTESTFILELENGTH)
-1)
when (NEQ (SETQ READBYTE (BIN STRM))
(IMOD COMPUTEDBYTE PERIOD))
do (printout LOGFILE "FILE HAS WRONG BYTE .. " T "should have "
(IMOD COMPUTEDBYTE PERIOD)
" but read " READBYTE "from file" T "at location"
(SUB1 (GETFILEPTR STRM))
T)
(ERROR "FILE HAS WRONG BYTE .. " FILEINFO))
(OR (EOFP STRM)
(ERROR "FILE doesn't get EOFP ... " FILEINFO)))
(OR DONTCLOSEFILESFLG (CLOSEF STRM])
(CHOOSERANDOMFILEOPERATION
[LAMBDA (FILESINFO HOST/DIR) (* hts: "22-Oct-84 17:07")
(* chooses a random file operation add delete setlength
on a random file and return a TESTFILEOP record for
it.)
(if FILESINFO
then [PROG ((RANDNUM (RAND 1 200)))
(RETURN (COND
((ILEQ RANDNUM 66) (* add a file)
(GENERATEADDFILEOP FILESINFO NIL HOST/DIR))
((ILEQ RANDNUM 132) (* delete a file)
(GENERATEDELETEFILEOP FILESINFO NIL HOST/DIR))
((ILEQ RANDNUM 198)
(GENERATECHANGEFILEOP FILESINFO HOST/DIR))
(T (* delete all files once in a while)
(GENERATEDELETEALLFILEOP]
else (* add a file)
(GENERATEADDFILEOP FILESINFO NIL HOST/DIR])
(DEFAULT.DSKFREEPAGESFN
[LAMBDA (HOST/DIR) (* hts: "15-Jan-85 20:32")
(PROG [(HOST (FILENAMEFIELD HOST/DIR (QUOTE HOST]
(RETURN (if (EQ HOST (QUOTE DSK))
then (SELECTQ (MACHINETYPE)
((DOLPHIN DORADO)
(DISKFREEPAGES HOST))
((DANDELION DOVE)
(DISKFREEPAGES HOST/DIR))
(SHOULDNT))
else MAX.SMALLP])
(DEFAULT.DSKMINALLOCFN
[LAMBDA (NEWFILELENGTH) (* hts: "15-Jan-85 20:35")
(* Default minimum-allocation unit function)
(SELECTQ (MACHINETYPE)
((DANDELION DOVE) (* DLIONFS allocates 25 at a crackj.)
25)
((DOLPHIN DORADO)
1)
(SHOULDNT])
(DEFAULT.DSKPAGESOVERHEADFN
[LAMBDA (NEWFILELENGTH) (* hts: "15-Jan-85 20:34")
(* default overhead function)
(SELECTQ (MACHINETYPE)
[(DANDELION DOVE)
(* DLIONFS may take 1 B-Tree page per 25 file pages, worst case. In addition, it allocates in 64-page hunks, so you
have to be prepared to get 64 whole pages when you ask for 1 more.)
(IPLUS (IQUOTIENT (ITIMES (IQUOTIENT (IPLUS NEWFILELENGTH 63)
64)
64)
25)
(IDIFFERENCE 64 (IREMAINDER NEWFILELENGTH 64]
((DOLPHIN DORADO)
(IPLUS NEWFILELENGTH 5))
(SHOULDNT])
(DOTESTFILEOP
[LAMBDA (FILEOP FILEINFOLST HOST/DIR) (* hts: "22-Oct-84 15:41")
(* performs a TESTFILEOPERATION and updates the incore
idea about what the directory should now look like.
Returns the changed FILEINFOLST.)
(* operation can be add, delete or changelength)
(SELECTQ (fetch (TESTFILEOP TESTOPERATION) of FILEOP)
[ADD (PROG ((FULLFILE (fetch (TESTFILEOP TESTOPFILENAME) of FILEOP))
(BYTELEN (fetch (TESTFILEOP TESTOPFILELENGTH) of FILEOP))
(STARTBYTE (fetch (TESTFILEOP STARTBYTE) of FILEOP))
(PERIOD (fetch (TESTFILEOP PERIOD) of FILEOP))
(OLDDISKFREEPAGES (DSKFREEPAGES HOST/DIR)))
(if (SETQ FULLFILE (WRITETESTFILE FULLFILE BYTELEN STARTBYTE PERIOD))
then (BLOCK)
else (ERROR "file wasn't written. " FILEOP))
(if (EQ FULLFILE T)
then (HELP))
(RETURN (SORTBYCAR (CONS (create TESTFILEINFO
TESTFILEFULLNAME ← FULLFILE
FILELENGTH ← BYTELEN
STARTBYTE ← STARTBYTE
PERIOD ← PERIOD
TESTFILEORIGNAME ←(fetch (TESTFILEOP
TESTOPFILENAME)
of FILEOP))
FILEINFOLST]
[DELETE (PROG ((DELFILEINFO (fetch (TESTFILEOP TESTOPFILENAME) of FILEOP)))
(if (DELFILE (fetch (TESTFILEINFO TESTFILEFULLNAME) of DELFILEINFO))
then (BLOCK)
else (ERROR "file won't delete" DELFILEINFO))
(RETURN (REMOVE DELFILEINFO FILEINFOLST]
(DELETEALL (for F in FILEINFOLST unless (DELFILE (fetch (TESTFILEINFO TESTFILEFULLNAME)
of F))
do (ERROR "file won't delete" F))
NIL)
(CHANGELENGTH (PROG ((TESTFILE (fetch (TESTFILEINFO TESTFILEFULLNAME)
of (fetch (TESTFILEOP TESTOPFILENAME) of FILEOP)))
(NEWLENGTH (fetch (TESTFILEOP TESTOPFILELENGTH) of FILEOP))
(OLDDISKFREEPAGES (DSKFREEPAGES HOST/DIR))
NOWLENGTH CHANGEFILEINFO XFILEINFO)
(if (SETQ CHANGEFILEINFO (for FILEINFO in FILEINFOLST
thereis (EQ (fetch (TESTFILEINFO
TESTFILEFULLNAME)
of FILEINFO)
TESTFILE)))
then
(* look for the one on FILEINFOLST that has the same name as this one may have been read in from the replay file and
not be EQ.)
NIL
else (ERROR
"changing a file that is not on file information list."
CHANGEFILEINFO)
(RETURN))
(if (IGREATERP NEWLENGTH (SETQ NOWLENGTH (fetch (TESTFILEINFO
FILELENGTH)
of CHANGEFILEINFO)))
then (* extend the file)
(EXTENDTESTFILE TESTFILE (fetch (TESTFILEINFO STARTBYTE)
of CHANGEFILEINFO)
(fetch (TESTFILEINFO PERIOD) of
CHANGEFILEINFO)
NOWLENGTH NEWLENGTH)
(BLOCK)
else (* truncate the file.)
(TRUNCATETESTFILE TESTFILE NEWLENGTH))
(replace (TESTFILEINFO FILELENGTH) of CHANGEFILEINFO with NEWLENGTH)
(RETURN FILEINFOLST)))
(ERROR "unknown file operation" FILEOP])
(DSKFREEPAGES
[LAMBDA (HOST/DIR) (* hts: "29-Apr-84 16:23")
(* returns the number of free pages in the connected
directory if it knows how.)
(APPLY* DSKFREEPAGESFN HOST/DIR])
(DSKMINALLOC
[LAMBDA (NEWFILELENGTH) (* jds "25-May-84 15:22")
(* Calls the device dependent function that gives the
minimum # of pages the file system will allocate at a
crack.)
(APPLY* DSKMINALLOCFN NEWFILELENGTH])
(DSKPAGESOVERHEAD
[LAMBDA (NEWFILELENGTH) (* calls the device dependent function that gives the
overhead per file)
(APPLY* DSKPAGESOVERHEADFN NEWFILELENGTH])
(EXTENDTESTFILE
[LAMBDA (FILENAME STARTBYTE PERIOD OLDLENGTH NEWLENGTH) (* hts: "22-Oct-84 16:34")
(* extends a file by writing CONTENTS byte to it until
it has length LONGERLENGTH.)
(if (OPENP FILENAME)
then (* file may be open already for read.)
(CLOSEF FILENAME))
(PROG [(STRM (OPENSTREAM FILENAME (QUOTE BOTH]
(if (NULL STRM)
then (ERROR "file that it supposed to exist won't open for extending." FILENAME))
(* update the length count stored in the file.)
(WRITETESTFILELENGTH STRM NEWLENGTH)
(SETFILEPTR STRM -1)
(for BYTE from (IPLUS STARTBYTE OLDLENGTH (IMINUS MINTESTFILELENGTH))
to (IPLUS STARTBYTE NEWLENGTH (IMINUS MINTESTFILELENGTH)
-1)
do (BOUT STRM (IMOD BYTE PERIOD)))
(OR DONTCLOSEFILESFLG (CLOSEF STRM])
(FILEINFOFROMFILE
[LAMBDA (FILE) (* hts: "22-Oct-84 15:44")
(* returns a TESTFILEINFO record of information about
FILE.)
(* keep track of test files differently because
contents can be represented as a single byte.)
(if (EQ FILE T)
then (HELP "FILE IS T!!?"))
(PROG ((CONTENTS (TESTFILEP FILE NIL T)))
(RETURN (create TESTFILEINFO
TESTFILEFULLNAME ← FILE
FILELENGTH ←(GETFILEINFO FILE (QUOTE LENGTH))
STARTBYTE ←(CAR CONTENTS)
PERIOD ←(CDR CONTENTS])
(GENERATEADDFILEOP
[LAMBDA (FILEINFOLST STOPIFCANTFLG HOST/DIR) (* hts: "22-Oct-84 16:19")
(PROG ((LENGTH (RANDOMFILELENGTH HOST/DIR))
(PERIOD (RAND 0 255)))
(RETURN (COND
(LENGTH (create TESTFILEOP
TESTOPERATION ←(QUOTE ADD)
TESTOPFILENAME ←(RANDOMFILENAME HOST/DIR)
TESTOPFILELENGTH ← LENGTH
STARTBYTE ←(RAND 0 PERIOD)
PERIOD ← PERIOD))
(STOPIFCANTFLG (ERROR "probably out of disk space."))
(T (GENERATEDELETEFILEOP FILEINFOLST T HOST/DIR])
(GENERATECHANGEFILEOP
[LAMBDA (FILEINFOLST HOST/DIR) (* hts: "29-Apr-84 16:29")
(PROG ((FILETOCHANGE (RANDOMTESTFILE FILEINFOLST))
(LENGTH (RANDOMFILELENGTH HOST/DIR)))
(RETURN (COND
((NULL FILETOCHANGE) (* create a file instead)
(GENERATEADDFILEOP FILEINFOLST T HOST/DIR))
((NULL LENGTH) (* if can't change the length, try deleting a file.)
(GENERATEDELETEFILEOP FILEINFOLST T HOST/DIR))
(T (create TESTFILEOP
TESTOPERATION ←(QUOTE CHANGELENGTH)
TESTOPFILENAME ← FILETOCHANGE
TESTOPFILELENGTH ← LENGTH])
(GENERATEDELETEFILEOP
[LAMBDA (FILEINFOLST STOPIFNONEFLG HOST/DIR) (* hts: "22-Oct-84 16:54")
(* generates a delete file operation.)
(* if it can't, it generates an file operation to ADD
unless STOPIFNONEFLG is T)
(PROG ((FILETODEL (RANDOMTESTFILE FILEINFOLST)))
(RETURN (COND
(FILETODEL (create TESTFILEOP
TESTOPERATION ←(QUOTE DELETE)
TESTOPFILENAME ← FILETODEL))
(STOPIFNONEFLG (ERROR "No file to delete"))
(T (GENERATEADDFILEOP FILEINFOLST T HOST/DIR])
(GENERATEDELETEALLFILEOP
[LAMBDA NIL (* hts: " 5-Jun-84 08:58")
(create TESTFILEOP
TESTOPERATION ←(QUOTE DELETEALL])
(RANDOMELT
[LAMBDA (LST) (* rrb "27-Mar-84 09:59")
(* returns a random element of a list.)
(CAR (NTH LST (RAND 1 (LENGTH LST])
(RANDOMFILELENGTH
[LAMBDA (HOST/DIR) (* jds "28-May-84 11:52")
(* returns a random file length.
(In bytes))
(PROG ((NPAGES (RANDOMELT TESTFILEPAGELENGTHS))
(BYTESPERPAGE 512)
(DSKPAGES (DSKFREEPAGES HOST/DIR))
(MINALLOC (DSKMINALLOC HOST/DIR))
FILEOVERHEAD) (* checks that there are enough free pages to store the
file.)
[COND
((ILEQ DSKPAGES (IPLUS MINALLOC (DSKPAGESOVERHEAD MINALLOC)))
(* There is no room for this file under any conditions
-- there aren't enough pages to allocate a
minimum-sized file)
(RETURN NIL))
((IGREATERP (IPLUS NPAGES (SETQ FILEOVERHEAD (DSKPAGESOVERHEAD NPAGES)))
DSKPAGES)
(* There is room for A file. Now pick a file size that will fit. FILEOVERHEAD should be a high estimate of the
overhead for the file, since the new NPAGES will be lower than the prior number.)
(SETQ NPAGES (IDIFFERENCE DSKPAGES FILEOVERHEAD]
(* weight to return a length around an even number of
pages.)
(RETURN (IPLUS (ITIMES NPAGES BYTESPERPAGE)
(SELECTQ (RAND 0 3)
(0 0)
(1 1)
(2 -1)
(RAND -511 512])
(RANDOMFILENAME
[LAMBDA (HOST/DIR) (* hts: "16-Feb-85 20:33")
(* generates a random file name.)
(U-CASE (PACK* HOST/DIR (PACKFILENAME (QUOTE NAME)
(RANDOMSTR (RAND MINFILENAMELENGTH MAXFILENAMELENGTH))
(QUOTE EXTENSION)
(RANDOMSTR (RAND MINFILEEXTENSIONLENGTH
MAXFILEEXTENSIONLENGTH))
(QUOTE VERSION)
(SELECTQ (RAND 0 1)
(0 (* give an explicit extension)
(RAND 1 MAXVERSION))
NIL])
(RANDOMSTR
[LAMBDA (NCHARS) (* rrb "27-Mar-84 09:38")
(* returns a random string NCHARS long.)
(PACK (CONS [CAR (NTH LEGALFIRSTFILENAMECHARS (RAND 1 (LENGTH LEGALFIRSTFILENAMECHARS]
(bind (#LEGALFILENAMECHARS ←(LENGTH LEGALFILENAMECHARS)) for I from 1
to (SUB1 NCHARS) collect (CAR (NTH LEGALFILENAMECHARS (RAND 1 #LEGALFILENAMECHARS])
(RANDOMTESTFILE
[LAMBDA (FILEINFOLST) (* hts: "22-Oct-84 16:10")
(* chooses a random test file from FILEINFOLST.
This avoids deleting not test files.)
(PROG ((NTESTFILES (for FILE in FILEINFOLST when (SMALLP (fetch (TESTFILEINFO STARTBYTE)
of FILE))
sum 1))
NFILE)
(RETURN (if (NEQ NTESTFILES 0)
then (SETQ NFILE (RAND 1 NTESTFILES))
(for FILE in FILEINFOLST when (SMALLP (fetch (TESTFILEINFO STARTBYTE)
of FILE))
do (if (ZEROP (SETQ NFILE (SUB1 NFILE)))
then (RETURN FILE])
(SORTBYCAR
[LAMBDA (LST) (* rrb "27-Mar-84 13:56")
(* sorts a list by its CARs)
(SORT LST (FUNCTION (LAMBDA (A B)
(ALPHORDER (CAR A)
(CAR B])
(TESTFILEP
[LAMBDA (FILE HINTONLYFLG RETURNCONTENTSFLG) (* hts: "22-Oct-84 14:54")
(* determines if a file is a test file.)
(PROG ((STRM (OPENSTREAM FILE (QUOTE INPUT)))
FILELENGTH STARTBYTE PERIOD)
(SETQ FILELENGTH (GETFILEINFO STRM (QUOTE LENGTH)))
(RETURN (PROG1 [COND
((ILESSP FILELENGTH MINTESTFILELENGTH)
(* test files contain at least enough bytes to hold
keys and stuff. Maybe should have a special test for
zero length files.)
NIL)
((AND (EQ (WORDIN STRM)
FIRSTTESTWORD)
(EQ (WORDIN STRM)
SECONDTESTWORD)
(EQP FILELENGTH (DOUBLEWORDIN STRM)))
(if HINTONLYFLG
then (* if asking about hint only, don't check contents.)
(if RETURNCONTENTSFLG
then (CONS (BIN STRM)
(BIN STRM))
else FILE)
else (SETQ STARTBYTE (BIN STRM))
(SETQ PERIOD (BIN STRM))
(for COMPUTEDBYTE from STARTBYTE to (IPLUS STARTBYTE FILELENGTH
(IMINUS
MINTESTFILELENGTH))
when (NEQ (BIN STRM)
(IMOD COMPUTEDBYTE PERIOD))
do (RETURN NIL) finally (RETURN (if RETURNCONTENTSFLG
then (CONS STARTBYTE
PERIOD)
else FILE]
(CLOSEF STRM])
(TRUNCATETESTFILE
[LAMBDA (FILENAME NEWLENGTH) (* hts: "22-Oct-84 15:30")
(* truncates a test file)
(if (OPENP FILENAME)
then (* file may be open already for read.)
(CLOSEF FILENAME))
(PROG [(STRM (OPENSTREAM FILENAME (QUOTE BOTH]
(if (NULL STRM)
then (ERROR "file that it supposed to exist won't open for truncation." FILENAME))
(WRITETESTFILELENGTH STRM NEWLENGTH)
(SETFILEPTR STRM NEWLENGTH)
(SETFILEINFO FILENAME (QUOTE LENGTH)
NEWLENGTH)
(CLOSEF STRM)
(if (NOT (EQP (GETFILEINFO FILENAME (QUOTE LENGTH))
NEWLENGTH))
then (ERROR "truncating file to NEWLENGTH didn't take" (LIST FILENAME NEWLENGTH])
(WORDIN
[LAMBDA (STRM) (* rrb "27-Mar-84 14:37")
(* read two bytes from a stream)
(LOGOR (LLSH (\BIN STRM)
8)
(\BIN STRM])
(WORDOUT
[LAMBDA (STRM WORD) (* bouts two bytes onto stream)
(\BOUT STRM (LRSH WORD 8))
(\BOUT STRM (LOGAND WORD 255])
(DOUBLEWORDIN
[LAMBDA (FILE) (* jds " 3-JAN-83 16:08")
(IPLUS (LLSH (\BIN FILE)
24)
(LLSH (\BIN FILE)
16)
(LLSH (\BIN FILE)
8)
(\BIN FILE])
(DOUBLEWORDOUT
[LAMBDA (FILE NUMBER) (* jds " 3-JAN-83 15:30")
(\BOUT FILE (LOGAND 255 (LRSH NUMBER 24)))
(\BOUT FILE (LOGAND 255 (LRSH NUMBER 16)))
(\BOUT FILE (LOGAND 255 (LRSH NUMBER 8)))
(\BOUT FILE (LOGAND 255 NUMBER])
(WRITETESTFILE
[LAMBDA (NAME LENGTH STARTBYTE PERIOD) (* hts: "22-Oct-84 16:32")
(* writes a test file of length LENGTH with contents
CONTENTBYTE)
(PROG [(STRM (OPENSTREAM NAME (QUOTE OUTPUT]
(OR STRM (RETURN NIL))
(COND
((ILESSP LENGTH MINTESTFILELENGTH)
(ERROR "test files must have a minimum length " MINTESTFILELENGTH)))
(WORDOUT STRM FIRSTTESTWORD)
(WORDOUT STRM SECONDTESTWORD)
(DOUBLEWORDOUT STRM LENGTH)
(BOUT STRM STARTBYTE)
(BOUT STRM PERIOD)
(for COMPUTEDBYTE from STARTBYTE to (IPLUS STARTBYTE LENGTH (IMINUS MINTESTFILELENGTH)
-1)
do (BOUT STRM (IMOD COMPUTEDBYTE PERIOD)))
(CLOSEF STRM)
(RETURN (FULLNAME STRM])
(WRITETESTFILELENGTH
[LAMBDA (STRM NEWLENGTH) (* hts: "22-Oct-84 13:00")
(* update the length count stored in the file.)
(SETFILEPTR STRM 4)
(DOUBLEWORDOUT STRM NEWLENGTH])
)
(RPAQ DSKFREEPAGESFN (FUNCTION DEFAULT.DSKFREEPAGESFN))
(RPAQ DSKPAGESOVERHEADFN (FUNCTION DEFAULT.DSKPAGESOVERHEADFN))
(RPAQ DSKMINALLOCFN (FUNCTION DEFAULT.DSKMINALLOCFN))
(RPAQQ MINTESTFILELENGTH 10)
(RPAQQ FIRSTTESTWORD 48094)
(RPAQQ SECONDTESTWORD 56187)
(RPAQQ NUMBEROFTESTBYTES 5)
(RPAQQ EXHAUSTIVETESTFLG NIL)
(RPAQQ DEFAULTREPLAYFILE {PHYLUM}<LISPCORE>DLIONFS>REPLAY.LOG)
(RPAQQ DONTCLOSEFILESFLG NIL)
(RPAQQ LEGALFILENAMECHARS (A B C D E F G H I J K L M N O P Q R S T U V W X Y Z a b c d e f g h i j k
l m n o p q r s t u v w x y z 0 1 2 3 4 5 6 7 8 9))
(RPAQQ LEGALFIRSTFILENAMECHARS (A B C D E F G H I J K L M N O P Q R S T U V W X Y Z a b c d e f g h i
j k l m n o p q r s t u v w x y z))
(RPAQQ MINFILENAMELENGTH 1)
(RPAQQ MAXFILENAMELENGTH 15)
(RPAQQ MINFILEEXTENSIONLENGTH 0)
(RPAQQ MAXFILEEXTENSIONLENGTH 6)
(RPAQQ MAXVERSION 64000)
(RPAQQ TESTFILEPAGELENGTHS (1 2 5 8 13 16 24 64 78 128))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS FIRSTTESTWORD SECONDTESTWORD MINTESTFILELENGTH NUMBEROFTESTBYTES EXHAUSTIVETESTFLG
DSKFREEPAGESFN DSKPAGESOVERHEADFN)
)
[DECLARE: EVAL@COMPILE
(RECORD TESTFILEINFO (TESTFILEFULLNAME FILELENGTH STARTBYTE PERIOD TESTFILEORIGNAME))
(RECORD TESTFILEOP (TESTOPERATION (* TESTOPERATION can be ADD DELETE CHANGELENGTH
DELETEALL)
TESTOPFILENAME TESTOPFILELENGTH STARTBYTE PERIOD))
]
(PUTPROPS DSKTEST COPYRIGHT ("Xerox Corporation" 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2417 9510 (DSKTEST 2427 . 9051) (DELETETESTFILES 9053 . 9508)) (9511 33092 (
CHECKCONSISTENCY 9521 . 10603) (CHECKLENGTHANDCONTENTS 10605 . 12744) (CHOOSERANDOMFILEOPERATION 12746
. 13772) (DEFAULT.DSKFREEPAGESFN 13774 . 14247) (DEFAULT.DSKMINALLOCFN 14249 . 14677) (
DEFAULT.DSKPAGESOVERHEADFN 14679 . 15433) (DOTESTFILEOP 15435 . 19024) (DSKFREEPAGES 19026 . 19340) (
DSKMINALLOC 19342 . 19710) (DSKPAGESOVERHEAD 19712 . 19939) (EXTENDTESTFILE 19941 . 21066) (
FILEINFOFROMFILE 21068 . 21823) (GENERATEADDFILEOP 21825 . 22419) (GENERATECHANGEFILEOP 22421 . 23147)
(GENERATEDELETEFILEOP 23149 . 23862) (GENERATEDELETEALLFILEOP 23864 . 24054) (RANDOMELT 24056 . 24322
) (RANDOMFILELENGTH 24324 . 25903) (RANDOMFILENAME 25905 . 26544) (RANDOMSTR 26546 . 27077) (
RANDOMTESTFILE 27079 . 27864) (SORTBYCAR 27866 . 28162) (TESTFILEP 28164 . 29818) (TRUNCATETESTFILE
29820 . 30776) (WORDIN 30778 . 31046) (WORDOUT 31048 . 31239) (DOUBLEWORDIN 31241 . 31491) (
DOUBLEWORDOUT 31493 . 31823) (WRITETESTFILE 31825 . 32791) (WRITETESTFILELENGTH 32793 . 33090)))))
STOP