[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: [PATCH v2] pvm: add new pvm value: opaque values
|
From: |
Jose E. Marchesi |
|
Subject: |
Re: [PATCH v2] pvm: add new pvm value: opaque values |
|
Date: |
Sun, 23 Apr 2023 11:36:20 +0200 |
|
User-agent: |
Gnus/5.13 (Gnus v5.13) |
> This commit introduces a new PVM type to wrap opaque values,
> things like handles to resources which PVM cannot deal with
> them directly.
I think we do not need eqo and neo instructions, because:
1) They can always conmpare to false (in _pkl_eq_any).
2) These values are not directly visible in Poke unless you use
asm. Similar to null.
> 2023-04-20 Mohammad-Reza Nabipoor <mnabipoor@gnu.org>
>
> * libpoke/pkl-insn.def (opqgetn): New instruction.
> (mktyopq): Likewise.
> (tyisopq): Likewise.
> (eqo): Likewise.
> (neo): Likewise.
> * libpoke/pvm.jitter (opqgetn): New instruction.
> (mktyopq): Likewise.
> (tyisopq): Likewise.
> (eqo): Likewise.
> (neo): Likewise.
> (wrapped-functions): Add `pvm_make_opaque' and `pvm_make_opaque_type'.
> * libpoke/pkl-rt.pk (_pkl_print_format_any): Handle "opaque" values.
> (_pkl_eq_any): Likewise.
> * libpoke/pvm.h (pvm_make_opaque): Likewise.
> (pvm_make_opaque_type): Likewise.
> * libpoke/pvm-val.h (PVM_VAL_TAG_OPQ): New macro.
> (PVM_VAL_BOX_OPQ): Likewise.
> (struct pvm_val_box): New entry for "opaque" values.
> (enum pvm_type_code): Likewise.
> (PVM_VAL_OPQ): New macro.
> (PVM_VAL_OPQ_NAME): Likewise.
> (PVM_VAL_OPQ_PAYLOAD): Likewise.
> (struct pvm_opq): New struct.
> (pvm_opq): New typedef.
> (PVM_IS_OPQ): New macro.
> * libpoke/pvm-val.c (opaque_type): New variable.
> (pvm_make_opaque_type): New function.
> (pvm_make_opaque): Likewise.
> (pvm_val_equal_p): Handle "opaque" values.
> (pvm_typeof): Likewise.
> (pvm_val_initialize): Handle `opaque_type'.
> (pvm_val_finalize): Likewise.
> ---
>
> Hi Jose.
>
> Changes w.r.t v1:
>
> - Removed `_pkl_eq_opaque'
> - Removed `opqsetn`, `opqgetp' insns
> - Added `eqo' and `neo` insns
> For now they compare the payload's pointer, but in future,
> we can add a new `cmp' function pointer in the `struct pvm_opq'
> to be able do the right thing for each opaque value.
>
>
> Regards,
> Mohammad-Reza
>
>
> ChangeLog | 35 ++++++++++++++++++++
> libpoke/pkl-insn.def | 10 ++++++
> libpoke/pkl-rt.pk | 16 +++++++++
> libpoke/pvm-val.c | 35 ++++++++++++++++++++
> libpoke/pvm-val.h | 22 ++++++++++++
> libpoke/pvm.h | 12 +++++++
> libpoke/pvm.jitter | 79 +++++++++++++++++++++++++++++++++++++++++++-
> 7 files changed, 208 insertions(+), 1 deletion(-)
>
> diff --git a/ChangeLog b/ChangeLog
> index 1f790dc8..d1be1eb1 100644
> --- a/ChangeLog
> +++ b/ChangeLog
> @@ -1,3 +1,38 @@
> +2023-04-20 Mohammad-Reza Nabipoor <mnabipoor@gnu.org>
> +
> + * libpoke/pkl-insn.def (opqgetn): New instruction.
> + (mktyopq): Likewise.
> + (tyisopq): Likewise.
> + (eqo): Likewise.
> + (neo): Likewise.
> + * libpoke/pvm.jitter (opqgetn): New instruction.
> + (mktyopq): Likewise.
> + (tyisopq): Likewise.
> + (eqo): Likewise.
> + (neo): Likewise.
> + (wrapped-functions): Add `pvm_make_opaque' and `pvm_make_opaque_type'.
> + * libpoke/pkl-rt.pk (_pkl_print_format_any): Handle "opaque" values.
> + (_pkl_eq_any): Likewise.
> + * libpoke/pvm.h (pvm_make_opaque): Likewise.
> + (pvm_make_opaque_type): Likewise.
> + * libpoke/pvm-val.h (PVM_VAL_TAG_OPQ): New macro.
> + (PVM_VAL_BOX_OPQ): Likewise.
> + (struct pvm_val_box): New entry for "opaque" values.
> + (enum pvm_type_code): Likewise.
> + (PVM_VAL_OPQ): New macro.
> + (PVM_VAL_OPQ_NAME): Likewise.
> + (PVM_VAL_OPQ_PAYLOAD): Likewise.
> + (struct pvm_opq): New struct.
> + (pvm_opq): New typedef.
> + (PVM_IS_OPQ): New macro.
> + * libpoke/pvm-val.c (opaque_type): New variable.
> + (pvm_make_opaque_type): New function.
> + (pvm_make_opaque): Likewise.
> + (pvm_val_equal_p): Handle "opaque" values.
> + (pvm_typeof): Likewise.
> + (pvm_val_initialize): Handle `opaque_type'.
> + (pvm_val_finalize): Likewise.
> +
> 2023-04-17 Jose E. Marchesi <jemarch@gnu.org>
>
> * NEWS: Add entries for 3.1.
> diff --git a/libpoke/pkl-insn.def b/libpoke/pkl-insn.def
> index 94a0a06b..2e22f0df 100644
> --- a/libpoke/pkl-insn.def
> +++ b/libpoke/pkl-insn.def
> @@ -255,6 +255,9 @@ PKL_DEF_INSN(PKL_INSN_LES,"","les")
> PKL_DEF_INSN(PKL_INSN_EQC,"","eqc")
> PKL_DEF_INSN(PKL_INSN_NEC,"","nec")
>
> +PKL_DEF_INSN(PKL_INSN_EQO,"","eqo")
> +PKL_DEF_INSN(PKL_INSN_NEO,"","neo")
> +
> /* String instructions. */
>
> PKL_DEF_INSN(PKL_INSN_SCONC,"","sconc")
> @@ -284,6 +287,10 @@ PKL_DEF_INSN(PKL_INSN_OSETM,"","osetm")
> PKL_DEF_INSN(PKL_INSN_OGETU,"","ogetu")
> PKL_DEF_INSN(PKL_INSN_OGETBT,"","ogetbt")
>
> +/* Opaque values instructions. */
> +
> +PKL_DEF_INSN(PKL_INSN_OPQGETN,"","opqgetn")
> +
> /* Containers instructions. */
>
> PKL_DEF_INSN(PKL_INSN_SEL,"","sel")
> @@ -369,6 +376,9 @@ PKL_DEF_INSN(PKL_INSN_TYOGETM,"","tyogetm")
> PKL_DEF_INSN(PKL_INSN_TYOGETU,"","tyogetu")
> PKL_DEF_INSN(PKL_INSN_TYISO,"","tyiso")
>
> +PKL_DEF_INSN(PKL_INSN_MKTYOPQ,"","mktyopq")
> +PKL_DEF_INSN(PKL_INSN_TYISOPQ,"","tyisopq")
> +
> PKL_DEF_INSN(PKL_INSN_MKTYC,"","mktyc")
> PKL_DEF_INSN(PKL_INSN_TYISC,"","tyisc")
> /* PKL_DEF_INSN(PKL_INSN_TYCNA,"","tycna") */
> diff --git a/libpoke/pkl-rt.pk b/libpoke/pkl-rt.pk
> index be60948c..decb3b24 100644
> --- a/libpoke/pkl-rt.pk
> +++ b/libpoke/pkl-rt.pk
> @@ -1268,6 +1268,10 @@ immutable fun _pkl_eq_any = (any v1, any v2) int<32>:
> && asm int<32>: ("typof; nip; tyiso; nip" : v2))
> /* Offsets. */
> return _pkl_eq_offset (v1, v2);
> + else if (asm int<32>: ("typof; nip; tyisopq; nip" : v1)
> + && asm int<32>: ("typof; nip; tyisopq; nip" : v2))
> + /* Opaques. */
> + return asm int<32>: ("eqo; nip2" : v1, v2);
> else if (asm int<32>: ("typof; nip; tyiss; nip" : v1)
> && asm int<32>: ("typof; nip; tyiss; nip" : v2))
> /* Strings. */
> @@ -1358,6 +1362,8 @@ immutable fun _pkl_print_format_any = (any val,
> ctx.emit ("string");
> else if (asm int<32>: ("tyisv; nip" : val))
> ctx.emit ("void");
> + else if (asm int<32>: ("tyisopq; nip" : val))
> + ctx.emit ("opaque");
> else if (asm int<32>: ("tyisa; nip" : val))
> {
> var bound = asm any: ("tyagetb; nip; call" : val);
> @@ -1665,6 +1671,16 @@ immutable fun _pkl_print_format_any = (any val,
> handle_integral :long_p 0 :signed_p 1;
> else if (asm int<32>: ("typof; nip; tyiso; nip" : val))
> handle_offset;
> + else if (asm int<32>: ("typof; nip; tyisopq; nip" : val))
> + {
> + var name = asm string: ("opqgetn; nip" : val);
> +
> + ctx.begin_class ("special");
> + ctx.emit ("#<opaque:");
> + ctx.emit (name);
> + ctx.emit (">");
> + ctx.end_class ("special");
> + }
> else if (asm int<32>: ("typof; nip; tyisl; nip" : val))
> handle_integral :long_p 1 :signed_p 1;
> else if (asm int<32>: ("typof; nip; tyisiu; nip" : val))
> diff --git a/libpoke/pvm-val.c b/libpoke/pvm-val.c
> index 21c114e9..5cfcce91 100644
> --- a/libpoke/pvm-val.c
> +++ b/libpoke/pvm-val.c
> @@ -38,6 +38,7 @@
>
> static pvm_val string_type;
> static pvm_val void_type;
> +static pvm_val opaque_type;
>
> /* We are currently only supporting a relatively small number of
> integral types, i.e. signed and unsigned types of sizes 1 to 64
> @@ -516,6 +517,12 @@ pvm_make_void_type (void)
> return void_type;
> }
>
> +pvm_val
> +pvm_make_opaque_type (void)
> +{
> + return opaque_type;
> +}
> +
> pvm_val
> pvm_make_offset_type (pvm_val base_type, pvm_val unit)
> {
> @@ -593,6 +600,18 @@ pvm_make_offset (pvm_val magnitude, pvm_val type)
> return PVM_BOX (box);
> }
>
> +pvm_val
> +pvm_make_opaque (pvm_val name, uintptr_t payload)
> +{
> + pvm_val_box box = pvm_make_box (PVM_VAL_TAG_OPQ);
> + pvm_opq opq = pvm_alloc (sizeof (struct pvm_opq));
> +
> + opq->name = name;
> + opq->payload = payload;
> + PVM_VAL_BOX_OPQ (box) = opq;
> + return PVM_BOX (box);
> +}
> +
> int
> pvm_val_equal_p (pvm_val val1, pvm_val val2)
> {
> @@ -625,6 +644,8 @@ pvm_val_equal_p (pvm_val val1, pvm_val val2)
>
> return pvm_off_mag_equal && pvm_off_unit_equal;
> }
> + else if (PVM_IS_OPQ (val1) && PVM_IS_OPQ (val2))
> + return PVM_VAL_OPQ_PAYLOAD (val1) == PVM_VAL_OPQ_PAYLOAD (val2);
> else if (PVM_IS_SCT (val1) && PVM_IS_SCT (val2))
> {
> size_t pvm_sct1_nfields = PVM_VAL_ULONG (PVM_VAL_SCT_NFIELDS (val1));
> @@ -981,6 +1002,9 @@ pvm_sizeof (pvm_val val)
> }
> else if (PVM_IS_OFF (val))
> return pvm_sizeof (PVM_VAL_OFF_MAGNITUDE (val));
> + else if (PVM_IS_OPQ (val))
> + /* By convention, opque values have size zero. */
> + return 0;
> else if (PVM_IS_TYP (val))
> /* By convention, type values have size zero. */
> return 0;
> @@ -1578,6 +1602,12 @@ pvm_print_val_1 (pvm vm, int depth, int mode, int
> base, int indent,
> print_unit_name (PVM_VAL_ULONG (PVM_VAL_TYP_O_UNIT (val_type)));
> pk_term_end_class ("offset");
> }
> + else if (PVM_IS_OPQ (val))
> + {
> + pk_term_class ("special");
> + pk_printf ("#<opaque:%s>", PVM_VAL_OPQ_NAME (val));
> + pk_term_end_class ("special");
> + }
> else if (PVM_IS_CLS (val))
> {
> pk_term_class ("special");
> @@ -1652,6 +1682,8 @@ pvm_typeof (pvm_val val)
> type = val;
> else if (PVM_IS_CLS (val))
> type = PVM_NULL;
> + else if (PVM_IS_OPQ (val))
> + type = pvm_make_opaque_type ();
> else
> PK_UNREACHABLE ();
>
> @@ -1819,10 +1851,12 @@ pvm_val_initialize (void)
>
> pvm_alloc_add_gc_roots (&string_type, 1);
> pvm_alloc_add_gc_roots (&void_type, 1);
> + pvm_alloc_add_gc_roots (&opaque_type, 1);
> pvm_alloc_add_gc_roots (&common_int_types, 65 * 2);
>
> string_type = pvm_make_type (PVM_TYPE_STRING);
> void_type = pvm_make_type (PVM_TYPE_VOID);
> + opaque_type = pvm_make_type (PVM_TYPE_OPAQUE);
>
> for (i = 0; i < 65; ++i)
> for (j = 0; j < 2; ++j)
> @@ -1834,5 +1868,6 @@ pvm_val_finalize (void)
> {
> pvm_alloc_remove_gc_roots (&string_type, 1);
> pvm_alloc_remove_gc_roots (&void_type, 1);
> + pvm_alloc_remove_gc_roots (&opaque_type, 1);
> pvm_alloc_remove_gc_roots (&common_int_types, 65 * 2);
> }
> diff --git a/libpoke/pvm-val.h b/libpoke/pvm-val.h
> index 192a5741..c3c8a479 100644
> --- a/libpoke/pvm-val.h
> +++ b/libpoke/pvm-val.h
> @@ -45,6 +45,7 @@
> #define PVM_VAL_TAG_SCT 0xb
> #define PVM_VAL_TAG_TYP 0xc
> #define PVM_VAL_TAG_CLS 0xd
> +#define PVM_VAL_TAG_OPQ 0xe
>
> #define PVM_VAL_BOXED_P(V) (PVM_VAL_TAG((V)) > 1)
>
> @@ -148,6 +149,7 @@
> #define PVM_VAL_BOX_TYP(B) ((B)->v.type)
> #define PVM_VAL_BOX_CLS(B) ((B)->v.cls)
> #define PVM_VAL_BOX_OFF(B) ((B)->v.offset)
> +#define PVM_VAL_BOX_OPQ(B) ((B)->v.opaque)
>
> struct pvm_val_box
> {
> @@ -160,6 +162,7 @@ struct pvm_val_box
> struct pvm_type *type;
> struct pvm_off *offset;
> struct pvm_cls *cls;
> + struct pvm_opq *opaque;
> } v;
> };
>
> @@ -446,6 +449,7 @@ enum pvm_type_code
> PVM_TYPE_STRUCT,
> PVM_TYPE_OFFSET,
> PVM_TYPE_CLOSURE,
> + PVM_TYPE_OPAQUE,
> PVM_TYPE_VOID
> };
>
> @@ -546,6 +550,21 @@ struct pvm_off
>
> typedef struct pvm_off *pvm_off;
>
> +/* Opaques are boxed values. */
> +
> +#define PVM_VAL_OPQ(V) (PVM_VAL_BOX_OPQ (PVM_VAL_BOX ((V))))
> +
> +#define PVM_VAL_OPQ_NAME(V) (PVM_VAL_OPQ((V))->name)
> +#define PVM_VAL_OPQ_PAYLOAD(V) (PVM_VAL_OPQ((V))->payload)
> +
> +struct pvm_opq
> +{
> + pvm_val name;
> + uintptr_t payload;
> +};
> +
> +typedef struct pvm_opq *pvm_opq;
> +
> #define PVM_IS_INT(V) (PVM_VAL_TAG(V) == PVM_VAL_TAG_INT)
> #define PVM_IS_UINT(V) (PVM_VAL_TAG(V) == PVM_VAL_TAG_UINT)
> #define PVM_IS_LONG(V) (PVM_VAL_TAG(V) == PVM_VAL_TAG_LONG)
> @@ -568,6 +587,9 @@ typedef struct pvm_off *pvm_off;
> #define PVM_IS_OFF(V) \
> (PVM_VAL_TAG(V) == PVM_VAL_TAG_BOX \
> && PVM_VAL_BOX_TAG (PVM_VAL_BOX ((V))) == PVM_VAL_TAG_OFF)
> +#define PVM_IS_OPQ(V) \
> + (PVM_VAL_TAG(V) == PVM_VAL_TAG_BOX \
> + && PVM_VAL_BOX_TAG (PVM_VAL_BOX ((V))) == PVM_VAL_TAG_OPQ)
>
>
> #define PVM_IS_INTEGRAL(V) \
> diff --git a/libpoke/pvm.h b/libpoke/pvm.h
> index 44a0d11c..100ba685 100644
> --- a/libpoke/pvm.h
> +++ b/libpoke/pvm.h
> @@ -236,6 +236,15 @@ pvm_val pvm_make_string_nodup (char *value);
>
> pvm_val pvm_make_offset (pvm_val magnitude, pvm_val type);
>
> +/* Make an opaque PVM value.
> +
> + NAME is a PVM string value.
> +
> + PAYLOAD is the opaque thing that we want to wrap; it's capable of
> + wrapping pointer values safely. */
> +
> +pvm_val pvm_make_opaque (pvm_val name, uintptr_t payload);
> +
> /* Make an array PVM value.
>
> NELEM is an ulong<64> PVM value specifying the number of elements
> @@ -303,7 +312,10 @@ 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_opaque_type (void);
> +
> pvm_val pvm_make_offset_type (pvm_val base_type, pvm_val unit);
> +
> 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..cb515462 100644
> --- a/libpoke/pvm.jitter
> +++ b/libpoke/pvm.jitter
> @@ -84,11 +84,13 @@ wrapped-functions
> pvm_make_uint
> pvm_make_long
> pvm_make_ulong
> + pvm_make_opaque
> pvm_make_exception
> pvm_make_integral_type
> pvm_make_string_type
> pvm_make_offset_type
> pvm_make_array_type
> + pvm_make_opaque_type
> pk_upow
> pk_print_binary
> pk_format_binary
> @@ -3908,6 +3910,38 @@ instruction nec ()
> end
> end
>
> +# Instruction: eqo
> +#
> +# Push 1 on the stack if the two opaque values at the top of the stack
> +# are equal. Otherwise push 0.
> +#
> +# Stack: ( OPQ OPQ -- OPQ OPQ INT )
> +
> +instruction eqo ()
> + code
> + pvm_val a = PVM_VAL_OPQ_PAYLOAD (JITTER_TOP_STACK ());
> + pvm_val b = PVM_VAL_OPQ_PAYLOAD (JITTER_UNDER_TOP_STACK ());
> +
> + JITTER_PUSH_STACK (PVM_MAKE_INT (a == b, 32));
> + end
> +end
> +
> +# Instruction: neo
> +#
> +# Push 1 on the stack if the two opaque values at the top of the stack
> +# are not equal. Otherwise push 0.
> +#
> +# Stack: ( OPQ OPQ -- OPQ OPQ INT )
> +
> +instruction neo ()
> + code
> + pvm_val a = PVM_VAL_OPQ_PAYLOAD (JITTER_TOP_STACK ());
> + pvm_val b = PVM_VAL_OPQ_PAYLOAD (JITTER_UNDER_TOP_STACK ());
> +
> + JITTER_PUSH_STACK (PVM_MAKE_INT (a != b, 32));
> + end
> +end
> +
>
> ## Concatenation instructions
>
> @@ -5584,6 +5618,21 @@ instruction ogetbt ()
> end
> end
>
> +
> +## Opaque Values Instructions
> +
> +# Instruction: opqgetn
> +#
> +# Given an opaque OPQ, push its name on the stack.
> +#
> +# Stack: ( OPQ -- OPQ NAME )
> +
> +instruction opqgetn ()
> + code
> + JITTER_PUSH_STACK (PVM_VAL_OPQ_NAME (JITTER_TOP_STACK ()));
> + end
> +end
> +
>
> ## Instructions to handle mapped values
>
> @@ -6102,7 +6151,7 @@ end
> # Given a type, push 1 on the stack if it is a void. Push 0
> # otherwise.
> #
> -# Stack: ( TYPE -- TYPE INT)
> +# Stack: ( TYPE -- TYPE INT )
>
> instruction tyisv ()
> code
> @@ -6113,6 +6162,22 @@ instruction tyisv ()
> end
> end
>
> +# Instruction: tyisopq
> +#
> +# Given a type, push 1 on the stack if it is a opaque. Push 0
> +# otherwise.
> +#
> +# Stack: ( TYPE -- TYPE INT )
> +
> +instruction tyisopq ()
> + code
> + pvm_val typ = JITTER_TOP_STACK ();
> + int isopq_p = PVM_VAL_TYP_CODE (typ) == PVM_TYPE_OPAQUE;
> +
> + JITTER_PUSH_STACK (PVM_MAKE_INT (isopq_p, 32));
> + end
> +end
> +
> # Instruction: mktyv
> #
> # Build a "void" type and push it on the stack.
> @@ -6125,6 +6190,18 @@ instruction mktyv ()
> end
> end
>
> +# Instruction: mktyopq
> +#
> +# Build an "opaque" type and push it on the stack.
> +#
> +# Stack: ( -- TYPE )
> +
> +instruction mktyopq ()
> + code
> + JITTER_PUSH_STACK (pvm_make_opaque_type ());
> + end
> +end
> +
> # Instruction: mktyi
> #
> # Given an unsigned long denoting a bit width, and an unsigned int