Move internal/library to internal, xerox font dirs, loadup and medleydir (#709)
* Move internal/library to internal, xerox font dirs, loadup and medleydir * and MEDLEYDIR too * mised some changes in 'promote/internal' * tiny typo
This commit is contained in:
Larry Masinter
GitHub
194
internal/DUMPFILE
Normal file
194
internal/DUMPFILE
Normal file
@@ -0,0 +1,194 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
(FILECREATED "15-Jun-90 14:12:44" |{DSK}<usr>local>lde>lispcore>internal>library>DUMPFILE.;2| 10177
|
||||
|
||||
|changes| |to:| (VARS DUMPFILECOMS)
|
||||
|
||||
|previous| |date:| "16-Dec-88 19:00:26"
|
||||
|{DSK}<usr>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
|
||||
Reference in New Issue
Block a user