[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[PATCH 2/2] pkl: fix mktya doc and usage
|
From: |
Mohammad-Reza Nabipoor |
|
Subject: |
[PATCH 2/2] pkl: fix mktya doc and usage |
|
Date: |
Thu, 27 Oct 2022 22:10:46 +0200 |
The `mktya' instruction expects a closure as the bounder.
This patch fixes all `mktya' usages. It also adds helper
functions to make creating array types easier.
2022-10-27 Mohammad-Reza Nabipoor <mnabipoor@gnu.org>
* libpoke/pvm.jitter (mktya): Fix documentation.
* libpoke/pkl-rt.pk (_Pkl_ClsN): New type.
(_Pkl_ClsI): Likewise.
(_Pkl_ClsO): Likewise.
(_pkl_mkclsn): New function.
(_pkl_mkclsi): Likewise.
(_pkl_mkclso): Likewise.
---
ChangeLog | 10 ++++++++++
libpoke/pkl-gen-builtins.pks | 2 +-
libpoke/pkl-gen.c | 6 +++---
libpoke/pkl-gen.pks | 6 +++---
libpoke/pkl-rt.pk | 26 ++++++++++++++++++++++++++
libpoke/pvm.jitter | 13 +++++++------
6 files changed, 50 insertions(+), 13 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index f433a704..ece8e980 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2022-10-27 Mohammad-Reza Nabipoor <mnabipoor@gnu.org>
+
+ * libpoke/pvm.jitter (mktya): Fix documentation.
+ * libpoke/pkl-rt.pk (_Pkl_ClsN): New type.
+ (_Pkl_ClsI): Likewise.
+ (_Pkl_ClsO): Likewise.
+ (_pkl_mkclsn): New function.
+ (_pkl_mkclsi): Likewise.
+ (_pkl_mkclso): Likewise.
+
2022-10-27 Mohammad-Reza Nabipoor <mnabipoor@gnu.org>
* libpoke/pkl-insn.def (isn): Remove instruction because we
diff --git a/libpoke/pkl-gen-builtins.pks b/libpoke/pkl-gen-builtins.pks
index f8c74533..8c6b7619 100644
--- a/libpoke/pkl-gen-builtins.pks
+++ b/libpoke/pkl-gen-builtins.pks
@@ -131,7 +131,7 @@
.macro builtin_get_color_bgcolor
.let #itype = pvm_make_integral_type (pvm_make_ulong (32, 64),
pvm_make_int (1, 32))
push #itype
- push null
+ .call _pkl_mkclsn
mktya
push ulong<64>3
mka ; ARR
diff --git a/libpoke/pkl-gen.c b/libpoke/pkl-gen.c
index caa3c810..1e02caf6 100644
--- a/libpoke/pkl-gen.c
+++ b/libpoke/pkl-gen.c
@@ -1397,7 +1397,7 @@ PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_format)
/* Save all the intermediate strings in an array of strings and at the
end, concatenate all of elements into a single string on the stack. */
pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, pvm_make_string_type ());
- pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, PVM_NULL);
+ pkl_asm_call (PKL_GEN_ASM, PKL_GEN_PAYLOAD->env, "_pkl_mkclsn");
pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MKTYA);
pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
pvm_make_ulong (0, 64)); /* FIXME use better hint */
@@ -1845,8 +1845,8 @@ PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_funcall)
/* Create the array of variable arguments. */
pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, PVM_NULL);
- pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, PVM_NULL);
- pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MKTYA);
+ pkl_asm_call (PKL_GEN_ASM, PKL_GEN_PAYLOAD->env, "_pkl_mkclsn");
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MKTYA); /* ANY[] */
pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
pvm_make_ulong (aindex, 64));
pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MKA);
diff --git a/libpoke/pkl-gen.pks b/libpoke/pkl-gen.pks
index ad4f13ed..2c77268d 100644
--- a/libpoke/pkl-gen.pks
+++ b/libpoke/pkl-gen.pks
@@ -572,8 +572,8 @@
.macro emit_tv_field_absent
push null
- push null
- mktya
+ .call _pkl_mkclsn
+ mktya ; any[]
push ulong<64>1
mka ; STR ARGS
over ; STR ARGS STR
@@ -998,7 +998,7 @@
;; Generate a PK_TV_FIELD_MAPPED tracer event.
;; First, create an empty any[] array for the arguments.
push null ; ... BOFF STR VAL ANYT
- push null ; ... BOFF STR VAL ANYT NULL
+ .call _pkl_mkclsn ; ... BOFF STR VAL ANYT BOUNDER
mktya ; ... BOFF STR VAL ATYPE
push ulong<64>6 ; ... BOFF STR VAL ATYPE NELEM
mka ; ... BOFF STR VAL ARGS
diff --git a/libpoke/pkl-rt.pk b/libpoke/pkl-rt.pk
index 454661d5..ee2b0973 100644
--- a/libpoke/pkl-rt.pk
+++ b/libpoke/pkl-rt.pk
@@ -708,6 +708,32 @@ immutable fun _pkl_dispatch_tv = (int<32> e, any[] a) void:
pk_tracer_dispatch.table[e] (e, a);
}
+/* Closures which are useful for creating array bounders. */
+
+type _Pkl_ClsN = () any;
+type _Pkl_ClsI = () uint<64>;
+type _Pkl_ClsO = () offset<uint<64>,1>;
+
+/* Return a closure that returns `null'. */
+
+immutable fun _pkl_mkclsn = _Pkl_ClsN:
+{
+ /* HACK This is equivalent to `push null'.
+ Until we get a more powerful assembler, we have to use this
+ trick. */
+ return lambda any: { return asm any: ("push 7"); };
+}
+
+immutable fun _pkl_mkclsi = (uint<64> i) _Pkl_ClsI:
+{
+ return lambda uint<64>: { return i; };
+}
+
+immutable fun _pkl_mkclso = (offset<uint<64>,1> o) _Pkl_ClsO:
+{
+ return lambda offset<uint<64>,1>: { return o; };
+}
+
/* Hooks for the IO subsystem.
The functions in `ios_open_hook' are invoked once a new IO space
diff --git a/libpoke/pvm.jitter b/libpoke/pvm.jitter
index 95fcc563..c20eea9a 100644
--- a/libpoke/pvm.jitter
+++ b/libpoke/pvm.jitter
@@ -5998,19 +5998,20 @@ end
# Instruction: mktya
#
-# Given an elements type and an unsigned long denoting a length, build
-# an array type having these features and push it on the stack. If
-# the type array is unbounded then length is PVM_NULL.
+# Given an elements type and a bounder closure, build an array type
+# having these features and push it on the stack. The bounder closure
+# can return either PVM_NULL, or an integer, or an offset as the boundary
+# of the array type.
#
-# Stack: ( TYPE (ULONG|NULL) -- TYPE )
+# Stack: ( TYPE BOUNDER -- TYPE )
instruction mktya ()
code
- pvm_val bound = JITTER_TOP_STACK ();
+ pvm_val bounder = JITTER_TOP_STACK ();
pvm_val etype = JITTER_UNDER_TOP_STACK ();
JITTER_DROP_STACK ();
- JITTER_TOP_STACK () = pvm_make_array_type (etype, bound);
+ JITTER_TOP_STACK () = pvm_make_array_type (etype, bounder);
end
end
--
2.38.1