Skip to content
Projects
Groups
Snippets
Help
Loading...
Sign in / Register
Toggle navigation
C
capnproto
Project
Project
Details
Activity
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Packages
Packages
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
submodule
capnproto
Commits
eb8404a1
Commit
eb8404a1
authored
Apr 11, 2013
by
Kenton Varda
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Fully implement unions.
parent
e33b08f9
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
10 changed files
with
327 additions
and
69 deletions
+327
-69
capnproto-eval.c++
c++/src/capnproto/benchmark/capnproto-eval.c++
+16
-12
eval.capnp
c++/src/capnproto/benchmark/eval.capnp
+6
-8
encoding-test.c++
c++/src/capnproto/encoding-test.c++
+145
-0
message-test.c++
c++/src/capnproto/message-test.c++
+1
-0
test.capnp
c++/src/capnproto/test.capnp
+75
-0
Compiler.hs
compiler/src/Compiler.hs
+57
-37
CxxGenerator.hs
compiler/src/CxxGenerator.hs
+16
-1
Semantics.hs
compiler/src/Semantics.hs
+9
-10
c++-header.mustache
compiler/src/c++-header.mustache
+0
-0
encoding.md
doc/encoding.md
+2
-1
No files found.
c++/src/capnproto/benchmark/capnproto-eval.c++
View file @
eb8404a1
...
@@ -35,7 +35,6 @@ int32_t makeExpression(Expression::Builder exp, uint depth) {
...
@@ -35,7 +35,6 @@ int32_t makeExpression(Expression::Builder exp, uint depth) {
uint32_t
left
,
right
;
uint32_t
left
,
right
;
if
(
fastRand
(
8
)
<
depth
)
{
if
(
fastRand
(
8
)
<
depth
)
{
exp
.
setLeftIsValue
(
true
);
left
=
fastRand
(
128
)
+
1
;
left
=
fastRand
(
128
)
+
1
;
exp
.
setLeftValue
(
left
);
exp
.
setLeftValue
(
left
);
}
else
{
}
else
{
...
@@ -43,7 +42,6 @@ int32_t makeExpression(Expression::Builder exp, uint depth) {
...
@@ -43,7 +42,6 @@ int32_t makeExpression(Expression::Builder exp, uint depth) {
}
}
if
(
fastRand
(
8
)
<
depth
)
{
if
(
fastRand
(
8
)
<
depth
)
{
exp
.
setRightIsValue
(
true
);
right
=
fastRand
(
128
)
+
1
;
right
=
fastRand
(
128
)
+
1
;
exp
.
setRightValue
(
right
);
exp
.
setRightValue
(
right
);
}
else
{
}
else
{
...
@@ -66,18 +64,24 @@ int32_t makeExpression(Expression::Builder exp, uint depth) {
...
@@ -66,18 +64,24 @@ int32_t makeExpression(Expression::Builder exp, uint depth) {
}
}
int32_t
evaluateExpression
(
Expression
::
Reader
exp
)
{
int32_t
evaluateExpression
(
Expression
::
Reader
exp
)
{
int32_t
left
,
right
;
int32_t
left
=
0
,
right
=
0
;
if
(
exp
.
getLeftIsValue
())
{
switch
(
exp
.
whichLeft
())
{
left
=
exp
.
getLeftValue
();
case
Expression
:
:
Left
::
LEFT_VALUE
:
}
else
{
left
=
exp
.
getLeftValue
();
left
=
evaluateExpression
(
exp
.
getLeftExpression
());
break
;
case
Expression
:
:
Left
::
LEFT_EXPRESSION
:
left
=
evaluateExpression
(
exp
.
getLeftExpression
());
break
;
}
}
if
(
exp
.
getRightIsValue
())
{
switch
(
exp
.
whichRight
())
{
right
=
exp
.
getRightValue
();
case
Expression
:
:
Right
::
RIGHT_VALUE
:
}
else
{
right
=
exp
.
getRightValue
();
right
=
evaluateExpression
(
exp
.
getRightExpression
());
break
;
case
Expression
:
:
Right
::
RIGHT_EXPRESSION
:
right
=
evaluateExpression
(
exp
.
getRightExpression
());
break
;
}
}
switch
(
exp
.
getOp
())
{
switch
(
exp
.
getOp
())
{
...
...
c++/src/capnproto/benchmark/eval.capnp
View file @
eb8404a1
...
@@ -32,15 +32,13 @@ enum Operation {
...
@@ -32,15 +32,13 @@ enum Operation {
struct Expression {
struct Expression {
op@0: Operation;
op@0: Operation;
# TODO: Use unions once fully-implemented.
union left @1;
leftValue@2 in left: Int32;
leftExpression@3 in left: Expression;
leftIsValue@1: Bool;
union right @4;
leftValue@2: Int32;
rightValue@5 in right: Int32;
leftExpression@3: Expression;
rightExpression@6 in right: Expression;
rightIsValue@4: Bool;
rightValue@5: Int32;
rightExpression@6: Expression;
}
}
struct EvaluationResult {
struct EvaluationResult {
...
...
c++/src/capnproto/encoding-test.c++
View file @
eb8404a1
...
@@ -107,6 +107,151 @@ TEST(Encoding, DefaultsFromEmptyMessage) {
...
@@ -107,6 +107,151 @@ TEST(Encoding, DefaultsFromEmptyMessage) {
checkTestMessage
(
readMessageTrusted
<
TestDefaults
>
(
emptyMessage
.
words
));
checkTestMessage
(
readMessageTrusted
<
TestDefaults
>
(
emptyMessage
.
words
));
}
}
#ifdef NDEBUG
#define EXPECT_DEBUG_ANY_THROW(EXP)
#else
#define EXPECT_DEBUG_ANY_THROW EXPECT_ANY_THROW
#endif
TEST
(
Encoding
,
Unions
)
{
MallocMessageBuilder
builder
;
TestUnion
::
Builder
root
=
builder
.
getRoot
<
TestUnion
>
();
EXPECT_EQ
(
TestUnion
::
Union0
::
U0F0S0
,
root
.
whichUnion0
());
EXPECT_EQ
(
Void
::
VOID
,
root
.
getU0f0s0
());
EXPECT_DEBUG_ANY_THROW
(
root
.
getU0f0s1
());
root
.
setU0f0s1
(
true
);
EXPECT_EQ
(
TestUnion
::
Union0
::
U0F0S1
,
root
.
whichUnion0
());
EXPECT_TRUE
(
root
.
getU0f0s1
());
EXPECT_DEBUG_ANY_THROW
(
root
.
getU0f0s0
());
root
.
setU0f0s8
(
123
);
EXPECT_EQ
(
TestUnion
::
Union0
::
U0F0S8
,
root
.
whichUnion0
());
EXPECT_EQ
(
123
,
root
.
getU0f0s8
());
EXPECT_DEBUG_ANY_THROW
(
root
.
getU0f0s1
());
}
struct
UnionState
{
uint
discriminants
[
4
];
int
dataOffset
;
UnionState
(
std
::
initializer_list
<
uint
>
discriminants
,
int
dataOffset
)
:
dataOffset
(
dataOffset
)
{
memcpy
(
this
->
discriminants
,
discriminants
.
begin
(),
sizeof
(
discriminants
));
}
bool
operator
==
(
const
UnionState
&
other
)
const
{
for
(
uint
i
=
0
;
i
<
4
;
i
++
)
{
if
(
discriminants
[
i
]
!=
other
.
discriminants
[
i
])
{
return
false
;
}
}
return
dataOffset
==
other
.
dataOffset
;
}
};
std
::
ostream
&
operator
<<
(
std
::
ostream
&
os
,
const
UnionState
&
us
)
{
os
<<
"UnionState({"
;
for
(
uint
i
=
0
;
i
<
4
;
i
++
)
{
if
(
i
>
0
)
os
<<
", "
;
os
<<
us
.
discriminants
[
i
];
}
return
os
<<
"}, "
<<
us
.
dataOffset
<<
")"
;
}
template
<
typename
T
>
T
one
()
{
return
static_cast
<
T
>
(
1
);
}
template
<>
Text
::
Reader
one
()
{
return
"1"
;
}
template
<>
Void
one
()
{
return
Void
::
VOID
;
}
template
<
typename
T
>
UnionState
initUnion
(
void
(
TestUnion
::
Builder
::*
setter
)(
T
value
))
{
// Use the given setter to initialize the given union field and then return a struct indicating
// the location of the data that was written as well as the values of the four union
// discriminants.
MallocMessageBuilder
builder
;
(
builder
.
getRoot
<
TestUnion
>
().
*
setter
)(
one
<
T
>
());
ArrayPtr
<
const
word
>
segment
=
builder
.
getSegmentsForOutput
()[
0
];
CAPNPROTO_ASSERT
(
segment
.
size
()
>
2
,
"bug"
);
// Find the offset of the first set bit after the union discriminants.
int
offset
=
0
;
for
(
const
uint8_t
*
p
=
reinterpret_cast
<
const
uint8_t
*>
(
segment
.
begin
()
+
2
);
p
<
reinterpret_cast
<
const
uint8_t
*>
(
segment
.
end
());
p
++
)
{
if
(
*
p
!=
0
)
{
uint8_t
bits
=
*
p
;
while
((
bits
&
1
)
==
0
)
{
++
offset
;
bits
>>=
1
;
}
goto
found
;
}
offset
+=
8
;
}
offset
=
-
1
;
found
:
const
uint8_t
*
discriminants
=
reinterpret_cast
<
const
uint8_t
*>
(
segment
.
begin
()
+
1
);
return
UnionState
({
discriminants
[
0
],
discriminants
[
2
],
discriminants
[
4
],
discriminants
[
6
]},
offset
);
}
TEST
(
Encoding
,
UnionLayout
)
{
EXPECT_EQ
(
UnionState
({
0
,
0
,
0
,
0
},
-
1
),
initUnion
(
&
TestUnion
::
Builder
::
setU0f0s0
));
EXPECT_EQ
(
UnionState
({
1
,
0
,
0
,
0
},
0
),
initUnion
(
&
TestUnion
::
Builder
::
setU0f0s1
));
EXPECT_EQ
(
UnionState
({
2
,
0
,
0
,
0
},
0
),
initUnion
(
&
TestUnion
::
Builder
::
setU0f0s8
));
EXPECT_EQ
(
UnionState
({
3
,
0
,
0
,
0
},
0
),
initUnion
(
&
TestUnion
::
Builder
::
setU0f0s16
));
EXPECT_EQ
(
UnionState
({
4
,
0
,
0
,
0
},
0
),
initUnion
(
&
TestUnion
::
Builder
::
setU0f0s32
));
EXPECT_EQ
(
UnionState
({
5
,
0
,
0
,
0
},
0
),
initUnion
(
&
TestUnion
::
Builder
::
setU0f0s64
));
EXPECT_EQ
(
UnionState
({
6
,
0
,
0
,
0
},
448
),
initUnion
(
&
TestUnion
::
Builder
::
setU0f0sp
));
EXPECT_EQ
(
UnionState
({
7
,
0
,
0
,
0
},
-
1
),
initUnion
(
&
TestUnion
::
Builder
::
setU0f1s0
));
EXPECT_EQ
(
UnionState
({
8
,
0
,
0
,
0
},
0
),
initUnion
(
&
TestUnion
::
Builder
::
setU0f1s1
));
EXPECT_EQ
(
UnionState
({
9
,
0
,
0
,
0
},
0
),
initUnion
(
&
TestUnion
::
Builder
::
setU0f1s8
));
EXPECT_EQ
(
UnionState
({
10
,
0
,
0
,
0
},
0
),
initUnion
(
&
TestUnion
::
Builder
::
setU0f1s16
));
EXPECT_EQ
(
UnionState
({
11
,
0
,
0
,
0
},
0
),
initUnion
(
&
TestUnion
::
Builder
::
setU0f1s32
));
EXPECT_EQ
(
UnionState
({
12
,
0
,
0
,
0
},
0
),
initUnion
(
&
TestUnion
::
Builder
::
setU0f1s64
));
EXPECT_EQ
(
UnionState
({
13
,
0
,
0
,
0
},
448
),
initUnion
(
&
TestUnion
::
Builder
::
setU0f1sp
));
EXPECT_EQ
(
UnionState
({
0
,
0
,
0
,
0
},
-
1
),
initUnion
(
&
TestUnion
::
Builder
::
setU1f0s0
));
EXPECT_EQ
(
UnionState
({
0
,
1
,
0
,
0
},
65
),
initUnion
(
&
TestUnion
::
Builder
::
setU1f0s1
));
EXPECT_EQ
(
UnionState
({
0
,
2
,
0
,
0
},
65
),
initUnion
(
&
TestUnion
::
Builder
::
setU1f1s1
));
EXPECT_EQ
(
UnionState
({
0
,
3
,
0
,
0
},
72
),
initUnion
(
&
TestUnion
::
Builder
::
setU1f0s8
));
EXPECT_EQ
(
UnionState
({
0
,
4
,
0
,
0
},
72
),
initUnion
(
&
TestUnion
::
Builder
::
setU1f1s8
));
EXPECT_EQ
(
UnionState
({
0
,
5
,
0
,
0
},
80
),
initUnion
(
&
TestUnion
::
Builder
::
setU1f0s16
));
EXPECT_EQ
(
UnionState
({
0
,
6
,
0
,
0
},
80
),
initUnion
(
&
TestUnion
::
Builder
::
setU1f1s16
));
EXPECT_EQ
(
UnionState
({
0
,
7
,
0
,
0
},
96
),
initUnion
(
&
TestUnion
::
Builder
::
setU1f0s32
));
EXPECT_EQ
(
UnionState
({
0
,
8
,
0
,
0
},
96
),
initUnion
(
&
TestUnion
::
Builder
::
setU1f1s32
));
EXPECT_EQ
(
UnionState
({
0
,
9
,
0
,
0
},
128
),
initUnion
(
&
TestUnion
::
Builder
::
setU1f0s64
));
EXPECT_EQ
(
UnionState
({
0
,
10
,
0
,
0
},
128
),
initUnion
(
&
TestUnion
::
Builder
::
setU1f1s64
));
EXPECT_EQ
(
UnionState
({
0
,
11
,
0
,
0
},
512
),
initUnion
(
&
TestUnion
::
Builder
::
setU1f0sp
));
EXPECT_EQ
(
UnionState
({
0
,
12
,
0
,
0
},
512
),
initUnion
(
&
TestUnion
::
Builder
::
setU1f1sp
));
EXPECT_EQ
(
UnionState
({
0
,
13
,
0
,
0
},
-
1
),
initUnion
(
&
TestUnion
::
Builder
::
setU1f2s0
));
EXPECT_EQ
(
UnionState
({
0
,
14
,
0
,
0
},
128
),
initUnion
(
&
TestUnion
::
Builder
::
setU1f2s1
));
EXPECT_EQ
(
UnionState
({
0
,
15
,
0
,
0
},
128
),
initUnion
(
&
TestUnion
::
Builder
::
setU1f2s8
));
EXPECT_EQ
(
UnionState
({
0
,
16
,
0
,
0
},
128
),
initUnion
(
&
TestUnion
::
Builder
::
setU1f2s16
));
EXPECT_EQ
(
UnionState
({
0
,
17
,
0
,
0
},
128
),
initUnion
(
&
TestUnion
::
Builder
::
setU1f2s32
));
EXPECT_EQ
(
UnionState
({
0
,
18
,
0
,
0
},
128
),
initUnion
(
&
TestUnion
::
Builder
::
setU1f2s64
));
EXPECT_EQ
(
UnionState
({
0
,
19
,
0
,
0
},
512
),
initUnion
(
&
TestUnion
::
Builder
::
setU1f2sp
));
EXPECT_EQ
(
UnionState
({
0
,
0
,
0
,
0
},
192
),
initUnion
(
&
TestUnion
::
Builder
::
setU2f0s1
));
EXPECT_EQ
(
UnionState
({
0
,
0
,
0
,
0
},
193
),
initUnion
(
&
TestUnion
::
Builder
::
setU3f0s1
));
EXPECT_EQ
(
UnionState
({
0
,
0
,
1
,
0
},
200
),
initUnion
(
&
TestUnion
::
Builder
::
setU2f0s8
));
EXPECT_EQ
(
UnionState
({
0
,
0
,
0
,
1
},
208
),
initUnion
(
&
TestUnion
::
Builder
::
setU3f0s8
));
EXPECT_EQ
(
UnionState
({
0
,
0
,
2
,
0
},
224
),
initUnion
(
&
TestUnion
::
Builder
::
setU2f0s16
));
EXPECT_EQ
(
UnionState
({
0
,
0
,
0
,
2
},
240
),
initUnion
(
&
TestUnion
::
Builder
::
setU3f0s16
));
EXPECT_EQ
(
UnionState
({
0
,
0
,
3
,
0
},
256
),
initUnion
(
&
TestUnion
::
Builder
::
setU2f0s32
));
EXPECT_EQ
(
UnionState
({
0
,
0
,
0
,
3
},
288
),
initUnion
(
&
TestUnion
::
Builder
::
setU3f0s32
));
EXPECT_EQ
(
UnionState
({
0
,
0
,
4
,
0
},
320
),
initUnion
(
&
TestUnion
::
Builder
::
setU2f0s64
));
EXPECT_EQ
(
UnionState
({
0
,
0
,
0
,
4
},
384
),
initUnion
(
&
TestUnion
::
Builder
::
setU3f0s64
));
}
}
// namespace
}
// namespace
}
// namespace internal
}
// namespace internal
}
// namespace capnproto
}
// namespace capnproto
c++/src/capnproto/message-test.c++
View file @
eb8404a1
...
@@ -30,6 +30,7 @@ namespace {
...
@@ -30,6 +30,7 @@ namespace {
TEST
(
Message
,
MallocBuilderWithFirstSegment
)
{
TEST
(
Message
,
MallocBuilderWithFirstSegment
)
{
word
scratch
[
16
];
word
scratch
[
16
];
memset
(
scratch
,
0
,
sizeof
(
scratch
));
MallocMessageBuilder
builder
(
arrayPtr
(
scratch
,
16
),
AllocationStrategy
::
FIXED_SIZE
);
MallocMessageBuilder
builder
(
arrayPtr
(
scratch
,
16
),
AllocationStrategy
::
FIXED_SIZE
);
ArrayPtr
<
word
>
segment
=
builder
.
allocateSegment
(
1
);
ArrayPtr
<
word
>
segment
=
builder
.
allocateSegment
(
1
);
...
...
c++/src/capnproto/test.capnp
View file @
eb8404a1
...
@@ -151,3 +151,78 @@ struct TestDefaults {
...
@@ -151,3 +151,78 @@ struct TestDefaults {
enumList @32 : List(TestEnum) = [foo, garply];
enumList @32 : List(TestEnum) = [foo, garply];
interfaceList @33 : List(Void); # TODO
interfaceList @33 : List(Void); # TODO
}
}
struct TestUnion {
union union0 @0;
union union1 @1;
union union2 @2;
union union3 @3;
# Pack union 0 under ideal conditions: there is no unused padding space prior to it.
u0f0s0 @4 in union0: Void;
u0f0s1 @5 in union0: Bool;
u0f0s8 @6 in union0: Int8;
u0f0s16 @7 in union0: Int16;
u0f0s32 @8 in union0: Int32;
u0f0s64 @9 in union0: Int64;
u0f0sp @10 in union0: Text;
# Pack more stuff into union1 -- should go in same space.
u0f1s0 @11 in union0: Void;
u0f1s1 @12 in union0: Bool;
u0f1s8 @13 in union0: Int8;
u0f1s16 @14 in union0: Int16;
u0f1s32 @15 in union0: Int32;
u0f1s64 @16 in union0: Int64;
u0f1sp @17 in union0: Text;
# Pack one bit in order to make pathological situation for union1.
bit0 @18: Bool;
# Pack pathologically bad case. Each field takes up new space.
u1f0s0 @19 in union1: Void;
u1f0s1 @20 in union1: Bool;
u1f1s1 @21 in union1: Bool;
u1f0s8 @22 in union1: Int8;
u1f1s8 @23 in union1: Int8;
u1f0s16 @24 in union1: Int16;
u1f1s16 @25 in union1: Int16;
u1f0s32 @26 in union1: Int32;
u1f1s32 @27 in union1: Int32;
u1f0s64 @28 in union1: Int64;
u1f1s64 @29 in union1: Int64;
u1f0sp @30 in union1: Text;
u1f1sp @31 in union1: Text;
# Pack more stuff into union1 -- should go into same space as u1f0s64.
u1f2s0 @32 in union1: Void;
u1f2s1 @33 in union1: Bool;
u1f2s8 @34 in union1: Int8;
u1f2s16 @35 in union1: Int16;
u1f2s32 @36 in union1: Int32;
u1f2s64 @37 in union1: Int64;
u1f2sp @38 in union1: Text;
# Fill in the rest of that bitfield from earlier.
bit2 @39: Bool;
bit3 @40: Bool;
bit4 @41: Bool;
bit5 @42: Bool;
bit6 @43: Bool;
bit7 @44: Bool;
byte0 @49: UInt8;
# Interleave two unions to be really annoying.
# Also declare in reverse order to make sure union discriminant values are sorted by field number
# and not by declaration order.
u3f0s64 @55 in union3: Int64;
u2f0s64 @54 in union2: Int64;
u3f0s32 @53 in union3: Int32;
u2f0s32 @52 in union2: Int32;
u3f0s16 @51 in union3: Int16;
u2f0s16 @50 in union2: Int16;
u3f0s8 @48 in union3: Int8;
u2f0s8 @47 in union2: Int8;
u3f0s1 @46 in union3: Bool;
u2f0s1 @45 in union2: Bool;
}
compiler/src/Compiler.hs
View file @
eb8404a1
...
@@ -366,44 +366,68 @@ packValue Size1 s@(PackingState { packingHole1 = h1 }) =
...
@@ -366,44 +366,68 @@ packValue Size1 s@(PackingState { packingHole1 = h1 }) =
(
h1
,
s
{
packingHole1
=
if
mod
(
h1
+
1
)
8
==
0
then
0
else
h1
+
1
})
(
h1
,
s
{
packingHole1
=
if
mod
(
h1
+
1
)
8
==
0
then
0
else
h1
+
1
})
packValue
Size0
s
=
(
0
,
s
)
packValue
Size0
s
=
(
0
,
s
)
initialUnionPackingState
=
UnionPackingState
Nothing
Nothing
Nothing
initialUnionPackingState
=
UnionPackingState
Nothing
Nothing
packUnionizedValue
::
FieldSize
-- Size of field to pack.
packUnionizedValue
::
FieldSize
-- Size of field to pack.
->
Bool
-- Whether the field is retroactively unionized.
->
UnionPackingState
-- Current layout of the union
->
UnionPackingState
-- Current layout of the union
->
PackingState
-- Current layout of the struct.
->
PackingState
-- Current layout of the struct.
->
(
Integer
,
UnionPackingState
,
PackingState
)
->
(
Integer
,
UnionPackingState
,
PackingState
)
packUnionizedValue
(
SizeInlineComposite
_
_
)
_
_
_
=
error
"Can't put inline composite into union."
packUnionizedValue
(
SizeInlineComposite
_
_
)
_
_
=
error
"Can't put inline composite into union."
packUnionizedValue
Size0
_
u
s
=
(
0
,
u
,
s
)
packUnionizedValue
Size0
u
s
=
(
0
,
u
,
s
)
-- Pack reference when we already have a reference slot allocated.
-- Pack reference when we already have a reference slot allocated.
packUnionizedValue
SizeReference
_
u
@
(
UnionPackingState
_
(
Just
offset
)
_
)
s
=
(
offset
,
u
,
s
)
packUnionizedValue
SizeReference
u
@
(
UnionPackingState
_
(
Just
offset
)
)
s
=
(
offset
,
u
,
s
)
-- Pack reference when we don't have a reference slot.
-- Pack reference when we don't have a reference slot.
packUnionizedValue
SizeReference
_
(
UnionPackingState
d
Nothing
retro
)
s
=
(
offset
,
u2
,
s2
)
where
packUnionizedValue
SizeReference
(
UnionPackingState
d
Nothing
)
s
=
(
offset
,
u2
,
s2
)
where
(
offset
,
s2
)
=
packValue
SizeReference
s
(
offset
,
s2
)
=
packValue
SizeReference
s
u2
=
UnionPackingState
d
(
Just
offset
)
retro
u2
=
UnionPackingState
d
(
Just
offset
)
-- Pack data that fits into the retro slot.
-- Pack data.
packUnionizedValue
size
_
u
@
(
UnionPackingState
_
_
(
Just
(
offset
,
retroSize
)))
s
packUnionizedValue
size
(
UnionPackingState
d
r
)
s
=
|
sizeInBits
retroSize
>=
sizeInBits
size
=
case
packUnionizedData
(
fromMaybe
(
0
,
Size0
)
d
)
s
size
of
(
offset
*
div
(
sizeInBits
retroSize
)
(
sizeInBits
size
),
u
,
s
)
Just
(
offset
,
slotOffset
,
slotSize
,
s2
)
->
(
offset
,
UnionPackingState
(
Just
(
slotOffset
,
slotSize
))
r
,
s2
)
-- Pack data when a data word has been allocated.
Nothing
->
let
packUnionizedValue
size
_
u
@
(
UnionPackingState
(
Just
offset
)
_
_
)
s
=
(
offset
,
s2
)
=
packValue
size
s
(
offset
*
div
64
(
sizeInBits
size
),
u
,
s
)
in
(
offset
,
UnionPackingState
(
Just
(
offset
,
size
))
r
,
s2
)
-- Pack retroactive data when no data word has been allocated.
packUnionizedData
::
(
Integer
,
FieldSize
)
-- existing slot to expand
packUnionizedValue
size
True
(
UnionPackingState
Nothing
r
Nothing
)
s
=
->
PackingState
-- existing packing state
(
offset
,
u2
,
s2
)
where
->
FieldSize
-- desired field size
(
offset
,
s2
)
=
packValue
size
s
->
Maybe
(
Integer
,
-- Offset of the new field (in multiples of field size).
u2
=
UnionPackingState
Nothing
r
(
Just
(
offset
,
size
))
Integer
,
-- New offset of the slot (in multiples of slot size).
FieldSize
,
-- New size of the slot.
-- Pack non-retroactive data when no data word has been allocated.
PackingState
)
-- New struct packing state.
packUnionizedValue
size
_
(
UnionPackingState
Nothing
r
retro
)
s
=
(
offset
*
div
64
(
sizeInBits
size
),
u2
,
s2
)
where
-- Don't try to allocate space for voids.
(
offset
,
s2
)
=
packValue
Size64
s
packUnionizedData
(
slotOffset
,
slotSize
)
state
Size0
=
Just
(
0
,
slotOffset
,
slotSize
,
state
)
u2
=
UnionPackingState
(
Just
offset
)
r
retro
-- If slot is bigger than desired size, no expansion is needed.
packUnionizedData
(
slotOffset
,
slotSize
)
state
desiredSize
|
sizeInBits
slotSize
>=
sizeInBits
desiredSize
=
Just
(
div
(
sizeInBits
slotSize
)
(
sizeInBits
desiredSize
)
*
slotOffset
,
slotOffset
,
slotSize
,
state
)
-- If slot is a bit, and it is the first bit in its byte, and the bit hole immediately follows
-- expand it to a byte.
packUnionizedData
(
slotOffset
,
Size1
)
p
@
(
PackingState
{
packingHole1
=
hole
})
desiredSize
|
mod
slotOffset
8
==
0
&&
hole
==
slotOffset
+
1
=
packUnionizedData
(
div
slotOffset
8
,
Size8
)
(
p
{
packingHole1
=
0
})
desiredSize
-- If slot is size N, and the next N bits are padding, expand.
packUnionizedData
(
slotOffset
,
Size8
)
p
@
(
PackingState
{
packingHole8
=
hole
})
desiredSize
|
hole
==
slotOffset
+
1
=
packUnionizedData
(
div
slotOffset
2
,
Size16
)
(
p
{
packingHole8
=
0
})
desiredSize
packUnionizedData
(
slotOffset
,
Size16
)
p
@
(
PackingState
{
packingHole16
=
hole
})
desiredSize
|
hole
==
slotOffset
+
1
=
packUnionizedData
(
div
slotOffset
2
,
Size32
)
(
p
{
packingHole16
=
0
})
desiredSize
packUnionizedData
(
slotOffset
,
Size32
)
p
@
(
PackingState
{
packingHole32
=
hole
})
desiredSize
|
hole
==
slotOffset
+
1
=
packUnionizedData
(
div
slotOffset
2
,
Size64
)
(
p
{
packingHole32
=
0
})
desiredSize
-- Otherwise, we fail.
packUnionizedData
_
_
_
=
Nothing
-- Determine the offset for the given field, and update the packing states to include the field.
-- Determine the offset for the given field, and update the packing states to include the field.
packField
::
FieldDesc
->
PackingState
->
Map
.
Map
Integer
UnionPackingState
packField
::
FieldDesc
->
PackingState
->
Map
.
Map
Integer
UnionPackingState
...
@@ -416,9 +440,8 @@ packField fieldDesc state unionState =
...
@@ -416,9 +440,8 @@ packField fieldDesc state unionState =
Just
unionDesc
->
let
Just
unionDesc
->
let
n
=
unionNumber
unionDesc
n
=
unionNumber
unionDesc
oldUnionPacking
=
fromMaybe
initialUnionPackingState
(
Map
.
lookup
n
unionState
)
oldUnionPacking
=
fromMaybe
initialUnionPackingState
(
Map
.
lookup
n
unionState
)
isRetro
=
fieldNumber
fieldDesc
<
unionNumber
unionDesc
(
offset
,
newUnionPacking
,
newState
)
=
(
offset
,
newUnionPacking
,
newState
)
=
packUnionizedValue
(
fieldSize
$
fieldType
fieldDesc
)
isRetro
oldUnionPacking
state
packUnionizedValue
(
fieldSize
$
fieldType
fieldDesc
)
oldUnionPacking
state
newUnionState
=
Map
.
insert
n
newUnionPacking
unionState
newUnionState
=
Map
.
insert
n
newUnionPacking
unionState
in
(
offset
,
newState
,
newUnionState
)
in
(
offset
,
newState
,
newUnionState
)
...
@@ -427,7 +450,7 @@ packField fieldDesc state unionState =
...
@@ -427,7 +450,7 @@ packField fieldDesc state unionState =
packUnion
::
UnionDesc
->
PackingState
->
Map
.
Map
Integer
UnionPackingState
packUnion
::
UnionDesc
->
PackingState
->
Map
.
Map
Integer
UnionPackingState
->
(
Integer
,
PackingState
,
Map
.
Map
Integer
UnionPackingState
)
->
(
Integer
,
PackingState
,
Map
.
Map
Integer
UnionPackingState
)
packUnion
_
state
unionState
=
(
offset
,
newState
,
unionState
)
where
packUnion
_
state
unionState
=
(
offset
,
newState
,
unionState
)
where
(
offset
,
newState
)
=
packValue
Size
8
state
(
offset
,
newState
)
=
packValue
Size
16
state
packFields
::
[
FieldDesc
]
->
[
UnionDesc
]
packFields
::
[
FieldDesc
]
->
[
UnionDesc
]
->
(
PackingState
,
Map
.
Map
Integer
UnionPackingState
,
Map
.
Map
Integer
(
Integer
,
PackingState
))
->
(
PackingState
,
Map
.
Map
Integer
UnionPackingState
,
Map
.
Map
Integer
(
Integer
,
PackingState
))
...
@@ -533,7 +556,7 @@ compileDecl scope (StructDecl (Located _ name) decls) =
...
@@ -533,7 +556,7 @@ compileDecl scope (StructDecl (Located _ name) decls) =
return
(
let
return
(
let
fields
=
[
d
|
DescField
d
<-
members
]
fields
=
[
d
|
DescField
d
<-
members
]
unions
=
[
d
|
DescUnion
d
<-
members
]
unions
=
[
d
|
DescUnion
d
<-
members
]
(
packing
,
unionPackingMap
,
fieldPackingMap
)
=
packFields
fields
unions
(
packing
,
_
,
fieldPackingMap
)
=
packFields
fields
unions
in
DescStruct
StructDesc
in
DescStruct
StructDesc
{
structName
=
name
{
structName
=
name
,
structParent
=
scope
,
structParent
=
scope
...
@@ -549,26 +572,23 @@ compileDecl scope (StructDecl (Located _ name) decls) =
...
@@ -549,26 +572,23 @@ compileDecl scope (StructDecl (Located _ name) decls) =
,
structMemberMap
=
memberMap
,
structMemberMap
=
memberMap
,
structStatements
=
statements
,
structStatements
=
statements
,
structFieldPackingMap
=
fieldPackingMap
,
structFieldPackingMap
=
fieldPackingMap
,
structUnionPackingMap
=
unionPackingMap
})))
})))
compileDecl
(
DescStruct
parent
)
(
UnionDecl
(
Located
_
name
)
(
Located
numPos
number
)
decls
)
=
compileDecl
(
DescStruct
parent
)
(
UnionDecl
(
Located
_
name
)
(
Located
numPos
number
)
decls
)
=
CompiledMemberStatus
name
(
feedback
(
\
desc
->
do
CompiledMemberStatus
name
(
feedback
(
\
desc
->
do
(
_
,
_
,
options
,
statements
)
<-
compileChildDecls
desc
decls
(
_
,
_
,
options
,
statements
)
<-
compileChildDecls
desc
decls
let
fields
=
[
f
|
f
<-
structFields
parent
,
fieldInUnion
name
f
]
let
compareFieldNumbers
a
b
=
compare
(
fieldNumber
a
)
(
fieldNumber
b
)
fields
=
List
.
sortBy
compareFieldNumbers
[
f
|
f
<-
structFields
parent
,
fieldInUnion
name
f
]
requireNoMoreThanOneFieldNumberLessThan
name
numPos
number
fields
requireNoMoreThanOneFieldNumberLessThan
name
numPos
number
fields
return
(
let
return
(
let
(
tagOffset
,
tagPacking
)
=
structFieldPackingMap
parent
!
number
(
tagOffset
,
tagPacking
)
=
structFieldPackingMap
parent
!
number
unionPacking
=
structUnionPackingMap
parent
!
number
in
DescUnion
UnionDesc
in
DescUnion
UnionDesc
{
unionName
=
name
{
unionName
=
name
,
unionParent
=
parent
,
unionParent
=
parent
,
unionNumber
=
number
,
unionNumber
=
number
,
unionTagOffset
=
tagOffset
,
unionTagOffset
=
tagOffset
,
unionTagPacking
=
tagPacking
,
unionTagPacking
=
tagPacking
,
unionDataOffset
=
unionPackDataOffset
unionPacking
,
unionReferenceOffset
=
unionPackReferenceOffset
unionPacking
,
unionRetroactiveSlot
=
unionPackRetroactiveSlot
unionPacking
,
unionFields
=
fields
,
unionFields
=
fields
,
unionOptions
=
options
,
unionOptions
=
options
,
unionStatements
=
statements
,
unionStatements
=
statements
...
...
compiler/src/CxxGenerator.hs
View file @
eb8404a1
...
@@ -176,9 +176,11 @@ defaultBytesContext parent t bytes = mkStrContext context where
...
@@ -176,9 +176,11 @@ defaultBytesContext parent t bytes = mkStrContext context where
_
->
error
"defaultBlobSize used on non-blob."
_
->
error
"defaultBlobSize used on non-blob."
context
s
=
parent
s
context
s
=
parent
s
descDecl
desc
=
head
$
lines
$
descToCode
""
desc
fieldContext
parent
desc
=
mkStrContext
context
where
fieldContext
parent
desc
=
mkStrContext
context
where
context
"fieldName"
=
MuVariable
$
fieldName
desc
context
"fieldName"
=
MuVariable
$
fieldName
desc
context
"fieldDecl"
=
MuVariable
$
desc
ToCode
""
(
DescField
desc
)
context
"fieldDecl"
=
MuVariable
$
desc
Decl
$
DescField
desc
context
"fieldTitleCase"
=
MuVariable
$
toTitleCase
$
fieldName
desc
context
"fieldTitleCase"
=
MuVariable
$
toTitleCase
$
fieldName
desc
context
"fieldUpperCase"
=
MuVariable
$
toUpperCaseWithUnderscores
$
fieldName
desc
context
"fieldUpperCase"
=
MuVariable
$
toUpperCaseWithUnderscores
$
fieldName
desc
context
"fieldIsPrimitive"
=
MuBool
$
isPrimitive
$
fieldType
desc
context
"fieldIsPrimitive"
=
MuBool
$
isPrimitive
$
fieldType
desc
...
@@ -202,11 +204,24 @@ fieldContext parent desc = mkStrContext context where
...
@@ -202,11 +204,24 @@ fieldContext parent desc = mkStrContext context where
MuVariable
$
cxxFieldSizeString
$
elementSize
$
elementType
$
fieldType
desc
MuVariable
$
cxxFieldSizeString
$
elementSize
$
elementType
$
fieldType
desc
context
"fieldElementType"
=
context
"fieldElementType"
=
MuVariable
$
cxxTypeString
$
elementType
$
fieldType
desc
MuVariable
$
cxxTypeString
$
elementType
$
fieldType
desc
context
"fieldUnion"
=
case
fieldUnion
desc
of
Just
u
->
MuList
[
unionContext
context
u
]
Nothing
->
muNull
context
s
=
parent
s
unionContext
parent
desc
=
mkStrContext
context
where
context
"unionName"
=
MuVariable
$
unionName
desc
context
"unionDecl"
=
MuVariable
$
descDecl
$
DescUnion
desc
context
"unionTitleCase"
=
MuVariable
$
toTitleCase
$
unionName
desc
context
"unionTagOffset"
=
MuVariable
$
unionTagOffset
desc
context
"unionFields"
=
MuList
$
map
(
fieldContext
context
)
$
unionFields
desc
context
"unionHasRetro"
=
MuBool
$
unionHasRetro
desc
context
s
=
parent
s
context
s
=
parent
s
structContext
parent
desc
=
mkStrContext
context
where
structContext
parent
desc
=
mkStrContext
context
where
context
"structName"
=
MuVariable
$
structName
desc
context
"structName"
=
MuVariable
$
structName
desc
context
"structFields"
=
MuList
$
map
(
fieldContext
context
)
$
structFields
desc
context
"structFields"
=
MuList
$
map
(
fieldContext
context
)
$
structFields
desc
context
"structUnions"
=
MuList
$
map
(
unionContext
context
)
$
structUnions
desc
context
"structDataSize"
=
MuVariable
$
packingDataSize
$
structPacking
desc
context
"structDataSize"
=
MuVariable
$
packingDataSize
$
structPacking
desc
context
"structReferenceCount"
=
MuVariable
$
packingReferenceCount
$
structPacking
desc
context
"structReferenceCount"
=
MuVariable
$
packingReferenceCount
$
structPacking
desc
context
"structChildren"
=
MuList
[]
-- TODO
context
"structChildren"
=
MuList
[]
-- TODO
...
...
compiler/src/Semantics.hs
View file @
eb8404a1
...
@@ -162,9 +162,8 @@ packingSize PackingState { packingDataSize = ds, packingReferenceCount = rc } =
...
@@ -162,9 +162,8 @@ packingSize PackingState { packingDataSize = ds, packingReferenceCount = rc } =
-- this is the piece that had been allocated to that field, and is now retroactively part of the
-- this is the piece that had been allocated to that field, and is now retroactively part of the
-- union.
-- union.
data
UnionPackingState
=
UnionPackingState
data
UnionPackingState
=
UnionPackingState
{
unionPackDataOffset
::
Maybe
Integer
{
unionPackDataOffset
::
Maybe
(
Integer
,
FieldSize
)
,
unionPackReferenceOffset
::
Maybe
Integer
,
unionPackReferenceOffset
::
Maybe
Integer
,
unionPackRetroactiveSlot
::
Maybe
(
Integer
,
FieldSize
)
}
}
data
FieldSize
=
Size0
|
Size1
|
Size8
|
Size16
|
Size32
|
Size64
|
SizeReference
data
FieldSize
=
Size0
|
Size1
|
Size8
|
Size16
|
Size32
|
Size64
|
SizeReference
...
@@ -310,11 +309,10 @@ data StructDesc = StructDesc
...
@@ -310,11 +309,10 @@ data StructDesc = StructDesc
,
structMemberMap
::
MemberMap
,
structMemberMap
::
MemberMap
,
structStatements
::
[
CompiledStatement
]
,
structStatements
::
[
CompiledStatement
]
-- Don't use th
ese
directly, use the members of FieldDesc and UnionDesc.
-- Don't use th
is
directly, use the members of FieldDesc and UnionDesc.
-- Th
ese fields are exposed here only because I was too lazy to create a way to pass them
on
-- Th
is field is exposed here only because I was too lazy to create a way to pass it
on
-- the side when compiling members of a struct.
-- the side when compiling members of a struct.
,
structFieldPackingMap
::
Map
.
Map
Integer
(
Integer
,
PackingState
)
,
structFieldPackingMap
::
Map
.
Map
Integer
(
Integer
,
PackingState
)
,
structUnionPackingMap
::
Map
.
Map
Integer
UnionPackingState
}
}
data
UnionDesc
=
UnionDesc
data
UnionDesc
=
UnionDesc
...
@@ -323,14 +321,15 @@ data UnionDesc = UnionDesc
...
@@ -323,14 +321,15 @@ data UnionDesc = UnionDesc
,
unionNumber
::
Integer
,
unionNumber
::
Integer
,
unionTagOffset
::
Integer
,
unionTagOffset
::
Integer
,
unionTagPacking
::
PackingState
,
unionTagPacking
::
PackingState
,
unionDataOffset
::
Maybe
Integer
,
unionFields
::
[
FieldDesc
]
-- ordered by field number
,
unionReferenceOffset
::
Maybe
Integer
,
unionRetroactiveSlot
::
Maybe
(
Integer
,
FieldSize
)
,
unionFields
::
[
FieldDesc
]
,
unionOptions
::
OptionMap
,
unionOptions
::
OptionMap
,
unionStatements
::
[
CompiledStatement
]
,
unionStatements
::
[
CompiledStatement
]
}
}
unionHasRetro
desc
=
case
unionFields
desc
of
[]
->
False
f
:
_
->
fieldNumber
f
<
unionNumber
desc
data
FieldDesc
=
FieldDesc
data
FieldDesc
=
FieldDesc
{
fieldName
::
String
{
fieldName
::
String
,
fieldParent
::
StructDesc
,
fieldParent
::
StructDesc
...
@@ -422,7 +421,7 @@ descToCode indent (DescField desc) = printf "%s%s@%d%s: %s%s; # %s\n" indent
...
@@ -422,7 +421,7 @@ descToCode indent (DescField desc) = printf "%s%s@%d%s: %s%s; # %s\n" indent
-- (maybeBlockCode indent $ fieldStatements desc)
-- (maybeBlockCode indent $ fieldStatements desc)
descToCode
indent
(
DescUnion
desc
)
=
printf
"%sunion %s@%d; # [%d, %d)
\n
"
indent
descToCode
indent
(
DescUnion
desc
)
=
printf
"%sunion %s@%d; # [%d, %d)
\n
"
indent
(
unionName
desc
)
(
unionNumber
desc
)
(
unionName
desc
)
(
unionNumber
desc
)
(
unionTagOffset
desc
*
8
)
(
unionTagOffset
desc
*
8
+
8
)
(
unionTagOffset
desc
*
16
)
(
unionTagOffset
desc
*
16
+
16
)
-- (maybeBlockCode indent $ unionStatements desc)
-- (maybeBlockCode indent $ unionStatements desc)
descToCode
indent
(
DescInterface
desc
)
=
printf
"%sinterface %s%s"
indent
descToCode
indent
(
DescInterface
desc
)
=
printf
"%sinterface %s%s"
indent
(
interfaceName
desc
)
(
interfaceName
desc
)
...
...
compiler/src/c++-header.mustache
View file @
eb8404a1
This diff is collapsed.
Click to expand it.
doc/encoding.md
View file @
eb8404a1
...
@@ -161,7 +161,8 @@ When unions are present, add the following logic:
...
@@ -161,7 +161,8 @@ When unions are present, add the following logic:
If an earlier member of the union is in the same section as
If an earlier member of the union is in the same section as
this field and it combined with any following padding
this field and it combined with any following padding
is at least as large as the new field {
is at least as large as the new field {
Give the new field the same offset, so they overlap.
Give the new field the same offset and the highest-numbered
such previous field, so they overlap.
} else {
} else {
Assign a new offset to this field as if it were not a union
Assign a new offset to this field as if it were not a union
member at all. (See no-union logic, above.)
member at all. (See no-union logic, above.)
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment