(FILECREATED "14-AUG-83 13:56:54" {PHYLUM}<LISPCORE>MISC>FILEBANGER.;23 11126
changes to: (VARS FILEBANGERCOMS)
(FNS DOZEROBANGER DOMAKEFILEBANGER MAKEFILEBANGER)
previous date: "13-AUG-83 15:42:41" {PHYLUM}<LISPCORE>MISC>FILEBANGER.;22)
(* Copyright (c) 1983 by Xerox Corporation)
(PRETTYCOMPRINT FILEBANGERCOMS)
(RPAQQ FILEBANGERCOMS ((FNS DOFILEBANGER DOMAKEFILEBANGER DOZEROBANGER FILEBANGER FBCOPYBYTES
FBMAKETESTFILE MAKEBANGERWINDOW MAKEFILEBANGER ZEROBANGER
SUSPEND.FILEBANGER WATCHDISKPAGES)
(FNS BINCOM)
(FNS CHECKFORZEROS)
(INITVARS (FBREPEATCOUNT 4)
(FILEBANGERS))))
(DEFINEQ
(DOFILEBANGER
[LAMBDA (DESTINATION LENGTH NOBREAK) (* bvm: "10-AUG-83 17:37")
(push FILEBANGERS (ADD.PROCESS (BQUOTE (FILEBANGER (QUOTE , LENGTH)
(QUOTE , DESTINATION)
T
(QUOTE , NOBREAK])
(DOMAKEFILEBANGER
[LAMBDA (SOURCE) (* bvm: "14-AUG-83 13:53")
(push FILEBANGERS (ADD.PROCESS (BQUOTE (MAKEFILEBANGER (QUOTE , SOURCE])
(DOZEROBANGER
[LAMBDA (TESTFILE1 TESTFILE2 TMPFILENAME) (* bvm: "14-AUG-83 13:54")
(push FILEBANGERS (ADD.PROCESS (BQUOTE (ZEROBANGER (QUOTE , TESTFILE1)
(QUOTE , TESTFILE2)
(QUOTE , TMPFILENAME])
(FILEBANGER
[LAMBDA (TESTFILE DESTINATION MAKEWINDOW NOBREAK INPARMS OUTPARMS)
(* bvm: "12-AUG-83 13:06")
(DECLARE (SPECVARS ERRCNT LOOPCNT))
(RESETLST (PROG ((ERRCNT 0)
(LOOPCNT 0)
(OPTION (AND (NOT NOBREAK)
(QUOTE BREAK)))
MYFILE NEWFILE LASTFILE TMPFILENAME OUTPUTSTREAM)
[COND
[(OR (NULL TESTFILE)
(FIXP TESTFILE))
(SETQ TESTFILE (SETQ MYFILE (FBMAKETESTFILE TESTFILE
(PACKFILENAME
(QUOTE EXTENSION)
(QUOTE SOURCE)
(QUOTE BODY)
(OR DESTINATION (QUOTE
FILEBANGER]
(T (CLOSEF (SETQ TESTFILE (OPENFILE (OR TESTFILE (RETURN "No TESTFILE supplied")
)
(QUOTE INPUT]
[COND
[MAKEWINDOW (SETQ OUTPUTSTREAM (GETSTREAM (MAKEBANGERWINDOW TESTFILE
"File Banger")
(QUOTE OUTPUT]
(T (SETQ OUTPUTSTREAM (GETSTREAM T (QUOTE OUTPUT]
(COND
((NOT MYFILE)
(SETQ MYFILE (COPYFILE TESTFILE (PACKFILENAME (QUOTE EXTENSION)
(QUOTE FBTESTER)
(QUOTE VERSION)
NIL
(QUOTE BODY)
TESTFILE)))
(BINCOM MYFILE TESTFILE OPTION OUTPUTSTREAM)))
[SETQ TMPFILENAME (OR DESTINATION (PACKFILENAME (QUOTE EXTENSION)
(QUOTE FBTEMP)
(QUOTE VERSION)
NIL
(QUOTE BODY)
(OR MYFILE (QUOTE FILEBANGER]
LP (PRIN1 (add LOOPCNT 1)
OUTPUTSTREAM)
(RESETLST [RESETSAVE (SETQ NEWFILE (OPENFILE TMPFILENAME (QUOTE OUTPUT)
NIL NIL OUTPARMS))
(QUOTE (PROGN (CLOSEF OLDVALUE]
[RESETSAVE (OPENFILE MYFILE (QUOTE INPUT)
NIL NIL INPARMS)
(QUOTE (PROGN (CLOSEF OLDVALUE]
(COPYBYTES MYFILE NEWFILE))
(AND LASTFILE (DELFILE LASTFILE))
[RPTQ FBREPEATCOUNT (PROGN (PRIN1 (QUOTE %.)
OUTPUTSTREAM)
(COND
((NEQ (BINCOM MYFILE NEWFILE OPTION OUTPUTSTREAM)
T)
(add ERRCNT 1]
(SETQ LASTFILE NEWFILE)
(GO LP])
(FBCOPYBYTES
[LAMBDA (INSTREAM ECHOSTREAM START) (* bvm: "24-JUN-83 19:00")
(SETFILEPTR INSTREAM START)
(RPTQ 50Q (\OUTCHAR ECHOSTREAM (\BIN INSTREAM])
(FBMAKETESTFILE
[LAMBDA (LENGTH NAME) (* bvm: "10-AUG-83 17:47")
(RESETLST (PROG [(FILE (OPENFILE (OR NAME (QUOTE FILEBANGER.TMP))
(QUOTE OUTPUT)
(QUOTE NEW]
(RESETSAVE NIL (LIST (QUOTE CLOSEF)
FILE))
(for I from 1 to (OR LENGTH 1000) bind (STREAM ←(GETSTREAM FILE (QUOTE OUTPUT)))
do (\OUTCHAR STREAM (RAND 32 127)))
(RETURN FILE])
(MAKEBANGERWINDOW
[LAMBDA (FILE TYPE) (* bvm: "12-AUG-83 13:06")
(PROG (W)
[RESETSAVE (TTYDISPLAYSTREAM (SETQ W (CREATEW NIL (CONCAT TYPE " for " FILE]
(DSPFONT (QUOTE (GACHA 8))
W)
[WINDOWPROP W (QUOTE CLOSEFN)
(FUNCTION (LAMBDA (W P)
(AND [PROCESSP (SETQ P (WINDOWPROP W (QUOTE PROCESS]
(PROCESS.EVAL P (QUOTE (ERROR!]
(WINDOWPROP W (QUOTE PAGEFULLFN)
(FUNCTION NILL))
(RETURN W])
(MAKEFILEBANGER
[LAMBDA (TESTFILE) (* bvm: "14-AUG-83 13:56")
(DECLARE (SPECVARS ERRCNT LOOPCNT))
(RESETLST (PROG ((LOOPCNT 0)
NEWFILE LASTFILE)
[SETQ TESTFILE (LOADFROM (OR TESTFILE (RETURN "No TESTFILE supplied"]
(MAKEBANGERWINDOW TESTFILE "MAKEFILE Banger")
(SETQ TESTFILE (NAMEFIELD TESTFILE T))
LP (SETQ NEWFILE (MAKEFILE TESTFILE))
(AND (CHECKFORZEROS NEWFILE)
(HELP "Zeros found"))
[COND
(LASTFILE (DELFILE LASTFILE)
(REMPROP LASTFILE (QUOTE PAGES]
(SETQ LASTFILE NEWFILE)
(GO LP])
(ZEROBANGER
[LAMBDA (TESTFILE1 TESTFILE2 TMPFILENAME N NOBREAK OUTPUTSTREAM)
(* bvm: "12-AUG-83 13:07")
(DECLARE (SPECVARS ERRCNT LOOPCNT))
(RESETLST (PROG ((ERRCNT 0)
(LOOPCNT 0)
(OPTION (AND (NOT NOBREAK)
(QUOTE BREAK)))
THISFILE NEWFILE LASTFILE)
[SETQ THISFILE (CLOSEF (SETQ TESTFILE1 (OPENFILE (OR TESTFILE1 (RETURN
"No TESTFILE supplied"))
(QUOTE INPUT]
(RESETSAVE NIL (LIST (QUOTE CLOSEF?)
TESTFILE1))
[CLOSEF (SETQ TESTFILE2 (OPENFILE (OR TESTFILE2 (RETURN "No TESTFILE supplied"))
(QUOTE INPUT]
(RESETSAVE NIL (LIST (QUOTE CLOSEF?)
TESTFILE2))
[CLOSEF (SETQ TMPFILENAME (OPENFILE (OR TMPFILENAME (QUOTE ZEROBANGER.TMP))
(QUOTE OUTPUT]
(RESETSAVE NIL (LIST (QUOTE CLOSEF?)
TMPFILENAME))
(SETQ OUTPUTSTREAM (GETSTREAM (OR OUTPUTSTREAM (MAKEBANGERWINDOW THISFILE
"Zero Banger"))
(QUOTE OUTPUT)))
LP (COND
((AND N (ILESSP (add N -1)
0))
(RETURN ERRCNT)))
(printout OUTPUTSTREAM (add LOOPCNT 1)
,)
(OPENFILE TMPFILENAME (QUOTE BOTH)
(QUOTE OLD))
(OPENFILE THISFILE (QUOTE INPUT))
(COPYBYTES THISFILE TMPFILENAME 0 -1)
(CLOSEF THISFILE)
(SETFILEINFO TMPFILENAME (QUOTE LENGTH)
(GETFILEPTR TMPFILENAME))
(CLOSEF TMPFILENAME) (* (AND LASTFILE (DELFILE LASTFILE)))
(COND
((NEQ (BINCOM THISFILE TMPFILENAME OPTION OUTPUTSTREAM)
T)
(add ERRCNT 1))) (* (SETQ LASTFILE NEWFILE))
(SETQ THISFILE (COND
((EQ THISFILE TESTFILE1)
TESTFILE2)
(T TESTFILE1)))
(GO LP])
(SUSPEND.FILEBANGER
[LAMBDA NIL (* bvm: "10-AUG-83 17:39")
(for PROC in FILEBANGERS when (AND (PROCESSP PROC)
(NEQ PROC (THIS.PROCESS)))
do (SUSPEND.PROCESS PROC))
(CLOSEF (PROG1 PUPTRACEFILE (SETQ PUPTRACEFILE (PUPTRACE PUPTRACEFLG
(QUOTE (832 416 190 336])
(WATCHDISKPAGES
[LAMBDA (THRESHOLD) (* bvm: "10-AUG-83 17:11")
(OR THRESHOLD (SETQ THRESHOLD 3720Q))
(while T bind (MARGIN ← THRESHOLD)
LASTFILE
do (COND
((ILESSP (DISKFREEPAGES)
(IPLUS THRESHOLD MARGIN))
(COND
(LASTFILE (DELFILE LASTFILE)))
(SETQ LASTFILE (CLOSEF PUPTRACEFILE))
(SETQ PUPTRACEFILE (OPENFILE (QUOTE {DSK}PUPTRACE.TMP)
(QUOTE OUTPUT)
(QUOTE NEW)))
(SETQ MARGIN 0)))
(BLOCK 165140Q])
)
(DEFINEQ
(BINCOM
[LAMBDA (FILE1 FILE2 OPTION OUTPUTSTREAM) (* bvm: "24-JUN-83 18:45")
(RESETLST (PROG ((STRM1 (OPENSTREAM FILE1 (QUOTE INPUT)
(QUOTE OLD)))
(STRM2 (OPENSTREAM FILE2 (QUOTE INPUT)
(QUOTE OLD)))
HERE B1 B2)
(RESETSAVE NIL (LIST (QUOTE CLOSEF)
STRM1))
(RESETSAVE NIL (LIST (QUOTE CLOSEF)
STRM2))
(SETQ OUTPUTSTREAM (GETSTREAM (OR OUTPUTSTREAM T)
(QUOTE OUTPUT)))
(RETURN (COND
((IEQP (GETEOFPTR STRM1)
(GETEOFPTR STRM2))
(for I from 1 to (GETEOFPTR STRM1)
do (COND
((NEQ (SETQ B1 (\BIN STRM1))
(SETQ B2 (\BIN STRM2)))
(COND
((NEQ OPTION (QUOTE NOMSG))
(printout OUTPUTSTREAM T (FULLNAME STRM1)
" and "
(FULLNAME STRM2)
" differ at byte " .P2 (SETQ HERE
(SUB1 (GETFILEPTR STRM1)))
" (page " .P2 (fetch (BYTEPTR PAGE)
of HERE)
", byte " .P2 (fetch (BYTEPTR OFFSET)
of HERE)
"): ")
(\OUTCHAR OUTPUTSTREAM B1)
(printout OUTPUTSTREAM "[" .P2 B1 "] vs. ")
(\OUTCHAR OUTPUTSTREAM B2)
(printout OUTPUTSTREAM "[" .P2 B2 "]" T (FULLNAME
STRM1)
" reads:" T)
(FBCOPYBYTES STRM1 OUTPUTSTREAM HERE)
(printout OUTPUTSTREAM T (FULLNAME STRM2)
" reads:" T)
(FBCOPYBYTES STRM2 OUTPUTSTREAM HERE)
(TERPRI T)))
(COND
((EQ OPTION (QUOTE BREAK))
(HELP STRM1 STRM2)))
(RETURN I)))
finally (RETURN T)))
(T (COND
((NEQ OPTION (QUOTE NOMSG))
(printout OUTPUTSTREAM T (FULLNAME STRM1)
" has length " .P2 (GETEOFPTR STRM1)
", but "
(FULLNAME STRM2)
" has length " .P2 (GETEOFPTR STRM2)
T)))
(COND
((EQ OPTION (QUOTE BREAK))
(HELP STRM1 STRM2)))
(LIST (GETEOFPTR STRM1)
(GETEOFPTR STRM2])
)
(DEFINEQ
(CHECKFORZEROS
[LAMBDA (FILE MINZEROS) (* bvm: " 9-AUG-83 16:14")
(RESETLST (PROG ((STREAM (OPENSTREAM FILE (QUOTE INPUT)))
(#FAILURES 0)
N)
(RESETSAVE NIL (LIST (QUOTE CLOSEF)
STREAM))
(OR MINZEROS (SETQ MINZEROS 24Q))
(replace ENDOFSTREAMOP of STREAM with (FUNCTION NILL))
(printout T (FULLNAME STREAM)
": " T)
(do (SELECTQ (BIN STREAM)
(NIL (RETURN))
[0 (SETQ N 1)
(while (ZEROP (BIN STREAM)) do (add N 1))
(COND
((IGREATERP N MINZEROS)
(printout T .P2 N " zeros starting at byte " .P2
(SUB1 (IDIFFERENCE (GETFILEPTR STREAM)
N))
T)
(add #FAILURES 1]
NIL))
(RETURN (AND (NOT (ZEROP #FAILURES))
#FAILURES])
)
(RPAQ? FBREPEATCOUNT 4)
(RPAQ? FILEBANGERS )
(PUTPROPS FILEBANGER COPYRIGHT ("Xerox Corporation" 1983))
(DECLARE: DONTCOPY
(FILEMAP (NIL (661 8075 (DOFILEBANGER 671 . 942) (DOMAKEFILEBANGER 944 . 1142) (DOZEROBANGER 1144 .
1405) (FILEBANGER 1407 . 3556) (FBCOPYBYTES 3558 . 3750) (FBMAKETESTFILE 3752 . 4206) (
MAKEBANGERWINDOW 4208 . 4729) (MAKEFILEBANGER 4731 . 5357) (ZEROBANGER 5359 . 7161) (
SUSPEND.FILEBANGER 7163 . 7532) (WATCHDISKPAGES 7534 . 8073)) (8076 10131 (BINCOM 8086 . 10129)) (
10132 10990 (CHECKFORZEROS 10142 . 10988)))))
STOP