poke-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[COMMITTED] pkl,testsuite,doc: support for struct deintegrators


From: Jose E. Marchesi
Subject: [COMMITTED] pkl,testsuite,doc: support for struct deintegrators
Date: Thu, 30 Dec 2021 13:29:37 +0100
User-agent: Gnus/5.13 (Gnus v5.13) Emacs/28.0.50 (gnu/linux)

This commit adds support for casting integral values to integral
struct types.  For example:

  (poke) type Foo = struct int<32> { offset<int<16>,B> a; uint<16> b; }
  (poke) 0xdeadbeef as Foo
  Foo {
    a=0xdeadH#B,
    b=0xbeefUH
  }

This complements the already existing support for casting integral
struct types to integral values.

Tests and documentation included.

2021-12-30  Jose E. Marchesi  <jemarch@gnu.org>

        * libpoke/pkl-ast.h (PKL_AST_TYPE_S_DEINTEGRATOR): Define.
        * libpoke/pkl-ast.c (pkl_ast_make_struct_type): Increase the
        number of closures to 8.
        (pkl_ast_make_struct_type): Initialize deintegrator to PVM_NULL.
        * libpoke/pkl-typify.c (pkl_typify1_ps_cast): Allow casts from
        integral types to integral structs.
        * libpoke/pkl-promo.c (pkl_promo_ps_cast): New handler.
        (pkl_phase_promo): Install handler.
        * libpoke/pkl-gen.c (pkl_gen_pr_decl): Compile deintegrator
        closures for named struct types.
        * libpoke/pkl-gen.pks (struct_deintegrator): New function.
        (deint_extract_field_value): New macro.
        (struct_constructor): Do not check for constraint errors if
        `be_strict' is set to false.
        * testsuite/poke.pkl/deint-struct-1.pk: New test.
        * testsuite/poke.pkl/deint-struct-2.pk: Likewise.
        * testsuite/poke.pkl/deint-struct-3.pk: Likewise.
        * testsuite/poke.pkl/deint-struct-4.pk: Likewise.
        * testsuite/poke.pkl/deint-struct-5.pk: Likewise.
        * testsuite/poke.pkl/deint-struct-6.pk: Likewise.
        * testsuite/poke.pkl/deint-struct-7.pk: Likewise.
        * testsuite/poke.pkl/deint-struct-8.pk: Likewise.
        * testsuite/poke.pkl/deint-struct-9.pk: Likewise.
        * testsuite/Makefile.am (EXTRA_DIST): Add new tests.
        * doc/poke.texi (Casting Structs): Note that it is possible to
        cast an integral value to an integral struct.
---
 ChangeLog                            |  29 +++++++
 doc/poke.texi                        |  10 +++
 libpoke/pkl-ast.c                    |   5 +-
 libpoke/pkl-ast.h                    |  11 +--
 libpoke/pkl-gen.c                    |  51 ++++++++++++
 libpoke/pkl-gen.pks                  | 153 +++++++++++++++++++++++++++++++++++
 libpoke/pkl-promo.c                  |  35 ++++++++
 libpoke/pkl-tab.y                    |   6 ++
 libpoke/pkl-typify.c                 |  20 +++--
 libpoke/pvm.jitter                   |   1 +
 testsuite/Makefile.am                |   9 +++
 testsuite/poke.pkl/deint-struct-1.pk |   6 ++
 testsuite/poke.pkl/deint-struct-2.pk |   6 ++
 testsuite/poke.pkl/deint-struct-3.pk |   7 ++
 testsuite/poke.pkl/deint-struct-4.pk |  14 ++++
 testsuite/poke.pkl/deint-struct-5.pk |   7 ++
 testsuite/poke.pkl/deint-struct-6.pk |   7 ++
 testsuite/poke.pkl/deint-struct-7.pk |  14 ++++
 testsuite/poke.pkl/deint-struct-8.pk |   7 ++
 testsuite/poke.pkl/deint-struct-9.pk |   7 ++
 20 files changed, 392 insertions(+), 13 deletions(-)
 create mode 100644 testsuite/poke.pkl/deint-struct-1.pk
 create mode 100644 testsuite/poke.pkl/deint-struct-2.pk
 create mode 100644 testsuite/poke.pkl/deint-struct-3.pk
 create mode 100644 testsuite/poke.pkl/deint-struct-4.pk
 create mode 100644 testsuite/poke.pkl/deint-struct-5.pk
 create mode 100644 testsuite/poke.pkl/deint-struct-6.pk
 create mode 100644 testsuite/poke.pkl/deint-struct-7.pk
 create mode 100644 testsuite/poke.pkl/deint-struct-8.pk
 create mode 100644 testsuite/poke.pkl/deint-struct-9.pk

diff --git a/ChangeLog b/ChangeLog
index 7ab3b1fc..4b5c66c7 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,32 @@
+2021-12-30  Jose E. Marchesi  <jemarch@gnu.org>
+
+       * libpoke/pkl-ast.h (PKL_AST_TYPE_S_DEINTEGRATOR): Define.
+       * libpoke/pkl-ast.c (pkl_ast_make_struct_type): Increase the
+       number of closures to 8.
+       (pkl_ast_make_struct_type): Initialize deintegrator to PVM_NULL.
+       * libpoke/pkl-typify.c (pkl_typify1_ps_cast): Allow casts from
+       integral types to integral structs.
+       * libpoke/pkl-promo.c (pkl_promo_ps_cast): New handler.
+       (pkl_phase_promo): Install handler.
+       * libpoke/pkl-gen.c (pkl_gen_pr_decl): Compile deintegrator
+       closures for named struct types.
+       * libpoke/pkl-gen.pks (struct_deintegrator): New function.
+       (deint_extract_field_value): New macro.
+       (struct_constructor): Do not check for constraint errors if
+       `be_strict' is set to false.
+       * testsuite/poke.pkl/deint-struct-1.pk: New test.
+       * testsuite/poke.pkl/deint-struct-2.pk: Likewise.
+       * testsuite/poke.pkl/deint-struct-3.pk: Likewise.
+       * testsuite/poke.pkl/deint-struct-4.pk: Likewise.
+       * testsuite/poke.pkl/deint-struct-5.pk: Likewise.
+       * testsuite/poke.pkl/deint-struct-6.pk: Likewise.
+       * testsuite/poke.pkl/deint-struct-7.pk: Likewise.
+       * testsuite/poke.pkl/deint-struct-8.pk: Likewise.
+       * testsuite/poke.pkl/deint-struct-9.pk: Likewise.
+       * testsuite/Makefile.am (EXTRA_DIST): Add new tests.
+       * doc/poke.texi (Casting Structs): Note that it is possible to
+       cast an integral value to an integral struct.
+
 2021-12-27  Mohammad-Reza Nabipoor  <mnabipoor@gnu.org>
 
        * pickles/btf.pk (BTF_Type): s/enum/_enum/.
diff --git a/doc/poke.texi b/doc/poke.texi
index f9ef3116..68b4d87a 100644
--- a/doc/poke.texi
+++ b/doc/poke.texi
@@ -10864,6 +10864,16 @@ We can operate:
 0x100000003UL
 @end example
 
+Conversely, it is possible to cast an integral value to an integral struct:
+
+@example
+(poke) 0x100000003UL as Foo
+Foo @{
+  f1=0x1,
+  f2=0x3U
+@}
+@end example
+
 @node Declarations in Structs
 @subsection Declarations in Structs
 
diff --git a/libpoke/pkl-ast.c b/libpoke/pkl-ast.c
index fdfccf99..5e24706f 100644
--- a/libpoke/pkl-ast.c
+++ b/libpoke/pkl-ast.c
@@ -443,8 +443,8 @@ pkl_ast_make_struct_type (pkl_ast ast,
                           int pinned_p, int union_p)
 {
   pkl_ast_node type = pkl_ast_make_type (ast);
-  const int nclosures = 7; /* writer, mapper, constructor, comparator,
-                              integrator, printer, formater.  */
+  const int nclosures = 8; /* writer, mapper, constructor, comparator,
+                              integrator, deintegrator, printer, formater.  */
 
   PKL_AST_TYPE_CODE (type) = PKL_TYPE_STRUCT;
   PKL_AST_TYPE_S_NELEM (type) = nelem;
@@ -467,6 +467,7 @@ pkl_ast_make_struct_type (pkl_ast ast,
   PKL_AST_TYPE_S_INTEGRATOR (type) = PVM_NULL;
   PKL_AST_TYPE_S_FORMATER (type) = PVM_NULL;
   PKL_AST_TYPE_S_PRINTER (type) = PVM_NULL;
+  PKL_AST_TYPE_S_DEINTEGRATOR (type) = PVM_NULL;
 
   return type;
 }
diff --git a/libpoke/pkl-ast.h b/libpoke/pkl-ast.h
index e7e32247..a8719e6b 100644
--- a/libpoke/pkl-ast.h
+++ b/libpoke/pkl-ast.h
@@ -862,10 +862,10 @@ pkl_ast_node pkl_ast_make_func_type_arg (pkl_ast ast,
    declarations.  ELEMS is a chain of elements, which can be
    PKL_AST_STRUCT_TYPE_FIELD or PKL_AST_DECL nodes, potentially mixed.
    PINNED_P is 1 if the struct is pinned, 0 otherwise.  MAPPER, WRITER
-   CONSTRUCTOR, FORMATER, PRINTER, COMPARATOR and INTEGRATOR are used to
-   hold closures, or PVM_NULL.  INT_TYPE, if not NULL, is an AST node
-   with an integral type, that defines the nature of this struct type as
-   integral.
+   CONSTRUCTOR, FORMATER, PRINTER, COMPARATOR, INTEGRATOR and
+   DEINTEGRATOR are used to hold closures, or PVM_NULL.  INT_TYPE, if
+   not NULL, is an AST node with an integral type, that defines the
+   nature of this struct type as integral.
 
    In offset types, BASE_TYPE is a PKL_AST_TYPE with the base type for
    the offset's magnitude, and UNIT is either a PKL_AST_IDENTIFIER
@@ -914,6 +914,7 @@ pkl_ast_node pkl_ast_make_func_type_arg (pkl_ast ast,
 #define PKL_AST_TYPE_S_COMPARATOR(AST) ((AST)->type.val.sct.closures[4])
 #define PKL_AST_TYPE_S_INTEGRATOR(AST) ((AST)->type.val.sct.closures[5])
 #define PKL_AST_TYPE_S_FORMATER(AST) ((AST)->type.val.sct.closures[6])
+#define PKL_AST_TYPE_S_DEINTEGRATOR(AST) ((AST)->type.val.sct.closures[7])
 #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)
@@ -963,7 +964,7 @@ struct pkl_ast_type
       int pinned_p;
       int union_p;
       /* Uncollectable array for MAPPER, WRITER, CONSTRUCTOR, COMPARATOR,
-         INTEGRATOR, PRINTER and FORMATER.  */
+         INTEGRATOR, DEINTEGRATOR, PRINTER and FORMATER.  */
       pvm_val *closures;
     } sct;
 
diff --git a/libpoke/pkl-gen.c b/libpoke/pkl-gen.c
index 0197dfc6..f1550128 100644
--- a/libpoke/pkl-gen.c
+++ b/libpoke/pkl-gen.c
@@ -199,6 +199,7 @@ PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_decl)
             pvm_val constructor_closure;
             pvm_val comparator_closure;
             pvm_val integrator_closure;
+            pvm_val deintegrator_closure;
 
             pkl_ast_node type_struct = initial;
 
@@ -284,6 +285,26 @@ PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_decl)
                 PKL_AST_TYPE_S_INTEGRATOR (type_struct) = integrator_closure;
               }
 
+            if (PKL_AST_TYPE_S_ITYPE (type_struct)
+                && PKL_AST_TYPE_S_DEINTEGRATOR (type_struct) == PVM_NULL)
+              {
+                /* Yes, the in_writer context is also used for
+                   deintegrators, since deintegrators do not call
+                   writers nor the other way around.  This eases
+                   sharing of code in the pks.  */
+                PKL_GEN_PUSH_SET_CONTEXT (PKL_GEN_CTX_IN_WRITER);
+                {
+                  RAS_FUNCTION_STRUCT_DEINTEGRATOR (deintegrator_closure,
+                                                    type_struct);           /* 
CLS */
+                  pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, 
deintegrator_closure); /* CLS */
+                  pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PEC);                    
    /* CLS */
+                  pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP);                   
    /* _ */
+                }
+                PKL_GEN_POP_CONTEXT;
+
+                PKL_AST_TYPE_S_DEINTEGRATOR (type_struct) = 
deintegrator_closure;
+              }
+
             PKL_PASS_BREAK;
             break;
           }
@@ -2206,6 +2227,36 @@ PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_cast)
       pkl_asm_insn (pasm, PKL_INSN_PUSH, constructor);
       pkl_asm_insn (pasm, PKL_INSN_CALL);
     }
+  else if (PKL_AST_TYPE_CODE (to_type) == PKL_TYPE_STRUCT
+           && PKL_AST_TYPE_CODE (from_type) == PKL_TYPE_INTEGRAL)
+    {
+      pkl_ast_node itype = PKL_AST_TYPE_S_ITYPE (to_type);
+
+      /* This is guaranteed as per typify.  */
+      assert (itype);
+
+      /* Make sure the struct type has a deintegrator.  */
+      if (PKL_AST_TYPE_S_DEINTEGRATOR (to_type) == PVM_NULL)
+        {
+          pvm_val deintegrator_closure;
+
+          /* See note about in_writer in pkl_gen_pr_decl.  */
+          PKL_GEN_PUSH_SET_CONTEXT (PKL_GEN_CTX_IN_WRITER);
+          RAS_FUNCTION_STRUCT_DEINTEGRATOR (deintegrator_closure,
+                                            to_type);           /* CLS */
+
+          pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, deintegrator_closure); /* 
CLS */
+          pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PEC);                        /* 
CLS */
+          pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP);                       /* 
_ */
+          PKL_GEN_POP_CONTEXT;
+
+          PKL_AST_TYPE_S_DEINTEGRATOR (to_type) = deintegrator_closure;
+        }
+
+      pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
+                    PKL_AST_TYPE_S_DEINTEGRATOR (to_type));
+      pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_CALL);
+    }
   else if (PKL_AST_TYPE_CODE (to_type) == PKL_TYPE_INTEGRAL
            && PKL_AST_TYPE_CODE (from_type) == PKL_TYPE_STRUCT)
     {
diff --git a/libpoke/pkl-gen.pks b/libpoke/pkl-gen.pks
index d0317d0f..2897300f 100644
--- a/libpoke/pkl-gen.pks
+++ b/libpoke/pkl-gen.pks
@@ -1705,6 +1705,159 @@
         return
         .end
 
+;;; RAS_MACRO_DEINT_EXTRACT_FIELD_VALUE @uint64_type @itype @field_type 
#bit_offset
+;;; ( IVAL -- EVAL )
+;;;
+;;; Extract the portion of IVAL corresponding to the field with
+;;; type @FIELD_TYPE located at bit-offset @BIT_OFFSET in the containing
+;;; integral struct.
+;;;
+;;; Note that the extracted value is converted to the type of the
+;;; field.
+
+        .macro deint_extract_field_value @uint64_type @itype @field_type 
#bit_offset
+        .let @field_type = PKL_AST_STRUCT_TYPE_FIELD_TYPE (@field)
+        .let @field_int_type = PKL_AST_TYPE_CODE (@field_type) == 
PKL_TYPE_OFFSET ? PKL_AST_TYPE_O_BASE_TYPE (@field_type) : @field_type
+ .c     size_t field_type_size = PKL_AST_TYPE_I_SIZE (@field_int_type);
+ .c     size_t itype_bits = PKL_AST_TYPE_I_SIZE (@itype);
+        ;; Field extraction:
+        ;;   (IVAL <<. OFFSET) .>> (ITYPE_SIZE - FIELD_SIZE)
+        .let #shift_right_count = pvm_make_int (itype_bits - field_type_size, 
32)
+        push #bit_offset
+        bsllu
+        nip2
+        push #shift_right_count
+        bsrlu
+        nip2
+        ;; Convert the extracted value to the type of the field. If
+        ;; the field is an offset, set an offset with the extracted
+        ;; value as magnitude and same unit.
+        nton @uint64_type, @field_int_type
+        nip
+ .c if (PKL_AST_TYPE_CODE (@field_type) == PKL_TYPE_OFFSET)
+ .c {
+        .let @offset_unit = PKL_AST_TYPE_O_UNIT (@field_type)
+        .let #unit = pvm_make_ulong (PKL_AST_INTEGER_VALUE (@offset_unit), 64)
+        push #unit
+        mko
+ .c }
+        .end
+
+;;; RAS_FUNCTION_STRUCT_DEINTEGRATOR @type_struct
+;;; ( VAL -- VAL )
+;;;
+;;; Assemble a function that, given an integral value, transforms it
+;;; into an equivalent integral struct with the given type.  The
+;;; integral value in the stack should of the same type than the
+;;; integral type of TYPE_STRUCT.
+;;;
+;;; Macro-arguments:
+;;;
+;;; @type_struct is a pkl_ast_node with the type of the struct to
+;;; which convert the integer.
+
+        .function struct_deintegrator @type_struct
+        prolog
+        pushf 2
+        ;; Convert the value to deintegrate to an ulong<64> to ease
+        ;; calculations below.
+        .let @itype = PKL_AST_TYPE_S_ITYPE (@type_struct)
+        .let @uint64_type = pkl_ast_make_integral_type (PKL_PASS_AST, 64, 0)
+        nton @itype, @uint64_type
+        nip
+        regvar $ival
+        ;; Create a struct of the given type using the type
+        ;; constructor, in non-strict mode.  All the fields of the
+        ;; constructed struct will be 0 (or 0#b).
+        push ulong<64>0         ; OFF
+        ;; Iterate over the struct named fields creating triplets for the
+        ;; fields, whose value is extracted from IVAL.  We know that
+        ;; IVAL has the same width than the struct fields all combined.
+        ;; Anonymous fields are handled in a loop below.
+        .let @field
+ .c      uint64_t i, bit_offset;
+ .c for (i = 0, bit_offset = 0, @field = PKL_AST_TYPE_S_ELEMS (@type_struct);
+ .c      @field;
+ .c      @field = PKL_AST_CHAIN (@field))
+ .c {
+ .c     if (PKL_AST_CODE (@field) != PKL_AST_STRUCT_TYPE_FIELD)
+ .c       continue;
+        .let @field_type = PKL_AST_STRUCT_TYPE_FIELD_TYPE (@field)
+ .c     size_t field_type_size
+ .c       = PKL_AST_TYPE_I_SIZE (PKL_AST_TYPE_CODE (@field_type) == 
PKL_TYPE_OFFSET
+ .c         ? PKL_AST_TYPE_O_BASE_TYPE (@field_type) : @field_type);
+        ;; Anonymous fields are not handled in this loop, but we have
+        ;; to advance the offset nevertheless.
+        .let @type_field_name = PKL_AST_STRUCT_TYPE_FIELD_NAME (@field)
+ .c     if (@type_field_name == NULL)
+ .c     {
+ .c       bit_offset += field_type_size;
+ .c       continue;
+ .c     }
+        .let #bit_offset = pvm_make_int (bit_offset, 32)
+        ;; Extract the value for this field from IVAL
+        pushvar $ival           ; IVAL
+        .e deint_extract_field_value @uint64_type, @itype, @field_type, 
#bit_offset
+        ;; Create the triplet with the converted value.
+        .let #field_name = pvm_make_string (PKL_AST_IDENTIFIER_POINTER 
(@type_field_name))
+        .let #field_offset = pvm_make_ulong (bit_offset, 64)
+        push #field_offset      ; CVAL OFFSET
+        push #field_name        ; CVAL OFFSET NAME
+        rot                     ; OFFSET NAME CVAL
+ .c     bit_offset += field_type_size;
+ .c     i++;
+ .c }
+                                ; OFF [TRIPLETS...]
+        .let #nfields = pvm_make_ulong (i, 64)
+        push ulong<64>0         ; OFF [TRIPLETS...] NMETHODS
+        push #nfields           ; OFF [TRIPLETS...] NMETHODS NFIELDS
+  .c    PKL_GEN_PUSH_SET_CONTEXT (PKL_GEN_CTX_IN_TYPE);
+  .c    PKL_PASS_SUBPASS (@type_struct);
+  .c    PKL_GEN_POP_CONTEXT;
+                                ; OFF [TRIPLETS...] NMETHODS NFIELDS TYPE
+        mksct
+  .c    PKL_GEN_PUSH_SET_CONTEXT (PKL_GEN_CTX_IN_CONSTRUCTOR);
+  .c    PKL_PASS_SUBPASS (@type_struct);
+  .c    PKL_GEN_POP_CONTEXT;
+                                ; SCT
+        ;; At this point the anonymous fields in the struct created above are
+        ;; all zero.  This is because we coudln't include them in the argument
+        ;; to the struct constructor.  So now we have to iterate over the
+        ;; fields again and set the value of the anonymous fields.  Fortunately
+        ;; this results in very concise code at run-time.
+ .c for (i = 0, bit_offset = 0, @field = PKL_AST_TYPE_S_ELEMS (@type_struct);
+ .c      @field;
+ .c      @field = PKL_AST_CHAIN (@field))
+ .c {
+ .c     if (PKL_AST_CODE (@field) != PKL_AST_STRUCT_TYPE_FIELD)
+ .c       continue;
+        .let @field_type = PKL_AST_STRUCT_TYPE_FIELD_TYPE (@field)
+ .c       size_t field_type_size
+ .c         = PKL_AST_TYPE_I_SIZE (PKL_AST_TYPE_CODE (@field_type) == 
PKL_TYPE_OFFSET
+ .c           ? PKL_AST_TYPE_O_BASE_TYPE (@field_type) : @field_type);
+ .c     if (PKL_AST_STRUCT_TYPE_FIELD_NAME (@field))
+ .c     {
+ .c       bit_offset += field_type_size;
+ .c       i++;
+ .c       continue;
+ .c     }
+        .let #bit_offset = pvm_make_int (bit_offset, 32)
+        ;; Extract the value for this field from IVAL
+        pushvar $ival           ; SCT IVAL
+        .e deint_extract_field_value @uint64_type, @itype, @field_type, 
#bit_offset
+                                ; SCT CVAL
+        .let #index = pvm_make_ulong (i, 64)
+        push #index             ; SCT CVAL IDX
+        swap                    ; SCT IDX CVAL
+        sseti
+ .c
+ .c     bit_offset += field_type_size;
+ .c     i++;
+ .c }
+        popf 1
+        return
+        .end
+
 ;;; RAS_MACRO_COMPLEX_LMAP @type #writer
 ;;; ( VAL IOS BOFF -- )
 ;;;
diff --git a/libpoke/pkl-promo.c b/libpoke/pkl-promo.c
index e71a63d3..83d8a705 100644
--- a/libpoke/pkl-promo.c
+++ b/libpoke/pkl-promo.c
@@ -1583,6 +1583,40 @@ PKL_PHASE_BEGIN_HANDLER (pkl_promo_ps_cons)
 }
 PKL_PHASE_END_HANDLER
 
+/* When an integral value is casted to an integral struct, it shall be
+   promoted to the later integral type.  */
+
+PKL_PHASE_BEGIN_HANDLER (pkl_promo_ps_cast)
+{
+  pkl_ast_node cast = PKL_PASS_NODE;
+  pkl_ast_node exp = PKL_AST_CAST_EXP (cast);
+  pkl_ast_node to_type = PKL_AST_CAST_TYPE (cast);
+
+  if (PKL_AST_TYPE_CODE (to_type) == PKL_TYPE_STRUCT)
+    {
+      pkl_ast_node itype = PKL_AST_TYPE_S_ITYPE (to_type);
+
+      if (itype)
+        {
+          int restart = 0;
+
+          if (!promote_integral (PKL_PASS_AST,
+                                 PKL_AST_TYPE_I_SIZE (itype),
+                                 PKL_AST_TYPE_I_SIGNED_P (itype),
+                                 &PKL_AST_CAST_EXP (cast),
+                                 &restart))
+            {
+              PKL_ICE (PKL_AST_LOC (exp),
+                       "couldn't promote integral to integral struct");
+              PKL_PASS_ERROR;
+            }
+
+          PKL_PASS_RESTART = restart;
+        }
+    }
+}
+PKL_PHASE_END_HANDLER
+
 struct pkl_phase pkl_phase_promo =
   {
    PKL_PHASE_PS_OP_HANDLER (PKL_AST_OP_EQ, pkl_promo_ps_op_rela),
@@ -1626,6 +1660,7 @@ struct pkl_phase pkl_phase_promo =
    PKL_PHASE_PS_HANDLER (PKL_AST_STRUCT_TYPE_FIELD, 
pkl_promo_ps_struct_type_field),
    PKL_PHASE_PS_HANDLER (PKL_AST_COND_EXP, pkl_promo_ps_cond_exp),
    PKL_PHASE_PS_HANDLER (PKL_AST_CONS, pkl_promo_ps_cons),
+   PKL_PHASE_PS_HANDLER (PKL_AST_CAST, pkl_promo_ps_cast),
    PKL_PHASE_PS_TYPE_HANDLER (PKL_TYPE_ARRAY, pkl_promo_ps_type_array),
    PKL_PHASE_PS_TYPE_HANDLER (PKL_TYPE_OFFSET, pkl_promo_ps_type_offset),
   };
diff --git a/libpoke/pkl-tab.y b/libpoke/pkl-tab.y
index cf066a22..3a63c596 100644
--- a/libpoke/pkl-tab.y
+++ b/libpoke/pkl-tab.y
@@ -1141,6 +1141,12 @@ primary:
                   $$ = $2;
                 }
         | array
+        | primary ".>" identifier
+                {
+                    $$ = pkl_ast_make_struct_ref (pkl_parser->ast, $1, $3);
+                    PKL_AST_LOC ($3) = @3;
+                    PKL_AST_LOC ($$) = @$;
+                }
         | primary '.' identifier
                 {
                     $$ = pkl_ast_make_struct_ref (pkl_parser->ast, $1, $3);
diff --git a/libpoke/pkl-typify.c b/libpoke/pkl-typify.c
index 6b29b487..0a69c97f 100644
--- a/libpoke/pkl-typify.c
+++ b/libpoke/pkl-typify.c
@@ -483,16 +483,24 @@ PKL_PHASE_BEGIN_HANDLER (pkl_typify1_ps_cast)
       PKL_PASS_ERROR;
     }
 
-  /* Only structs can be casted to structs.  */
+  /* Only structs can be casted to structs.  Integers can also be
+     casted to integral structs.  */
   if (PKL_AST_TYPE_CODE (type) == PKL_TYPE_STRUCT
       && PKL_AST_TYPE_CODE (exp_type) != PKL_TYPE_STRUCT)
     {
-      char *found_type = pkl_type_str (exp_type, 1);
+      pkl_ast_node itype = PKL_AST_TYPE_S_ITYPE (type);
 
-      PKL_ERROR (PKL_AST_LOC (exp),
-                 "invalid cast, expected struct, got %s", found_type);
-      PKL_TYPIFY_PAYLOAD->errors++;
-      PKL_PASS_ERROR;
+      if (!itype
+          || !pkl_ast_type_promoteable_p (itype, exp_type,
+                                          0 /* promote_array_of_any */))
+        {
+          char *found_type = pkl_type_str (exp_type, 1);
+
+          PKL_ERROR (PKL_AST_LOC (exp),
+                     "invalid cast, expected struct, got %s", found_type);
+          PKL_TYPIFY_PAYLOAD->errors++;
+          PKL_PASS_ERROR;
+        }
     }
 
   /* Structs can be casted to other structs.  Additionally, integral
diff --git a/libpoke/pvm.jitter b/libpoke/pvm.jitter
index d91fcd07..54ad564b 100644
--- a/libpoke/pvm.jitter
+++ b/libpoke/pvm.jitter
@@ -4771,6 +4771,7 @@ end
 # offset of field, STR the name of the field or PVM_NULL if the field
 # is anonymous, and VAL is a value.
 #
+
 # Each method is specified as a tuple [STR VAL] where STR is the name
 # of the method and VAL is the closure value corresponding to the
 # method.
diff --git a/testsuite/Makefile.am b/testsuite/Makefile.am
index fee8c9e3..07324e95 100644
--- a/testsuite/Makefile.am
+++ b/testsuite/Makefile.am
@@ -920,6 +920,15 @@ EXTRA_DIST = \
   poke.pkl/defvar-4.pk \
   poke.pkl/defvar-5.pk \
   poke.pkl/defvar-6.pk \
+  poke.pkl/deint-struct-1.pk \
+  poke.pkl/deint-struct-2.pk \
+  poke.pkl/deint-struct-3.pk \
+  poke.pkl/deint-struct-4.pk \
+  poke.pkl/deint-struct-5.pk \
+  poke.pkl/deint-struct-6.pk \
+  poke.pkl/deint-struct-7.pk \
+  poke.pkl/deint-struct-8.pk \
+  poke.pkl/deint-struct-9.pk \
   poke.pkl/div-integers-1.pk \
   poke.pkl/div-integers-2.pk \
   poke.pkl/div-integers-3.pk \
diff --git a/testsuite/poke.pkl/deint-struct-1.pk 
b/testsuite/poke.pkl/deint-struct-1.pk
new file mode 100644
index 00000000..f41652ad
--- /dev/null
+++ b/testsuite/poke.pkl/deint-struct-1.pk
@@ -0,0 +1,6 @@
+/* { dg-do run } */
+
+type Foo = struct int<32> { int<16> a; uint<16> b;};
+
+/* { dg-command { 0 as Foo } } */
+/* { dg-output "Foo {a=0H,b=0UH}" } */
diff --git a/testsuite/poke.pkl/deint-struct-2.pk 
b/testsuite/poke.pkl/deint-struct-2.pk
new file mode 100644
index 00000000..fbc7865a
--- /dev/null
+++ b/testsuite/poke.pkl/deint-struct-2.pk
@@ -0,0 +1,6 @@
+/* { dg-do run } */
+
+type Foo = struct int<32> { int<16> a; uint<16> b;};
+
+/* { dg-command { 0UL as Foo } } */
+/* { dg-output "Foo {a=0H,b=0UH}" } */
diff --git a/testsuite/poke.pkl/deint-struct-3.pk 
b/testsuite/poke.pkl/deint-struct-3.pk
new file mode 100644
index 00000000..1a33ac71
--- /dev/null
+++ b/testsuite/poke.pkl/deint-struct-3.pk
@@ -0,0 +1,7 @@
+/* { dg-do run } */
+
+type Foo = struct int<32> { int<16> a; var jorl = a + 1; uint<16> b; };
+
+/* { dg-command {.set obase 16} } */
+/* { dg-command { 0xdeadbeef as Foo } } */
+/* { dg-output "Foo \{a=0xdeadH,b=0xbeefUH\}" } */
diff --git a/testsuite/poke.pkl/deint-struct-4.pk 
b/testsuite/poke.pkl/deint-struct-4.pk
new file mode 100644
index 00000000..4e39e5bf
--- /dev/null
+++ b/testsuite/poke.pkl/deint-struct-4.pk
@@ -0,0 +1,14 @@
+/* { dg-do run } */
+
+type Foo =
+  struct int<32>
+  {
+    int<16> a;
+    method aa = int: { return a + 2; }
+    int<8> b;
+    uint<8> c;
+  };
+
+/* { dg-command {.set obase 16} } */
+/* { dg-command { 0xdeadbeef as Foo } } */
+/* { dg-output "Foo \{a=0xdeadH,b=0xbeB,c=0xefUB\}" } */
diff --git a/testsuite/poke.pkl/deint-struct-5.pk 
b/testsuite/poke.pkl/deint-struct-5.pk
new file mode 100644
index 00000000..d9a57ba0
--- /dev/null
+++ b/testsuite/poke.pkl/deint-struct-5.pk
@@ -0,0 +1,7 @@
+/* { dg-do run } */
+
+type Foo = struct int<32> { offset<int<16>,B> a; uint<16> b; };
+
+/* { dg-command {.set obase 16} } */
+/* { dg-command { 0xdeadbeef as Foo } } */
+/* { dg-output "Foo \{a=0xdeadH#B,b=0xbeefUH\}" } */
diff --git a/testsuite/poke.pkl/deint-struct-6.pk 
b/testsuite/poke.pkl/deint-struct-6.pk
new file mode 100644
index 00000000..6f6b061a
--- /dev/null
+++ b/testsuite/poke.pkl/deint-struct-6.pk
@@ -0,0 +1,7 @@
+/* { dg-do run } */
+
+type Foo = struct int<32> { int<16> a; offset<int<8>,B> b; uint<8> c; };
+
+/* { dg-command {.set obase 16} } */
+/* { dg-command { 0xdeadbeef as Foo } } */
+/* { dg-output "Foo \{a=0xdeadH,b=0xbeB#B,c=0xefUB\}" } */
diff --git a/testsuite/poke.pkl/deint-struct-7.pk 
b/testsuite/poke.pkl/deint-struct-7.pk
new file mode 100644
index 00000000..f8a85786
--- /dev/null
+++ b/testsuite/poke.pkl/deint-struct-7.pk
@@ -0,0 +1,14 @@
+/* { dg-do run } */
+
+type Foo =
+  struct int<32>
+  {
+    type lala = int<3>;
+    int<16>;
+    var lolo = 32;
+    uint<16> b;
+  };
+
+/* { dg-command {.set obase 16} } */
+/* { dg-command { 0xdeadbeef as Foo } } */
+/* { dg-output "Foo \{\[0\]xdeadH,b=0xbeefUH\}" } */
diff --git a/testsuite/poke.pkl/deint-struct-8.pk 
b/testsuite/poke.pkl/deint-struct-8.pk
new file mode 100644
index 00000000..a859f302
--- /dev/null
+++ b/testsuite/poke.pkl/deint-struct-8.pk
@@ -0,0 +1,7 @@
+/* { dg-do run } */
+
+type Foo = struct int<32> { int<16> a; uint<8>; offset<int<8>,3> c; };
+
+/* { dg-command {.set obase 16} } */
+/* { dg-command { 0xdeadbeef as Foo } } */
+/* { dg-output "Foo \{a=0xdeadH,0xbeUB,c=0xefB#\[3\]\}" } */
diff --git a/testsuite/poke.pkl/deint-struct-9.pk 
b/testsuite/poke.pkl/deint-struct-9.pk
new file mode 100644
index 00000000..a18c5ef0
--- /dev/null
+++ b/testsuite/poke.pkl/deint-struct-9.pk
@@ -0,0 +1,7 @@
+/* { dg-do run } */
+
+type Foo = struct int<32> { int<16> a; uint<8>; offset<int<8>,3> c; };
+
+/* { dg-command {.set obase 16} } */
+/* { dg-command { (0xdeadbeef as Foo).c } } */
+/* { dg-output "0xefB#3" } */
-- 
2.11.0




reply via email to

[Prev in Thread] Current Thread [Next in Thread]