(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10) (FILECREATED "15-Jun-90 14:12:44" |{DSK}local>lde>lispcore>internal>library>DUMPFILE.;2| 10177 |changes| |to:| (VARS DUMPFILECOMS) |previous| |date:| "16-Dec-88 19:00:26" |{DSK}local>lde>lispcore>internal>library>DUMPFILE.;1|) ; Copyright (c) 1987, 1988, 1990 by Venue & Xerox Corporation. All rights reserved. (PRETTYCOMPRINT DUMPFILECOMS) (RPAQQ DUMPFILECOMS ( (* |;;| "For dumping an octal/hex dump of a file") (FNS DUMPFILE DUMPFILE.HEXBYTE DUMPFILE.NEWPAGE DUMPFILE.PRINTCHAR DUMPFILE.PRINTLINE) (INITVARS (*PRINT-DOTS-FOR-UNPRINTABLE-CHARS*) (*DUMPFILE-HEX-TABLE* "0123456789ABCDEF")))) (* |;;| "For dumping an octal/hex dump of a file") (DEFINEQ (DUMPFILE (LAMBDA (FILE ST ND OUTFILE RADIX) (* \; "Edited 16-Dec-88 18:52 by jds") (* \; "Octal/char file dump") (LET NIL (CL:WITH-OPEN-STREAM (OUTPUT-STREAM (COND (OUTFILE (OPENIMAGESTREAM OUTFILE)) (T (\\GETSTREAM T 'OUTPUT)))) (CL:WITH-OPEN-STREAM (INPUT-STREAM (OR (OPENP FILE) (OPENSTREAM FILE 'INPUT)) X) (STREAMPROP OUTPUT-STREAM 'INFILENAME (FULLNAME INPUT-STREAM)) (STREAMPROP OUTPUT-STREAM 'FILEDATE (DATE)) (STREAMPROP OUTPUT-STREAM 'HDGFONT '(TERMINAL 8 BOLD)) (STREAMPROP OUTPUT-STREAM 'MAINFONT '(TERMINAL 10)) (COND ((IMAGESTREAMTYPEP OUTPUT-STREAM 'INTERPRESS) (STREAMPROP OUTPUT-STREAM 'AFTERNEWPAGEFN (FUNCTION DUMPFILE.NEWPAGE)) (DSPLEFTMARGIN 2540 OUTPUT-STREAM) (DSPRIGHTMARGIN 19050 OUTPUT-STREAM) (DUMPFILE.NEWPAGE OUTPUT-STREAM))) (PROG ((TERM10 (FONTCREATE 'TERMINAL 10 NIL NIL OUTPUT-STREAM)) (TERM6 (FONTCREATE 'TERMINAL 6 NIL NIL OUTPUT-STREAM)) (START (OR ST 0)) (END (OR ND (GETEOFPTR INPUT-STREAM))) (CHARS (ARRAY 16 'SMALLP 0 0)) CH \#CHARS) (SETFILEPTR INPUT-STREAM START) (|for| I |from| START |to| (SUB1 END) |by| 16 |do| (SETQ \#CHARS (IMIN 15 (IDIFFERENCE (SUB1 END) I))) (\\BINS INPUT-STREAM (|fetch| (ARRAYP BASE) |of| CHARS) 0 (ADD1 \#CHARS)) (DUMPFILE.PRINTLINE OUTPUT-STREAM I RADIX CHARS (ADD1 \#CHARS) TERM10 TERM6)))))))) (DUMPFILE.HEXBYTE (LAMBDA (OUTFILE WORD HEXBASE) (* \; "Edited 3-Dec-87 18:13 by jds") (* |;;| "Dump WORD as 4 hexadecimal digits onto OUTFILE. HEXBASE is the pointer to byte 0 of a 16-byte table of character codes for the hex digits.") (\\OUTCHAR OUTFILE (\\GETBASEBYTE HEXBASE (LOGAND 15 (LRSH WORD 12)))) (\\OUTCHAR OUTFILE (\\GETBASEBYTE HEXBASE (LOGAND 15 (LRSH WORD 8)))) (\\OUTCHAR OUTFILE (\\GETBASEBYTE HEXBASE (LOGAND 15 (LRSH WORD 4)))) (\\OUTCHAR OUTFILE (\\GETBASEBYTE HEXBASE (LOGAND 15 WORD))))) (DUMPFILE.NEWPAGE (LAMBDA (OUTFILE) (* |jds| " 9-Feb-86 17:41") (* * |Set| |up| |things| |for| \a |new| |page| |of| |the| |dump|) (* |Prints| \a |heading,| |moves| |to| |the| |first| |line's| |starting|  |spot,| |and| |sets| |the| |font| |back| |to| |Terminal| 10) (PROG ((FILEDATE (CONCAT "Dumped on: " (STREAMPROP OUTFILE 'FILEDATE)))) (MOVETO 2540 26670 OUTFILE) (DSPFONT (STREAMPROP OUTFILE 'HDGFONT) OUTFILE) (PRINTOUT OUTFILE "Dump of file " (STREAMPROP OUTFILE 'INFILENAME)) (MOVETO (IDIFFERENCE 19050 (STRINGWIDTH FILEDATE OUTFILE)) 26670 OUTFILE) (PRIN1 FILEDATE OUTFILE) (DRAWLINE 2540 26635 19050 26635 35 'PAINT OUTFILE) (MOVETO 2540 25400 OUTFILE) (DSPFONT (STREAMPROP OUTFILE 'MAINFONT) OUTFILE)))) (DUMPFILE.PRINTCHAR (LAMBDA (OUTFILE CHAR WASTERM10 TERM10 TERM6) (* \; "Edited 28-Jul-87 18:08 by jds") (* |;;;| "Print a single character in the char part of the listing") (* \;  "Returns T if it leaves OUTFILE in TERMINAL 10.") (PROG ((A10WIDTH (CHARWIDTH (CHARCODE A) TERM10)) (A6WIDTH (CHARWIDTH (CHARCODE A) TERM6)) (CURX (DSPXPOSITION NIL OUTFILE)) (CURY (DSPYPOSITION NIL OUTFILE)) (ASC10 (FONTPROP TERM10 'ASCENT)) (ASC6 (FONTPROP TERM6 'ASCENT))) (COND ((AND *PRINT-DOTS-FOR-UNPRINTABLE-CHARS* (OR (ILEQ CHAR 31) (IGEQ CHAR 127))) (\\OUTCHAR OUTFILE (CONSTANT (CHARCODE "."))) (SETQ WASTERM10 T)) ((ILEQ CHAR 31) (* \;  "It's a control character; print ^ & char in 6pt in 1 10pt char's block.") (SETQ WASTERM10 NIL) (DSPFONT TERM6 OUTFILE) (MOVETO CURX (IPLUS CURY (IDIFFERENCE ASC10 ASC6)) OUTFILE) (PRIN1 "^" OUTFILE) (MOVETO (IPLUS CURX (IDIFFERENCE A10WIDTH A6WIDTH)) CURY OUTFILE) (\\OUTCHAR OUTFILE (IPLUS CHAR 64))) ((IGEQ CHAR 127) (* \;  "It's a special. Print a name or .. in 6pt in one 10pt char's block") (SETQ WASTERM10 NIL) (DSPFONT TERM6 OUTFILE) (PRIN1 "." OUTFILE) (MOVETO (IPLUS CURX (IDIFFERENCE A10WIDTH A6WIDTH)) CURY OUTFILE) (PRIN1 "." OUTFILE)) (T (* \; "Just print the character.") (OR WASTERM10 (DSPFONT TERM10 OUTFILE)) (* \;  "Regular characters always print in Terminal 10") (SETQ WASTERM10 T) (\\OUTCHAR OUTFILE CHAR))) (RETURN WASTERM10)))) (DUMPFILE.PRINTLINE (LAMBDA (OUTFILE ADDR RADIX CHARS \#CHARS TERM10 TERM6)(* \; "Edited 16-Dec-88 18:39 by jds") (* |;;;| "Print out one line of a file dump") (PROG ((BASE (|fetch| (ARRAYP BASE) |of| CHARS)) (HEXBASE (|fetch| (STRINGP BASE) |of| *DUMPFILE-HEX-TABLE*)) (WASTERM10 T)) (SELECTQ RADIX (8 (|printout| OUTFILE |.I10.8| ADDR |,,,|)) (16 (|for| I |from| 28 |to| 0 |by| -4 |do| (\\OUTCHAR OUTFILE (\\GETBASEBYTE HEXBASE (LOGAND 15 (LRSH ADDR I))))) (|for| I |from| 1 |to| 3 |do| (\\OUTCHAR OUTFILE (CHARCODE SPACE)))) (10 (|printout| OUTFILE |.I10| ADDR |,,,|)) (|printout| OUTFILE |.I10.8| ADDR |,,,|)) (* \;  "Print the current file address for the start of this line") (|for| CH# |from| 0 |to| (SELECTQ RADIX (16 (SUB1 (LRSH (ADD1 \#CHARS) 1))) (SUB1 \#CHARS)) |do| (SELECTQ RADIX (8 (|printout| OUTFILE |.I4.8| (\\GETBASEBYTE BASE CH#))) (16 (\\OUTCHAR OUTFILE (CHARCODE SPACE)) (DUMPFILE.HEXBYTE OUTFILE (\\GETBASE BASE CH#) HEXBASE)) (10 (|printout| OUTFILE |.I4| (\\GETBASEBYTE BASE CH#))) (|printout| OUTFILE |.I4.8| (\\GETBASEBYTE BASE CH#)))) (SPACES 3 OUTFILE) (PRIN1 "|" OUTFILE) (|for| CH# |from| 0 |to| (SUB1 \#CHARS) |do| (SETQ WASTERM10 (DUMPFILE.PRINTCHAR OUTFILE (\\GETBASEBYTE BASE CH#) WASTERM10 TERM10 TERM6))) (COND ((NOT WASTERM10) (* \;  "If the last character was a special char, then we were left in terminal 6; need to switch back.") (DSPFONT TERM10 OUTFILE))) (PRIN1 "|" OUTFILE) (TERPRI OUTFILE)))) ) (RPAQ? *PRINT-DOTS-FOR-UNPRINTABLE-CHARS* ) (RPAQ? *DUMPFILE-HEX-TABLE* "0123456789ABCDEF") (PUTPROPS DUMPFILE COPYRIGHT ("Venue & Xerox Corporation" 1987 1988 1990)) (DECLARE\: DONTCOPY (FILEMAP (NIL (904 9977 (DUMPFILE 914 . 3560) (DUMPFILE.HEXBYTE 3562 . 4154) (DUMPFILE.NEWPAGE 4156 . 5124) (DUMPFILE.PRINTCHAR 5126 . 7458) (DUMPFILE.PRINTLINE 7460 . 9975))))) STOP