In article <················@naggum.no> Erik Naggum <····@naggum.no> writes:
From: Erik Naggum <····@naggum.no>
Date: 14 Aug 1995 19:08:25 GMT
Organization: Naggum Software; +47 2295 0313
Lines: 46
[Jonah Thomas]
| Well, it doesn't look like a big effort. I put an hour into writing
| and testing the code. ... If he mentions the ANSI Standard for Forth
| then I figure Forth is likely to get valuable publicity. ... As it
| turned out, a lot of my code duplicated things from optional wordsets.
| It's extremely simple if you can assume those optional words are there.
ok, you got me. here's what I sent Jerry Fitzpatrick:
I don't necessarily think you're doing the right thing in asking for code
examples for this simple task, but just to avoid the situation where Lisp
is left out, I'm submitting this example in ANSI Common Lisp.
#<Erik 3017177764>
(defun dump-file (file)
"Dump FILE with hexadecimal bytes and printable ASCII."
(with-open-file (input file)
(do* ((buffer (make-string 16))
(address (file-position input) (file-position input))
(line (read-sequence buffer input) (read-sequence buffer input)))
((= line 0) (format t "~&~8,'0X~%" address))
(format t "~&~8,'0X ~V{~2,'0X ~}~61T~V{~A~}" address
line (map 'list #'char-code buffer)
line (map 'list (lambda (char)
(if (graphic-char-p char)
char #\.))
buffer)))))
This is pretty good, but it conses quite a bit (the two 'map' are
elegant but potentially expensive, 'map-into' could be used with a
'list-buffer' but maybe it is not worth the trouble).
Here is my rewrite of the program. If you remove the comments and the
declarations (which help a lot with CMUCL) the length of the code is
not much more than Erik's.
The code was written for CMUCL 17f running on a Sparc10 under Solaris.
This code is at the level of UN*X 'read' and 'write' syscalls.
READ-SEQUENCE is ANSI CL and it is assumed to behave like UN*X 'read'
(which might not be the case in implementation X). A 'buffered input'
wrapper - a' la` 'getchar' - around 'READ-SEQUENCE' could be easily
written. (See e.g. the 'fast-io' code in the AI.Repository at CMU).
All in all the point is that you can write efficient code in CL and
have all the bells and whistles of other (*WARNING* this is a flame
bait :) ) obviously less powerful languages :). It also makes the point
that any piece of code gets longer if lower level constructs are used
for the sake of efficiency and comments are included to explain the
inner working of the program. (Most of the comments are for non Common
Lisp programmers).
Finally, I am sure that the piece of code could easily be made more
efficient or rewritten in other ways.
===============================================================================
;;; The DEFPACKAGE would go in a different file
(defpackage "HEXDUMP"
(:use "COMMON-LISP")
(:export "HEX-DUMP"))
;;;----------------------------------------------------------------------------
(in-package "HEXDUMP")
(defparameter *block-size* 16
"The size of the buffer to be read in at once")
(defun HEX-DUMP (filename)
"Opens a file, reads and dumps it in HEX/ASCII on '*standard-output*'.
The format of the input file is assumed to be 'unsigned-bytes'. The
format of the output is similar to the one of the UN*X utility 'od'."
;; The string above is a 'documentation string' which CL integrated
;; environments (even bare bone ones like ILISP under Emacs) use for
;; a variety of documenting purposes. All the 'define' constructs of
;; CL have this feature.
;; FLET introduces local, non recursive functions.
;; The two local functions 'print-hex' and 'print-ASCII' scan the
;; buffer and print out its content to 'stream'.
;; They are not strictly necessary, but make the code somewhat
;; cleaner.
(flet ((print-hex (buffer n-bytes stream)
(declare (type (array unsigned-byte *) buffer)
(type fixnum n-bytes))
(loop for i of-type fixnum from 0 below n-bytes
do (format stream "~2,'0X " (aref buffer i))
;; The call to FORMAT must be read as
;; "print a number in hexadecimal format, using a
;; field width equal to 2, and a 0 as a leading
;; padding character".
))
(print-ASCII (buffer n-bytes stream)
(declare (type (array unsigned-byte *) buffer)
(type fixnum n-bytes))
;; Note that we are reading 'unsigned-byte's. Hence we need
;; an explicit type coercion.
(loop for i of-type fixnum from 0 below n-bytes
for c = (coerce (aref buffer i) 'base-char)
do (format stream "~C" (if (graphic-char-p c) c #\.))
;; The call to FORMAT must be read as "print a character".
;; The standard predicate 'graphic-char-p' returns
;; true if the character has a graphic representation.
))
)
;; The 'with-open-file' is a macro (which cannot be easily
;; reproduced with the C preprocessor) which opens the file for
;; input and does a few other tricks, like conditions
;; (i.e. exception) signalling, and file closing at the end or in
;; case of errors.
(with-open-file (in filename
:direction :input
:element-type 'unsigned-byte
:if-does-not-exist :error
)
;; LET introduces new variable bindings
(let ((buffer (make-array *block-size*
:element-type 'unsigned-byte
:initial-element 0)))
;; The local 'buffer' variable is the temporary
;; repository for the bytes read.
(declare (type (array unsigned-byte *) buffer)
(dynamic-extent buffer))
;; The 'dynamic-extent' declaration advises the compiler to
;; allocate 'buffer' on the stack, if it can.
;; LOOP is an extremely powerful (and complicated) macro that
;; offers a variety of ways to iterate over various CL data
;; structures while keeping track of local variable bindings.
(loop for bytes-read of-type fixnum = (read-sequence buffer in)
for file-address of-type (integer 0 *) = (file-position in)
while (plusp bytes-read)
do (progn (format *standard-output* "~&~8,'0X " file-address)
(print-hex buffer bytes-read *standard-output*)
(format *standard-output* "~61T")
;; This FORMAT moves the 'printing head' to
;; column 61, unless this is already there (or
;; past it).
(print-ASCII buffer bytes-read *standard-output*))
finally (format *standard-output* "~&~8,'0X~%" file-address)
))
)))
===============================================================================
Cheers
--
Marco G. Antoniotti - Resistente Umano
-------------------------------------------------------------------------------
Robotics Lab | room: 1220 - tel. #: (212) 998 3370
Courant Institute NYU | e-mail: ·······@cs.nyu.edu
| WWW: http://found.cs.nyu.edu/marcoxa
...e` la semplicita` che e` difficile a farsi.
...it is simplicity that is difficult to make.
Bertholdt Brecht