(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (FILECREATED "14-Jun-90 21:20:39" {DSK}local>lde>lispcore>internal>library>FILEBANGER.;2 16050 chnges to%: (VARS FILEBANGERCOMS) (FNS CHECKFORZEROS) previous date%: " 1-Oct-87 18:36:57" {DSK}local>lde>lispcore>internal>library>FILEBANGER.;1 ) (* ; " Copyright (c) 1983, 1987, 1990 by Venue & Xerox Corporation. All rights reserved. ") (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)) (PROP FILETYPE FILEBANGER))) (DEFINEQ (DOFILEBANGER [LAMBDA (DESTINATION LENGTH NOBREAK) (* ; "Edited 1-Oct-87 18:00 by Daniels") (push FILEBANGERS (ADD.PROCESS `(FILEBANGER ',LENGTH ',DESTINATION T ',NOBREAK]) (DOMAKEFILEBANGER [LAMBDA (SOURCE) (* bvm%: "14-AUG-83 13:53") (push FILEBANGERS (ADD.PROCESS `(MAKEFILEBANGER (QUOTE %, SOURCE]) (DOZEROBANGER [LAMBDA (TESTFILE1 TESTFILE2 TMPFILENAME) (* bvm%: "14-AUG-83 13:54") (push FILEBANGERS (ADD.PROCESS `(ZEROBANGER (QUOTE %, TESTFILE1) (QUOTE %, TESTFILE2) (QUOTE %, TMPFILENAME]) (FILEBANGER [LAMBDA (TESTFILE DESTINATION MAKEWINDOW NOBREAK INPARMS OUTPARMS) (* ; "Edited 1-Oct-87 18:31 by Daniels") (DECLARE (SPECVARS ERRCNT LOOPCNT)) (RESETLST (PROG ((ERRCNT 0) (LOOPCNT 0) (OPTION (AND (NOT NOBREAK) 'BREAK)) MYFILE NEWFILE LASTFILE TMPFILENAME OUTPUTSTREAM) [COND [(OR (NULL TESTFILE) (FIXP TESTFILE)) (SETQ TESTFILE (SETQ MYFILE (FBMAKETESTFILE TESTFILE (PACKFILENAME 'EXTENSION 'SOURCE 'BODY (OR DESTINATION 'FILEBANGER] (T (SETQ TESTFILE (CL:PROBE-FILE (OR TESTFILE (RETURN "No TESTFILE supplied"] [COND [MAKEWINDOW (SETQ OUTPUTSTREAM (GETSTREAM (MAKEBANGERWINDOW TESTFILE "File Banger") 'OUTPUT] (T (SETQ OUTPUTSTREAM (GETSTREAM T 'OUTPUT] (COND ((NOT MYFILE) [SETQ MYFILE (CL:WITH-OPEN-FILE (TESTFILE TESTFILE :DIRECTION :INPUT) (COPYFILE TESTFILE (PACKFILENAME 'EXTENSION 'FBTESTER 'VERSION NIL 'BODY TESTFILE] (BINCOM MYFILE TESTFILE OPTION OUTPUTSTREAM))) [SETQ TMPFILENAME (OR DESTINATION (PACKFILENAME 'EXTENSION 'FBTEMP 'VERSION NIL 'BODY (OR MYFILE 'FILEBANGER] LP (PRIN1 (add LOOPCNT 1) OUTPUTSTREAM) (RESETLST [RESETSAVE (SETQ NEWFILE (OPENFILE TMPFILENAME 'OUTPUT NIL NIL OUTPARMS )) '(PROGN (CLOSEF OLDVALUE] (CL:WITH-OPEN-FILE (MYFILE MYFILE :DIRECTION :INPUT) (COPYBYTES MYFILE NEWFILE))) (AND LASTFILE (DELFILE LASTFILE)) [RPTQ FBREPEATCOUNT (PROGN (BLOCK) (PRIN1 '%. OUTPUTSTREAM) (COND ((NEQ (BINCOM MYFILE NEWFILE OPTION OUTPUTSTREAM) T) (add ERRCNT 1] (SETQ LASTFILE NEWFILE) (BLOCK) (GO LP]) (FBCOPYBYTES [LAMBDA (INSTREAM ECHOSTREAM START) (* bvm%: "24-JUN-83 19:00") (SETFILEPTR INSTREAM START) (RPTQ 40 (\OUTCHAR ECHOSTREAM (\BIN INSTREAM]) (FBMAKETESTFILE [LAMBDA (LENGTH NAME) (* ; "Edited 1-Oct-87 18:20 by Daniels") (LET ((PATHNAME)) [CL:WITH-OPEN-FILE (FILE (OR NAME "FILEBANGER.TMP") :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION) (SETQ PATHNAME (CL:TRUENAME FILE)) (for I from 1 to (OR LENGTH 1000) do (\OUTCHAR FILE (RAND 32 127] PATHNAME]) (MAKEBANGERWINDOW [LAMBDA (FILE TYPE) (* bvm%: "12-AUG-83 13:06") (PROG (W) [RESETSAVE (TTYDISPLAYSTREAM (SETQ W (CREATEW NIL (CONCAT TYPE " for " FILE] (DSPFONT '(GACHA 8) W) [WINDOWPROP W 'CLOSEFN (FUNCTION (LAMBDA (W P) (AND [PROCESSP (SETQ P (WINDOWPROP W 'PROCESS] (PROCESS.EVAL P '(ERROR!] (WINDOWPROP W '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 '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) 'BREAK)) THISFILE NEWFILE LASTFILE) [SETQ THISFILE (CLOSEF (SETQ TESTFILE1 (OPENFILE (OR TESTFILE1 (RETURN "No TESTFILE supplied" )) 'INPUT] (RESETSAVE NIL (LIST 'CLOSEF? TESTFILE1)) [CLOSEF (SETQ TESTFILE2 (OPENFILE (OR TESTFILE2 (RETURN "No TESTFILE supplied")) 'INPUT] (RESETSAVE NIL (LIST 'CLOSEF? TESTFILE2)) [CLOSEF (SETQ TMPFILENAME (OPENFILE (OR TMPFILENAME 'ZEROBANGER.TMP) 'OUTPUT] (RESETSAVE NIL (LIST 'CLOSEF? TMPFILENAME)) (SETQ OUTPUTSTREAM (GETSTREAM (OR OUTPUTSTREAM (MAKEBANGERWINDOW THISFILE "Zero Banger"))r 'OUTPUT)) LP (COND ((AND N (ILESSP (add N -1) 0)) (RETURN ERRCNT))) (printout OUTPUTSTREAM (add LOOPCNT 1) %,) (OPENFILE TMPFILENAME 'BOTH 'OLD) (OPENFILE THISFILE 'INPUT) (COPYBYTES THISFILE TMPFILENAME 0 -1) (CLOSEF THISFILE) (SETFILEINFO TMPFILENAME '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 '(832 416 190 336]) (WATCHDISKPAGES [LAMBDA (THRESHOLD) (* bvm%: "10-AUG-83 17:11") (OR THRESHOLD (SETQ THRESHOLD 2000)) (while T bind (MARGIN _ THRESHOLD) LASTFILE do (COND ((ILESSP (DISKFREEPAGES) (IPLUS THRESHOLD MARGIN)) (COND (LASTFILE (DELFILE LASTFILE))) (SETQ LASTFILE (CLOSEF PUPTRACEFILE)) (SETQ PUPTRACEFILE (OPENFILE '{DSK}PUPTRACE.TMP 'OUTPUT 'NEW)) (SETQ MARGIN 0))) (BLOCK 60000]) ) (DEFINEQ (BINCOM [LAMBDA (FILE1 FILE2 OPTION OUTPUTSTREAM) (* ; "Edited 1-Oct-87 18:36 by Daniels") (RESETLST (PROG ((STRM1 (OPENSTREAM FILE1 'INPUT 'OLD)) (STRM2 (OPENSTREAM FILE2 'INPUT 'OLD)) HERE B1 B2) (RESETSAVE NIL (LIST 'CLOSEF STRM1)) (RESETSAVE NIL (LIST 'CLOSEF STRM2)) (SETQ OUTPUTSTREAM (GETSTREAM (OR OUTPUTSTREAM T) 'OUTPUT)) (RETURN (COND ((IEQP (GETEOFPTR STRM1) (GETEOFPTR STRM2)) (for I from 1 to (GETEOFPTR STRM1) do (IF (ZEROP (MOD I 5120)) THEN (BLOCK)) (COND ((NEQ (SETQ B1 (\BIN STRM1)) (SETQ B2 (\BIN STRM2))) (COND ((NEQ OPTION '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 'BREAK) (HELP STRM1 STRM2))) (RETURN I))) finally (RETURN T))) (T (COND ((NEQ OPTION 'NOMSG) (printout OUTPUTSTREAM T (FULLNAME STRM1) " has length " |.P2| (GETEOFPTR STRM1) ", but " (FULLNAME STRM2) " has length " |.P2| (GETEOFPTR STRM2) T))) (COND ((EQ OPTION 'BREAK) (HELP STRM1 STRM2))) (LIST (GETEOFPTR STRM1) (GETEOFPTR STRM2]) ) (DEFINEQ (CHECKFORZEROS [LAMBDA (FILE MINZEROS) (* ; "Edited 14-Jun-90 21:18 by jds") (RESETLST (PROG ((STREAM (OPENSTREAM FILE 'INPUT)) (%#FAILURES 0) N) (RESETSAVE NIL (LIST 'CLOSEF STREAM)) (OR MINZEROS (SETQ MINZEROS 20)) (replace (STREAM 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 FILETYPE :COMPILE-FILE) (PUTPROPS FILEBANGER COPYRIGHT ("Venue & Xerox Corporation" 1983 1987 1990)) (DECLARE%: DONTCOPY (FILEMAP (NIL (853 10546 (DOFILEBANGER 863 . 1083) (DOMAKEFILEBANGER 1085 . 1282) (DOZEROBANGER 1284 . 1606) (FILEBANGER 1608 . 4686) (FBCOPYBYTES 4688 . 4884) (FBMAKETESTFILE 4886 . 5345) ( MAKEBANGERWINDOW 5347 . 5899) (MAKEFILEBANGER 5901 . 6714) (ZEROBANGER 6716 . 9360) ( SUSPEND.FILEBANGER 9362 . 9739) (WATCHDISKPAGES 9741 . 10544)) (10547 14583 (BINCOM 10557 . 14581)) ( 14584 15841 (CHECKFORZEROS 14594 . 15839))))) STOP