Commit ad01c06c authored by Frode Vatvedt Fjeld's avatar Frode Vatvedt Fjeld

*** empty log message ***

parents
# CVS default ignores begin
tags
TAGS
.make.state
.nse_depinfo
*~
#*
.#*
,*
_$*
*$
*.old
*.bak
*.BAK
*.orig
*.rej
.del-*
*.a
*.olb
*.o
*.obj
*.so
*.exe
*.Z
*.elc
*.ln
core
# CVS default ignores end
######################################################################
##
## Copyright (C) 1999,
## Department of Computer Science, University of Tromsø, Norway
##
## Filename: COPYING
## Description: Defines the terms under which this software may be copied.
## Author: Frode Vatvedt Fjeld <frodef@acm.org>
## Created at: Mon Nov 8 20:32:12 1999
## Distribution: See the accompanying file COPYING.
##
## $Id: COPYING,v 1.1 1999/12/08 14:38:34 frodef Exp $
##
######################################################################
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
are met:
1. Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.
3. Neither the name of the University nor the names of its contributors
may be used to endorse or promote products derived from this software
without specific prior written permission.
\ No newline at end of file
This diff is collapsed.
######################################################################
##
## Copyright (C) 2001,2000,1999, 2003
## Department of Computer Science, University of Troms, Norway
##
## Filename: Makefile
## Author: Frode Vatvedt Fjeld <frodef@acm.org>
## Created at: Wed Sep 29 19:28:52 1999
##
## $Id: Makefile,v 1.11 2003/12/11 11:34:45 frodef Exp $
##
######################################################################
SCP = scp -oProtocol=1
SSH = ssh -1
DIST_EXTRAS = README README-bitfield ChangeLog COPYING type-hierarchy.ps type-hierarchy.png
dist: binary-types.lisp $(DIST_EXTRAS)
@ if [ ! "${VER}" ]; then echo 'You must set $$VER!'; exit 5; fi
mkdir binary-types-$(VER)
cp *.lisp $(DIST_EXTRAS) binary-types-$(VER)
tar czf binary-types-$(VER).tar.gz binary-types-$(VER)
rm -rf binary-types-$(VER)
updist: dist
- $(SSH) www.stud "mv www/sw/binary-types/*.tar.gz www/sw/binary-types/old"
$(SCP) binary-types-$(VER).tar.gz www.stud:www/sw/binary-types/
$(SCP) $(DIST_EXTRAS) www.stud:www/sw/binary-types/
@ echo "Remember cvs TAG REL_x_xx"
repdist: dist
- $(SSH) www.stud "rm www/sw/binary-types/*.tar.gz"
$(SCP) binary-types-$(VER).tar.gz www.stud:www/sw/binary-types/
$(SCP) $(DIST_EXTRAS) www.stud:www/sw/binary-types/
@ echo "Remember cvs TAG REL_x_xx"
clean:
rm -f *.fasl memdump *~
force:
######################################################################
##
## Copyright (C) 2001,2000, 2003
## Department of Computer Science, University of Tromsø, Norway
##
## Filename: README
## Author: Frode Vatvedt Fjeld <frodef@acm.org>
## Created at: Wed Dec 8 15:35:53 1999
## Distribution: See the accompanying file COPYING.
##
## $Id: README,v 1.21 2003/12/11 11:28:21 frodef Exp $
##
######################################################################
Binary-types is a Common Lisp package for reading and writing binary
files. Binary-types provides macros that are used to declare the
mapping between lisp objects and some binary (i.e. octet-based)
representation.
Supported kinds of binary types include:
* Signed and unsigned integers of any octet-size, big-endian or
little-endian. Maps to lisp integers.
* Enumerated types based on any integer type. Maps to lisp symbols.
* Complex bit-field types based on any integer type. Sub-fields can
be numeric, enumerated, or bit-flags. Maps to lisp lists of symbols
and integers.
* Fixed-length and null-terminated strings. Maps to lisp strings.
* Compound records of other binary types. Maps to lisp DEFCLASS
classes or, when you prefer, DEFSTRUCT structs.
Typically, a complete binary record format/type can be specified in a
single (nested) declaration statement. Such compound records may then
be read and written with READ-BINARY and WRITE-BINARY.
Binary-types is *not* helpful in reading files with variable
bit-length code-words, such as most compressed file formats. It will
basically only work with file-formats based on 8-bit bytes
(octets). Also, at this time no floating-point types are supported out
of the box.
Binary types may now be declared with the DEFINE-BINARY-CLASS macro,
which has the same syntax (and semantics) as DEFCLASS, only there is
an additional slot-option (named :BINARY-TYPE) that declares that
slot's binary type. Note that the binary aspects of slots are *not*
inherited (the semantics of inheriting binary slots is unclear to me).
Another slot-option added by binary-types is :MAP-BINARY-WRITE, which
names a function (of two arguments) that is applied to the slot's
value and the name of the slot's binary-type in order to obtain the
value that is actually passed to WRITE-BINARY. Similarly,
:MAP-BINARY-READ takes a function that is to be applied to the binary
data and type-name when a record of that type is being read. A
slightly modified version of :map-binary-read is
:MAP-BINARY-READ-DELAYED, which will do essentially the same thing as
:map-binary-read, only the mapping will be "on-demand": A slot-unbound
method will be created for this purpose.
A variation of the :BINARY-TYPE slot-option is :BINARY-LISP-TYPE,
which does everything :BINARY-TYPE does, but also passes on a :TYPE
slot-option to DEFCLASS (or DEFSTRUCT). The type-spec is inferred
from the binary-type declaration. When using this mechanism, you
should be careful to always provide a legal value in the slot (as you
must always do when declaring slots' types). If you find this
confusing, just use :BINARY-TYPE.
Performance has not really been a concern for me while designing this
package. There's no obvious performance bottlenecks that I know of,
but keep in mind that all "binary" reads and writes are reduced to
individual 8-bit READ-BYTEs and WRITE-BYTEs. If you do identify
particular performance bottlenecks, let me know.
The included file "example.lisp" demonstrates how to use this
package. To give you a taste of what it looks like, the following
declarations are enough to read the header of an ELF executable file
with the form
(let ((*endian* :big-endian))
(read-binary 'elf-header stream)
;;; ELF basic type declarations
(define-unsigned word 4)
(define-signed sword 4)
(define-unsigned addr 4)
(define-unsigned off 4)
(define-unsigned half 2)
;;; ELF file header structure
(define-binary-class elf-header ()
((e-ident
:binary-type (define-binary-struct e-ident ()
(ei-magic nil :binary-type
(define-binary-struct ei-magic ()
(ei-mag0 0 :binary-type u8)
(ei-mag1 #\null :binary-type char8)
(ei-mag2 #\null :binary-type char8)
(ei-mag3 #\null :binary-type char8)))
(ei-class nil :binary-type
(define-enum ei-class (u8)
elf-class-none 0
elf-class-32 1
elf-class-64 2))
(ei-data nil :binary-type
(define-enum ei-data (u8)
elf-data-none 0
elf-data-2lsb 1
elf-data-2msb 2))
(ei-version 0 :binary-type u8)
(padding nil :binary-type 1)
(ei-name "" :binary-type
(define-null-terminated-string ei-name 8))))
(e-type
:binary-type (define-enum e-type (half)
et-none 0
et-rel 1
et-exec 2
et-dyn 3
et-core 4
et-loproc #xff00
et-hiproc #xffff))
(e-machine
:binary-type (define-enum e-machine (half)
em-none 0
em-m32 1
em-sparc 2
em-386 3
em-68k 4
em-88k 5
em-860 7
em-mips 8))
(e-version :binary-type word)
(e-entry :binary-type addr)
(e-phoff :binary-type off)
(e-shoff :binary-type off)
(e-flags :binary-type word)
(e-ehsize :binary-type half)
(e-phentsize :binary-type half)
(e-phnum :binary-type half)
(e-shentsize :binary-type half)
(e-shnum :binary-type half)
(e-shstrndx :binary-type half)))
For a second example, here's an approach to supporting floats:
(define-bitfield ieee754-single-float (u32)
(((:enum :byte (1 31))
positive 0
negative 1)
((:numeric exponent 8 23))
((:numeric significand 23 0))))
The postscript file "type-hierarchy.ps" shows the binary types
hierarchy. It is generated using psgraph from the CMU lisp
repository:
(with-open-file (*standard-output* "type-hierarchy.ps"
:direction :output
:if-exists :supersede)
(psgraph:psgraph 'binary-type
#'(lambda (p)
(mapcar #'class-name
(aclmop:class-direct-subclasses
(find-class p))))
#'(lambda (s) (list (symbol-name s)))
t))
> My only problem is with DEF-BITFIELD. All other BINARY-TYPES
> features are intuitive and easy to use.
Hi, you are right that DEF-BITFIELD is poorly documented. I think
that's because it's a bit complex and I'm not quite confident it is
the way it should be. Anyways, here are a couple of examples:
(define-bitfield r-info (u32)
(((:enum :byte (8 0))
r-386-none 0
r-386-32 1
r-386-pc32 2
r-386-got32 3
r-386-plt32 4
r-386-copy 5
r-386-glob-dat 6
r-386-jmp-slot 7
r-386-relative 8
r-386-gotoff 9
r-386-gotpc 10)
((:numeric r-sym 24 8))))
This declares R-INFO to be an unsigned 32-bit number, divided into two
fields. The first field resides in bits 0-7, and is one of the values
r-386-xx. The second field is a numeric value that resides in bits
8-23. So this type R-INFO may for example have symbolic value
(r-386-pc32 (r-sym . 1)), which translates to a numeric value of
(logior 2 1<<8)) = 258.
Another example:
(define-bitfield p-flags (u8)
(((:bits)
pf-x 0
pf-w 1
pf-r 2)))
Here P-FLAGS has just one bit-field, where bit 0 is named PF-X, bit 1
is named PF-W etc. So the value (PF-X PF-R) maps to 5.
As you may see by now, DEF-BITFIELD divides a numeric base-type
(typically an unsigned integer) into a number of fields, where each
field is one of :BITS for bitmaps, :ENUM for an enumerated field
(takes an optional :BYTE <bytespec>), and finally :NUMERIC <byte-size>
<byte-pos> for a subfield that is a number.
Hope this helps.
--
Frode Vatvedt Fjeld
This diff is collapsed.
;;;;------------------------------------------------------------------
;;;;
;;;; Copyright (C) 200120001999,
;;;; Department of Computer Science, University of Troms, Norway
;;;;
;;;; Filename: example.lisp
;;;; Description:
;;;; Author: Frode Vatvedt Fjeld <frodef@acm.org>
;;;; Created at: Wed Dec 8 15:15:06 1999
;;;; Distribution: See the accompanying file COPYING.
;;;;
;;;; $Id: example.lisp,v 1.18 2003/12/11 11:28:21 frodef Exp $
;;;;
;;;;------------------------------------------------------------------
(defpackage "EXAMPLE"
(:use "COMMON-LISP" "BINARY-TYPES")
(:export run))
(in-package "EXAMPLE")
;;; ELF basic types
(define-unsigned word 4)
(define-signed sword 4)
(define-unsigned addr 4)
(define-unsigned off 4)
(define-unsigned half 2)
;;; Mapping from ELF symbols to BT:*ENDIAN* values
(defun elf-data-to-endian (elf-data)
(ecase elf-data
((elf-data-2lsb) :little-endian)
((elf-data-2msb) :big-endian)))
(defconstant +ELF-MAGIC+ '(#x7f #\E #\L #\F))
;;; ELF file header structure
(define-binary-class elf-header ()
((e-ident
:binary-type (define-binary-struct e-ident ()
(ei-magic nil :binary-type
(define-binary-struct ei-magic ()
(ei-mag0 0 :binary-type u8)
(ei-mag1 #\null :binary-type char8)
(ei-mag2 #\null :binary-type char8)
(ei-mag3 #\null :binary-type char8)))
(ei-class nil :binary-type
(define-enum ei-class (u8)
elf-class-none 0
elf-class-32 1
elf-class-64 2))
(ei-data nil :binary-type
(define-enum ei-data (u8)
elf-data-none 0
elf-data-2lsb 1
elf-data-2msb 2))
(ei-version 0 :binary-type u8)
(padding nil :binary-type 1)
(ei-name "" :binary-type
(define-null-terminated-string ei-name 8))))
(e-type
:binary-type (define-enum e-type (half)
et-none 0
et-rel 1
et-exec 2
et-dyn 3
et-core 4
et-loproc #xff00
et-hiproc #xffff))
(e-machine
:binary-type (define-enum e-machine (half)
em-none 0
em-m32 1
em-sparc 2
em-386 3
em-68k 4
em-88k 5
em-860 7
em-mips 8))
(e-version :binary-type word)
(e-entry :binary-type addr)
(e-phoff :binary-type off)
(e-shoff :binary-type off)
(e-flags :binary-type word)
(e-ehsize :binary-type half)
(e-phentsize :binary-type half)
(e-phnum :binary-type half)
(e-shentsize :binary-type half)
(e-shnum :binary-type half)
(e-shstrndx :binary-type half)))
(define-condition elf32-reader-error (error)
((stream :initarg :stream :reader elf32-parse-error-stream)
(message :initarg :message :reader elf32-parse-error-message))
(:report (lambda (condition stream)
(princ (elf32-parse-error-message condition)
stream))))
(define-condition elf32-wrong-magic (elf32-reader-error)
((magic :initarg :magic :reader elf32-wrong-magic-magic)))
(define-condition elf32-wrong-class (elf32-reader-error)
((class :initarg :class :reader elf32-wrong-class-class)))
(defun read-elf-file-header (stream)
"Returns an ELF-HEADER and the file's endianess."
(let ((header (read-binary 'elf-header stream :stop 'e-type)))
(with-slots (ei-data ei-class ei-magic)
(slot-value header 'e-ident)
(let* ((binary-types:*endian* (elf-data-to-endian ei-data))
(magic (mapcar #'(lambda (slot-name)
(slot-value ei-magic slot-name))
(binary-record-slot-names 'ei-magic))))
;; Check that file is in fact 32-bit ELF
(unless (equal +ELF-MAGIC+ magic)
(error 'elf32-wrong-magic
:stream stream
:message (format nil "file doesn't match ELF-MAGIC: ~A" magic)
:magic magic))
(unless (eq 'elf-class-32 ei-class)
(error 'elf32-wrong-class
:stream stream
:message (format nil "file is not 32-bit ELF (~A)" ei-class)
:class ei-class))
;; Read the rest of the file-header and merge it with what
;; we've allready got.
(let ((rest (read-binary 'elf-header stream :start 'e-type)))
(dolist (slot-name (binary-record-slot-names 'elf-header))
(unless (slot-boundp header slot-name)
(setf (slot-value header slot-name)
(slot-value rest slot-name))))
(values header binary-types:*endian*))))))
(defun run (path)
(with-binary-file (stream path :direction :input)
(let ((elf-header (read-elf-file-header stream)))
(format t "~&ELF header for \"~A\":~:{~&~12@A: ~S~}~%" path
(mapcar #'(lambda (slot-name)
(list slot-name
(slot-value elf-header slot-name)))
(binary-record-slot-names 'elf-header)))
elf-header)))
#+unix
(run "/bin/ls")
%!PS-Adobe-1.0
%%Page: ? ?
/max {2 copy lt {exch} if pop} def
/min {2 copy gt {exch} if pop} def
/inch {72 mul} def
/drawbox
{/height exch def
/width exch def
/y exch def
/x exch def
gsave newpath
x y boxradius add moveto
x y height add x width add y height add boxradius arcto pop pop pop pop
x width add y height add x width add y boxradius arcto pop pop pop pop
x width add y x y boxradius arcto pop pop pop pop
x y x y height add boxradius arcto pop pop pop pop
boxgray setgray boxkind grestore
} def
/printposter
{/rows exch def
/columns exch def
/bigpictureproc exch def
newpath
leftmargin botmargin moveto
0 pageheight rlineto
pagewidth 0 rlineto
0 pageheight neg rlineto
closepath clip
leftmargin botmargin translate
0 1 rows 1 sub
{/rowcount exch def
0 1 columns 1 sub
{/colcount exch def
gsave
pagewidth colcount mul neg
pageheight rowcount mul neg
translate
bigpictureproc
gsave showpage grestore
grestore
} for
} for
} def
/xarray 10 array def
/widtharray 10 array def
/leftmargin 36 def
/botmargin 36 def
/pagewidth 540 def
/pageheight 720 def
/boxradius 5 def
/boxedge 2 def
/boxgray .2 def
/boxkind {stroke} def
/Helvetica findfont 10 scalefont setfont
widtharray 0 (BINARY-TYPE) stringwidth pop put
widtharray 1 (BITFIELD) stringwidth pop put
widtharray 2 (BINARY-RECORD) stringwidth pop put
widtharray 3 (BINARY-STRUCT) stringwidth pop put
widtharray 4 (BINARY-CLASS) stringwidth pop put
widtharray 5 (BINARY-STRING) stringwidth pop put
widtharray 6 (BINARY-CHAR8) stringwidth pop put
widtharray 7 (BINARY-INTEGER) stringwidth pop put
widtharray 8 (BINARY-SIGNED) stringwidth pop put
widtharray 9 (BINARY-UNSIGNED) stringwidth pop put
/Helvetica-Oblique findfont 8 scalefont setfont
widtharray 0 get
4 add widtharray exch 0 exch put
widtharray 1 get
4 add widtharray exch 1 exch put
widtharray 2 get
4 add widtharray exch 2 exch put
widtharray 3 get
4 add widtharray exch 3 exch put
widtharray 4 get
4 add widtharray exch 4 exch put
widtharray 5 get
4 add widtharray exch 5 exch put
widtharray 6 get
4 add widtharray exch 6 exch put
widtharray 7 get
4 add widtharray exch 7 exch put
widtharray 8 get
4 add widtharray exch 8 exch put
widtharray 9 get
4 add widtharray exch 9 exch put
xarray 0 0 put
xarray 0 get widtharray 0 get add
20 add xarray exch 1 exch put
xarray 0 get widtharray 0 get add
20 add xarray exch 2 exch put
xarray 2 get widtharray 2 get add
20 add xarray exch 3 exch put
xarray 2 get widtharray 2 get add
20 add xarray exch 4 exch put
xarray 0 get widtharray 0 get add
20 add xarray exch 5 exch put
xarray 0 get widtharray 0 get add
20 add xarray exch 6 exch put
xarray 0 get widtharray 0 get add
20 add xarray exch 7 exch put
xarray 7 get widtharray 7 get add
20 add xarray exch 8 exch put
xarray 7 get widtharray 7 get add
20 add xarray exch 9 exch put
/maximum-x 0
xarray 0 get widtharray 0 get add max
xarray 1 get widtharray 1 get add max
xarray 2 get widtharray 2 get add max
xarray 3 get widtharray 3 get add max
xarray 4 get widtharray 4 get add max
xarray 5 get widtharray 5 get add max
xarray 6 get widtharray 6 get add max
xarray 7 get widtharray 7 get add max
xarray 8 get widtharray 8 get add max
xarray 9 get widtharray 9 get add max
def
94 dict begin
/box0 {
xarray 0 get 67 widtharray 0 get 14 drawbox
} def
/box1 {
xarray 1 get 123 widtharray 1 get 14 drawbox
} def
/box2 {
xarray 2 get 93 widtharray 2 get 14 drawbox
} def
/box3 {
xarray 3 get 103 widtharray 3 get 14 drawbox
} def
/box4 {
xarray 4 get 83 widtharray 4 get 14 drawbox
} def
/box5 {
xarray 5 get 63 widtharray 5 get 14 drawbox
} def
/box6 {
xarray 6 get 43 widtharray 6 get 14 drawbox
} def
/box7 {
xarray 7 get 13 widtharray 7 get 14 drawbox
} def
/box8 {
xarray 8 get 23 widtharray 8 get 14 drawbox
} def
/box9 {
xarray 9 get 3 widtharray 9 get 14 drawbox
} def
/text0 {xarray 0 get boxedge add 71 moveto (BINARY-TYPE) show} def
/text1 {xarray 1 get boxedge add 127 moveto (BITFIELD) show} def
/text2 {xarray 2 get boxedge add 97 moveto (BINARY-RECORD) show} def
/text3 {xarray 3 get boxedge add 107 moveto (BINARY-STRUCT) show} def
/text4 {xarray 4 get boxedge add 87 moveto (BINARY-CLASS) show} def
/text5 {xarray 5 get boxedge add 67 moveto (BINARY-STRING) show} def
/text6 {xarray 6 get boxedge add 47 moveto (BINARY-CHAR8) show} def
/text7 {xarray 7 get boxedge add 17 moveto (BINARY-INTEGER) show} def
/text8 {xarray 8 get boxedge add 27 moveto (BINARY-SIGNED) show} def
/text9 {xarray 9 get boxedge add 7 moveto (BINARY-UNSIGNED) show} def
/edge0 {newpath
stroke } def
/edge1 {newpath
xarray 0 get widtharray 0 get add 74 moveto
xarray 1 get 130 lineto
stroke } def
/edge2 {newpath
xarray 0 get widtharray 0 get add 74 moveto
xarray 2 get 100 lineto
stroke } def
/edge3 {newpath
xarray 2 get widtharray 2 get add 100 moveto
xarray 3 get 110 lineto
stroke } def
/edge4 {newpath
xarray 2 get widtharray 2 get add 100 moveto
xarray 4 get 90 lineto
stroke } def
/edge5 {newpath
xarray 0 get widtharray 0 get add 74 moveto
xarray 5 get 70 lineto
stroke } def
/edge6 {newpath
xarray 0 get widtharray 0 get add 74 moveto
xarray 6 get 50 lineto
stroke } def
/edge7 {newpath
xarray 0 get widtharray 0 get add 74 moveto
xarray 7 get 20 lineto
stroke } def
/edge8 {newpath
xarray 7 get widtharray 7 get add 20 moveto
xarray 8 get 30 lineto
stroke } def
/edge9 {newpath
xarray 7 get widtharray 7 get add 20 moveto
xarray 9 get 10 lineto
stroke } def
/boxchunk0 {
box0
box1
box2
box3
box4
box5
box6
box7
box8
box9
} def
/textchunk0 {
text0
text1
text2
text3
text4
text5
text6
text7
text8
text9
} def
/secondtextchunk0 {
} def
/edgechunk0 {
edge0
edge1
edge2
edge3
edge4
edge5
edge6
edge7
edge8
edge9
} def
/drawgraph { gsave
boxchunk0
.5 setlinewidth
1 setlinecap
.2 setgray
edgechunk0
0 setgray
/Helvetica findfont 10 scalefont setfont
textchunk0
/Helvetica-Oblique findfont 8 scalefont setfont
secondtextchunk0
grestore } def
leftmargin botmargin translate
pagewidth dup maximum-x max div pageheight dup 140 max div min dup scale
drawgraph showpage end
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment