(FILECREATED "22-Mar-86 18:30:39" {ERIS}<LISPCORE>SOURCES>FLOPPYTESTER.;7
 4235   

      changes to:  (FNS STARTTEST STOPTEST KILLTEST)
		   (VARS FLOPPYTESTERCOMS)

      previous date: "20-Mar-86 21:06:46" {ERIS}<LISPCORE>SOURCES>FLOPPYTESTER.;5)


(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT FLOPPYTESTERCOMS)

(RPAQQ FLOPPYTESTERCOMS
 ((* * FLOPPYTESTER -- Runs FILEBANGER on FLOPPY. *)
			   (P (LOAD? (QUOTE {ERINYES}<TEST>TOOLS>FILEBANGER.DCOM)))
			   (INITVARS (ALLOCATIONSW NIL))
			   (FNS STARTTEST STOPTEST KILLTEST BLTALLOCS BLTALLOC)))
(* * FLOPPYTESTER -- Runs FILEBANGER on FLOPPY. *)


(LOAD? (QUOTE {ERINYES}<TEST>TOOLS>FILEBANGER.DCOM))

(RPAQ? ALLOCATIONSW
 NIL)
(DEFINEQ

(STARTTEST

  (LAMBDA (N)                                                (* kbr: "22-Mar-86 17:19")

    (
CNDIR
 (
QUOTE
 {FLOPPY}))
    (
FLOPPY.FORMAT
 (
QUOTE
 TEST))
    (
DIRECTORY
 (
QUOTE
 {FLOPPY}*))
    (BLTALLOCS
)
    (for
 I from
 1 to
 N do
 (
DOFILEBANGER
 (
PACK*
 (
QUOTE
 {FLOPPY})
							   (
QUOTE
 TESTFILE)
							   I)
						  (
RAND
 10 30)))))

(STOPTEST

  (LAMBDA NIL                                                (* kbr: "22-Mar-86 17:36")

    (for
 P in
 FILEBANGERS when
 (
NOT
 (
EQ
 P (
THIS.PROCESS
))) do
 (
SUSPEND.PROCESS
 P))))

(KILLTEST

  (LAMBDA NIL                                                (* kbr: "22-Mar-86 17:18")

    (for
 P in
 FILEBANGERS do
 (
DEL.PROCESS
 P))
    (
SETQ
 FILEBANGERS NIL)))

(BLTALLOCS

  [LAMBDA NIL                                                (* kbr: "18-Nov-85 12:32")

                                                             (* Debugging fn. Puts up a window representation of 

							     allocations on floppy. *)

    (
PROG
 (PIXELS XLENGTH YLENGTH)
	    (
SETQ
 PIXELS 5)
	    (
SETQ
 XLENGTH (
ITIMES
 \FLOPPY.TRACKSPERCYLINDER \FLOPPY.SECTORSPERTRACK))
	    (
SETQ
 YLENGTH \FLOPPY.CYLINDERS)
	    [
COND

	      ((
NULL
 ALLOCATIONSW)
		(
SETQ
 ALLOCATIONSW (
CREATEW
 (
GETBOXREGION
 (
WIDTHIFWINDOW
 (
ITIMES
 PIXELS 
											  XLENGTH))
								(
HEIGHTIFWINDOW
 (
ITIMES
 PIXELS 
											  YLENGTH)
										  T)
								NIL NIL NIL 
							     "Position FLOPPY ALLOCATIONS window")
						"FLOPPY ALLOCATIONS"))
		(
UNADVISE
 (
QUOTE
 \PFLOPPY.ALLOCATE))
		(
ADVISE
 (
QUOTE
 \PFLOPPY.ALLOCATE)
			  (
QUOTE
 AFTER)
			  (
QUOTE
 (
COND
 (!VALUE (BLTALLOC
 !VALUE]
	    (
BITBLT
 NIL NIL NIL ALLOCATIONSW NIL NIL NIL NIL (
QUOTE
 TEXTURE)
		      (
QUOTE
 REPLACE)
		      WHITESHADE)
	    (for
 Y from
 0 to
 (
SUB1
 YLENGTH) do
 (for
 X from
 0 to
 (
SUB1
 XLENGTH)
							    do
 (
BITMAPBIT
 ALLOCATIONSW
									      (
ITIMES
 PIXELS X)
									      (
ITIMES
 PIXELS Y)
									      1)))
	    (for
 PFALLOC in
 (fetch
 (PFLOPPYFDEV PFALLOCS) of
 \FLOPPYFDEV)
	       when
 [
NOT
 (
EQUAL
 (fetch
 (PFALLOC FILENAME) of
 PFALLOC)
				      (
QUOTE
 (FREE]
	       do
 (BLTALLOC
 PFALLOC])

(BLTALLOC

  [LAMBDA (PFALLOC)                                          (* kbr: "18-Nov-85 12:21")

    (
PROG
 (SHADE OPSHADE LEFT BOTTOM PIXELS XLENGTH)
	    (
SETQ
 PIXELS 5)
	    (
SETQ
 XLENGTH (
ITIMES
 \FLOPPY.TRACKSPERCYLINDER \FLOPPY.SECTORSPERTRACK))
	    (
SETQ
 SHADE (
COND

		((
EQUAL
 (fetch
 (PFALLOC FILENAME) of
 PFALLOC)
			  (
QUOTE
 (FREE)))
		  WHITESHADE)
		(T BLACKSHADE)))
	    (
SETQ
 OPSHADE (
IDIFFERENCE
 BLACKSHADE SHADE))
	    (for
 I from
 (fetch
 (PFALLOC START) of
 PFALLOC) to
 (fetch
 (PFALLOC END)
									   of
 PFALLOC)
	       do
 (
SETQ
 LEFT (
ITIMES
 PIXELS (
IREMAINDER
 (
SUB1
 I)
								XLENGTH)))
		    (
SETQ
 BOTTOM (
ITIMES
 PIXELS (
IQUOTIENT
 (
SUB1
 I)
								 XLENGTH)))
		    (
BLTSHADE
 SHADE ALLOCATIONSW LEFT BOTTOM PIXELS PIXELS (
QUOTE
 REPLACE))
		    (
BLTSHADE
 OPSHADE ALLOCATIONSW LEFT BOTTOM 1 1 (
QUOTE
 REPLACE])
)
(PUTPROPS FLOPPYTESTER COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (745 4147 (STARTTEST 755 . 1166) (STOPTEST 1168 . 1390) (KILLTEST 1392 . 1592) (
BLTALLOCS 1594 . 3180) (BLTALLOC 3182 . 4145)))))
STOP