From 0227ff8dc479579039de2bc3600ea2ab2e5712d9 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Fri, 19 Aug 2011 13:13:34 -0700
Subject: [PATCH] classes.struct.packed: adding support for packed structures.

---
 extra/classes/struct/packed/authors.txt       |  1 +
 .../classes/struct/packed/packed-tests.factor | 17 +++++++
 extra/classes/struct/packed/packed.factor     | 50 +++++++++++++++++++
 extra/classes/struct/packed/summary.txt       |  1 +
 4 files changed, 69 insertions(+)
 create mode 100644 extra/classes/struct/packed/authors.txt
 create mode 100644 extra/classes/struct/packed/packed-tests.factor
 create mode 100644 extra/classes/struct/packed/packed.factor
 create mode 100644 extra/classes/struct/packed/summary.txt

diff --git a/extra/classes/struct/packed/authors.txt b/extra/classes/struct/packed/authors.txt
new file mode 100644
index 0000000000..e091bb8164
--- /dev/null
+++ b/extra/classes/struct/packed/authors.txt
@@ -0,0 +1 @@
+John Benediktsson
diff --git a/extra/classes/struct/packed/packed-tests.factor b/extra/classes/struct/packed/packed-tests.factor
new file mode 100644
index 0000000000..4ff264265e
--- /dev/null
+++ b/extra/classes/struct/packed/packed-tests.factor
@@ -0,0 +1,17 @@
+
+USING: alien.c-types classes.struct.packed tools.test words ;
+
+IN: classes.struct.packed
+
+PACKED-STRUCT: abcd
+    { a int }
+    { b int }
+    { c int }
+    { d int }
+    { e short }
+    { f int }
+    { g int }
+    { h int }
+;
+
+[ 30 ] [ \ abcd "struct-size" word-prop ] unit-test
diff --git a/extra/classes/struct/packed/packed.factor b/extra/classes/struct/packed/packed.factor
new file mode 100644
index 0000000000..2f2b1ac8d8
--- /dev/null
+++ b/extra/classes/struct/packed/packed.factor
@@ -0,0 +1,50 @@
+! Copyright (C) 2011 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: accessors alien.c-types classes.struct
+classes.struct.private kernel locals math sequences slots
+words ;
+
+IN: classes.struct.packed
+
+<PRIVATE
+
+CONSTANT: ALIGNMENT 1
+
+GENERIC: compute-packed-offset ( offset class -- offset' )
+
+M: struct-slot-spec compute-packed-offset
+    [ ALIGNMENT 8 * align ] dip
+    [ [ 8 /i ] dip offset<< ] [ type>> heap-size 8 * + ] 2bi ;
+
+M: struct-bit-slot-spec compute-packed-offset
+    [ offset<< ] [ bits>> + ] 2bi ;
+
+: compute-packed-offsets ( slots -- size )
+    0 [ compute-packed-offset ] reduce 8 align 8 /i ;
+
+:: (define-packed-class) ( class slots offsets-quot -- )
+    slots empty? [ struct-must-have-slots ] when
+    class redefine-struct-tuple-class
+    slots make-slots dup check-struct-slots :> slot-specs
+    slot-specs offsets-quot call :> unaligned-size
+    ALIGNMENT :> alignment
+    unaligned-size :> size
+
+    class  slot-specs  size  alignment  c-type-for-class :> c-type
+
+    c-type class typedef
+    class slot-specs define-accessors
+    class size "struct-size" set-word-prop
+    class dup make-struct-prototype "prototype" set-word-prop
+    class (struct-methods) ; inline
+
+: define-packed-struct-class ( class slots -- )
+    [ compute-packed-offsets ] (define-packed-class) ;
+
+PRIVATE>
+
+SYNTAX: PACKED-STRUCT:
+    parse-struct-definition define-packed-struct-class ;
+
+
diff --git a/extra/classes/struct/packed/summary.txt b/extra/classes/struct/packed/summary.txt
new file mode 100644
index 0000000000..29f80ee9e1
--- /dev/null
+++ b/extra/classes/struct/packed/summary.txt
@@ -0,0 +1 @@
+Support for packed structures