[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[COMMITTED] Support for built-in `ioflags'
|
From: |
Jose E. Marchesi |
|
Subject: |
[COMMITTED] Support for built-in `ioflags' |
|
Date: |
Sat, 27 Mar 2021 13:27:03 +0100 |
This makes it possible for Poke programs to get access to the IO flags
of some given IO space.
2021-03-27 Jose E. Marchesi <jemarch@gnu.org>
* libpoke/pkl-tab.y (builtin): Rule for BUILTIN_IOFLAGS.
* libpoke/pkl-ast.h (PKL_AST_BUILTIN_IOFLAGS): Define.
* libpoke/pkl-lex.l: Handle __PKL_BUILTIN_IOFLAGS__.
* libpoke/pkl-insn.def: New instruction ioflags.
* libpoke/pvm.jitter: Likewise.
* libpoke/pkl-rt.pk (ioflags): Define function.
* libpoke/pkl-gen.c (pkl_gen_ps_comp_stmt): Generate code for the
ioflags builtin.
* doc/poke.texi (ioflags): New section.
* testsuite/poke.pkl/ioflags-1.pk: New test.
* testsuite/poke.pkl/ioflags-2.pk: Likewise.
* testsuite/poke.pkl/ioflags-3.pk: Likewise.
* testsuite/Makefile.am (EXTRA_DIST): Add new tests.
---
ChangeLog | 16 ++++++++++++++++
doc/poke.texi | 18 +++++++++++++++++-
libpoke/pkl-ast.h | 1 +
libpoke/pkl-gen.c | 6 ++++++
libpoke/pkl-insn.def | 1 +
libpoke/pkl-lex.l | 2 ++
libpoke/pkl-rt.pk | 1 +
libpoke/pkl-tab.y | 3 ++-
libpoke/pvm.jitter | 21 +++++++++++++++++++++
testsuite/Makefile.am | 3 +++
testsuite/poke.pkl/ioflags-1.pk | 9 +++++++++
testsuite/poke.pkl/ioflags-2.pk | 9 +++++++++
testsuite/poke.pkl/ioflags-3.pk | 8 ++++++++
13 files changed, 96 insertions(+), 2 deletions(-)
create mode 100644 testsuite/poke.pkl/ioflags-1.pk
create mode 100644 testsuite/poke.pkl/ioflags-2.pk
create mode 100644 testsuite/poke.pkl/ioflags-3.pk
diff --git a/ChangeLog b/ChangeLog
index 5b52061e..c9a6a721 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,19 @@
+2021-03-27 Jose E. Marchesi <jemarch@gnu.org>
+
+ * libpoke/pkl-tab.y (builtin): Rule for BUILTIN_IOFLAGS.
+ * libpoke/pkl-ast.h (PKL_AST_BUILTIN_IOFLAGS): Define.
+ * libpoke/pkl-lex.l: Handle __PKL_BUILTIN_IOFLAGS__.
+ * libpoke/pkl-insn.def: New instruction ioflags.
+ * libpoke/pvm.jitter: Likewise.
+ * libpoke/pkl-rt.pk (ioflags): Define function.
+ * libpoke/pkl-gen.c (pkl_gen_ps_comp_stmt): Generate code for the
+ ioflags builtin.
+ * doc/poke.texi (ioflags): New section.
+ * testsuite/poke.pkl/ioflags-1.pk: New test.
+ * testsuite/poke.pkl/ioflags-2.pk: Likewise.
+ * testsuite/poke.pkl/ioflags-3.pk: Likewise.
+ * testsuite/Makefile.am (EXTRA_DIST): Add new tests.
+
2021-03-27 Jose E. Marchesi <jemarch@gnu.org>
Mohammad-Reza Nabipoor <m.nabipoor@yahoo.com>
diff --git a/doc/poke.texi b/doc/poke.texi
index a10b13dc..69761b36 100644
--- a/doc/poke.texi
+++ b/doc/poke.texi
@@ -11560,6 +11560,7 @@ memory of some process.
* get_ios:: Getting the current IO space.
* set_ios:: Setting the current IO space.
* iosize:: Getting the size of an IO space.
+* ioflags:: Getting the flags of an IO space.
@end menu
@node open
@@ -11712,12 +11713,27 @@ The @code{iosize} builtin returns the size of a given
IO space, as an
offset. It has the following prototype:
@example
-fun iosize = (int<32> ios) offset<uint<64>,1>
+fun iosize = (int<32> ios = get_ios) offset<uint<64>,1>
@end example
If the IO space specified to @code{iosize} doesn't exist,
@code{E_no_ios} will be raised.
+@node ioflags
+@subsubsection @code{ioflags}
+@cindex @code{ioflags}
+
+The @code{ioflags} builtin returns the flags active in a given IO
+space, encoded in an unsigned 64-bit integer. It has the following
+prototype:
+
+@example
+fun ioflags = (int<32> ios = get_ios) uint<64>
+@end example
+
+If the IO space specified to @code{ioflags} doesn't exist,
+@code{E_no_ios} will be raised.
+
@node The Map Operator
@subsection The Map Operator
@cindex mapping
diff --git a/libpoke/pkl-ast.h b/libpoke/pkl-ast.h
index 5ea9be5e..1101607e 100644
--- a/libpoke/pkl-ast.h
+++ b/libpoke/pkl-ast.h
@@ -1433,6 +1433,7 @@ pkl_ast_node pkl_ast_make_incrdecr (pkl_ast ast,
#define PKL_AST_BUILTIN_TERM_END_CLASS 20
#define PKL_AST_BUILTIN_TERM_BEGIN_HYPERLINK 21
#define PKL_AST_BUILTIN_TERM_END_HYPERLINK 22
+#define PKL_AST_BUILTIN_IOFLAGS 23
struct pkl_ast_comp_stmt
{
diff --git a/libpoke/pkl-gen.c b/libpoke/pkl-gen.c
index 9f977661..fda9c1ee 100644
--- a/libpoke/pkl-gen.c
+++ b/libpoke/pkl-gen.c
@@ -658,6 +658,12 @@ PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_comp_stmt)
pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP);
pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_RETURN);
break;
+ case PKL_AST_BUILTIN_IOFLAGS:
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSHVAR, 0, 0);
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_IOFLAGS);
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP);
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_RETURN);
+ break;
case PKL_AST_BUILTIN_FORGET:
pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSHVAR, 0, 0);
pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSHVAR, 0, 1);
diff --git a/libpoke/pkl-insn.def b/libpoke/pkl-insn.def
index 725f519e..b709bc1e 100644
--- a/libpoke/pkl-insn.def
+++ b/libpoke/pkl-insn.def
@@ -431,6 +431,7 @@ PKL_DEF_INSN(PKL_INSN_OPEN,"","open")
PKL_DEF_INSN(PKL_INSN_CLOSE,"","close")
PKL_DEF_INSN(PKL_INSN_FLUSH,"","flush")
PKL_DEF_INSN(PKL_INSN_IOSIZE,"","iosize")
+PKL_DEF_INSN(PKL_INSN_IOFLAGS,"","ioflags")
PKL_DEF_INSN(PKL_INSN_IOGETB,"","iogetb")
PKL_DEF_INSN(PKL_INSN_IOSETB,"","iosetb")
diff --git a/libpoke/pkl-lex.l b/libpoke/pkl-lex.l
index b6e2e21c..be5aac22 100644
--- a/libpoke/pkl-lex.l
+++ b/libpoke/pkl-lex.l
@@ -243,6 +243,8 @@ S ::
if (yyextra->bootstrapped) REJECT; return BUILTIN_CLOSE; }
"__PKL_BUILTIN_IOSIZE__" {
if (yyextra->bootstrapped) REJECT; return BUILTIN_IOSIZE; }
+"__PKL_BUILTIN_IOFLAGS__" {
+ if (yyextra->bootstrapped) REJECT; return BUILTIN_IOFLAGS; }
"__PKL_BUILTIN_GETENV__" {
if (yyextra->bootstrapped) REJECT; return BUILTIN_GETENV; }
"__PKL_BUILTIN_FORGET__" {
diff --git a/libpoke/pkl-rt.pk b/libpoke/pkl-rt.pk
index bfb63259..c5affab7 100644
--- a/libpoke/pkl-rt.pk
+++ b/libpoke/pkl-rt.pk
@@ -26,6 +26,7 @@ fun set_ios = (int<32> ios) int<32>: __PKL_BUILTIN_SET_IOS__;
fun open = (string handler, uint<64> flags = 0) int<32>: __PKL_BUILTIN_OPEN__;
fun close = (int<32> ios) void: __PKL_BUILTIN_CLOSE__;
fun iosize = (int<32> ios = get_ios) offset<uint<64>,1>:
__PKL_BUILTIN_IOSIZE__;
+fun ioflags = (int<32> ios = get_ios) uint<64>: __PKL_BUILTIN_IOFLAGS__;
fun getenv = (string name) string: __PKL_BUILTIN_GETENV__;
fun flush = (int<32> ios, offset<uint<64>,1> offset) void:
__PKL_BUILTIN_FORGET__;
fun get_time = int<64>[2]: __PKL_BUILTIN_GET_TIME__;
diff --git a/libpoke/pkl-tab.y b/libpoke/pkl-tab.y
index c82a0edc..970d4969 100644
--- a/libpoke/pkl-tab.y
+++ b/libpoke/pkl-tab.y
@@ -418,7 +418,7 @@ token <integer> UNION _("keyword `union'")
%token LAMBDA _("keyword `lambda'")
%token BUILTIN_RAND BUILTIN_GET_ENDIAN BUILTIN_SET_ENDIAN
%token BUILTIN_GET_IOS BUILTIN_SET_IOS BUILTIN_OPEN BUILTIN_CLOSE
-%token BUILTIN_IOSIZE BUILTIN_GETENV BUILTIN_FORGET BUILTIN_GET_TIME
+%token BUILTIN_IOSIZE BUILTIN_IOFLAGS BUILTIN_GETENV BUILTIN_FORGET
BUILTIN_GET_TIME
%token BUILTIN_STRACE BUILTIN_TERM_RGB_TO_COLOR
%token BUILTIN_TERM_GET_COLOR BUILTIN_TERM_SET_COLOR
%token BUILTIN_TERM_GET_BGCOLOR BUILTIN_TERM_SET_BGCOLOR
@@ -2038,6 +2038,7 @@ builtin:
| BUILTIN_OPEN { $$ = PKL_AST_BUILTIN_OPEN; }
| BUILTIN_CLOSE { $$ = PKL_AST_BUILTIN_CLOSE; }
| BUILTIN_IOSIZE { $$ = PKL_AST_BUILTIN_IOSIZE; }
+ | BUILTIN_IOFLAGS { $$ = PKL_AST_BUILTIN_IOFLAGS; }
| BUILTIN_GETENV { $$ = PKL_AST_BUILTIN_GETENV; }
| BUILTIN_FORGET { $$ = PKL_AST_BUILTIN_FORGET; }
| BUILTIN_GET_TIME { $$ = PKL_AST_BUILTIN_GET_TIME; }
diff --git a/libpoke/pvm.jitter b/libpoke/pvm.jitter
index 16224ad2..d0411a7d 100644
--- a/libpoke/pvm.jitter
+++ b/libpoke/pvm.jitter
@@ -1470,6 +1470,27 @@ instruction popios ()
end
end
+# Instruction: ioflags
+#
+# Push an unsigned 64-bit integer with the flags of the given IO space
+# on the stack. The IO space is identified by a descriptor, which is
+# a signed integer. If the given IO space doesn't exist, raise
+# PVM_E_NO_IOS.
+#
+# Stack: ( INT -- INT ULONG )
+# Exceptions: PVM_E_NO_IOS
+
+instruction ioflags ()
+ code
+ ios io = ios_search_by_id (PVM_VAL_INT (JITTER_TOP_STACK ()));
+
+ if (io == NULL)
+ PVM_RAISE_DFL (PVM_E_NO_IOS);
+
+ JITTER_PUSH_STACK (PVM_MAKE_ULONG (ios_flags (io), 64));
+ end
+end
+
# Instruction: iosize
#
# Push the size of the given IO space on the stack, as an offset. The
diff --git a/testsuite/Makefile.am b/testsuite/Makefile.am
index 28968938..29440fae 100644
--- a/testsuite/Makefile.am
+++ b/testsuite/Makefile.am
@@ -817,6 +817,9 @@ EXTRA_DIST = \
poke.pkl/cdiv-integers-3.pk \
poke.pkl/cdiv-integers-diag-1.pk \
poke.pkl/cdiv-integers-diag-2.pk \
+ poke.pkl/ioflags-1.pk \
+ poke.pkl/ioflags-2.pk \
+ poke.pkl/ioflags-3.pk \
poke.pkl/cdiv-integers-overflow-1.pk \
poke.pkl/cdiv-integers-overflow-2.pk \
poke.pkl/cdiv-integers-overflow-3.pk \
diff --git a/testsuite/poke.pkl/ioflags-1.pk b/testsuite/poke.pkl/ioflags-1.pk
new file mode 100644
index 00000000..fc13412f
--- /dev/null
+++ b/testsuite/poke.pkl/ioflags-1.pk
@@ -0,0 +1,9 @@
+/* { dg-do run } */
+/* { dg-data {c*} {0x01 0x02 0x03} foo.data } */
+
+/* { dg-command { .set obase 10 } } */
+/* { dg-command { var foo = open ("foo.data", IOS_M_RDWR) } } */
+/* { dg-command { !! (ioflags (foo) & IOS_F_READ) } } */
+/* { dg-output "1" } */
+/* { dg-command { !! (ioflags (foo) & IOS_F_WRITE) } } */
+/* { dg-output "\n1" } */
diff --git a/testsuite/poke.pkl/ioflags-2.pk b/testsuite/poke.pkl/ioflags-2.pk
new file mode 100644
index 00000000..ec68a4c0
--- /dev/null
+++ b/testsuite/poke.pkl/ioflags-2.pk
@@ -0,0 +1,9 @@
+/* { dg-do run } */
+/* { dg-data {c*} {0x01 0x02 0x03} foo.data } */
+
+/* { dg-command { .set obase 10 } } */
+/* { dg-command { var foo = open ("foo.data", IOS_M_RDONLY) } } */
+/* { dg-command { !! (ioflags (foo) & IOS_F_READ) } } */
+/* { dg-output "1" } */
+/* { dg-command { !! (ioflags (foo) & IOS_F_WRITE) } } */
+/* { dg-output "\n0" } */
diff --git a/testsuite/poke.pkl/ioflags-3.pk b/testsuite/poke.pkl/ioflags-3.pk
new file mode 100644
index 00000000..841a63d3
--- /dev/null
+++ b/testsuite/poke.pkl/ioflags-3.pk
@@ -0,0 +1,8 @@
+/* { dg-do run } */
+/* { dg-data {c*} {0x01 0x02 0x03} } */
+
+/* { dg-command { .set obase 10 } } */
+/* { dg-command { !! (ioflags & IOS_F_READ) } } */
+/* { dg-output "1" } */
+/* { dg-command { !! (ioflags & IOS_F_WRITE) } } */
+/* { dg-output "\n1" } */
--
2.25.0.2.g232378479e
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [COMMITTED] Support for built-in `ioflags',
Jose E. Marchesi <=