[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