[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[WIP][PATCH 1/2] pvm: add new pvm value: opaque values
From: |
Mohammad-Reza Nabipoor |
Subject: |
[WIP][PATCH 1/2] pvm: add new pvm value: opaque values |
Date: |
Tue, 14 Feb 2023 23:52:48 +0100 |
This commit introduces a new PVM type to wrap opaque values,
things like handles to resources which PVM cannot deal with
them directly.
2023-02-14 Mohammad-Reza Nabipoor <mnabipoor@gnu.org>
* libpoke/pkl-insn.def (opqgetn): New instruction.
(opqsetn): Likewise.
(opqgetp): Likewise.
(mktyopq): Likewise.
(tyisopq): Likewise.
* libpoke/pvm.jitter (opqgetn): New instruction.
(opqsetn): Likewise.
(opqgetp): Likewise.
(tyisopq): Likewise.
(mktyopq): 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.
(_pkl_eq_opaque): New function.
* 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.
---
Hello Jose.
The reason for [WIP] is these patches doesn't have doc and test.
I wanted to get one round of review, before spending some time
writing the docs (please don't accept the patches without doc and test!).
Regards,
Mohammad-Reza
ChangeLog | 36 +++++++++++++++++++++
libpoke/pkl-insn.def | 9 ++++++
libpoke/pkl-rt.pk | 27 ++++++++++++++++
libpoke/pvm-val.c | 39 ++++++++++++++++++++++
libpoke/pvm-val.h | 22 +++++++++++++
libpoke/pvm.h | 12 +++++++
libpoke/pvm.jitter | 77 +++++++++++++++++++++++++++++++++++++++++++-
7 files changed, 221 insertions(+), 1 deletion(-)
diff --git a/ChangeLog b/ChangeLog
index ccdbb8e7..9b07b666 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,39 @@
+2023-02-14 Mohammad-Reza Nabipoor <mnabipoor@gnu.org>
+
+ * libpoke/pkl-insn.def (opqgetn): New instruction.
+ (opqsetn): Likewise.
+ (opqgetp): Likewise.
+ (mktyopq): Likewise.
+ (tyisopq): Likewise.
+ * libpoke/pvm.jitter (opqgetn): New instruction.
+ (opqsetn): Likewise.
+ (opqgetp): Likewise.
+ (tyisopq): Likewise.
+ (mktyopq): 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.
+ (_pkl_eq_opaque): New function.
+ * 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-02-14 Mohammad-Reza Nabipoor <mnabipoor@gnu.org>
* common/pk-utils.h (pk_unreachable): New function declaration.
diff --git a/libpoke/pkl-insn.def b/libpoke/pkl-insn.def
index c086bdf1..cf30396b 100644
--- a/libpoke/pkl-insn.def
+++ b/libpoke/pkl-insn.def
@@ -281,6 +281,12 @@ PKL_DEF_INSN(PKL_INSN_OSETM,"","osetm")
PKL_DEF_INSN(PKL_INSN_OGETU,"","ogetu")
PKL_DEF_INSN(PKL_INSN_OGETBT,"","ogetbt")
+/* Opaque instructions. */
+
+PKL_DEF_INSN(PKL_INSN_OPQGETN,"","opqgetn")
+PKL_DEF_INSN(PKL_INSN_OPQSETN,"","opqsetn")
+PKL_DEF_INSN(PKL_INSN_OPQGETP,"","opqgetp")
+
/* Containers instructions. */
PKL_DEF_INSN(PKL_INSN_SEL,"","sel")
@@ -367,6 +373,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..7371f982 100644
--- a/libpoke/pkl-rt.pk
+++ b/libpoke/pkl-rt.pk
@@ -1196,6 +1196,17 @@ immutable fun _pkl_eq_offset = (any v1, any v2) int<32>:
return v1_normalized == v2_normalized;
}
+/* Determine whether two given opaque values are equal. */
+
+immutable fun _pkl_eq_opaque = (any v1, any v2) int<32>:
+{
+ if (asm string: ("opqgetn; nip" : v1) != asm string: ("opqgetn; nip" : v2))
+ return 0;
+ if (asm uint<64>: ("opqgetp; nip" : v1) != asm uint<64>: ("opqgetp; nip" :
v2))
+ return 0;
+ return 1;
+}
+
/* Determine whether two given string values are equal. */
immutable fun _pkl_eq_string = (any v1, any v2) int<32>:
@@ -1268,6 +1279,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 _pkl_eq_opaque (v1, v2);
else if (asm int<32>: ("typof; nip; tyiss; nip" : v1)
&& asm int<32>: ("typof; nip; tyiss; nip" : v2))
/* Strings. */
@@ -1358,6 +1373,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 +1682,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..a123bc9b 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,12 @@ 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_equal_p (PVM_VAL_OPQ_NAME (val1), PVM_VAL_OPQ_NAME (val2))
+ && pvm_val_equal_p (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 +1006,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 +1606,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 +1686,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 +1855,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 +1872,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 7f67eb9b..b42df3ab 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
@@ -5586,6 +5588,51 @@ instruction ogetbt ()
end
end
+
+## Opaque 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
+
+# Instruction: opqsetn
+#
+# Given an opaque OPQ and a string STR, make it the opaque's name.
+#
+# Stack: ( OPQ -- OPQ NAME )
+
+instruction opqsetn ()
+ code
+ pvm_val name = JITTER_TOP_STACK ();
+ pvm_val opq = JITTER_UNDER_TOP_STACK ();
+
+ JITTER_DROP_STACK ();
+ PVM_VAL_OPQ_NAME (opq) = name;
+ end
+end
+
+# Instruction: opqgetp
+#
+# Given an opaque OPQ, push its payload on the stack as ULONG.
+#
+# Stack: ( OPQ -- OPQ ULONG )
+
+instruction opqgetp ()
+ code
+ pvm_val opq = JITTER_TOP_STACK ();
+
+ JITTER_PUSH_STACK (PVM_MAKE_ULONG (PVM_VAL_OPQ_PAYLOAD (opq), 64));
+ end
+end
+
## Instructions to handle mapped values
@@ -6104,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
@@ -6115,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.
@@ -6127,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.39.1
- [WIP][PATCH 1/2] pvm: add new pvm value: opaque values,
Mohammad-Reza Nabipoor <=
- [WIP][PATCH 2/2] pkl,pvm: add support for regular expression, Mohammad-Reza Nabipoor, 2023/02/14
- Re: [WIP][PATCH 2/2] pkl,pvm: add support for regular expression, Jose E. Marchesi, 2023/02/15
- Re: [WIP][PATCH 2/2] pkl,pvm: add support for regular expression, Mohammad-Reza Nabipoor, 2023/02/15
- Re: [WIP][PATCH 2/2] pkl,pvm: add support for regular expression, Jose E. Marchesi, 2023/02/15
- Re: [WIP][PATCH 2/2] pkl,pvm: add support for regular expression, Mohammad-Reza Nabipoor, 2023/02/16
- Re: [WIP][PATCH 2/2] pkl,pvm: add support for regular expression, Jose E. Marchesi, 2023/02/17
- Re: [WIP][PATCH 2/2] pkl,pvm: add support for regular expression, Mohammad-Reza Nabipoor, 2023/02/19
- Re: [WIP][PATCH 2/2] pkl,pvm: add support for regular expression, Jose E. Marchesi, 2023/02/20
Re: [WIP][PATCH 1/2] pvm: add new pvm value: opaque values, Jose E. Marchesi, 2023/02/15