[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[COMMITTED 1/3] pkl,pvm: add a ref_type attribute to offset types
|
From: |
Jose E. Marchesi |
|
Subject: |
[COMMITTED 1/3] pkl,pvm: add a ref_type attribute to offset types |
|
Date: |
Sun, 23 Apr 2023 15:28:06 +0200 |
|
User-agent: |
Gnus/5.13 (Gnus v5.13) |
This patch adds a new attribute to offset types: a referred type.
This means that values of this type refer to some other value in an IO
space. Sort of a pointer.
The syntax is the following:
offset<uint<64>,B,Foo> pointer_to_foo;
This patch adds the compiler support to recognize such types, and also
the corresponding PVM support code that expands the PVM offset types
at runtime. The printers (both C and Poke) are also updated
accordingly.
2023-02-12 Jose E. Marchesi <jemarch@gnu.org>
* libpoke/pkl-ast.h (struct pkl_ast_type): New field ref_type in
offset types.
(PKL_AST_TYPE_O_REF_TYPE): Define.
* libpoke/pkl-ast.c (pkl_ast_make_offset_type): Get a ref_type
argument.
(pkl_ast_node_free_1): Free ref_type.
(pkl_ast_print_1): Print ref_type.
(pkl_type_append_to): Include ref_type in printed representation.
* libpoke/pkl-tab.y (ref_type): New rule.
* libpoke/pkl-typify.c: Pass ref_type argument to calls to
pkl_ast_make_offset_type.
* libpoke/pkl-promo.c (promote_offset): Likewise.
* libpoke/pkl-trans.c: Likewise.
* libpoke/pkl-pass.c (pkl_do_pass_1): Traverse ref_type in offset
type nodes.
* libpoke/pkl-lex.l: Likewise.
* libpoke/pkl-gen.c (pkl_gen_pr_type_offset): Use ref_type.
* libpoke/pkl-rt.pk (_pkl_print_format_any): Print ref_type in
offset types.
* libpoke/pvm-val.h (PVM_VAL_TYP_O_REF_TYPE): Define.
* libpoke/pvm-val.c (pvm_make_offset_type): Get an argument
ref_type.
* libpoke/pvm.jitter (mktyor): New instruction.
(tyogetrt): New instruction.
* libpoke/pkl-insn.def: New instruction PKL_INSN_TYOGETRT.
* libpoke/pk-val.c (pk_make_offset_type): Likewise.
---
ChangeLog | 86 ++++++++++++++++++++++++++++
doc/poke.texi | 27 ++++++---
libpoke/libpoke.h | 7 ++-
libpoke/pk-val.c | 6 +-
libpoke/pkl-ast.c | 24 +++++++-
libpoke/pkl-ast.h | 4 +-
libpoke/pkl-fold.c | 4 +-
libpoke/pkl-gen.c | 10 +++-
libpoke/pkl-insn.def | 2 +
libpoke/pkl-lex.l | 2 +-
libpoke/pkl-pass.c | 2 +
libpoke/pkl-promo.c | 49 +++++++++++-----
libpoke/pkl-rt.pk | 18 +++++-
libpoke/pkl-tab.y | 19 ++++--
libpoke/pkl-trans.c | 2 +-
libpoke/pkl-typify.c | 68 ++++++++++++++--------
libpoke/pkl.c | 4 +-
libpoke/pvm-val.c | 3 +-
libpoke/pvm-val.h | 2 +
libpoke/pvm.h | 2 +-
libpoke/pvm.jitter | 47 ++++++++++++---
testsuite/Makefile.am | 8 +++
testsuite/poke.pkl/add-offsets-11.pk | 15 +++++
testsuite/poke.pkl/bnot-offsets-2.pk | 14 +++++
testsuite/poke.pkl/div-offsets-5.pk | 15 +++++
testsuite/poke.pkl/mod-offsets-6.pk | 15 +++++
testsuite/poke.pkl/mul-offsets-12.pk | 15 +++++
testsuite/poke.pkl/offset-type-2.pk | 6 ++
testsuite/poke.pkl/print-any-4.pk | 11 ++++
testsuite/poke.pkl/sub-offsets-9.pk | 15 +++++
30 files changed, 427 insertions(+), 75 deletions(-)
create mode 100644 testsuite/poke.pkl/add-offsets-11.pk
create mode 100644 testsuite/poke.pkl/bnot-offsets-2.pk
create mode 100644 testsuite/poke.pkl/div-offsets-5.pk
create mode 100644 testsuite/poke.pkl/mod-offsets-6.pk
create mode 100644 testsuite/poke.pkl/mul-offsets-12.pk
create mode 100644 testsuite/poke.pkl/offset-type-2.pk
create mode 100644 testsuite/poke.pkl/print-any-4.pk
create mode 100644 testsuite/poke.pkl/sub-offsets-9.pk
diff --git a/ChangeLog b/ChangeLog
index 61128120..c7da75de 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,89 @@
+2023-02-12 Jose E. Marchesi <jemarch@gnu.org>
+
+ * libpoke/pkl-ast.h (struct pkl_ast_type): New field ref_type in
+ offset types.
+ (PKL_AST_TYPE_O_REF_TYPE): Define.
+ * libpoke/pkl-ast.c (pkl_ast_make_offset_type): Get a ref_type
+ argument.
+ (pkl_ast_node_free_1): Free ref_type.
+ (pkl_ast_print_1): Print ref_type.
+ (pkl_type_append_to): Include ref_type in printed representation.
+ (pkl_ast_type_equal_p): Handle referred types.
+ * libpoke/pkl-tab.y (ref_type): New rule.
+ * libpoke/pkl-typify.c: Pass ref_type argument to calls to
+ pkl_ast_make_offset_type.
+ * libpoke/pkl-promo.c (promote_offset): Likewise.
+ * libpoke/pkl-trans.c: Likewise.
+ * libpoke/pkl-promo.c (promote_offset): Handle ref_type.
+ (promote_node): Likewise.
+ * libpoke/pkl-pass.c (pkl_do_pass_1): Traverse ref_type in offset
+ type nodes.
+ * libpoke/pkl-lex.l: Likewise.
+ * libpoke/pkl-gen.c (pkl_gen_pr_type_offset): Use ref_type.
+ * libpoke/pkl-rt.pk (_pkl_print_format_any): Print ref_type in
+ offset types.
+ * libpoke/pvm-val.h (PVM_VAL_TYP_O_REF_TYPE): Define.
+ * libpoke/pvm-val.c (pvm_make_offset_type): Get an argument
+ ref_type.
+ * libpoke/pvm.jitter (tyosetrt): New instruction.
+ (tyogetrt): Likewise.
+ * libpoke/pkl-insn.def: New instructions PKL_INSN_TYOSETRT and
+ PKL_INSN_TYOGETRT.
+ * libpoke/pk-val.c (pk_make_offset_type): Likewise.
+ * doc/poke.texi (Offset Types): Document referred types in offset
+ types.
+ * testsuite/poke.pkl/offset-type-2.pk: New test.
+ * testsuite/poke.pkl/print-any-4.pk: Likewise.
+ * testsuite/poke.pkl/add-offset-11.pk: Likewise.
+ * testsuite/poke.pkl/sub-offsets-9.pk: Likewise.
+ * testsuite/poke.pkl/mul-offsets-12.pk: Likewise.
+ * testsuite/poke.pkl/div-offsets-5.pk: Likewise.
+ * testsuite/poke.pkl/bnot-offsets-2.pk: Likewise.
+ * testsuite/Makefile.am (EXTRA_DIST): Add new tests.
+
+2023-02-12 Jose E. Marchesi <jemarch@gnu.org>
+
+ * libpoke/pkl-ast.h (struct pkl_ast_type): New field ref_type in
+ offset types.
+ (PKL_AST_TYPE_O_REF_TYPE): Define.
+ * libpoke/pkl-ast.c (pkl_ast_make_offset_type): Get a ref_type
+ argument.
+ (pkl_ast_node_free_1): Free ref_type.
+ (pkl_ast_print_1): Print ref_type.
+ (pkl_type_append_to): Include ref_type in printed representation.
+ (pkl_ast_type_equal_p): Handle referred types.
+ * libpoke/pkl-tab.y (ref_type): New rule.
+ * libpoke/pkl-typify.c: Pass ref_type argument to calls to
+ pkl_ast_make_offset_type.
+ * libpoke/pkl-promo.c (promote_offset): Likewise.
+ * libpoke/pkl-trans.c: Likewise.
+ * libpoke/pkl-promo.c (promote_offset): Handle ref_type.
+ (promote_node): Likewise.
+ * libpoke/pkl-pass.c (pkl_do_pass_1): Traverse ref_type in offset
+ type nodes.
+ * libpoke/pkl-lex.l: Likewise.
+ * libpoke/pkl-gen.c (pkl_gen_pr_type_offset): Use ref_type.
+ * libpoke/pkl-rt.pk (_pkl_print_format_any): Print ref_type in
+ offset types.
+ * libpoke/pvm-val.h (PVM_VAL_TYP_O_REF_TYPE): Define.
+ * libpoke/pvm-val.c (pvm_make_offset_type): Get an argument
+ ref_type.
+ * libpoke/pvm.jitter (tyosetrt): New instruction.
+ (tyogetrt): Likewise.
+ * libpoke/pkl-insn.def: New instructions PKL_INSN_TYOSETRT and
+ PKL_INSN_TYOGETRT.
+ * libpoke/pk-val.c (pk_make_offset_type): Likewise.
+ * doc/poke.texi (Offset Types): Document referred types in offset
+ types.
+ * testsuite/poke.pkl/offset-type-2.pk: New test.
+ * testsuite/poke.pkl/print-any-4.pk: Likewise.
+ * testsuite/poke.pkl/add-offset-11.pk: Likewise.
+ * testsuite/poke.pkl/sub-offsets-9.pk: Likewise.
+ * testsuite/poke.pkl/mul-offsets-11.pk: Likewise.
+ * testsuite/poke.pkl/div-offsets-5.pk: Likewise.
+ * testsuite/poke.pkl/bnot-offsets-2.pk: Likewise.
+ * testsuite/Makefile.am (EXTRA_DIST): Add new tests.
+
2023-04-21 Mohammad-Reza Nabipoor <mnabipoor@gnu.org>
* libpoke/pkl-tab.y (primary): Add new rule for `format' with no
diff --git a/doc/poke.texi b/doc/poke.texi
index ef7f8d77..c054bd71 100644
--- a/doc/poke.texi
+++ b/doc/poke.texi
@@ -9950,9 +9950,11 @@ entirely. To denote one kilobyte, for example, we can
write
@node Offset Types
@subsection Offset Types
-Offset types are denoted as @code{offset<@var{base_type},@var{unit}>},
-where @var{base_type} is an integer type and @var{unit} the
-specification of an unit.
+Offset types are denoted as
+@code{offset<@var{base_type},@var{unit}[,@var{ref_type}]>}, where
+@var{base_type} is an integer type, @var{unit} the specification of an
+unit, and @var{ref_type} is an optional type of a @dfn{referred
+value}.
The offset base type is the type of the magnitude part of the united
value. It can be any integer type, signed or unsigned, of any size.
@@ -9961,6 +9963,10 @@ The unit specification should be one of the unit
identifiers that are
allowed in offset literals (see above), a constant positive integer or
the name of a Poke type whose size is known at compile time.
+If a referred type is specified, this tells poke that the offset may
+be used in order to refer to a value stored on some IO space. This is
+similar to the notion of a pointer in other programming languages.
+
@cindex kilobits
Let's see some examples. A signed 32-bit offset expressed in bytes
has type @code{offset<int<32>,B>}. An unsigned 12-bit offset
@@ -9970,6 +9976,10 @@ type can also be written using an explicit integer unit
like in
of ``packets'', where a packet is denoted with a Poke type
@code{Packet} has type @code{offset<uint<64>,Packet>}.
+An offset whose purpose is to refer to some data structure of type
+@code{Packet} stored in some IO space could have type
+@code{offset<uint<64>,B,Packet>}.
+
@node Casting Offsets
@subsection Casting Offsets
@cindex casts
@@ -10014,7 +10024,7 @@ Examples:
@end example
The unit of the result is the greatest common divisor of the units of
-the operands.
+the operands. The result offset is not a referring offset.
The operators @code{++} and @code{--}, in their prefix and suffix
versions, can be applied to offsets as well. The step used in the
@@ -10032,8 +10042,8 @@ Examples:
0#MB
@end example
-The unit of the result is the same as the unit of the offset
-operand.
+The unit of the result is the same as the unit of the offset operand.
+The result offset is not a referring offset.
Note that multiplying two offsets is not supported. This makes sense,
since computer memory is linear, and therefore it wouldn't make any
@@ -10081,6 +10091,9 @@ Dividing an offset by an integer gives you an offset.
Example:
4#B
@end example
+The unit of the result is the unit of the offset operand. The result
+offset is not a referring offset.
+
@subsubsection Modulus
@cindex modulus
The modulus of two offsets gives you another offset with the expected
@@ -10094,7 +10107,7 @@ semantics. Examples:
@end example
The unit of the result is the greatest common divisor of the units of
-the operands.
+the operands. The result offset is not a referring offset.
@node Offset Attributes
@subsection Offset Attributes
diff --git a/libpoke/libpoke.h b/libpoke/libpoke.h
index 32cba115..7732f96c 100644
--- a/libpoke/libpoke.h
+++ b/libpoke/libpoke.h
@@ -966,9 +966,12 @@ pk_val pk_make_any_type (void) LIBPOKE_API;
of the offset.
UNIT is an uint<64> with the unit of the offset type. The unit is
- a multiple of the base unit, which is the bit. */
+ a multiple of the base unit, which is the bit.
-pk_val pk_make_offset_type (pk_val base_type, pk_val unit) LIBPOKE_API;
+ REF_TYPE is either PK_NULL or the type of the referenced type if the
+ offset is also a reference or pointer. */
+
+pk_val pk_make_offset_type (pk_val base_type, pk_val unit, pk_val ref_type)
LIBPOKE_API;
/* Get the base type of a given offset type. */
diff --git a/libpoke/pk-val.c b/libpoke/pk-val.c
index 9605eefe..5bafce8f 100644
--- a/libpoke/pk-val.c
+++ b/libpoke/pk-val.c
@@ -94,7 +94,7 @@ pk_make_offset (pk_val magnitude, pk_val unit)
else
{
pvm_val type = pvm_make_offset_type (pvm_typeof (magnitude),
- unit);
+ unit, PVM_NULL /* ref_type */);
return pvm_make_offset (magnitude, type);
}
}
@@ -385,9 +385,9 @@ pk_make_string_type (void)
}
pk_val
-pk_make_offset_type (pk_val base_type, pk_val unit)
+pk_make_offset_type (pk_val base_type, pk_val unit, pk_val ref_type)
{
- return pvm_make_offset_type (base_type, unit);
+ return pvm_make_offset_type (base_type, unit, ref_type);
}
pk_val
diff --git a/libpoke/pkl-ast.c b/libpoke/pkl-ast.c
index 123c8f65..16133544 100644
--- a/libpoke/pkl-ast.c
+++ b/libpoke/pkl-ast.c
@@ -448,7 +448,8 @@ pkl_ast_make_void_type (pkl_ast ast)
pkl_ast_node
pkl_ast_make_offset_type (pkl_ast ast,
pkl_ast_node base_type,
- pkl_ast_node unit)
+ pkl_ast_node unit,
+ pkl_ast_node ref_type)
{
pkl_ast_node type = pkl_ast_make_type (ast);
@@ -459,6 +460,8 @@ pkl_ast_make_offset_type (pkl_ast ast,
= PKL_AST_TYPE_COMPLETE_YES;
PKL_AST_TYPE_O_UNIT (type) = ASTREF (unit);
PKL_AST_TYPE_O_BASE_TYPE (type) = ASTREF (base_type);
+ if (ref_type)
+ PKL_AST_TYPE_O_REF_TYPE (type) = ASTREF (ref_type);
return type;
}
@@ -933,6 +936,8 @@ pkl_ast_type_equal_p (pkl_ast_node a, pkl_ast_node b)
{
pkl_ast_node a_unit = PKL_AST_TYPE_O_UNIT (a);
pkl_ast_node b_unit = PKL_AST_TYPE_O_UNIT (b);
+ pkl_ast_node a_ref_type = PKL_AST_TYPE_O_REF_TYPE (a);
+ pkl_ast_node b_ref_type = PKL_AST_TYPE_O_REF_TYPE (b);
/* If the units of the types are not known yet (because they
are identifiers, or whatever then we cannot guarantee the
@@ -941,6 +946,14 @@ pkl_ast_type_equal_p (pkl_ast_node a, pkl_ast_node b)
|| PKL_AST_CODE (b_unit) != PKL_AST_INTEGER)
return 0;
+ /* Offset types having different referred types are not
+ equal. */
+ if (!((a_ref_type == NULL && b_ref_type == NULL)
+ || (a_ref_type
+ && b_ref_type
+ && pkl_ast_type_equal_p (a_ref_type, b_ref_type))))
+ return 0;
+
return (PKL_AST_INTEGER_VALUE (a_unit) == PKL_AST_INTEGER_VALUE
(b_unit)
&& pkl_ast_type_equal_p (PKL_AST_TYPE_O_BASE_TYPE (a),
PKL_AST_TYPE_O_BASE_TYPE (b)));
@@ -1531,6 +1544,13 @@ pkl_type_append_to (pkl_ast_node type, int
use_given_name,
else
PK_UNREACHABLE ();
+ if (PKL_AST_TYPE_O_REF_TYPE (type))
+ {
+ sb_append (buffer, ",");
+ pkl_type_append_to (PKL_AST_TYPE_O_REF_TYPE (type), 1,
+ buffer);
+ }
+
sb_append (buffer, ">");
break;
}
@@ -2392,6 +2412,7 @@ pkl_ast_node_free_1 (gl_set_t visitations, pkl_ast_node
ast)
case PKL_TYPE_OFFSET:
PKL_AST_NODE_FREE (PKL_AST_TYPE_O_UNIT (ast));
PKL_AST_NODE_FREE (PKL_AST_TYPE_O_BASE_TYPE (ast));
+ PKL_AST_NODE_FREE (PKL_AST_TYPE_O_REF_TYPE (ast));
break;
case PKL_TYPE_INTEGRAL:
case PKL_TYPE_STRING:
@@ -3292,6 +3313,7 @@ pkl_ast_print_1 (FILE *fp, pkl_ast_node ast, int indent)
case PKL_TYPE_OFFSET:
PRINT_AST_SUBAST (base_type, TYPE_O_BASE_TYPE);
PRINT_AST_SUBAST (unit, TYPE_O_UNIT);
+ PRINT_AST_SUBAST (ref_type, TYPE_O_REF_TYPE);
break;
case PKL_TYPE_STRING:
case PKL_TYPE_ANY:
diff --git a/libpoke/pkl-ast.h b/libpoke/pkl-ast.h
index dc357850..41c5b317 100644
--- a/libpoke/pkl-ast.h
+++ b/libpoke/pkl-ast.h
@@ -964,6 +964,7 @@ pkl_ast_node pkl_ast_make_func_type_arg (pkl_ast ast,
#define PKL_AST_TYPE_S_ITYPE(AST) ((AST)->type.val.sct.itype)
#define PKL_AST_TYPE_O_UNIT(AST) ((AST)->type.val.off.unit)
#define PKL_AST_TYPE_O_BASE_TYPE(AST) ((AST)->type.val.off.base_type)
+#define PKL_AST_TYPE_O_REF_TYPE(AST) ((AST)->type.val.off.ref_type)
#define PKL_AST_TYPE_F_RTYPE(AST) ((AST)->type.val.fun.rtype)
#define PKL_AST_TYPE_F_NARG(AST) ((AST)->type.val.fun.narg)
#define PKL_AST_TYPE_F_ARGS(AST) ((AST)->type.val.fun.args)
@@ -1020,6 +1021,7 @@ struct pkl_ast_type
{
union pkl_ast_node *unit;
union pkl_ast_node *base_type;
+ union pkl_ast_node *ref_type;
} off;
struct
@@ -1051,7 +1053,7 @@ pkl_ast_node pkl_ast_make_struct_type (pkl_ast ast,
size_t nelem, size_t nfield,
int pinned_p, int union_p);
pkl_ast_node pkl_ast_make_offset_type (pkl_ast ast, pkl_ast_node base_type,
- pkl_ast_node unit);
+ pkl_ast_node unit, pkl_ast_node
ref_type);
pkl_ast_node pkl_ast_make_function_type (pkl_ast ast, pkl_ast_node rtype,
size_t narg, pkl_ast_node args);
diff --git a/libpoke/pkl-fold.c b/libpoke/pkl-fold.c
index fe1d7692..e7c1c3df 100644
--- a/libpoke/pkl-fold.c
+++ b/libpoke/pkl-fold.c
@@ -1130,10 +1130,12 @@ PKL_PHASE_BEGIN_HANDLER (pkl_fold_ps_cast)
pkl_ast_node to_unit = PKL_AST_TYPE_O_UNIT (to_type);
pkl_ast_node from_base_type = PKL_AST_TYPE_O_BASE_TYPE (from_type);
pkl_ast_node to_base_type = PKL_AST_TYPE_O_BASE_TYPE (to_type);
+ pkl_ast_node to_ref_type = PKL_AST_TYPE_O_REF_TYPE (to_type);
if (PKL_AST_CODE (magnitude) != PKL_AST_INTEGER
|| PKL_AST_CODE (unit) != PKL_AST_INTEGER
- || PKL_AST_CODE (to_unit) != PKL_AST_INTEGER)
+ || PKL_AST_CODE (to_unit) != PKL_AST_INTEGER
+ || to_ref_type != NULL) /* XXX why?? */
/* We can't fold this cast. */
PKL_PASS_DONE;
diff --git a/libpoke/pkl-gen.c b/libpoke/pkl-gen.c
index 9e4d837d..8ed59586 100644
--- a/libpoke/pkl-gen.c
+++ b/libpoke/pkl-gen.c
@@ -2236,8 +2236,14 @@ PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_type_offset)
{
/* Just build an offset type. */
PKL_PASS_SUBPASS (PKL_AST_TYPE_O_BASE_TYPE (PKL_PASS_NODE)); /*
BASE_TYPE */
- PKL_PASS_SUBPASS (PKL_AST_TYPE_O_UNIT (PKL_PASS_NODE)); /* UNIT */
- pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MKTYO);
+ PKL_PASS_SUBPASS (PKL_AST_TYPE_O_UNIT (PKL_PASS_NODE)); /*
BASE_TYPE UNIT */
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MKTYO); /* TYPE */
+ if (PKL_AST_TYPE_O_REF_TYPE (PKL_PASS_NODE))
+ {
+ PKL_PASS_SUBPASS (PKL_AST_TYPE_O_REF_TYPE (PKL_PASS_NODE)); /* TYPE
REF_TYPE */
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_TYOSETRT); /* TYPE
*/
+ }
+
PKL_PASS_BREAK;
}
diff --git a/libpoke/pkl-insn.def b/libpoke/pkl-insn.def
index 94a0a06b..71bf71e5 100644
--- a/libpoke/pkl-insn.def
+++ b/libpoke/pkl-insn.def
@@ -367,6 +367,8 @@ PKL_DEF_INSN(PKL_INSN_TYISS,"","tyiss")
PKL_DEF_INSN(PKL_INSN_MKTYO,"","mktyo")
PKL_DEF_INSN(PKL_INSN_TYOGETM,"","tyogetm")
PKL_DEF_INSN(PKL_INSN_TYOGETU,"","tyogetu")
+PKL_DEF_INSN(PKL_INSN_TYOGETRT,"","tyogetrt")
+PKL_DEF_INSN(PKL_INSN_TYOSETRT,"","tyosetrt")
PKL_DEF_INSN(PKL_INSN_TYISO,"","tyiso")
PKL_DEF_INSN(PKL_INSN_MKTYC,"","mktyc")
diff --git a/libpoke/pkl-lex.l b/libpoke/pkl-lex.l
index 7494f024..e64462c3 100644
--- a/libpoke/pkl-lex.l
+++ b/libpoke/pkl-lex.l
@@ -458,7 +458,7 @@ S ::
/* Build the offset value itself. */
offset_type = pkl_ast_make_offset_type (yyextra->ast,
magnitude_type,
- unit);
+ unit, NULL /* ref_type */);
yylval->ast = pkl_ast_make_offset (yyextra->ast,
magnitude, unit);
PKL_AST_TYPE (yylval->ast) = ASTREF (offset_type);
diff --git a/libpoke/pkl-pass.c b/libpoke/pkl-pass.c
index 29274a7e..c4148dfc 100644
--- a/libpoke/pkl-pass.c
+++ b/libpoke/pkl-pass.c
@@ -447,6 +447,8 @@ pkl_do_pass_1 (pkl_compiler compiler,
case PKL_TYPE_OFFSET:
PKL_PASS (PKL_AST_TYPE_O_BASE_TYPE (node));
PKL_PASS (PKL_AST_TYPE_O_UNIT (node));
+ if (PKL_AST_TYPE_O_REF_TYPE (node))
+ PKL_PASS (PKL_AST_TYPE_O_REF_TYPE (node));
break;
case PKL_TYPE_INTEGRAL:
diff --git a/libpoke/pkl-promo.c b/libpoke/pkl-promo.c
index 5f239fcf..113febab 100644
--- a/libpoke/pkl-promo.c
+++ b/libpoke/pkl-promo.c
@@ -96,6 +96,7 @@ static int
promote_offset (pkl_ast ast,
size_t size, int sign,
pkl_ast_node unit,
+ pkl_ast_node ref_type,
pkl_ast_node *a,
int *restart)
{
@@ -111,6 +112,7 @@ promote_offset (pkl_ast ast,
int a_type_base_type_sign = PKL_AST_TYPE_I_SIGNED_P (a_type_base_type);
int different_units = 1;
+ int different_ref_types = 1;
/* If the offset units happen to be integer nodes, we can
determine whether they are equal right away. */
@@ -120,9 +122,19 @@ promote_offset (pkl_ast ast,
== PKL_AST_INTEGER_VALUE (unit)))
different_units = 0;
+ /* Determine whether both offset types do not have a referred
+ type, or if the referred type is the same. */
+ if ((!PKL_AST_TYPE_O_REF_TYPE (a_type) && !ref_type)
+ || (ref_type
+ && PKL_AST_TYPE_O_REF_TYPE (a_type)
+ && !pkl_ast_type_equal_p (PKL_AST_TYPE_O_REF_TYPE (a_type),
+ ref_type)))
+ different_ref_types = 0;
+
if (a_type_base_type_size != size
|| a_type_base_type_sign != sign
- || different_units)
+ || different_units
+ || different_ref_types)
{
pkl_ast_loc loc = PKL_AST_LOC (*a);
pkl_ast_node base_type
@@ -130,7 +142,7 @@ promote_offset (pkl_ast ast,
pkl_ast_node unit_type
= pkl_ast_make_integral_type (ast, 64, 0);
pkl_ast_node type
- = pkl_ast_make_offset_type (ast, base_type, unit);
+ = pkl_ast_make_offset_type (ast, base_type, unit, NULL /* ref_type
*/);
PKL_AST_TYPE (unit) = ASTREF (unit_type);
PKL_AST_LOC (base_type) = loc;
@@ -238,12 +250,13 @@ promote_node (pkl_ast ast,
{
pkl_ast_node base_type = PKL_AST_TYPE_O_BASE_TYPE (type);
pkl_ast_node unit = PKL_AST_TYPE_O_UNIT (type);
+ pkl_ast_node ref_type = PKL_AST_TYPE_O_REF_TYPE (type);
size_t size = PKL_AST_TYPE_I_SIZE (base_type);
int signed_p = PKL_AST_TYPE_I_SIGNED_P (base_type);
if (!promote_offset (ast,
- size, signed_p, unit,
+ size, signed_p, unit, ref_type,
node,
restart))
goto error;
@@ -341,12 +354,12 @@ PKL_PHASE_BEGIN_HANDLER (pkl_promo_ps_op_div)
PKL_AST_LOC (unit_bit) = PKL_AST_LOC (exp);
if (!promote_offset (PKL_PASS_AST,
- size, signed_p, unit_bit,
+ size, signed_p, unit_bit, NULL /* ref_type */,
&PKL_AST_EXP_OPERAND (exp, 0), &restart1))
goto error;
if (!promote_offset (PKL_PASS_AST,
- size, signed_p, unit_bit,
+ size, signed_p, unit_bit, NULL /* ref_type */,
&PKL_AST_EXP_OPERAND (exp, 1), &restart2))
goto error;
@@ -356,16 +369,22 @@ PKL_PHASE_BEGIN_HANDLER (pkl_promo_ps_op_div)
}
else
{
- int restart;
+ int restart1, restart2;
pkl_ast_node op1_base_type = PKL_AST_TYPE_O_BASE_TYPE (op1_type);
+ if (!promote_node (PKL_PASS_AST,
+ &PKL_AST_EXP_OPERAND (exp, 0),
+ PKL_AST_TYPE (PKL_PASS_NODE),
+ &restart1))
+ goto error;
+
if (!promote_node (PKL_PASS_AST,
&PKL_AST_EXP_OPERAND (exp, 1),
op1_base_type,
- &restart))
+ &restart2))
goto error;
- PKL_PASS_RESTART = restart;
+ PKL_PASS_RESTART = restart1 || restart2;
}
break;
}
@@ -695,12 +714,12 @@ PKL_PHASE_BEGIN_HANDLER (pkl_promo_ps_op_rela)
PKL_AST_LOC (unit_bit) = PKL_AST_LOC (exp);
if (!promote_offset (PKL_PASS_AST,
- size, signed_p, unit_bit,
+ size, signed_p, unit_bit, NULL /* ref_type */,
&PKL_AST_EXP_OPERAND (exp, 0), &restart1))
goto error;
if (!promote_offset (PKL_PASS_AST,
- size, signed_p, unit_bit,
+ size, signed_p, unit_bit, NULL /* ref_type */,
&PKL_AST_EXP_OPERAND (exp, 1), &restart2))
goto error;
@@ -774,7 +793,7 @@ PKL_PHASE_BEGIN_HANDLER (pkl_promo_ps_op_bshiftpow)
int signed_p = PKL_AST_TYPE_I_SIGNED_P (base_type);
if (!promote_offset (PKL_PASS_AST,
- size, signed_p, unit,
+ size, signed_p, unit, NULL /* ref_type */,
&PKL_AST_EXP_OPERAND (exp, 0), &restart1)
|| !promote_integral (PKL_PASS_AST, 32, 0,
&PKL_AST_EXP_OPERAND (exp, 1), &restart2))
@@ -890,7 +909,7 @@ PKL_PHASE_BEGIN_HANDLER (pkl_promo_ps_indexer)
pkl_ast_node unit_bit = pkl_ast_make_integer (PKL_PASS_AST, 1);
unit_bit = ASTREF (unit_bit);
- if (!promote_offset (PKL_PASS_AST, 64, 0, unit_bit,
+ if (!promote_offset (PKL_PASS_AST, 64, 0, unit_bit, NULL /* ref_type */,
&PKL_AST_INDEXER_INDEX (node), &restart))
{
PKL_ICE (PKL_AST_LOC (node),
@@ -995,7 +1014,7 @@ PKL_PHASE_BEGIN_HANDLER (pkl_promo_ps_type_array)
unit_bit = ASTREF (unit_bit);
if (!promote_offset (PKL_PASS_AST,
- 64, 0, unit_bit,
+ 64, 0, unit_bit, NULL /* ref_type */,
&PKL_AST_TYPE_A_BOUND (array_type), &restart))
{
PKL_ICE (PKL_AST_LOC (bound),
@@ -1331,7 +1350,7 @@ PKL_PHASE_BEGIN_HANDLER (pkl_promo_ps_map)
unit_bit = ASTREF (unit_bit);
if (!promote_offset (PKL_PASS_AST,
- 64, 0, unit_bit,
+ 64, 0, unit_bit, NULL /* ref_type */,
&PKL_AST_MAP_OFFSET (map),
&restart))
{
@@ -1532,7 +1551,7 @@ PKL_PHASE_BEGIN_HANDLER (pkl_promo_ps_struct_type_field)
pkl_ast_node unit_bit = pkl_ast_make_integer (PKL_PASS_AST, 1);
if (!promote_offset (PKL_PASS_AST,
- 64, 0, unit_bit,
+ 64, 0, unit_bit, NULL /* ref_type */,
&PKL_AST_STRUCT_TYPE_FIELD_LABEL (elem),
&restart))
{
diff --git a/libpoke/pkl-rt.pk b/libpoke/pkl-rt.pk
index be60948c..290d4acb 100644
--- a/libpoke/pkl-rt.pk
+++ b/libpoke/pkl-rt.pk
@@ -1298,7 +1298,8 @@ immutable type _Pkl_Print_Format_Ctx =
immutable fun _pkl_print_format_any = (any val,
_Pkl_Print_Format_Ctx ctx,
int<32> depth,
- int<32> obase = vm_obase) void:
+ int<32> obase = vm_obase,
+ int<32> only_struct_type_name = 0) void:
{
fun lutos = (uint<64> i, int<32> base, int<32> padbits = 0) string:
{
@@ -1329,6 +1330,7 @@ immutable fun _pkl_print_format_any = (any val,
return s;
}
+
fun handle_type = void:
{
ctx.begin_class ("type");
@@ -1349,10 +1351,17 @@ immutable fun _pkl_print_format_any = (any val,
{
var base_type = asm any: ("tyogetm; nip" : val),
unit_in_bits = asm uint<64>: ("tyogetu; nip" : val);
+ var ref_type = asm any: ("tyogetrt; nip" : val);
ctx.emit ("offset<");
_pkl_print_format_any (base_type, ctx, depth);
- ctx.emit ("," + lutos (unit_in_bits, 10) + ">");
+ ctx.emit ("," + lutos (unit_in_bits, 10));
+ if (asm int<32>: ("nn; nip" : ref_type))
+ {
+ ctx.emit (",");
+ _pkl_print_format_any (ref_type, ctx, depth, obase, 1);
+ }
+ ctx.emit (">");
}
else if (asm int<32>: ("tyiss; nip" : val))
ctx.emit ("string");
@@ -1377,6 +1386,11 @@ immutable fun _pkl_print_format_any = (any val,
var nfields = asm uint<64>: ("tysctgetnf; nip" : val);
ctx.emit (name);
+ if (name != "struct" && only_struct_type_name)
+ {
+ ctx.end_class ("type");
+ return;
+ }
ctx.emit (" {");
for (var i = 0UL; i < nfields; ++i)
{
diff --git a/libpoke/pkl-tab.y b/libpoke/pkl-tab.y
index 47023cc2..2fe17b65 100644
--- a/libpoke/pkl-tab.y
+++ b/libpoke/pkl-tab.y
@@ -566,7 +566,7 @@ load_module (struct pkl_parser *parser,
%type <ast> typename type_specifier simple_type_specifier cons_type_specifier
%type <ast> integral_type_specifier offset_type_specifier array_type_specifier
%type <ast> function_type_specifier function_type_arg_list function_type_arg
-%type <ast> struct_type_specifier string_type_specifier
+%type <ast> struct_type_specifier string_type_specifier ref_type
%type <ast> struct_type_elem_list struct_type_field
struct_type_field_identifier
%type <ast> struct_type_field_label struct_type_computed_field
%type <field_const_init> struct_type_field_constraint_and_init
@@ -1596,8 +1596,13 @@ integral_type_sign:
| UINTCONSTR { $$ = 0; }
;
+ref_type:
+ %empty { $$ = NULL; }
+ | ',' simple_type_specifier { $$ = $2; }
+ ;
+
offset_type_specifier:
- OFFSETCONSTR simple_type_specifier ',' identifier '>'
+ OFFSETCONSTR simple_type_specifier ',' identifier ref_type '>'
{
pkl_ast_node decl
= pkl_env_lookup (pkl_parser->env,
@@ -1623,15 +1628,16 @@ offset_type_specifier:
$$ = pkl_ast_make_offset_type (pkl_parser->ast,
$2,
- PKL_AST_DECL_INITIAL (decl));
+ PKL_AST_DECL_INITIAL (decl),
+ $5);
$4 = ASTREF ($4); pkl_ast_node_free ($4);
PKL_AST_LOC ($$) = @$;
}
- | OFFSETCONSTR simple_type_specifier ',' integer '>'
+ | OFFSETCONSTR simple_type_specifier ',' integer ref_type '>'
{
$$ = pkl_ast_make_offset_type (pkl_parser->ast,
- $2, $4);
+ $2, $4, $5);
PKL_AST_LOC (PKL_AST_TYPE ($4)) = @4;
PKL_AST_LOC ($4) = @4;
PKL_AST_LOC ($$) = @$;
@@ -1757,7 +1763,8 @@ struct_type_specifier:
offset_unit);
type = pkl_ast_make_offset_type (pkl_parser->ast,
type,
- offset_unit);
+ offset_unit,
+ NULL /* ref_type */);
PKL_AST_TYPE (offset) = ASTREF (type);
decl = pkl_ast_make_decl (pkl_parser->ast,
diff --git a/libpoke/pkl-trans.c b/libpoke/pkl-trans.c
index 27c4554f..b8184557 100644
--- a/libpoke/pkl-trans.c
+++ b/libpoke/pkl-trans.c
@@ -1973,7 +1973,7 @@ PKL_PHASE_BEGIN_HANDLER (pkl_trans3_ps_op_sizeof)
offset_type = pkl_ast_make_offset_type (PKL_PASS_AST,
PKL_AST_TYPE (magnitude),
- unit);
+ unit, NULL /* ref_type */);
PKL_AST_TYPE (offset) = ASTREF (offset_type);
}
diff --git a/libpoke/pkl-typify.c b/libpoke/pkl-typify.c
index 98342992..d81dfdc8 100644
--- a/libpoke/pkl-typify.c
+++ b/libpoke/pkl-typify.c
@@ -338,6 +338,7 @@ PKL_PHASE_BEGIN_HANDLER (pkl_typify1_ps_neg_pos_bnot)
pkl_ast_node exp = PKL_PASS_NODE;
pkl_ast_node op1 = PKL_AST_EXP_OPERAND (exp, 0);
pkl_ast_node op1_type = PKL_AST_TYPE (op1);
+ pkl_ast_node type = NULL;
/* Handle an integral struct operand. */
if (PKL_AST_TYPE_CODE (op1_type) == PKL_TYPE_STRUCT
@@ -347,13 +348,22 @@ PKL_PHASE_BEGIN_HANDLER (pkl_typify1_ps_neg_pos_bnot)
switch (PKL_AST_TYPE_CODE (op1_type))
{
case PKL_TYPE_INTEGRAL:
+ type = op1_type;
+ break;
case PKL_TYPE_OFFSET:
+ /* The type of the result has the same magnitude and unit
+ than the operand, but some attributes of the type are
+ not propagated. */
+ type = pkl_ast_make_offset_type (PKL_PASS_AST,
+ PKL_AST_TYPE_O_BASE_TYPE (op1_type),
+ PKL_AST_TYPE_O_UNIT (op1_type),
+ NULL /* ref_type */);
break;
default:
INVALID_OPERAND (op1, "expected integral or offset");
}
- PKL_AST_TYPE (exp) = ASTREF (op1_type);
+ PKL_AST_TYPE (exp) = ASTREF (type);
}
PKL_PHASE_END_HANDLER
@@ -601,20 +611,24 @@ PKL_PHASE_BEGIN_HANDLER (pkl_typify1_ps_bin)
INVALID_OPERAND (op2, "expected integral or offset");
/* For OFFSET / INTEGRAL the type of the result is the
- type of the first operand. */
+ type of the first operand. But note that ref_type is
+ not propagated. */
if (op2_type_code == PKL_TYPE_INTEGRAL)
{
- type = op1_type;
- break;
+ type = pkl_ast_make_offset_type (PKL_PASS_AST,
+ PKL_AST_TYPE_O_BASE_TYPE
(op1_type),
+ PKL_AST_TYPE_O_UNIT
(op1_type),
+ NULL /* ref_type */);
+ }
+ else
+ {
+ /* For OFFSET / OFFSET the type of the result is an
+ integral as promoted by the base types of the
+ offset operands. */
+ type = pkl_type_integral_promote (PKL_PASS_AST,
+ PKL_AST_TYPE_O_BASE_TYPE
(op1_type),
+ PKL_AST_TYPE_O_BASE_TYPE
(op2_type));
}
-
- /* For OFFSET / OFFSET the type of the result is an
- integral as promoted by the base types of the offset
- operands. */
-
- type = pkl_type_integral_promote (PKL_PASS_AST,
- PKL_AST_TYPE_O_BASE_TYPE
(op1_type),
- PKL_AST_TYPE_O_BASE_TYPE
(op2_type));
break;
case PKL_AST_OP_MOD:
{
@@ -646,7 +660,8 @@ PKL_PHASE_BEGIN_HANDLER (pkl_typify1_ps_bin)
PKL_AST_TYPE (unit) = ASTREF (unit_type);
type = pkl_ast_make_offset_type (PKL_PASS_AST,
- base_type_1, unit);
+ base_type_1, unit,
+ NULL /* ref_type */);
break;
}
default:
@@ -687,7 +702,7 @@ PKL_PHASE_BEGIN_HANDLER (pkl_typify1_ps_bin)
PKL_AST_TYPE (unit) = ASTREF (unit_type);
type = pkl_ast_make_offset_type (PKL_PASS_AST,
base_type,
- unit);
+ unit, NULL /* ref_type */);
break;
}
}
@@ -776,7 +791,7 @@ PKL_PHASE_BEGIN_HANDLER (pkl_typify1_ps_bshift_pow)
pkl_ast_node unit = PKL_AST_TYPE_O_UNIT (op1_type);
type = pkl_ast_make_offset_type (PKL_PASS_AST,
- base_type, unit);
+ base_type, unit, NULL /* ref_type */);
break;
}
default:
@@ -846,7 +861,8 @@ PKL_PHASE_BEGIN_HANDLER (pkl_typify1_ps_mul)
op2_type);
type = pkl_ast_make_offset_type (PKL_PASS_AST,
res_base_type,
- PKL_AST_TYPE_O_UNIT (op1_type));
+ PKL_AST_TYPE_O_UNIT (op1_type),
+ NULL /* ref_type */);
break;
}
case PKL_TYPE_INTEGRAL:
@@ -867,7 +883,8 @@ PKL_PHASE_BEGIN_HANDLER (pkl_typify1_ps_mul)
op1_type);
type = pkl_ast_make_offset_type (PKL_PASS_AST,
res_base_type,
- PKL_AST_TYPE_O_UNIT (op2_type));
+ PKL_AST_TYPE_O_UNIT (op2_type),
+ NULL /* ref_type */);
break;
}
default:
@@ -986,7 +1003,7 @@ PKL_PHASE_BEGIN_HANDLER (pkl_typify1_ps_op_sizeof)
= pkl_ast_make_integer (PKL_PASS_AST, PKL_AST_OFFSET_UNIT_BITS);
pkl_ast_node type
- = pkl_ast_make_offset_type (PKL_PASS_AST, itype, unit);
+ = pkl_ast_make_offset_type (PKL_PASS_AST, itype, unit, NULL /* ref_type
*/);
PKL_AST_TYPE (unit) = ASTREF (itype);
PKL_AST_TYPE (PKL_PASS_NODE) = ASTREF (type);
@@ -1045,7 +1062,8 @@ PKL_PHASE_BEGIN_HANDLER (pkl_typify1_ps_offset)
}
type = pkl_ast_make_offset_type (PKL_PASS_AST,
- magnitude_type, unit);
+ magnitude_type, unit,
+ NULL /* ref_type */);
PKL_AST_TYPE (offset) = ASTREF (type);
}
PKL_PHASE_END_HANDLER
@@ -2560,7 +2578,8 @@ PKL_PHASE_BEGIN_HANDLER (pkl_typify1_ps_attr)
PKL_AST_TYPE (offset_unit) = ASTREF (offset_unit_type);
exp_type = pkl_ast_make_integral_type (PKL_PASS_AST, 64, 0);
- exp_type = pkl_ast_make_offset_type (PKL_PASS_AST, exp_type,
offset_unit);
+ exp_type = pkl_ast_make_offset_type (PKL_PASS_AST, exp_type, offset_unit,
+ NULL /* ref_type */);
PKL_AST_TYPE (exp) = ASTREF (exp_type);
break;
@@ -2611,7 +2630,8 @@ PKL_PHASE_BEGIN_HANDLER (pkl_typify1_ps_attr)
PKL_AST_TYPE (offset_unit) = ASTREF (offset_unit_type);
exp_type = pkl_ast_make_integral_type (PKL_PASS_AST, 64, 0);
- exp_type = pkl_ast_make_offset_type (PKL_PASS_AST, exp_type,
offset_unit);
+ exp_type = pkl_ast_make_offset_type (PKL_PASS_AST, exp_type, offset_unit,
+ NULL /* ref_type */);
PKL_AST_TYPE (exp) = ASTREF (exp_type);
break;
@@ -2678,7 +2698,8 @@ PKL_PHASE_BEGIN_HANDLER (pkl_typify1_ps_attr)
PKL_AST_TYPE (offset_unit) = ASTREF (offset_unit_type);
exp_type = pkl_ast_make_integral_type (PKL_PASS_AST, 64, 0);
- exp_type = pkl_ast_make_offset_type (PKL_PASS_AST, exp_type,
offset_unit);
+ exp_type = pkl_ast_make_offset_type (PKL_PASS_AST, exp_type,
offset_unit,
+ NULL /* ref_type */);
}
PKL_AST_TYPE (exp) = ASTREF (exp_type);
@@ -2886,7 +2907,8 @@ PKL_PHASE_BEGIN_HANDLER (pkl_typify1_ps_struct_type_field)
pkl_ast_node offset_type
= pkl_ast_make_offset_type (PKL_PASS_AST,
pkl_ast_make_integral_type (PKL_PASS_AST,
64, 0),
- pkl_ast_make_integer (PKL_PASS_AST, 1));
+ pkl_ast_make_integer (PKL_PASS_AST, 1),
+ NULL /* ref_type */);
if (!pkl_ast_type_promoteable_p (label_type, offset_type,
diff --git a/libpoke/pkl.c b/libpoke/pkl.c
index a067c7e0..0f781e8c 100644
--- a/libpoke/pkl.c
+++ b/libpoke/pkl.c
@@ -823,8 +823,10 @@ pvm_type_to_ast_type (pkl_ast ast, pvm_val type)
= pvm_type_to_ast_type (ast, PVM_VAL_TYP_O_BASE_TYPE (type));
pkl_ast_node unit
= pkl_ast_make_integer (ast, PVM_VAL_ULONG (PVM_VAL_TYP_O_UNIT
(type)));
+ pkl_ast_node ref_type
+ = pvm_type_to_ast_type (ast, PVM_VAL_TYP_O_REF_TYPE (type));
- return pkl_ast_make_offset_type (ast, base_type, unit);
+ return pkl_ast_make_offset_type (ast, base_type, unit, ref_type);
break;
}
case PVM_TYPE_VOID:
diff --git a/libpoke/pvm-val.c b/libpoke/pvm-val.c
index 21c114e9..2d93720b 100644
--- a/libpoke/pvm-val.c
+++ b/libpoke/pvm-val.c
@@ -517,12 +517,13 @@ pvm_make_void_type (void)
}
pvm_val
-pvm_make_offset_type (pvm_val base_type, pvm_val unit)
+pvm_make_offset_type (pvm_val base_type, pvm_val unit, pvm_val ref_type)
{
pvm_val otype = pvm_make_type (PVM_TYPE_OFFSET);
PVM_VAL_TYP_O_BASE_TYPE (otype) = base_type;
PVM_VAL_TYP_O_UNIT (otype) = unit;
+ PVM_VAL_TYP_O_REF_TYPE (otype) = ref_type;
return otype;
}
diff --git a/libpoke/pvm-val.h b/libpoke/pvm-val.h
index 192a5741..b4cf1861 100644
--- a/libpoke/pvm-val.h
+++ b/libpoke/pvm-val.h
@@ -433,6 +433,7 @@ typedef struct pvm_struct *pvm_struct;
#define PVM_VAL_TYP_S_FTYPE(V,I) (PVM_VAL_TYP_S_FTYPES((V))[(I)])
#define PVM_VAL_TYP_O_UNIT(V) (PVM_VAL_TYP((V))->val.off.unit)
#define PVM_VAL_TYP_O_BASE_TYPE(V) (PVM_VAL_TYP((V))->val.off.base_type)
+#define PVM_VAL_TYP_O_REF_TYPE(V) (PVM_VAL_TYP((V))->val.off.ref_type)
#define PVM_VAL_TYP_C_RETURN_TYPE(V) (PVM_VAL_TYP((V))->val.cls.return_type)
#define PVM_VAL_TYP_C_NARGS(V) (PVM_VAL_TYP((V))->val.cls.nargs)
#define PVM_VAL_TYP_C_ATYPES(V) (PVM_VAL_TYP((V))->val.cls.atypes)
@@ -479,6 +480,7 @@ struct pvm_type
{
pvm_val base_type;
pvm_val unit;
+ pvm_val ref_type;
} off;
struct
diff --git a/libpoke/pvm.h b/libpoke/pvm.h
index 44a0d11c..1c000d3b 100644
--- a/libpoke/pvm.h
+++ b/libpoke/pvm.h
@@ -303,7 +303,7 @@ pvm_val pvm_make_array_type (pvm_val type, pvm_val bound);
pvm_val pvm_make_struct_type (pvm_val nfields, pvm_val name,
pvm_val *fnames, pvm_val *ftypes);
-pvm_val pvm_make_offset_type (pvm_val base_type, pvm_val unit);
+pvm_val pvm_make_offset_type (pvm_val base_type, pvm_val unit, pvm_val
ref_type);
pvm_val pvm_make_closure_type (pvm_val rtype, pvm_val nargs,
pvm_val *atypes);
diff --git a/libpoke/pvm.jitter b/libpoke/pvm.jitter
index d42b69bd..61d4ee16 100644
--- a/libpoke/pvm.jitter
+++ b/libpoke/pvm.jitter
@@ -1630,7 +1630,7 @@ instruction iosize ()
{
pvm_val magnitude = PVM_MAKE_ULONG (ios_size (io), 64);
pvm_val type = pvm_make_offset_type (pvm_typeof (magnitude),
- PVM_MAKE_ULONG (8, 64));
+ PVM_MAKE_ULONG (8, 64), PVM_NULL
/* ref_type */);
JITTER_PUSH_STACK (pvm_make_offset (PVM_MAKE_ULONG (ios_size (io),
64), type));
}
end
@@ -1733,7 +1733,7 @@ instruction iogetb ()
unit = PVM_MAKE_ULONG (1, 64);
}
- type = pvm_make_offset_type (pvm_typeof (magnitude), unit);
+ type = pvm_make_offset_type (pvm_typeof (magnitude), unit, PVM_NULL /*
ref_type */);
JITTER_PUSH_STACK (pvm_make_offset (magnitude, type));
end
end
@@ -5524,7 +5524,7 @@ end
instruction mkoq ()
code
pvm_val type = pvm_make_offset_type (pvm_typeof (JITTER_UNDER_TOP_STACK ()),
- JITTER_TOP_STACK ());
+ JITTER_TOP_STACK (), PVM_NULL /*
ref_type */);
pvm_val res = pvm_make_offset (JITTER_UNDER_TOP_STACK (), type);
JITTER_DROP_STACK ();
JITTER_TOP_STACK () = res;
@@ -6192,10 +6192,14 @@ end
instruction mktyo ()
code
-#define F(res, a, b) \
- { res = pvm_make_offset_type (a, b); }
- JITTER_BINARY_STACK(F);
-#undef F
+ pvm_val base_type, unit;
+
+ unit = JITTER_TOP_STACK ();
+ base_type = JITTER_UNDER_TOP_STACK ();
+ JITTER_DROP_STACK ();
+ JITTER_DROP_STACK ();
+ JITTER_PUSH_STACK (pvm_make_offset_type (base_type, unit,
+ PVM_NULL /* ref_type */));
end
end
@@ -6223,6 +6227,35 @@ instruction tyogetu ()
end
end
+# Instruction: tyogetrt
+#
+# Given an offset type, push the referred type to the stack.
+# This can be PVM_NULL if the offset type isn't a reference.
+#
+# Stack: ( OTYPE -- OTYPE TYPE )
+
+instruction tyogetrt ()
+ code
+ JITTER_PUSH_STACK (PVM_VAL_TYP_O_REF_TYPE (JITTER_TOP_STACK ()));
+ end
+end
+
+# Instruction: tyosetrt
+#
+# Given an offset type and a referred type, make the offset type
+# a referring type. The referred type can be PVM_NULL. In this
+# case the resulting offset type is not a referring offset type.
+#
+# Stack: ( OTYPE TYPE -- OTYPE )
+
+instruction tyosetrt ()
+ code
+ PVM_VAL_TYP_O_REF_TYPE (JITTER_UNDER_TOP_STACK ())
+ = JITTER_TOP_STACK ();
+ JITTER_DROP_STACK ();
+ end
+end
+
# Instruction: mktya
#
# Given an elements type and a bounder closure, build an array type
diff --git a/testsuite/Makefile.am b/testsuite/Makefile.am
index a9c9a560..99d28d8d 100644
--- a/testsuite/Makefile.am
+++ b/testsuite/Makefile.am
@@ -706,6 +706,7 @@ EXTRA_DIST = \
poke.pkl/add-offsets-9.pk \
poke.pkl/add-offsets-diag-1.pk \
poke.pkl/add-offsets-10.pk \
+ poke.pkl/add-offsets-11.pk \
poke.pkl/add-strings-1.pk \
poke.pkl/add-strings-diag-1.pk \
poke.pkl/adda-int-1.pk \
@@ -1031,6 +1032,7 @@ EXTRA_DIST = \
poke.pkl/bnot-integers-4.pk \
poke.pkl/bnot-int-struct-1.pk \
poke.pkl/bnot-offsets-1.pk \
+ poke.pkl/bnot-offsets-2.pk \
poke.pkl/break-diag-1.pk \
poke.pkl/break-for-1.pk \
poke.pkl/break-while-1.pk \
@@ -1257,6 +1259,7 @@ EXTRA_DIST = \
poke.pkl/div-offsets-2.pk \
poke.pkl/div-offsets-3.pk \
poke.pkl/div-offsets-4.pk \
+ poke.pkl/div-offsets-5.pk \
poke.pkl/div-offsets-diag-1.pk \
poke.pkl/div-offsets-diag-2.pk \
poke.pkl/div-offsets-diag-3.pk \
@@ -1813,6 +1816,7 @@ EXTRA_DIST = \
poke.pkl/mod-offsets-3.pk \
poke.pkl/mod-offsets-4.pk \
poke.pkl/mod-offsets-5.pk \
+ poke.pkl/mod-offsets-6.pk \
poke.pkl/mod-offsets-diag-1.pk \
poke.pkl/mod-offsets-diag-2.pk \
poke.pkl/moda-int-1.pk \
@@ -1845,6 +1849,7 @@ EXTRA_DIST = \
poke.pkl/mul-offsets-9.pk \
poke.pkl/mul-offsets-10.pk \
poke.pkl/mul-offsets-11.pk \
+ poke.pkl/mul-offsets-12.pk \
poke.pkl/mul-strings-1.pk \
poke.pkl/mul-strings-2.pk \
poke.pkl/mul-strings-3.pk \
@@ -1913,6 +1918,7 @@ EXTRA_DIST = \
poke.pkl/offset-arg-2.pk \
poke.pkl/offset-diag-1.pk \
poke.pkl/offset-type-1.pk \
+ poke.pkl/offset-type-2.pk \
poke.pkl/offset-type-diag-1.pk \
poke.pkl/offset-type-diag-2.pk \
poke.pkl/offset-type-diag-3.pk \
@@ -2038,6 +2044,7 @@ EXTRA_DIST = \
poke.pkl/print-any-1.pk \
poke.pkl/print-any-2.pk \
poke.pkl/print-any-3.pk \
+ poke.pkl/print-any-4.pk \
poke.pkl/print-diag-1.pk \
poke.pkl/preincr-field-1.pk \
poke.pkl/preincr-diag-2.pk \
@@ -2535,6 +2542,7 @@ EXTRA_DIST = \
poke.pkl/sub-offsets-6.pk \
poke.pkl/sub-offsets-7.pk \
poke.pkl/sub-offsets-8.pk \
+ poke.pkl/sub-offsets-9.pk \
poke.pkl/suba-int-1.pk \
poke.pkl/suba-offset-1.pk \
poke.pkl/term-class-1.pk \
diff --git a/testsuite/poke.pkl/add-offsets-11.pk
b/testsuite/poke.pkl/add-offsets-11.pk
new file mode 100644
index 00000000..714e08e5
--- /dev/null
+++ b/testsuite/poke.pkl/add-offsets-11.pk
@@ -0,0 +1,15 @@
+/* { dg-do run } */
+
+/* The ref_type attribute of offset types must not be propagated
+ in add expressions. */
+
+type Pointer_To_Exception = offset<int<32>,B,Exception>;
+var a = 1#B as Pointer_To_Exception;
+var b = 2*8#b as Pointer_To_Exception;
+
+/* { dg-command { asm any: ("typof; nip" : a + b) } } */
+/* { dg-output "offset<int<32>,8>" } */
+
+/* For constant folding: */
+/* { dg-command { asm any: ("typof; nip" : 1#B as Pointer_To_Exception + 2*8#b
as Pointer_To_Exception) } } */
+/* { dg-output "\noffset<int<32>,8>" } */
diff --git a/testsuite/poke.pkl/bnot-offsets-2.pk
b/testsuite/poke.pkl/bnot-offsets-2.pk
new file mode 100644
index 00000000..f1bb8eab
--- /dev/null
+++ b/testsuite/poke.pkl/bnot-offsets-2.pk
@@ -0,0 +1,14 @@
+/* { dg-do run } */
+
+/* The ref_type attribute of offset types must not be propagated
+ in bnot expressions. */
+
+type Pointer_To_Exception = offset<int<32>,B,Exception>;
+var a = 1#B as Pointer_To_Exception;
+
+/* { dg-command { asm any: ("typof; nip" : ~a) } } */
+/* { dg-output "offset<int<32>,8>" } */
+
+/* For constant folding: */
+/* { dg-command { asm any: ("typof; nip" : ~(1#B as Pointer_To_Exception)) } }
*/
+/* { dg-output "\noffset<int<32>,8>" } */
diff --git a/testsuite/poke.pkl/div-offsets-5.pk
b/testsuite/poke.pkl/div-offsets-5.pk
new file mode 100644
index 00000000..07bc9a82
--- /dev/null
+++ b/testsuite/poke.pkl/div-offsets-5.pk
@@ -0,0 +1,15 @@
+/* { dg-do run } */
+
+/* The ref_type attribute of offset types must not be propagated
+ in div expressions. */
+
+type Pointer_To_Exception = offset<int<32>,B,Exception>;
+var a = 1#B as Pointer_To_Exception;
+var b = 2;
+
+/* { dg-command { asm any: ("typof; nip" : a / b) } } */
+/* { dg-output "offset<int<32>,8>" } */
+
+/* For constant folding: */
+/* { dg-command { asm any: ("typof; nip" : 1#B as Pointer_To_Exception / 2) }
} */
+/* { dg-output "\noffset<int<32>,8>" } */
diff --git a/testsuite/poke.pkl/mod-offsets-6.pk
b/testsuite/poke.pkl/mod-offsets-6.pk
new file mode 100644
index 00000000..5715f799
--- /dev/null
+++ b/testsuite/poke.pkl/mod-offsets-6.pk
@@ -0,0 +1,15 @@
+/* { dg-do run } */
+
+/* The ref_type attribute of offset types must not be propagated
+ in mod expressions. */
+
+type Pointer_To_Exception = offset<int<32>,B,Exception>;
+var a = 1#B as Pointer_To_Exception;
+var b = 2#b;
+
+/* { dg-command { asm any: ("typof; nip" : a % b) } } */
+/* { dg-output "offset<int<32>,1>" } */
+
+/* For constant folding: */
+/* { dg-command { asm any: ("typof; nip" : 1#B as Pointer_To_Exception % 2#b)
} } */
+/* { dg-output "\noffset<int<32>,1>" } */
diff --git a/testsuite/poke.pkl/mul-offsets-12.pk
b/testsuite/poke.pkl/mul-offsets-12.pk
new file mode 100644
index 00000000..aba452ef
--- /dev/null
+++ b/testsuite/poke.pkl/mul-offsets-12.pk
@@ -0,0 +1,15 @@
+/* { dg-do run } */
+
+/* The ref_type attribute of offset types must not be propagated
+ in mul expressions. */
+
+type Pointer_To_Exception = offset<int<32>,B,Exception>;
+var a = 1#B as Pointer_To_Exception;
+var b = 2;
+
+/* { dg-command { asm any: ("typof; nip" : a * b) } } */
+/* { dg-output "offset<int<32>,8>" } */
+
+/* For constant folding: */
+/* { dg-command { asm any: ("typof; nip" : 1#B as Pointer_To_Exception * 2) }
} */
+/* { dg-output "\noffset<int<32>,8>" } */
diff --git a/testsuite/poke.pkl/offset-type-2.pk
b/testsuite/poke.pkl/offset-type-2.pk
new file mode 100644
index 00000000..e76f3e78
--- /dev/null
+++ b/testsuite/poke.pkl/offset-type-2.pk
@@ -0,0 +1,6 @@
+/* {dg-do run } */
+
+type Pointer_To_Exception = offset<int<32>,B,Exception>;
+
+/* { dg-command {23*8#b as Pointer_To_Exception} } */
+/* { dg-output {23#B} } */
diff --git a/testsuite/poke.pkl/print-any-4.pk
b/testsuite/poke.pkl/print-any-4.pk
new file mode 100644
index 00000000..3a21c8aa
--- /dev/null
+++ b/testsuite/poke.pkl/print-any-4.pk
@@ -0,0 +1,11 @@
+/* { dg-do run } */
+
+type Pointer_To_Exception = offset<int<32>,B,Exception>;
+var x = 23#B;
+
+/* { dg-command {asm any: ("typof; nip" : x as Pointer_To_Exception)} } */
+/* { dg-output "offset<int<32>,8,Exception>" } */
+
+/* For constant folding: */
+/* { dg-command {asm any: ("typof; nip" : 23#B as Pointer_To_Exception)} } */
+/* { dg-output "\noffset<int<32>,8,Exception>" } */
diff --git a/testsuite/poke.pkl/sub-offsets-9.pk
b/testsuite/poke.pkl/sub-offsets-9.pk
new file mode 100644
index 00000000..f060ebd3
--- /dev/null
+++ b/testsuite/poke.pkl/sub-offsets-9.pk
@@ -0,0 +1,15 @@
+/* { dg-do run } */
+
+/* The ref_type attribute of offset types must not be propagated
+ in sub expressions. */
+
+type Pointer_To_Exception = offset<int<32>,B,Exception>;
+var a = 1#B as Pointer_To_Exception;
+var b = 2*8#b as Pointer_To_Exception;
+
+/* { dg-command { asm any: ("typof; nip" : a - b) } } */
+/* { dg-output "offset<int<32>,8>" } */
+
+/* For constant folding: */
+/* { dg-command { asm any: ("typof; nip" : 1#B as Pointer_To_Exception - 2*8#b
as Pointer_To_Exception) } } */
+/* { dg-output "\noffset<int<32>,8>" } */
--
2.30.2
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [COMMITTED 1/3] pkl,pvm: add a ref_type attribute to offset types,
Jose E. Marchesi <=