poke-devel
[Top][All Lists]
Advanced

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

Re: Bug report for assignment inside methods


From: Jose E. Marchesi
Subject: Re: Bug report for assignment inside methods
Date: Mon, 29 May 2023 11:51:34 +0200
User-agent: Gnus/5.13 (Gnus v5.13)

> On Mon, May 22, 2023 at 09:08:28PM +0200, Mohammad-Reza Nabipoor wrote:
>> 
>> Bug:
>> 
>> (poke) .mem
>> (poke) byte[] @ 0x10#B = [0x83UB, 0xfUB]
>> (poke) type Byte = struct uint<8> { uint<1> hi : hi == 1; uint<7> lo; }
>> (poke) type Num = struct { Byte[] variable; uint<8> last; method set = 
>> (Byte[] v, uint<8> l) void: { variable = v; last = l; } }
>> (poke) var n = Num @ 0x10#B
>> (poke) n
>> Num {
>>   variable=[Byte {
>>     hi=(uint<1>) 0x1,
>>     lo=(uint<7>) 0x03
>>   }],
>>   last=0x0fUB
>> }
>> (poke) n.set (Byte[] (), 0)
>> (poke) dump
>> 76543210  0011 2233 4455 6677 8899 aabb ccdd eeff  0123456789ABCDEF
>> 00000000: 0000 0000 0000 0000 0000 0000 0000 0000  ................
>> 00000010: 8300 0000 0000 0000 0000 0000 0000 0000  ................
>> 
>> 
>> So, what happens is that in `set' method, on assignments, we call `SSET'
>> instruction (which in turn calls `pvm_set_struct' function).
>> When we change the `variable' from an array of size 1 to an array of
>> size 0, it should fix the boffset of next field (`last') to `0x10#B'.
>> That's not the case in the current implementation, and the boffset of `last'
>> stays as `0x11#B'.
>> 
>> Then after `SSET', we call `WRITE' instruction, which will write the empty
>> array at offset `0x10#B` (which is a NOP) and writes the `last' (which has
>> value 0) to offset `0x11#B' (which is wrong).
>> So, you see that `byte @ 0x11#B' has been changed from `0x0fUB' to `0UB'.
>> 
>> So the question is how should I fix the the boffset of values in a struct?
>> In `pvm_set_struct'?
>> Or we should add new instruction? Or ...?
>
>
> I think we correct thing to do is to run the constructor (after `SSET') for
> mapped values, but the problem is when we're in the body of methods, the
> constructor is not synthesized yet.

But the constructor can be made available at run-time when you call the
method.  I have a patch to that effect, see below.  But it doesn't work
for some reason :)

diff --git a/ChangeLog b/ChangeLog
index d7279c14..4849d8f7 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,23 @@
+2023-05-20  Jose E. Marchesi  <jemarch@gnu.org>
+
+       * libpoke/pvm-val.h (array): New field sct.constructor.
+       (PVM_VAL_TYP_S_CONSTRUCTOR): Define.
+       * libpoke/pvm-val.c (pvm_struct_type_constructor): New function.
+       (pvm_make_struct_type): Get a new `constructor' argument.
+       * libpoke/pkl-insn.def (PKL_INSN_TYSCTGETC): New instruction.
+       (PKL_INSN_TYSCTSETC): Likewise.
+       * libpoke/pk-val.c (pk_make_struct_type): Pass PVM_NULL for
+       constructor.
+       * libpoke/pvm-val.c (pvm_make_exception): Likewise.
+       * libpoke/pvm.jitter (mktysct): Likewise.
+       (tysctgetc): New instruction.
+       (tysctsetc): Likewise.
+       * libpoke/pkl-gen.c (pkl_gen_ps_type_struct): Install constructor
+       closure in the created PVM struct type.
+       (pkl_gen_pr_cons): Converted from pkl_gen_ps_cons.
+       * libpoke/pkl-asm.pks (ssetc): Use run-time consructor closure if
+       no struct_type AST node is provided.
+
 2023-05-28  Mohammad-Reza Nabipoor  <mnabipoor@gnu.org>
 
        * libpoke/pkl-ast.h (PKL_AST_DECL_IN_STRUCT_P): Add comment to
diff --git a/libpoke/pkl-asm.pks b/libpoke/pkl-asm.pks
index c1cd4635..9c92f389 100644
--- a/libpoke/pkl-asm.pks
+++ b/libpoke/pkl-asm.pks
@@ -396,11 +396,27 @@
         ;; Invoke the constructor of the struct in itself.  If it
         ;; raises E_constraint, then restore the original value
         ;; and re-raise the exception.
+        dup                     ; OVAL STR SCT SCT
+  .c if (@struct_type)
+  .c {
         .let #constructor = PKL_AST_TYPE_S_CONSTRUCTOR (@struct_type)
+        push #constructor       ; OVAL STR SCT SCT CLS
+  .c }
+  .c else
+  .c {
+        typof                   ; OVAL STR SCT SCT TYP
+        tysctgetc               ; OVAL STR SCT SCT TYP CLS
+        nip                     ; OVAL STR SCT SCT CLS
+        bnn .got_constructor
+        ;; If no constructor, do not check constraint
+        drop                    ; OVAL STR SCT SCT
+        drop                    ; OVAL STR SCT
+        nip2                    ; SCT
+        ba .integrity_ok
+.got_constructor:
+  .c }
         push PVM_E_CONSTRAINT
         pushe .integrity_fucked
-        dup                     ; OVAL STR SCT SCT CLS
-        push #constructor       ; OVAL STR SCT SCT CLS
         call                    ; OVAL STR SCT SCT
         pope
         drop                    ; OVAL STR SCT
diff --git a/libpoke/pkl-gen.c b/libpoke/pkl-gen.c
index 1315d0f0..723748f5 100644
--- a/libpoke/pkl-gen.c
+++ b/libpoke/pkl-gen.c
@@ -994,10 +994,45 @@ PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_ass_stmt)
               pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_REVN, 3); /* SCT STR VAL */
             }
 
-            /* XXX Use SSETC if the struct is mapped with strict
-               mapping.  */
-            pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SSET);  /* SCT */
-            pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_WRITE);
+            /* Set the value in the struct using SETC if the struct is
+               mapped in non-strict mode. Othewrise, use SSET.  */
+            {
+              pvm_program_label use_sset = pkl_asm_fresh_label (PKL_GEN_ASM);
+              pvm_program_label use_ssetc = pkl_asm_fresh_label (PKL_GEN_ASM);
+              pvm_program_label done = pkl_asm_fresh_label (PKL_GEN_ASM);
+
+              /* If the struct is not mapped, always check integrity,
+                 since there is not such a thing as non-strict
+                 construction (yet).  */
+              pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_ROT); /* STR VAL SCT */
+              pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MM);  /* STR VAL SCT 
MAPPED_P */
+              pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_BNZI, use_ssetc);
+              pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP); /* STR VAL SCT */
+
+              /* The value is mapped.  Check the strictness of the mapping.  */
+              pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MGETS); /* STR VAL SCT 
STRICT_P */
+              pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_BNZI, use_ssetc);
+              pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP); /* STR VAL SCT */
+
+              /* Set without integrity checks.  */
+              pkl_asm_label (PKL_GEN_ASM, use_sset);
+              pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP); /* STR VAL SCT */
+              pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NROT); /* SCT STR VAL */
+              pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SSET);  /* SCT */
+              pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_BA, done);
+
+              /* Set with integrity checks.  */
+              pkl_asm_label (PKL_GEN_ASM, use_ssetc);
+              pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP); /* STR VAL SCT */
+              pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NROT); /* SCT STR VAL */
+              pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SSETC, NULL);
+                                                         /* SCT */
+
+              pkl_asm_label (PKL_GEN_ASM, done);
+            }
+
+            /* In case the struct is mapped.  */
+            pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_WRITE); /* SCT */
             pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP);  /* _ */
           }
         else
@@ -4119,6 +4154,16 @@ PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_type_struct)
         pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, PVM_NULL);
 
       pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MKTYSCT);
+
+      /* Install the constructor closure of the struct type.  This may
+         be PVM_NULL.  */
+      {
+        pvm_val constructor = PKL_AST_TYPE_S_CONSTRUCTOR (PKL_PASS_NODE);
+
+        pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, constructor);
+        pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_STRACE, 1);
+        pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_TYSCTSETC);
+      }
     }
 }
 PKL_PHASE_END_HANDLER
diff --git a/libpoke/pkl-gen.pks b/libpoke/pkl-gen.pks
index 4fd7950e..efd4fcdd 100644
--- a/libpoke/pkl-gen.pks
+++ b/libpoke/pkl-gen.pks
@@ -2033,9 +2033,13 @@
  .c }
         ;; Push the number of fields, create the struct and return it.
         pushvar $nfield        ; null [OFF STR VAL]... NMETHOD NFIELD
+        push "one\n"
+        prints
         .c PKL_GEN_PUSH_SET_CONTEXT (PKL_GEN_CTX_IN_TYPE);
         .c PKL_PASS_SUBPASS (@type_struct);
         .c PKL_GEN_POP_CONTEXT;
+        push "two\n"
+        prints
                                 ; SCT 0UL [OFF STR VAL]... NMETHOD NFIELD TYP
         mksct                   ; SCT SCT
         nip                     ; SCT
diff --git a/libpoke/pkl-insn.def b/libpoke/pkl-insn.def
index c1a2d5ea..13ae2c58 100644
--- a/libpoke/pkl-insn.def
+++ b/libpoke/pkl-insn.def
@@ -387,6 +387,8 @@ PKL_DEF_INSN(PKL_INSN_TYSCTGETNF,"","tysctgetnf")
 PKL_DEF_INSN(PKL_INSN_TYSCTGETFN,"","tysctgetfn")
 PKL_DEF_INSN(PKL_INSN_TYSCTGETFT,"","tysctgetft")
 PKL_DEF_INSN(PKL_INSN_TYISSCT,"","tyissct")
+PKL_DEF_INSN(PKL_INSN_TYSCTSETC,"","tysctsetc")
+PKL_DEF_INSN(PKL_INSN_TYSCTGETC,"","tysctgetc")
 
 PKL_DEF_INSN(PKL_INSN_MKTYA,"","mktya")
 PKL_DEF_INSN(PKL_INSN_TYAGETN,"","tyagetn")
diff --git a/libpoke/pvm-val.c b/libpoke/pvm-val.c
index ed040ab8..58e33151 100644
--- a/libpoke/pvm-val.c
+++ b/libpoke/pvm-val.c
@@ -547,6 +547,7 @@ pvm_make_struct_type (pvm_val nfields, pvm_val name,
 
   PVM_VAL_TYP_S_NAME (stype) = name;
   PVM_VAL_TYP_S_NFIELDS (stype) = nfields;
+  PVM_VAL_TYP_S_CONSTRUCTOR (stype) = PVM_NULL;
   PVM_VAL_TYP_S_FNAMES (stype) = fnames;
   PVM_VAL_TYP_S_FTYPES (stype) = ftypes;
 
diff --git a/libpoke/pvm-val.h b/libpoke/pvm-val.h
index e332a877..aaddd5fa 100644
--- a/libpoke/pvm-val.h
+++ b/libpoke/pvm-val.h
@@ -426,6 +426,7 @@ typedef struct pvm_struct *pvm_struct;
 #define PVM_VAL_TYP_A_BOUND(V) (PVM_VAL_TYP((V))->val.array.bound)
 #define PVM_VAL_TYP_A_ETYPE(V) (PVM_VAL_TYP((V))->val.array.etype)
 #define PVM_VAL_TYP_S_NAME(V) (PVM_VAL_TYP((V))->val.sct.name)
+#define PVM_VAL_TYP_S_CONSTRUCTOR(V) (PVM_VAL_TYP((V))->val.sct.constructor)
 #define PVM_VAL_TYP_S_NFIELDS(V) (PVM_VAL_TYP((V))->val.sct.nfields)
 #define PVM_VAL_TYP_S_FNAMES(V) (PVM_VAL_TYP((V))->val.sct.fnames)
 #define PVM_VAL_TYP_S_FTYPES(V) (PVM_VAL_TYP((V))->val.sct.ftypes)
@@ -472,6 +473,7 @@ struct pvm_type
     {
       pvm_val name;
       pvm_val nfields;
+      pvm_val constructor;
       pvm_val *fnames;
       pvm_val *ftypes;
     } sct;
diff --git a/libpoke/pvm.jitter b/libpoke/pvm.jitter
index 9a348d66..299f1b59 100644
--- a/libpoke/pvm.jitter
+++ b/libpoke/pvm.jitter
@@ -6451,8 +6451,40 @@ instruction mktysct ()
       JITTER_DROP_STACK ();
     }
 
-    JITTER_PUSH_STACK (pvm_make_struct_type (nelem, name,
-                                             enames, etypes));
+    JITTER_PUSH_STACK (pvm_make_struct_type (nelem, name, enames, etypes));
+  end
+end
+
+# Instruction: tysctgetc
+#
+# Given a struct type, push its constructor closure to the stack. If
+# no constructor closure is installed in the type, push PVM_NULL.
+#
+# Stack: ( TYP -- TYP CLS|null )
+
+instruction tysctgetc ()
+  code
+    pvm_val type = JITTER_TOP_STACK ();
+    pvm_val constructor = PVM_VAL_TYP_S_CONSTRUCTOR (type);
+
+    JITTER_PUSH_STACK (constructor);
+  end
+end
+
+# Instruction: tysctsetc
+#
+# Given a struct type and a closure, install it as the type's
+# constructor.
+#
+# Stack: ( TYP CLS -- TYP )
+
+instruction tysctsetc ()
+  code
+    pvm_val type = JITTER_UNDER_TOP_STACK ();
+    pvm_val constructor = JITTER_TOP_STACK ();
+
+    PVM_VAL_TYP_S_CONSTRUCTOR (type) = constructor;
+    JITTER_DROP_STACK ();
   end
 end
 
@@ -6461,7 +6493,7 @@ end
 # Given a struct type, push its name to the stack.  If the struct
 # type is not named push PVM_NULL.
 #
-# Stack: ( SCT -- SCT STR )
+# Stack: ( TYP -- SCT STR )
 
 instruction tysctgetn ()
   code



reply via email to

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