(FILECREATED "13-Aug-85 19:26:06" {ERIS}<LISPCORE>LIBRARY>DSKTEST.;17 35576
changes to: (FNS CHECKLENGTHANDCONTENTS CHOOSERANDOMFILEOPERATION DEFAULT.DSKPAGESOVERHEADFN)
(VARS DSKTESTCOMS)
previous date: "13-Aug-85 11:29:56" {ERIS}<LISPCORE>LIBRARY>DSKTEST.;11)
(* Copyright (c) 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT DSKTESTCOMS)
(RPAQQ DSKTESTCOMS ((* * This program is a file system tester. It is suitable for testing any
random-access filing device. It is NOT intended for customer release. DSKTEST
is the entry function.)
(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 TESTFILEPAGELENGTHS)
(RECORDS TESTFILEINFO TESTFILEOP)))
(* * This program is a file system tester. It is suitable for testing any random-access filing
device. It is NOT intended for customer release. DSKTEST is the entry function.)
(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: "13-Aug-85 19:19")
(* 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))
(if (EQ 1 (RAND 1 7))
then
(* * SCAN ENTIRE FILE)
(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))
else
(* * SPOT CHECK FILE)
(bind SPOT COMPUTEDBYTE READBYTE to 7
do (SETQ SPOT (RAND MINTESTFILELENGTH (SUB1 FILELENGTH)))
(SETQ COMPUTEDBYTE (PLUS (MINUS MINTESTFILELENGTH)
SPOT STARTBYTE))
(SETFILEPTR STRM SPOT)
(if (NEQ (SETQ READBYTE (\BIN STRM))
(IMOD COMPUTEDBYTE PERIOD))
then (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)))
(SETFILEPTR STRM FILELENGTH))
(OR (EOFP STRM)
(ERROR "FILE doesn't get EOFP ... " FILEINFO)))
(OR DONTCLOSEFILESFLG (CLOSEF STRM])
(CHOOSERANDOMFILEOPERATION
[LAMBDA (FILESINFO HOST/DIR) (* hts: "13-Aug-85 17:37")
(* 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 150)))
(RETURN (COND
((ILEQ RANDNUM 75) (* add a file)
(GENERATEADDFILEOP FILESINFO NIL HOST/DIR))
((ILEQ RANDNUM 125) (* Change the length of a file)
(GENERATECHANGEFILEOP FILESINFO HOST/DIR))
((ILEQ RANDNUM 149) (* delete a file)
(GENERATEDELETEFILEOP FILESINFO NIL 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: "13-Aug-85 16:54")
(* default overhead function)
(SELECTQ (MACHINETYPE)
((DANDELION DOVE)
(* * 11 is 5 for worst-case btree split on file, 5 for split on directory, 1 for leaderpage;
NEWFILELENGTH and \LFrunSize for maximum length file will attain during allocation; and \LFrunSize for possible
directory extension.)
(PLUS 11 NEWFILELENGTH \LFrunSize \LFrunSize))
((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) (* edited: "13-Aug-85 11:28")
(PROG ((LENGTH (RANDOMFILELENGTH HOST/DIR))
(PERIOD (RAND 1 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 TESTFILEPAGELENGTHS)
)
[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 (2496 9561 (DSKTEST 2506 . 9102) (DELETETESTFILES 9104 . 9559)) (9562 33967 (
CHECKCONSISTENCY 9572 . 10654) (CHECKLENGTHANDCONTENTS 10656 . 13644) (CHOOSERANDOMFILEOPERATION 13646
. 14720) (DEFAULT.DSKFREEPAGESFN 14722 . 15195) (DEFAULT.DSKMINALLOCFN 15197 . 15625) (
DEFAULT.DSKPAGESOVERHEADFN 15627 . 16305) (DOTESTFILEOP 16307 . 19896) (DSKFREEPAGES 19898 . 20212) (
DSKMINALLOC 20214 . 20582) (DSKPAGESOVERHEAD 20584 . 20811) (EXTENDTESTFILE 20813 . 21938) (
FILEINFOFROMFILE 21940 . 22695) (GENERATEADDFILEOP 22697 . 23294) (GENERATECHANGEFILEOP 23296 . 24022)
(GENERATEDELETEFILEOP 24024 . 24737) (GENERATEDELETEALLFILEOP 24739 . 24929) (RANDOMELT 24931 . 25197
) (RANDOMFILELENGTH 25199 . 26778) (RANDOMFILENAME 26780 . 27419) (RANDOMSTR 27421 . 27952) (
RANDOMTESTFILE 27954 . 28739) (SORTBYCAR 28741 . 29037) (TESTFILEP 29039 . 30693) (TRUNCATETESTFILE
30695 . 31651) (WORDIN 31653 . 31921) (WORDOUT 31923 . 32114) (DOUBLEWORDIN 32116 . 32366) (
DOUBLEWORDOUT 32368 . 32698) (WRITETESTFILE 32700 . 33666) (WRITETESTFILELENGTH 33668 . 33965)))))
STOP