[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[PATCH v2] pvm: add new pvm value: opaque values
|
From: |
Mohammad-Reza Nabipoor |
|
Subject: |
[PATCH v2] pvm: add new pvm value: opaque values |
|
Date: |
Thu, 20 Apr 2023 03:17:40 +0200 |
This commit introduces a new PVM type to wrap opaque values,
things like handles to resources which PVM cannot deal with
them directly.
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
--
2.40.0
- [PATCH v2] pvm: add new pvm value: opaque values,
Mohammad-Reza Nabipoor <=