[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[PATCH v2 3/3] libpoke: Add `format`
|
From: |
Mohammad-Reza Nabipoor |
|
Subject: |
[PATCH v2 3/3] libpoke: Add `format` |
|
Date: |
Tue, 8 Jun 2021 03:52:07 +0430 |
2021-06-06 Mohammad-Reza Nabipoor <mnabipoor@gnu.org>
* common/pk-utils.h (pk_format_binary): New function declaration.
* common/pk-utils.c (pk_format_binary): New function definition.
* libpoke/pkl-lex.l (format): Recognize `format`.
* libpoke/pkl-ast.h (PKL_AST_FORMAT): Define.
(PKL_AST_FORMAT_ARG): Likewise.
(PKL_AST_TYPE_A_FORMATER): Likewise.
(PKL_AST_TYPE_S_FORMATER): Likewise.
(PKL_AST_FORMAT_NODE_NAME): Likewise.
(PKL_AST_FORMAT_FMT): Likewise.
(PKL_AST_FORMAT_TYPES): Likewise.
(PKL_AST_FORMAT_ARGS): Likewise.
(PKL_AST_FORMAT_NARGS): Likewise.
(PKL_AST_FORMAT_PREFIX): Likewise.
(PKL_AST_FORMAT_FMT_PROCESSED_P): Likewise.
(struct pkl_ast_format): New struct.
(pkl_ast_make_format): New function declaration.
(PKL_AST_FORMAT_ARG_EXP): Define.
(PKL_AST_FORMAT_ARG_BASE): Likewise.
(PKL_AST_FORMAT_ARG_SUFFIX): Likewise.
(PKL_AST_FORMAT_ARG_BEGIN_SC): Likewise.
(PKL_AST_FORMAT_ARG_END_SC): Likewise.
(PKL_AST_FORMAT_ARG_VALUE_P): Likewise.
(PKL_AST_FORMAT_ARG_FORMAT_MODE): Likewise.
(PKL_AST_FORMAT_ARG_FORMAT_DEPTH): Likewise.
(PKL_AST_FORMAT_MODE_FLAT): Likewise.
(PKL_AST_FORMAT_MODE_TREE): Likewise.
(struct pkl_ast_format_arg): New struct.
(pkl_ast_make_format_arg): New function declaration.
(struct pkl_ast_print_stmt): Delegate all format processing to a
PKL_AST_FORMAT node.
(pkl_ast_make_print_stmt): Change API.
(PKL_AST_PRINT_STMT_FMT): Remove.
(PKL_AST_PRINT_STMT_TYPES): Likewise.
(PKL_AST_PRINT_STMT_ARGS): Likewise.
(PKL_AST_PRINT_STMT_NARGS): Likewise.
(PKL_AST_PRINT_STMT_PREFIX): Likewise.
(PKL_AST_PRINT_STMT_FMT_PROCESSED_P): Likewise.
(PKL_AST_PRINT_STMT_ARG): Likewise.
(struct pkl_ast_print_stmt_arg): Likewise.
(PKL_AST_PRINT_STMT_ARG_EXP): Likewise.
(PKL_AST_PRINT_STMT_ARG_BASE): Likewise.
(PKL_AST_PRINT_STMT_ARG_SUFFIX): Likewise.
(PKL_AST_PRINT_STMT_ARG_BEGIN_SC): Likewise.
(PKL_AST_PRINT_STMT_ARG_END_SC): Likewise.
(PKL_AST_PRINT_STMT_ARG_VALUE_P): Likewise.
(PKL_AST_PRINT_STMT_ARG_PRINT_MODE): Likewise.
(PKL_AST_PRINT_STMT_ARG_PRINT_DEPTH): Likewise.
(PKL_AST_PRINT_MODE_FLAT): Likewise.
(PKL_AST_PRINT_MODE_TREE): Likewise.
(pkl_ast_make_print_stmt_arg): Likewise.
* libpoke/pkl-ast.c (pkl_ast_make_array_type): Add formater closure.
(pkl_ast_make_struct_type): Add formater closure.
(pkl_ast_make_format): New function definition.
(pkl_ast_make_format_arg): Likewise.
(pkl_ast_node_free): Handle `PKL_AST_FORMAT` and `PKL_AST_FORMAT_ARG`.
Remove `PKL_AST_PRINT_STMT_ARG` case. Revise `PKL_AST_PRINT_STMT` case.
(pkl_ast_print_1): Likewise.
(pkl_ast_make_print_stmt): Revise.
(pkl_ast_make_print_stmt_arg): Remove.
* libpoke/pkl-tab.y: Define token `FORMAT`.
(primary): Add `format` support.
(format_arg): New rule.
(format_arg_list): Likewise.
(print_stmt_arg_list): Remove.
* libpoke/pvm.jitter (wrapped-functions): Add `snprintf`.
(PVM_FORMATI): Define.
(PVM_FORMATL): Likewise.
(formati): New instruction.
(formatiu): Likewise.
(formatl): Likewise.
(formatlu): Likewise.
(push-drop-to-nop): New rule.
* libpoke/pkl-insn.def: Add `format{i,iu,l,lu}` instructions. Add
`format` macro instruction.
And also add previously defined instructions: `drop2`, `drop3`, `nip3`.
* libpoke/pkl-asm.c (pkl_asm_insn_format): New function definition.
(pkl_asm_insn): Add support for format macro instruction.
* libpoke/pkl-pass.c (pkl_do_pass_1): Handle `PKL_AST_FORMAT_ARG`
and `PKL_AST_FORMAT`. Remove `PKL_AST_PRINT_STMT_ARG`. Revise
`PKL_AST_PRINT_STMT`.
* libpoke/pkl-trans.c (pkl_trans1_ps_format): New phase.
(pkl_trans1_ps_print_stmt): Remove.
(pkl_phase_trans1): Revise.
* libpoke/pkl-typify.c (pkl_typify1_ps_format): New phase.
(pkl_typify1_ps_print_stmt): Revise.
(pkl_phase_typify1): Register new phase.
* libpoke/pkl-promo.c (pkl_promo_ps_format): New phase.
(pkl_promo_ps_print_stmt): Remove.
(pkl_phase_promo): Revise.
* libpoke/pkl-gen.h (PKL_GEN_CTX_IN_FORMATER): Define.
* libpoke/pkl-gen.c (pkl_gen_pr_format): Generate code for `format`.
(pkl_phase_gen): Register new phase.
(pkl_gen_pr_type_offset): Add formater context.
(pkl_gen_ps_type_integral): Likewise.
(pkl_gen_pr_type_function): Likewise.
(pkl_gen_pr_type_array): Likewise.
(pkl_gen_ps_type_string): Likewise.
(pkl_gen_pr_type_struct): Likewise.
* libpoke/pkl-rt.pk (_pkl_strcat3): New function.
(_pkl_indentation): Likewise.
(_pkl_format_int_suffix): Likewise.
(_pkl_reduce_string_array): Likewise.
* libpoke/pkl-gen.pks (format_int_suffix): New RAS macro.
(integral_formater): Likewise.
(offset_formater): Likewise.
(string_formater): Likewise.
(format_boffset): Likewise.
(array_formater): New RAS function.
(struct_formater): Likewise.
* testsuite/poke.pkl/format-1.pk: New test.
* testsuite/poke.pkl/format-2.pk: Likewise.
* testsuite/poke.pkl/format-3.pk: Likewise.
* testsuite/poke.pkl/format-4.pk: Likewise.
* testsuite/poke.pkl/format-5.pk: Likewise.
* testsuite/poke.pkl/format-6.pk: Likewise.
* testsuite/poke.pkl/format-7.pk: Likewise.
* testsuite/poke.pkl/format-8.pk: Likewise.
* testsuite/poke.pkl/format-9.pk: Likewise.
* testsuite/poke.pkl/format-10.pk: Likewise.
* testsuite/poke.pkl/format-11.pk: Likewise.
* testsuite/poke.pkl/format-12.pk: Likewise.
* testsuite/poke.pkl/format-13.pk: Likewise.
* testsuite/poke.pkl/format-14.pk: Likewise.
* testsuite/poke.pkl/format-15.pk: Likewise.
* testsuite/poke.pkl/format-16.pk: Likewise.
* testsuite/poke.pkl/format-17.pk: Likewise.
* testsuite/poke.pkl/format-18.pk: Likewise.
* testsuite/poke.pkl/format-19.pk: Likewise.
* testsuite/poke.pkl/format-20.pk: Likewise.
* testsuite/poke.pkl/format-21.pk: Likewise.
* testsuite/poke.pkl/format-22.pk: Likewise.
* testsuite/poke.pkl/format-23.pk: Likewise.
* testsuite/poke.pkl/format-24.pk: Likewise.
* testsuite/poke.pkl/format-25.pk: Likewise.
* testsuite/poke.pkl/format-26.pk: Likewise.
* testsuite/poke.pkl/format-27.pk: Likewise.
* testsuite/poke.pkl/format-28.pk: Likewise.
* testsuite/poke.pkl/format-29.pk: Likewise.
* testsuite/poke.pkl/format-diag-1.pk: Likewise.
* testsuite/poke.pkl/reduce-array-1.pk: Likewise.
* testsuite/poke.pkl/reduce-array-2.pk: Likewise.
* testsuite/Makefile.am (EXTRA_DIST): Add new tests.
---
ChangeLog | 145 +++++++
common/pk-utils.c | 28 ++
common/pk-utils.h | 4 +
libpoke/pkl-asm.c | 39 ++
libpoke/pkl-ast.c | 135 ++++---
libpoke/pkl-ast.h | 217 ++++++-----
libpoke/pkl-gen.c | 294 +++++++++++++-
libpoke/pkl-gen.h | 1 +
libpoke/pkl-gen.pks | 551 +++++++++++++++++++++++++++
libpoke/pkl-insn.def | 14 +
libpoke/pkl-lex.l | 1 +
libpoke/pkl-pass.c | 23 +-
libpoke/pkl-promo.c | 21 +-
libpoke/pkl-rt.pk | 68 ++++
libpoke/pkl-tab.y | 73 ++--
libpoke/pkl-trans.c | 113 +++---
libpoke/pkl-typify.c | 104 ++---
libpoke/pvm.jitter | 205 ++++++++++
testsuite/Makefile.am | 32 ++
testsuite/poke.pkl/format-1.pk | 21 +
testsuite/poke.pkl/format-10.pk | 7 +
testsuite/poke.pkl/format-11.pk | 7 +
testsuite/poke.pkl/format-12.pk | 7 +
testsuite/poke.pkl/format-13.pk | 4 +
testsuite/poke.pkl/format-14.pk | 4 +
testsuite/poke.pkl/format-15.pk | 4 +
testsuite/poke.pkl/format-16.pk | 7 +
testsuite/poke.pkl/format-17.pk | 7 +
testsuite/poke.pkl/format-18.pk | 4 +
testsuite/poke.pkl/format-19.pk | 5 +
testsuite/poke.pkl/format-2.pk | 20 +
testsuite/poke.pkl/format-20.pk | 7 +
testsuite/poke.pkl/format-21.pk | 5 +
testsuite/poke.pkl/format-22.pk | 5 +
testsuite/poke.pkl/format-23.pk | 5 +
testsuite/poke.pkl/format-24.pk | 6 +
testsuite/poke.pkl/format-25.pk | 7 +
testsuite/poke.pkl/format-26.pk | 11 +
testsuite/poke.pkl/format-27.pk | 10 +
testsuite/poke.pkl/format-28.pk | 11 +
testsuite/poke.pkl/format-29.pk | 11 +
testsuite/poke.pkl/format-3.pk | 20 +
testsuite/poke.pkl/format-4.pk | 20 +
testsuite/poke.pkl/format-5.pk | 4 +
testsuite/poke.pkl/format-6.pk | 4 +
testsuite/poke.pkl/format-7.pk | 4 +
testsuite/poke.pkl/format-8.pk | 7 +
testsuite/poke.pkl/format-9.pk | 7 +
testsuite/poke.pkl/format-diag-1.pk | 3 +
testsuite/poke.pkl/reduce-array-1.pk | 7 +
testsuite/poke.pkl/reduce-array-2.pk | 7 +
51 files changed, 2020 insertions(+), 306 deletions(-)
create mode 100644 testsuite/poke.pkl/format-1.pk
create mode 100644 testsuite/poke.pkl/format-10.pk
create mode 100644 testsuite/poke.pkl/format-11.pk
create mode 100644 testsuite/poke.pkl/format-12.pk
create mode 100644 testsuite/poke.pkl/format-13.pk
create mode 100644 testsuite/poke.pkl/format-14.pk
create mode 100644 testsuite/poke.pkl/format-15.pk
create mode 100644 testsuite/poke.pkl/format-16.pk
create mode 100644 testsuite/poke.pkl/format-17.pk
create mode 100644 testsuite/poke.pkl/format-18.pk
create mode 100644 testsuite/poke.pkl/format-19.pk
create mode 100644 testsuite/poke.pkl/format-2.pk
create mode 100644 testsuite/poke.pkl/format-20.pk
create mode 100644 testsuite/poke.pkl/format-21.pk
create mode 100644 testsuite/poke.pkl/format-22.pk
create mode 100644 testsuite/poke.pkl/format-23.pk
create mode 100644 testsuite/poke.pkl/format-24.pk
create mode 100644 testsuite/poke.pkl/format-25.pk
create mode 100644 testsuite/poke.pkl/format-26.pk
create mode 100644 testsuite/poke.pkl/format-27.pk
create mode 100644 testsuite/poke.pkl/format-28.pk
create mode 100644 testsuite/poke.pkl/format-29.pk
create mode 100644 testsuite/poke.pkl/format-3.pk
create mode 100644 testsuite/poke.pkl/format-4.pk
create mode 100644 testsuite/poke.pkl/format-5.pk
create mode 100644 testsuite/poke.pkl/format-6.pk
create mode 100644 testsuite/poke.pkl/format-7.pk
create mode 100644 testsuite/poke.pkl/format-8.pk
create mode 100644 testsuite/poke.pkl/format-9.pk
create mode 100644 testsuite/poke.pkl/format-diag-1.pk
create mode 100644 testsuite/poke.pkl/reduce-array-1.pk
create mode 100644 testsuite/poke.pkl/reduce-array-2.pk
diff --git a/ChangeLog b/ChangeLog
index 9ecfdcab..cc27c59e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,148 @@
+2021-06-06 Mohammad-Reza Nabipoor <mnabipoor@gnu.org>
+
+ * common/pk-utils.h (pk_format_binary): New function declaration.
+ * common/pk-utils.c (pk_format_binary): New function definition.
+ * libpoke/pkl-lex.l (format): Recognize `format`.
+ * libpoke/pkl-ast.h (PKL_AST_FORMAT): Define.
+ (PKL_AST_FORMAT_ARG): Likewise.
+ (PKL_AST_TYPE_A_FORMATER): Likewise.
+ (PKL_AST_TYPE_S_FORMATER): Likewise.
+ (PKL_AST_FORMAT_NODE_NAME): Likewise.
+ (PKL_AST_FORMAT_FMT): Likewise.
+ (PKL_AST_FORMAT_TYPES): Likewise.
+ (PKL_AST_FORMAT_ARGS): Likewise.
+ (PKL_AST_FORMAT_NARGS): Likewise.
+ (PKL_AST_FORMAT_PREFIX): Likewise.
+ (PKL_AST_FORMAT_FMT_PROCESSED_P): Likewise.
+ (struct pkl_ast_format): New struct.
+ (pkl_ast_make_format): New function declaration.
+ (PKL_AST_FORMAT_ARG_EXP): Define.
+ (PKL_AST_FORMAT_ARG_BASE): Likewise.
+ (PKL_AST_FORMAT_ARG_SUFFIX): Likewise.
+ (PKL_AST_FORMAT_ARG_BEGIN_SC): Likewise.
+ (PKL_AST_FORMAT_ARG_END_SC): Likewise.
+ (PKL_AST_FORMAT_ARG_VALUE_P): Likewise.
+ (PKL_AST_FORMAT_ARG_FORMAT_MODE): Likewise.
+ (PKL_AST_FORMAT_ARG_FORMAT_DEPTH): Likewise.
+ (PKL_AST_FORMAT_MODE_FLAT): Likewise.
+ (PKL_AST_FORMAT_MODE_TREE): Likewise.
+ (struct pkl_ast_format_arg): New struct.
+ (pkl_ast_make_format_arg): New function declaration.
+ (struct pkl_ast_print_stmt): Delegate all format processing to a
+ PKL_AST_FORMAT node.
+ (pkl_ast_make_print_stmt): Change API.
+ (PKL_AST_PRINT_STMT_FMT): Remove.
+ (PKL_AST_PRINT_STMT_TYPES): Likewise.
+ (PKL_AST_PRINT_STMT_ARGS): Likewise.
+ (PKL_AST_PRINT_STMT_NARGS): Likewise.
+ (PKL_AST_PRINT_STMT_PREFIX): Likewise.
+ (PKL_AST_PRINT_STMT_FMT_PROCESSED_P): Likewise.
+ (PKL_AST_PRINT_STMT_ARG): Likewise.
+ (struct pkl_ast_print_stmt_arg): Likewise.
+ (PKL_AST_PRINT_STMT_ARG_EXP): Likewise.
+ (PKL_AST_PRINT_STMT_ARG_BASE): Likewise.
+ (PKL_AST_PRINT_STMT_ARG_SUFFIX): Likewise.
+ (PKL_AST_PRINT_STMT_ARG_BEGIN_SC): Likewise.
+ (PKL_AST_PRINT_STMT_ARG_END_SC): Likewise.
+ (PKL_AST_PRINT_STMT_ARG_VALUE_P): Likewise.
+ (PKL_AST_PRINT_STMT_ARG_PRINT_MODE): Likewise.
+ (PKL_AST_PRINT_STMT_ARG_PRINT_DEPTH): Likewise.
+ (PKL_AST_PRINT_MODE_FLAT): Likewise.
+ (PKL_AST_PRINT_MODE_TREE): Likewise.
+ (pkl_ast_make_print_stmt_arg): Likewise.
+ * libpoke/pkl-ast.c (pkl_ast_make_array_type): Add formater closure.
+ (pkl_ast_make_struct_type): Add formater closure.
+ (pkl_ast_make_format): New function definition.
+ (pkl_ast_make_format_arg): Likewise.
+ (pkl_ast_node_free): Handle `PKL_AST_FORMAT` and `PKL_AST_FORMAT_ARG`.
+ Remove `PKL_AST_PRINT_STMT_ARG` case. Revise `PKL_AST_PRINT_STMT` case.
+ (pkl_ast_print_1): Likewise.
+ (pkl_ast_make_print_stmt): Revise.
+ (pkl_ast_make_print_stmt_arg): Remove.
+ * libpoke/pkl-tab.y: Define token `FORMAT`.
+ (primary): Add `format` support.
+ (format_arg): New rule.
+ (format_arg_list): Likewise.
+ (print_stmt_arg_list): Remove.
+ * libpoke/pvm.jitter (wrapped-functions): Add `snprintf`.
+ (PVM_FORMATI): Define.
+ (PVM_FORMATL): Likewise.
+ (formati): New instruction.
+ (formatiu): Likewise.
+ (formatl): Likewise.
+ (formatlu): Likewise.
+ (push-drop-to-nop): New rule.
+ * libpoke/pkl-insn.def: Add `format{i,iu,l,lu}` instructions. Add
+ `format` macro instruction.
+ And also add previously defined instructions: `drop2`, `drop3`, `nip3`.
+ * libpoke/pkl-asm.c (pkl_asm_insn_format): New function definition.
+ (pkl_asm_insn): Add support for format macro instruction.
+ * libpoke/pkl-pass.c (pkl_do_pass_1): Handle `PKL_AST_FORMAT_ARG`
+ and `PKL_AST_FORMAT`. Remove `PKL_AST_PRINT_STMT_ARG`. Revise
+ `PKL_AST_PRINT_STMT`.
+ * libpoke/pkl-trans.c (pkl_trans1_ps_format): New phase.
+ (pkl_trans1_ps_print_stmt): Remove.
+ (pkl_phase_trans1): Revise.
+ * libpoke/pkl-typify.c (pkl_typify1_ps_format): New phase.
+ (pkl_typify1_ps_print_stmt): Revise.
+ (pkl_phase_typify1): Register new phase.
+ * libpoke/pkl-promo.c (pkl_promo_ps_format): New phase.
+ (pkl_promo_ps_print_stmt): Remove.
+ (pkl_phase_promo): Revise.
+ * libpoke/pkl-gen.h (PKL_GEN_CTX_IN_FORMATER): Define.
+ * libpoke/pkl-gen.c (pkl_gen_pr_format): Generate code for `format`.
+ (pkl_phase_gen): Register new phase.
+ (pkl_gen_pr_type_offset): Add formater context.
+ (pkl_gen_ps_type_integral): Likewise.
+ (pkl_gen_pr_type_function): Likewise.
+ (pkl_gen_pr_type_array): Likewise.
+ (pkl_gen_ps_type_string): Likewise.
+ (pkl_gen_pr_type_struct): Likewise.
+ * libpoke/pkl-rt.pk (_pkl_strcat3): New function.
+ (_pkl_indentation): Likewise.
+ (_pkl_format_int_suffix): Likewise.
+ (_pkl_reduce_string_array): Likewise.
+ * libpoke/pkl-gen.pks (format_int_suffix): New RAS macro.
+ (integral_formater): Likewise.
+ (offset_formater): Likewise.
+ (string_formater): Likewise.
+ (format_boffset): Likewise.
+ (array_formater): New RAS function.
+ (struct_formater): Likewise.
+ * testsuite/poke.pkl/format-1.pk: New test.
+ * testsuite/poke.pkl/format-2.pk: Likewise.
+ * testsuite/poke.pkl/format-3.pk: Likewise.
+ * testsuite/poke.pkl/format-4.pk: Likewise.
+ * testsuite/poke.pkl/format-5.pk: Likewise.
+ * testsuite/poke.pkl/format-6.pk: Likewise.
+ * testsuite/poke.pkl/format-7.pk: Likewise.
+ * testsuite/poke.pkl/format-8.pk: Likewise.
+ * testsuite/poke.pkl/format-9.pk: Likewise.
+ * testsuite/poke.pkl/format-10.pk: Likewise.
+ * testsuite/poke.pkl/format-11.pk: Likewise.
+ * testsuite/poke.pkl/format-12.pk: Likewise.
+ * testsuite/poke.pkl/format-13.pk: Likewise.
+ * testsuite/poke.pkl/format-14.pk: Likewise.
+ * testsuite/poke.pkl/format-15.pk: Likewise.
+ * testsuite/poke.pkl/format-16.pk: Likewise.
+ * testsuite/poke.pkl/format-17.pk: Likewise.
+ * testsuite/poke.pkl/format-18.pk: Likewise.
+ * testsuite/poke.pkl/format-19.pk: Likewise.
+ * testsuite/poke.pkl/format-20.pk: Likewise.
+ * testsuite/poke.pkl/format-21.pk: Likewise.
+ * testsuite/poke.pkl/format-22.pk: Likewise.
+ * testsuite/poke.pkl/format-23.pk: Likewise.
+ * testsuite/poke.pkl/format-24.pk: Likewise.
+ * testsuite/poke.pkl/format-25.pk: Likewise.
+ * testsuite/poke.pkl/format-26.pk: Likewise.
+ * testsuite/poke.pkl/format-27.pk: Likewise.
+ * testsuite/poke.pkl/format-28.pk: Likewise.
+ * testsuite/poke.pkl/format-29.pk: Likewise.
+ * testsuite/poke.pkl/format-diag-1.pk: Likewise.
+ * testsuite/poke.pkl/reduce-array-1.pk: Likewise.
+ * testsuite/poke.pkl/reduce-array-2.pk: Likewise.
+ * testsuite/Makefile.am (EXTRA_DIST): Add new tests.
+
2021-06-06 Mohammad-Reza Nabipoor <mnabipoor@gnu.org>
* libpoke/pkl-gen.c (pkl_gen_pr_type_function): Add comment.
diff --git a/common/pk-utils.c b/common/pk-utils.c
index 620c99fb..2db67094 100644
--- a/common/pk-utils.c
+++ b/common/pk-utils.c
@@ -107,6 +107,34 @@ pk_print_binary (void (*puts_fn) (const char *str),
puts_fn (sign ? "N" : "UN");
}
+int
+pk_format_binary (char* out, size_t outlen,
+ uint64_t val, int size, int sign)
+{
+ char b[64 /* digits */ + 2 /* suffix */ + 1 /* nul */];
+
+ for (int z = 0; z < size; z++) {
+ b[size-1-z] = ((val >> z) & 0x1) + '0';
+ }
+ b[size] = '\0';
+
+ if (size == 64)
+ strcat (b, sign ? "L" : "UL");
+ else if (size == 16)
+ strcat (b, sign ? "H" : "UH");
+ else if (size == 8)
+ strcat (b, sign ? "B" : "UB");
+ else if (size == 4)
+ strcat (b, sign ? "N" : "UN");
+
+ if (strlen (b) < outlen)
+ {
+ strcpy (out, b);
+ return 0; /* success */
+ }
+ return 1; /* fail */
+}
+
/* Concatenate 2+ strings.
* Last argument must be NULL.
* Returns the malloc'ed concatenated string or NULL when out of memory.
diff --git a/common/pk-utils.h b/common/pk-utils.h
index 0d97e367..7e3810d0 100644
--- a/common/pk-utils.h
+++ b/common/pk-utils.h
@@ -50,6 +50,10 @@ uint64_t pk_upow (uint64_t base, uint32_t exp);
/* Print the given unsigned 64-bit integer in binary. */
void pk_print_binary (void (*puts_fn) (const char *str), uint64_t val, int
size, int sign);
+/* Format the given unsigned 64-bit integer in binary. */
+int pk_format_binary (char* out, size_t outlen, uint64_t val, int size,
+ int sign);
+
/* Concatenate string arguments into an malloc'ed string. */
char *pk_str_concat (const char *s0, ...) __attribute__ ((sentinel));
diff --git a/libpoke/pkl-asm.c b/libpoke/pkl-asm.c
index 9560e753..02ca6b96 100644
--- a/libpoke/pkl-asm.c
+++ b/libpoke/pkl-asm.c
@@ -453,6 +453,34 @@ pkl_asm_insn_rev (pkl_asm pasm, unsigned int depth)
pkl_asm_insn (pasm, PKL_INSN_REVN, depth);
}
+/* Macro-instruction: FORMAT type
+ ( OBASE VAL -- )
+*/
+
+static void
+pkl_asm_insn_format (pkl_asm pasm, pkl_ast_node type)
+{
+ int type_code = PKL_AST_TYPE_CODE (type);
+
+ if (type_code == PKL_TYPE_STRING)
+ pkl_asm_insn (pasm, PKL_INSN_DROP); /* The base. */
+ else if (type_code == PKL_TYPE_INTEGRAL)
+ {
+ static const int format_table[2][2] =
+ {
+ {PKL_INSN_FORMATIU, PKL_INSN_FORMATI},
+ {PKL_INSN_FORMATLU, PKL_INSN_FORMATL}
+ };
+ size_t size = PKL_AST_TYPE_I_SIZE (type);
+ int signed_p = PKL_AST_TYPE_I_SIGNED_P (type);
+
+ pkl_asm_insn (pasm, format_table[size > 32][signed_p],
+ (unsigned int) size);
+ }
+ else
+ assert (0);
+}
+
/* Macro-instruction: PRINT type
( OBASE VAL -- )
*/
@@ -1386,6 +1414,17 @@ pkl_asm_insn (pkl_asm pasm, enum pkl_asm_insn insn, ...)
pkl_asm_insn_poke (pasm, type, nenc, endian);
break;
}
+ case PKL_INSN_FORMAT:
+ {
+ pkl_ast_node type;
+
+ va_start (valist, insn);
+ type = va_arg (valist, pkl_ast_node);
+ va_end (valist);
+
+ pkl_asm_insn_format (pasm, type);
+ break;
+ }
case PKL_INSN_PRINT:
{
pkl_ast_node type;
diff --git a/libpoke/pkl-ast.c b/libpoke/pkl-ast.c
index 5c08b65b..26855913 100644
--- a/libpoke/pkl-ast.c
+++ b/libpoke/pkl-ast.c
@@ -370,7 +370,8 @@ pkl_ast_node
pkl_ast_make_array_type (pkl_ast ast, pkl_ast_node etype, pkl_ast_node bound)
{
pkl_ast_node type = pkl_ast_make_type (ast);
- const int nclosures = 5; /* mapper, writer, bounder, constructor, printer */
+ const int nclosures
+ = 6; /* mapper, writer, bounder, constructor, printer, formater. */
assert (etype);
@@ -386,6 +387,7 @@ pkl_ast_make_array_type (pkl_ast ast, pkl_ast_node etype,
pkl_ast_node bound)
PKL_AST_TYPE_A_WRITER (type) = PVM_NULL;
PKL_AST_TYPE_A_BOUNDER (type) = PVM_NULL;
PKL_AST_TYPE_A_CONSTRUCTOR (type) = PVM_NULL;
+ PKL_AST_TYPE_A_FORMATER (type) = PVM_NULL;
PKL_AST_TYPE_A_PRINTER (type) = PVM_NULL;
return type;
@@ -441,8 +443,8 @@ pkl_ast_make_struct_type (pkl_ast ast,
int pinned_p, int union_p)
{
pkl_ast_node type = pkl_ast_make_type (ast);
- const int nclosures
- = 6; /* writer, mapper, constructor, comparator, integrator, printer. */
+ const int nclosures = 7; /* writer, mapper, constructor, comparator,
+ integrator, printer, formater. */
PKL_AST_TYPE_CODE (type) = PKL_TYPE_STRUCT;
PKL_AST_TYPE_S_NELEM (type) = nelem;
@@ -463,6 +465,7 @@ pkl_ast_make_struct_type (pkl_ast ast,
PKL_AST_TYPE_S_CONSTRUCTOR (type) = PVM_NULL;
PKL_AST_TYPE_S_COMPARATOR (type) = PVM_NULL;
PKL_AST_TYPE_S_INTEGRATOR (type) = PVM_NULL;
+ PKL_AST_TYPE_S_FORMATER (type) = PVM_NULL;
PKL_AST_TYPE_S_PRINTER (type) = PVM_NULL;
return type;
@@ -1569,6 +1572,34 @@ pkl_ast_make_funcall_arg (pkl_ast ast, pkl_ast_node exp,
return funcall_arg;
}
+/* Build and return an AST node for `format'. */
+
+pkl_ast_node
+pkl_ast_make_format (pkl_ast ast,
+ pkl_ast_node fmt, pkl_ast_node args, int printf_p)
+{
+ pkl_ast_node format = pkl_ast_make_node (ast, PKL_AST_FORMAT);
+
+ PKL_AST_FORMAT_NODE_NAME (format) = printf_p ? "printf" : "format";
+ PKL_AST_FORMAT_FMT (format) = ASTREF (fmt);
+ if (args)
+ PKL_AST_FORMAT_ARGS (format) = ASTREF (args);
+
+ return format;
+}
+
+/* Build and return an AST node for a `format' argument. */
+
+pkl_ast_node
+pkl_ast_make_format_arg (pkl_ast ast, pkl_ast_node exp)
+{
+ pkl_ast_node format_arg = pkl_ast_make_node (ast, PKL_AST_FORMAT_ARG);
+
+ if (exp)
+ PKL_AST_FORMAT_ARG_EXP (format_arg) = ASTREF (exp);
+ return format_arg;
+}
+
/* Build and return an AST node for a variable reference. */
pkl_ast_node
@@ -1815,30 +1846,18 @@ pkl_ast_make_try_catch_stmt (pkl_ast ast, pkl_ast_node
code,
pkl_ast_node
pkl_ast_make_print_stmt (pkl_ast ast,
- pkl_ast_node fmt, pkl_ast_node args)
+ int printf_p, pkl_ast_node fmt)
{
- pkl_ast_node print_stmt = pkl_ast_make_node (ast,
- PKL_AST_PRINT_STMT);
-
- if (fmt)
- PKL_AST_PRINT_STMT_FMT (print_stmt) = ASTREF (fmt);
- if (args)
- PKL_AST_PRINT_STMT_ARGS (print_stmt) = ASTREF (args);
+ pkl_ast_node print_stmt = pkl_ast_make_node (ast, PKL_AST_PRINT_STMT);
- return print_stmt;
-}
+ assert (fmt != NULL);
-/* Build and return an AST node for a `printf' argument. */
+ if (printf_p) /* printf statement */
+ PKL_AST_PRINT_STMT_FORMAT (print_stmt) = ASTREF (fmt);
+ else /* print statement */
+ PKL_AST_PRINT_STMT_STR_EXP (print_stmt) = ASTREF (fmt);
-pkl_ast_node
-pkl_ast_make_print_stmt_arg (pkl_ast ast, pkl_ast_node exp)
-{
- pkl_ast_node print_stmt_arg = pkl_ast_make_node (ast,
- PKL_AST_PRINT_STMT_ARG);
-
- if (exp)
- PKL_AST_PRINT_STMT_ARG_EXP (print_stmt_arg) = ASTREF (exp);
- return print_stmt_arg;
+ return print_stmt;
}
/* Build and return an AST node for a `break' statement. */
@@ -2250,27 +2269,34 @@ pkl_ast_node_free (pkl_ast_node ast)
pkl_ast_node_free (PKL_AST_TRY_UNTIL_STMT_EXP (ast));
break;
- case PKL_AST_PRINT_STMT_ARG:
- free (PKL_AST_PRINT_STMT_ARG_SUFFIX (ast));
- free (PKL_AST_PRINT_STMT_ARG_BEGIN_SC (ast));
- free (PKL_AST_PRINT_STMT_ARG_END_SC (ast));
- pkl_ast_node_free (PKL_AST_PRINT_STMT_ARG_EXP (ast));
+ case PKL_AST_FORMAT_ARG:
+ free (PKL_AST_FORMAT_ARG_SUFFIX (ast));
+ free (PKL_AST_FORMAT_ARG_BEGIN_SC (ast));
+ free (PKL_AST_FORMAT_ARG_END_SC (ast));
+ pkl_ast_node_free (PKL_AST_FORMAT_ARG_EXP (ast));
break;
- case PKL_AST_PRINT_STMT:
+ case PKL_AST_FORMAT:
{
- free (PKL_AST_PRINT_STMT_PREFIX (ast));
- for (t = PKL_AST_PRINT_STMT_ARGS (ast); t; t = n)
+ free (PKL_AST_FORMAT_PREFIX (ast));
+ for (t = PKL_AST_FORMAT_ARGS (ast); t; t = n)
{
n = PKL_AST_CHAIN (t);
pkl_ast_node_free (t);
}
- for (t = PKL_AST_PRINT_STMT_TYPES (ast); t; t = n)
+ for (t = PKL_AST_FORMAT_TYPES (ast); t; t = n)
{
n = PKL_AST_CHAIN (t);
pkl_ast_node_free (t);
}
- pkl_ast_node_free (PKL_AST_PRINT_STMT_FMT (ast));
+ pkl_ast_node_free (PKL_AST_FORMAT_FMT (ast));
+ break;
+ }
+
+ case PKL_AST_PRINT_STMT:
+ {
+ pkl_ast_node_free (PKL_AST_PRINT_STMT_STR_EXP (ast));
+ pkl_ast_node_free (PKL_AST_PRINT_STMT_FORMAT (ast));
break;
}
@@ -3024,6 +3050,28 @@ pkl_ast_print_1 (FILE *fp, pkl_ast_node ast, int indent)
PRINT_AST_SUBAST (function, LAMBDA_FUNCTION);
break;
+ case PKL_AST_FORMAT_ARG:
+ IPRINTF ("FORMAT_ARG::\n");
+ PRINT_COMMON_FIELDS;
+ if (PKL_AST_FORMAT_ARG_BEGIN_SC (ast))
+ PRINT_AST_IMM (begin_sc, FORMAT_ARG_BEGIN_SC, "'%s'");
+ if (PKL_AST_FORMAT_ARG_END_SC (ast))
+ PRINT_AST_IMM (end_sc, FORMAT_ARG_END_SC, "'%s'");
+ if (PKL_AST_FORMAT_ARG_SUFFIX (ast))
+ PRINT_AST_IMM (suffix, FORMAT_ARG_SUFFIX, "'%s'");
+ PRINT_AST_SUBAST (exp, FORMAT_ARG_EXP);
+ break;
+
+ case PKL_AST_FORMAT:
+ IPRINTF ("FORMAT::\n");
+ PRINT_COMMON_FIELDS;
+ if (PKL_AST_FORMAT_PREFIX (ast))
+ PRINT_AST_IMM (prefix, FORMAT_PREFIX, "'%s'");
+ PRINT_AST_SUBAST (fmt, FORMAT_FMT);
+ PRINT_AST_SUBAST_CHAIN (FORMAT_TYPES);
+ PRINT_AST_SUBAST_CHAIN (FORMAT_ARGS);
+ break;
+
case PKL_AST_INCRDECR:
IPRINTF ("INCRDECR::\n");
@@ -3112,26 +3160,13 @@ pkl_ast_print_1 (FILE *fp, pkl_ast_node ast, int indent)
PRINT_AST_SUBAST (try_until_stmt_exp, TRY_UNTIL_STMT_EXP);
break;
- case PKL_AST_PRINT_STMT_ARG:
- IPRINTF ("PRINT_STMT_ARG::\n");
- PRINT_COMMON_FIELDS;
- if (PKL_AST_PRINT_STMT_ARG_BEGIN_SC (ast))
- PRINT_AST_IMM (begin_sc, PRINT_STMT_ARG_BEGIN_SC, "'%s'");
- if (PKL_AST_PRINT_STMT_ARG_END_SC (ast))
- PRINT_AST_IMM (end_sc, PRINT_STMT_ARG_END_SC, "'%s'");
- if (PKL_AST_PRINT_STMT_ARG_SUFFIX (ast))
- PRINT_AST_IMM (suffix, PRINT_STMT_ARG_SUFFIX, "'%s'");
- PRINT_AST_SUBAST (exp, PRINT_STMT_ARG_EXP);
- break;
-
case PKL_AST_PRINT_STMT:
IPRINTF ("PRINT_STMT::\n");
PRINT_COMMON_FIELDS;
- if (PKL_AST_PRINT_STMT_PREFIX (ast))
- PRINT_AST_IMM (prefix, PRINT_STMT_PREFIX, "'%s'");
- PRINT_AST_SUBAST (fmt, PRINT_STMT_FMT);
- PRINT_AST_SUBAST_CHAIN (PRINT_STMT_TYPES);
- PRINT_AST_SUBAST_CHAIN (PRINT_STMT_ARGS);
+ if (PKL_AST_PRINT_STMT_STR_EXP (ast))
+ PRINT_AST_SUBAST (pexp, PRINT_STMT_STR_EXP);
+ if (PKL_AST_PRINT_STMT_FORMAT (ast))
+ PRINT_AST_SUBAST (format, PRINT_STMT_FORMAT);
break;
case PKL_AST_BREAK_STMT:
diff --git a/libpoke/pkl-ast.h b/libpoke/pkl-ast.h
index 550b9f48..8a476915 100644
--- a/libpoke/pkl-ast.h
+++ b/libpoke/pkl-ast.h
@@ -57,6 +57,8 @@ enum pkl_ast_code
PKL_AST_FUNCALL_ARG,
PKL_AST_VAR,
PKL_AST_LAMBDA,
+ PKL_AST_FORMAT,
+ PKL_AST_FORMAT_ARG,
PKL_AST_INCRDECR,
PKL_AST_GCD,
PKL_AST_LAST_EXP = PKL_AST_GCD,
@@ -88,7 +90,6 @@ enum pkl_ast_code
PKL_AST_CONTINUE_STMT,
PKL_AST_RAISE_STMT,
PKL_AST_LAST_STMT = PKL_AST_RAISE_STMT,
- PKL_AST_PRINT_STMT_ARG,
PKL_AST_LAST
};
@@ -850,8 +851,8 @@ pkl_ast_node pkl_ast_make_func_type_arg (pkl_ast ast,
number of elements, then BOUND is an expression that must evaluate
to an integer. If the array type is bounded by size, then BOUND is
an expression that must evaluate to an offset. If the array type
- is unbounded, then BOUND is NULL. MAPPER, WRITER, PRINTER,
- CONSTRUCTOR and BOUNDCLS are used to hold closures, or
+ is unbounded, then BOUND is NULL. MAPPER, WRITER, FORMATER,
+ PRINTER, CONSTRUCTOR and BOUNDCLS are used to hold closures, or
PVM_NULL. The field LEX_CORRECTED is used by the transl phase, to
keep record of array types that have been lexically corrected; this
is to avoid processing the same type more than once.
@@ -861,9 +862,9 @@ pkl_ast_node pkl_ast_make_func_type_arg (pkl_ast ast,
declarations. ELEMS is a chain of elements, which can be
PKL_AST_STRUCT_TYPE_FIELD or PKL_AST_DECL nodes, potentially mixed.
PINNED_P is 1 if the struct is pinned, 0 otherwise. MAPPER, WRITER
- CONSTRUCTOR, PRINTER, COMPARATOR and INTEGRATOR are used to hold
- closures, or PVM_NULL. INT_TYPE, if not NULL, is an AST node with
- an integral type, that defines the nature of this struct type as
+ CONSTRUCTOR, FORMATER, PRINTER, COMPARATOR and INTEGRATOR are used to
+ hold closures, or PVM_NULL. INT_TYPE, if not NULL, is an AST node
+ with an integral type, that defines the nature of this struct type as
integral.
In offset types, BASE_TYPE is a PKL_AST_TYPE with the base type for
@@ -898,6 +899,7 @@ pkl_ast_node pkl_ast_make_func_type_arg (pkl_ast ast,
#define PKL_AST_TYPE_A_BOUNDER(AST) ((AST)->type.val.array.closures[2])
#define PKL_AST_TYPE_A_CONSTRUCTOR(AST) ((AST)->type.val.array.closures[3])
#define PKL_AST_TYPE_A_PRINTER(AST) ((AST)->type.val.array.closures[4])
+#define PKL_AST_TYPE_A_FORMATER(AST) ((AST)->type.val.array.closures[5])
#define PKL_AST_TYPE_S_NFIELD(AST) ((AST)->type.val.sct.nfield)
#define PKL_AST_TYPE_S_NDECL(AST) ((AST)->type.val.sct.ndecl)
#define PKL_AST_TYPE_S_NELEM(AST) ((AST)->type.val.sct.nelem)
@@ -911,6 +913,7 @@ pkl_ast_node pkl_ast_make_func_type_arg (pkl_ast ast,
#define PKL_AST_TYPE_S_PRINTER(AST) ((AST)->type.val.sct.closures[3])
#define PKL_AST_TYPE_S_COMPARATOR(AST) ((AST)->type.val.sct.closures[4])
#define PKL_AST_TYPE_S_INTEGRATOR(AST) ((AST)->type.val.sct.closures[5])
+#define PKL_AST_TYPE_S_FORMATER(AST) ((AST)->type.val.sct.closures[6])
#define PKL_AST_TYPE_S_ITYPE(AST) ((AST)->type.val.sct.itype)
#define PKL_AST_TYPE_O_UNIT(AST) ((AST)->type.val.off.unit)
#define PKL_AST_TYPE_O_BASE_TYPE(AST) ((AST)->type.val.off.base_type)
@@ -945,8 +948,8 @@ struct pkl_ast_type
{
union pkl_ast_node *bound;
union pkl_ast_node *etype;
- /* Uncollectable array for MAPPER, BOUNDER, WRITER, CONSTRUCTOR
- and PRINTER. */
+ /* Uncollectable array for MAPPER, BOUNDER, WRITER, CONSTRUCTOR,
+ PRINTER and FORMATER. */
pvm_val *closures;
} array;
@@ -960,7 +963,7 @@ struct pkl_ast_type
int pinned_p;
int union_p;
/* Uncollectable array for MAPPER, WRITER, CONSTRUCTOR, COMPARATOR,
- INTEGRATOR and PRINTER. */
+ INTEGRATOR, PRINTER and FORMATER. */
pvm_val *closures;
} sct;
@@ -1287,6 +1290,102 @@ struct pkl_ast_funcall_arg
pkl_ast_node pkl_ast_make_funcall_arg (pkl_ast ast, pkl_ast_node exp,
pkl_ast_node name);
+/* PKL_AST_FORMAT nodes represent `format'.
+
+ ARGS is a chained list of PKL_AST_FORMAT_ARG nodes. This may
+ contain zero or more nodes, and the types of their expressions
+ should match the format expressed in FMT.
+
+ FMT is the format string node.
+
+ TYPES is a linked list of type nodes, corresponding to the %-
+ directives in FMT. Note that %<class> and %</class> directives
+ have type PKL_TYPE_VOID.
+
+ NARGS is the number of arguments in ARGS.
+
+ PREFIX, if not NULL, is a C string that comes before the arguments.
+
+ FMT_PROCESSED_P is a boolean indicating whether the format string
+ has been already processed in this node. */
+
+#define PKL_AST_FORMAT_NODE_NAME(AST) ((AST)->format.node_name)
+#define PKL_AST_FORMAT_FMT(AST) ((AST)->format.fmt)
+#define PKL_AST_FORMAT_TYPES(AST) ((AST)->format.types)
+#define PKL_AST_FORMAT_ARGS(AST) ((AST)->format.args)
+#define PKL_AST_FORMAT_NARGS(AST) ((AST)->format.nargs)
+#define PKL_AST_FORMAT_PREFIX(AST) ((AST)->format.prefix)
+#define PKL_AST_FORMAT_FMT_PROCESSED_P(AST) ((AST)->format.fmt_processed_p)
+
+struct pkl_ast_format
+{
+ struct pkl_ast_common common;
+
+ const char* node_name; /* "format" or "printf" */
+ int nargs;
+ char *prefix;
+ int fmt_processed_p;
+ union pkl_ast_node *fmt;
+ union pkl_ast_node *types;
+ union pkl_ast_node *args;
+};
+
+pkl_ast_node pkl_ast_make_format (pkl_ast ast, pkl_ast_node fmt,
+ pkl_ast_node args, int printf_p);
+
+/* PKL_AST_FORMAT_ARG nodes represent expression arguments to `format'.
+
+ EXP is an expression node evaluating to the value to format.
+
+ BASE is the numeration base to use when formating this argument.
+
+ BEGIN_SC, if not NULL, marks that this argument is a %<class>
+ directive, and is a NULL-terminated string with the name of the
+ styling class to begin.
+
+ END_SC, if not NULL, marks that this argument is a %</class>
+ directive, and is a NULL-terminated string with the name of the
+ styling class to end.
+
+ SUFFIX, if not NULL, is a C string that should be appended after the
+ value of EXP, respectively.
+
+ VALUE_P indicates whether the argument shall be printed as a PVM
+ value or not (whether this arguement corresponds to a %v or not).
+
+ FORMAT_MODE and FORMAT_DEPTH specify how the argument shall be
+ printed if VALUE_P is true. FORMAT_MODE can be one of the
+ PKL_AST_FORMAT_MODE_* constants defined below, while FORMAT_DEPTH can
+ be zero or a positive integer. */
+
+#define PKL_AST_FORMAT_ARG_EXP(AST) ((AST)->format_arg.exp)
+#define PKL_AST_FORMAT_ARG_BASE(AST) ((AST)->format_arg.base)
+#define PKL_AST_FORMAT_ARG_SUFFIX(AST) ((AST)->format_arg.suffix)
+#define PKL_AST_FORMAT_ARG_BEGIN_SC(AST) ((AST)->format_arg.begin_sc)
+#define PKL_AST_FORMAT_ARG_END_SC(AST) ((AST)->format_arg.end_sc)
+#define PKL_AST_FORMAT_ARG_VALUE_P(AST) ((AST)->format_arg.value_p)
+#define PKL_AST_FORMAT_ARG_FORMAT_MODE(AST) ((AST)->format_arg.format_mode)
+#define PKL_AST_FORMAT_ARG_FORMAT_DEPTH(AST) ((AST)->format_arg.format_depth)
+
+#define PKL_AST_FORMAT_MODE_FLAT 0
+#define PKL_AST_FORMAT_MODE_TREE 1
+
+struct pkl_ast_format_arg
+{
+ struct pkl_ast_common common;
+
+ char *begin_sc;
+ char *end_sc;
+ int base;
+ int value_p;
+ int format_mode;
+ int format_depth;
+ char *suffix;
+ union pkl_ast_node *exp;
+};
+
+pkl_ast_node pkl_ast_make_format_arg (pkl_ast ast, pkl_ast_node exp);
+
/* PKL_AST_VAR nodes represent variable references.
NAME is a PKL_AST_IDENTIFIER containing the name used to refer to
@@ -1704,103 +1803,28 @@ pkl_ast_node pkl_ast_make_try_catch_stmt (pkl_ast ast,
pkl_ast_node code, pkl_ast_node
handler,
pkl_ast_node arg, pkl_ast_node exp);
-/* PKL_AST_PRINT_STMT nodes represent `print' statements.
-
- ARGS is a chained list of PKL_AST_PRINT_STMT_ARG nodes. In `print'
- statements, this only contains one argument, whose expression
- should be of type string. In `printf' statements, this may contain
- zero or more nodes, and the types of their expressions should match
- teh format expressed in FMT.
-
- FMT, if not NULL, is a format string node.
-
- TYPES is a linked list of type nodes, corresponding to the %-
- directives in FMT. Note that %<class> and %</class> directives
- have type PKL_TYPE_VOID.
-
- NARGS is the number of arguments in ARGS.
+/* PKL_AST_PRINT_STMT nodes represent `print' and `printf' statements.
- PREFIX, if not NULL, is a C string that should be printed before
- the arguments.
+ STR_EXP, if not NULL, is an expression node of type string. In
+ `print' statements this is not NULL, but in `printf' statements
+ this should be NULL.
- FMT_PROCESSED_P is a boolean indicating whether the format string
- has been already processed in this node. */
+ FORMAT, if not NULL, is a PKL_AST_FORMAT node capturing all the
+ information corresponding to the `printf' statements. */
-#define PKL_AST_PRINT_STMT_FMT(AST) ((AST)->print_stmt.fmt)
-#define PKL_AST_PRINT_STMT_TYPES(AST) ((AST)->print_stmt.types)
-#define PKL_AST_PRINT_STMT_ARGS(AST) ((AST)->print_stmt.args)
-#define PKL_AST_PRINT_STMT_NARGS(AST) ((AST)->print_stmt.nargs)
-#define PKL_AST_PRINT_STMT_PREFIX(AST) ((AST)->print_stmt.prefix)
-#define PKL_AST_PRINT_STMT_FMT_PROCESSED_P(AST)
((AST)->print_stmt.fmt_processed_p)
+#define PKL_AST_PRINT_STMT_STR_EXP(AST) ((AST)->print_stmt.str_exp)
+#define PKL_AST_PRINT_STMT_FORMAT(AST) ((AST)->print_stmt.format)
struct pkl_ast_print_stmt
{
struct pkl_ast_common common;
- int nargs;
- char *prefix;
- int fmt_processed_p;
- union pkl_ast_node *fmt;
- union pkl_ast_node *types;
- union pkl_ast_node *args;
+ union pkl_ast_node *str_exp;
+ union pkl_ast_node *format;
};
pkl_ast_node pkl_ast_make_print_stmt (pkl_ast ast,
- pkl_ast_node fmt, pkl_ast_node args);
-
-/* PKL_AST_PRINT_STMT_ARG nodes represent expression arguments to
- `printf' statements.
-
- EXP is an expression node evaluating to the value to print.
-
- BASE is the numeration base to use when printing this argument.
-
- BEGIN_SC, if not NULL, marks that this argument is a %<class>
- directive, and is a NULL-terminated string with the name of the
- styling class to begin.
-
- END_SC, if not NULL, marks that this argument is a %</class>
- directive, and is a NULL-terminated string with the name of the
- styling class to end.
-
- SUFFIX, if not NULL, is a C string that should be printed after the
- value of EXP, respectively.
-
- VALUE_P indicates whether the argument shall be printed as a PVM
- value or not.
-
- PRINT_MODE and PRINT_DEPTH specify how the argument shall be
- printed if VALUE_P is true. PRINT_MODE can be one of the
- PKL_AST_PRINT_MODE_* constants defined below, while PRINT_DEPTH can
- be zero or a positive integer. */
-
-#define PKL_AST_PRINT_STMT_ARG_EXP(AST) ((AST)->print_stmt_arg.exp)
-#define PKL_AST_PRINT_STMT_ARG_BASE(AST) ((AST)->print_stmt_arg.base)
-#define PKL_AST_PRINT_STMT_ARG_SUFFIX(AST) ((AST)->print_stmt_arg.suffix)
-#define PKL_AST_PRINT_STMT_ARG_BEGIN_SC(AST) ((AST)->print_stmt_arg.begin_sc)
-#define PKL_AST_PRINT_STMT_ARG_END_SC(AST) ((AST)->print_stmt_arg.end_sc)
-#define PKL_AST_PRINT_STMT_ARG_VALUE_P(AST) ((AST)->print_stmt_arg.value_p)
-#define PKL_AST_PRINT_STMT_ARG_PRINT_MODE(AST)
((AST)->print_stmt_arg.print_mode)
-#define PKL_AST_PRINT_STMT_ARG_PRINT_DEPTH(AST)
((AST)->print_stmt_arg.print_depth)
-
-#define PKL_AST_PRINT_MODE_FLAT 0
-#define PKL_AST_PRINT_MODE_TREE 1
-
-struct pkl_ast_print_stmt_arg
-{
- struct pkl_ast_common common;
-
- char *begin_sc;
- char *end_sc;
- int base;
- int value_p;
- int print_mode;
- int print_depth;
- char *suffix;
- union pkl_ast_node *exp;
-};
-
-pkl_ast_node pkl_ast_make_print_stmt_arg (pkl_ast ast, pkl_ast_node exp);
+ int printf_p, pkl_ast_node fmt);
/* PKL_AST_CONTINUE_STMT nodes represent `continue' statements. Each
continue statement is associated to a loop node.
@@ -1891,6 +1915,8 @@ union pkl_ast_node
struct pkl_ast_funcall_arg funcall_arg;
struct pkl_ast_var var;
struct pkl_ast_lambda lambda;
+ struct pkl_ast_format format;
+ struct pkl_ast_format_arg format_arg;
struct pkl_ast_incrdecr incrdecr;
/* Types. */
struct pkl_ast_type type;
@@ -1917,7 +1943,6 @@ union pkl_ast_node
struct pkl_ast_continue_stmt continue_stmt;
struct pkl_ast_raise_stmt raise_stmt;
struct pkl_ast_print_stmt print_stmt;
- struct pkl_ast_print_stmt_arg print_stmt_arg;
};
static inline pkl_ast_node __attribute__ ((always_inline, warn_unused_result))
diff --git a/libpoke/pkl-gen.c b/libpoke/pkl-gen.c
index a57d4b58..8e03ffe3 100644
--- a/libpoke/pkl-gen.c
+++ b/libpoke/pkl-gen.c
@@ -27,6 +27,7 @@
#include "pkl-pass.h"
#include "pkl-asm.h"
#include "pvm.h"
+#include "pk-utils.h"
/* The following macros are used in the rules below, to reduce
verbosity. */
@@ -1408,6 +1409,192 @@ PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_exp_stmt)
}
PKL_PHASE_END_HANDLER
+/*
+ * FORMAT
+ * | ARG
+ * | ...
+ */
+
+PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_format)
+{
+ pkl_ast_node format = PKL_PASS_NODE;
+ pkl_ast_node format_args = PKL_AST_FORMAT_ARGS (format);
+ pkl_ast_node arg;
+ char *prefix = PKL_AST_FORMAT_PREFIX (format);
+ int nstr = 0;
+ /* XXX this hard limit should go away.
+ See pkl-tran.c:pkl_trans1_ps_format. */
+#define MAX_CLASS_TAGS 32
+ int nclasses = 0;
+ struct
+ {
+ char *name;
+ int index;
+ } classes[MAX_CLASS_TAGS];
+
+ /* 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_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 */
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MKA);
+
+ if (prefix)
+ {
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, pvm_make_ulong (0, 64));
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, pvm_make_string (prefix));
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_AINS);
+ ++nstr;
+ }
+
+ for (arg = format_args; arg; arg = PKL_AST_CHAIN (arg))
+ {
+ pkl_ast_node exp = PKL_AST_FORMAT_ARG_EXP (arg);
+ char *begin_sc = PKL_AST_FORMAT_ARG_BEGIN_SC (arg);
+ char *end_sc = PKL_AST_FORMAT_ARG_END_SC (arg);
+ char *suffix = PKL_AST_FORMAT_ARG_SUFFIX (arg);
+ int base = PKL_AST_FORMAT_ARG_BASE (arg);
+ pkl_ast_node exp_type;
+ int arg_omode;
+ int arg_odepth;
+
+ if (begin_sc)
+ {
+ assert (nclasses < MAX_CLASS_TAGS);
+ classes[nclasses].name = begin_sc;
+ classes[nclasses].index = nstr;
+ ++nclasses;
+ }
+
+ if (end_sc)
+ {
+ char* cname;
+ int cindex, n;
+ pvm_val idx;
+
+ assert (nclasses > 0);
+ --nclasses;
+ cname = classes[nclasses].name;
+ cindex = classes[nclasses].index;
+
+ assert (STREQ (cname, end_sc) == 0);
+
+ n = nstr - cindex;
+ if (n > 0)
+ {
+ nstr = cindex + 1;
+ idx = pvm_make_ulong (cindex, 64);
+
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DUP); /* ARR ARR */
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, idx); /* ARR ARR IDX */
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
+ pvm_make_ulong (n, 64)); /* ARR ARR IDX
LEN */
+ pkl_asm_call (PKL_GEN_ASM, "_pkl_reduce_string_array"); /* ARR
STR */
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SWAP); /* STR ARR */
+
+ for (; n > 1; --n)
+ {
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, idx);
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_AREM);
+ }
+
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, idx); /* STR ARR IDX */
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_ROT); /* ARR IDX STR */
+
+ /* Set the string style property. */
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SEL);
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
+ pvm_make_ulong (0, 64));
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SWAP); /* STR 0UL LEN */
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
+ pvm_make_string (cname)); /* STR 0UL LEN CLASS */
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SPROPS); /* ARR STR */
+
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_ASET); /* ARR */
+ }
+ }
+
+ if (!exp)
+ goto fmt_suffix;
+
+ /* Generate code to put the value on the stack. */
+ PKL_PASS_SUBPASS (exp);
+
+ /* Everything except %v. */
+ if (!PKL_AST_FORMAT_ARG_VALUE_P (arg))
+ {
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
+ base ? pvm_make_int (base, 32) : PVM_NULL);
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_FORMAT, PKL_AST_TYPE (exp));
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, pvm_make_ulong (nstr++,
64));
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SWAP);
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_AINS);
+ goto fmt_suffix;
+ }
+
+ /* Generate code to format the literal value (%v). */
+ exp_type = PKL_AST_TYPE (exp);
+ arg_omode = PKL_AST_FORMAT_ARG_FORMAT_MODE (arg);
+ arg_odepth = PKL_AST_FORMAT_ARG_FORMAT_DEPTH (arg);
+
+ /* Set the argument's own omode and odepth, saving
+ the VM's own. */
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSHOM); /* OMODE */
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
+ pvm_make_int (arg_omode, 32)); /* OMODE NOMODE */
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_POPOM); /* OMODE */
+
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSHOD); /* OMODE ODEPTH */
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
+ pvm_make_int (arg_odepth, 32)); /* OMODE ODEPTH NODEPTH */
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_POPOD); /* OMODE ODEPTH */
+
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_ROT); /* OMODE ODEPTH EXP */
+
+ /* Format the value. */
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
+ pvm_make_int (0, 32)); /* OMODE ODEPTH EXP DEPTH */
+ PKL_GEN_PUSH_CONTEXT;
+ PKL_GEN_SET_CONTEXT (PKL_GEN_CTX_IN_FORMATER);
+ PKL_PASS_SUBPASS (exp_type); /* OMODE ODEPTH STR */
+ PKL_GEN_POP_CONTEXT;
+
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NROT); /* STR OMODE ODEPTH */
+
+ /* Restore the current omode and odepth in the VM. */
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_POPOD); /* ARR STR OMODE */
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_POPOM); /* ARR STR */
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
+ pvm_make_ulong (nstr++, 64)); /* ARR STR IDX */
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SWAP); /* ARR IDX STR */
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_AINS); /* ARR */
+
+ fmt_suffix:
+ if (suffix)
+ {
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, pvm_make_ulong (nstr++,
64));
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, pvm_make_string (suffix));
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_AINS);
+ }
+ }
+
+ if (nstr)
+ {
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DUP);
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, pvm_make_ulong (0, 64));
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, pvm_make_ulong (nstr, 64));
+ pkl_asm_call (PKL_GEN_ASM, "_pkl_reduce_string_array");
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP);
+ }
+
+ PKL_PASS_BREAK;
+
+#undef MAX_CLASS_TAGS
+}
+PKL_PHASE_END_HANDLER
+
/*
* PRINT_STMT
* | ARG
@@ -1417,13 +1604,19 @@ PKL_PHASE_END_HANDLER
PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_print_stmt)
{
pkl_ast_node print_stmt = PKL_PASS_NODE;
- pkl_ast_node print_stmt_args = PKL_AST_PRINT_STMT_ARGS (print_stmt);
- pkl_ast_node print_stmt_fmt = PKL_AST_PRINT_STMT_FMT (print_stmt);
+ pkl_ast_node print_stmt_str_exp = PKL_AST_PRINT_STMT_STR_EXP (print_stmt);
- if (print_stmt_fmt)
+ if (print_stmt_str_exp) /* print statement */
+ {
+ PKL_PASS_SUBPASS (print_stmt_str_exp);
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PRINTS);
+ }
+ else /* printf statement */
{
+ pkl_ast_node print_stmt_fmt = PKL_AST_PRINT_STMT_FORMAT (print_stmt);
+ pkl_ast_node print_stmt_args = PKL_AST_FORMAT_ARGS (print_stmt_fmt);
pkl_ast_node arg;
- char *prefix = PKL_AST_PRINT_STMT_PREFIX (print_stmt);
+ char *prefix = PKL_AST_FORMAT_PREFIX (print_stmt_fmt);
int nexp;
/* First, compute the arguments and push them to the stack. */
@@ -1432,7 +1625,7 @@ PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_print_stmt)
arg;
arg = PKL_AST_CHAIN (arg))
{
- pkl_ast_node exp = PKL_AST_PRINT_STMT_ARG_EXP (arg);
+ pkl_ast_node exp = PKL_AST_FORMAT_ARG_EXP (arg);
if (exp)
{
@@ -1456,11 +1649,11 @@ PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_print_stmt)
{
/* Handle the argument. */
- pkl_ast_node exp = PKL_AST_PRINT_STMT_ARG_EXP (arg);
- char *begin_sc = PKL_AST_PRINT_STMT_ARG_BEGIN_SC (arg);
- char *end_sc = PKL_AST_PRINT_STMT_ARG_END_SC (arg);
- char *suffix = PKL_AST_PRINT_STMT_ARG_SUFFIX (arg);
- int base = PKL_AST_PRINT_STMT_ARG_BASE (arg);
+ pkl_ast_node exp = PKL_AST_FORMAT_ARG_EXP (arg);
+ char *begin_sc = PKL_AST_FORMAT_ARG_BEGIN_SC (arg);
+ char *end_sc = PKL_AST_FORMAT_ARG_END_SC (arg);
+ char *suffix = PKL_AST_FORMAT_ARG_SUFFIX (arg);
+ int base = PKL_AST_FORMAT_ARG_BASE (arg);
if (begin_sc)
{
@@ -1478,12 +1671,12 @@ PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_print_stmt)
if (exp)
{
- if (PKL_AST_PRINT_STMT_ARG_VALUE_P (arg))
+ if (PKL_AST_FORMAT_ARG_VALUE_P (arg))
{
/* Generate code to print the value. */
pkl_ast_node exp_type = PKL_AST_TYPE (exp);
- int arg_omode = PKL_AST_PRINT_STMT_ARG_PRINT_MODE (arg);
- int arg_odepth = PKL_AST_PRINT_STMT_ARG_PRINT_DEPTH (arg);
+ int arg_omode = PKL_AST_FORMAT_ARG_FORMAT_MODE (arg);
+ int arg_odepth = PKL_AST_FORMAT_ARG_FORMAT_DEPTH (arg);
/* Set the argument's own omode and odepth, saving
the VM's own. */
@@ -1526,11 +1719,6 @@ PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_print_stmt)
}
}
}
- else
- {
- PKL_PASS_SUBPASS (print_stmt_args);
- pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PRINTS);
- }
PKL_PASS_BREAK;
}
@@ -1985,6 +2173,12 @@ PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_type_offset)
RAS_MACRO_OFFSET_PRINTER (PKL_PASS_NODE); /* _ */
PKL_PASS_BREAK;
}
+ else if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_FORMATER))
+ {
+ /* VAL DEPTH */
+ RAS_MACRO_OFFSET_FORMATER (PKL_PASS_NODE); /* _ */
+ PKL_PASS_BREAK;
+ }
else if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_TYPE))
{
/* Just build an offset type. */
@@ -2735,6 +2929,11 @@ PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_type_integral)
/* VAL DEPTH */
RAS_MACRO_INTEGRAL_PRINTER (PKL_PASS_NODE); /* _ */
}
+ else if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_FORMATER))
+ {
+ /* VAL DEPTH */
+ RAS_MACRO_INTEGRAL_FORMATER (PKL_PASS_NODE); /* _ */
+ }
else if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_TYPE))
{
pkl_asm_insn (pasm, PKL_INSN_PUSH,
@@ -2849,6 +3048,15 @@ PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_type_function)
pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PRINTS);
PKL_PASS_BREAK;
}
+ else if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_FORMATER))
+ {
+ /* Stack: VAL DEPTH */
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP); /* DEPTH is not used. */
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP); /* VAL is not used. */
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
+ pvm_make_string ("#<closure>"));
+ PKL_PASS_BREAK;
+ }
}
PKL_PHASE_END_HANDLER
@@ -3091,6 +3299,28 @@ PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_type_array)
pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_CALL); /* _ */
PKL_PASS_BREAK;
}
+ else if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_FORMATER))
+ {
+ /* Stack: ARR DEPTH */
+
+ pkl_ast_node array_type = PKL_PASS_NODE;
+ pvm_val formater_closure = PKL_AST_TYPE_A_FORMATER (array_type);
+
+ /* If the array type doesn't have a formater, compile one. */
+ if (formater_closure == PVM_NULL)
+ {
+ RAS_FUNCTION_ARRAY_FORMATER (formater_closure, array_type);
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, formater_closure);
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PEC);
+ PKL_AST_TYPE_A_FORMATER (array_type) = formater_closure;
+ }
+ else
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, formater_closure);
+
+ /* Invoke the formater. */
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_CALL); /* _ */
+ PKL_PASS_BREAK;
+ }
else if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_CONSTRUCTOR))
{
/* Stack: null */
@@ -3247,6 +3477,11 @@ PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_type_string)
/* Stack: VAL DEPTH */
RAS_MACRO_STRING_PRINTER; /* _ */
}
+ else if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_FORMATER))
+ {
+ /* Stack: VAL DEPTH */
+ RAS_MACRO_STRING_FORMATER; /* _ */
+ }
else if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_TYPE))
pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MKTYS);
}
@@ -3492,6 +3727,28 @@ PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_type_struct)
pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_CALL); /* _ */
PKL_PASS_BREAK;
}
+ else if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_FORMATER))
+ {
+ /* Stack: SCT DEPTH */
+
+ pkl_ast_node struct_type = PKL_PASS_NODE;
+ pvm_val formater_closure = PKL_AST_TYPE_S_FORMATER (struct_type);
+
+ /* If the struct type doesn't have a formater, compile one. */
+ if (formater_closure == PVM_NULL)
+ {
+ RAS_FUNCTION_STRUCT_FORMATER (formater_closure, struct_type);
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, formater_closure);
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PEC);
+ PKL_AST_TYPE_S_FORMATER (struct_type) = formater_closure;
+ }
+ else
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, formater_closure);
+
+ /* Invoke the formater. */
+ pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_CALL); /* _ */
+ PKL_PASS_BREAK;
+ }
else if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_TYPE))
{
/* Do nothing. See PS hook. */
@@ -4265,6 +4522,7 @@ struct pkl_phase pkl_phase_gen =
PKL_PHASE_PR_HANDLER (PKL_AST_RETURN_STMT, pkl_gen_pr_return_stmt),
PKL_PHASE_PS_HANDLER (PKL_AST_RETURN_STMT, pkl_gen_ps_return_stmt),
PKL_PHASE_PS_HANDLER (PKL_AST_EXP_STMT, pkl_gen_ps_exp_stmt),
+ PKL_PHASE_PR_HANDLER (PKL_AST_FORMAT, pkl_gen_pr_format),
PKL_PHASE_PR_HANDLER (PKL_AST_PRINT_STMT, pkl_gen_pr_print_stmt),
PKL_PHASE_PS_HANDLER (PKL_AST_RAISE_STMT, pkl_gen_ps_raise_stmt),
PKL_PHASE_PR_HANDLER (PKL_AST_TRY_CATCH_STMT, pkl_gen_pr_try_catch_stmt),
diff --git a/libpoke/pkl-gen.h b/libpoke/pkl-gen.h
index 49330460..7147113e 100644
--- a/libpoke/pkl-gen.h
+++ b/libpoke/pkl-gen.h
@@ -111,6 +111,7 @@ typedef struct pkl_gen_payload *pkl_gen_payload;
#define PKL_GEN_CTX_IN_ARRAY_BOUNDER 0x80
#define PKL_GEN_CTX_IN_FUNCALL 0x200
#define PKL_GEN_CTX_IN_TYPE 0x400
+#define PKL_GEN_CTX_IN_FORMATER 0x800
extern struct pkl_phase pkl_phase_gen;
diff --git a/libpoke/pkl-gen.pks b/libpoke/pkl-gen.pks
index eb0b60b8..7fa3e4a9 100644
--- a/libpoke/pkl-gen.pks
+++ b/libpoke/pkl-gen.pks
@@ -1767,6 +1767,557 @@
drop ; _
.end
+;;; RAS_MACRO_FORMAT_INT_SUFFIX @type
+;;; ( -- STR )
+;;;
+;;; Push the suffix corresponding to the specified integral type
+;;; to the stack.
+;;;
+;;; Macro-arguments:
+;;; @type
+;;; pkl_ast_node with an integral type.
+
+ .macro format_int_suffix @type
+ .let #signed_p = pvm_make_int (PKL_AST_TYPE_I_SIGNED_P (@type), 32)
+ .let #size = pvm_make_ulong (PKL_AST_TYPE_I_SIZE (@type), 64)
+ push #signed_p
+ push #size
+ .call _pkl_format_int_suffix
+ .end
+
+;;; RAS_MACRO_INTEGRAL_FORMATER @type
+;;; ( VAL DEPTH -- STR )
+;;;
+;;; Given an integral value and a depth in the stack, push the
+;;; string representation to the stack.
+;;;
+;;; Macro-arguments:
+;;; @type
+;;; pkl_ast_node with the type of the value in the stack.
+
+ .macro integral_formater @type
+ drop ; VAL
+ pushob ; VAL OBASE
+ ;; Calculate and format the prefix.
+ dup ; VAL OBASE OBASE
+ .call _pkl_base_prefix ; VAL OBASE PREFIX
+ nrot ; PREFIX VAL OBASE
+ ;; Format the value.
+ format @type ; PREFIX STR
+ ;; Push the suffix
+ .e format_int_suffix @type ; PREFIX STR SUFFIX
+ .call _pkl_strcat3 ; STR
+ sel ; STR LEN
+ push ulong<64>0 ; STR LEN IDX
+ swap ; STR IDX LEN
+ push "integer" ; STR IDX LEN CLASS
+ sprops ; STR
+ .end
+
+;;; RAS_MACRO_OFFSET_FORMATER @type
+;;; ( VAL DEPTH -- STR )
+;;;
+;;; Given an offset value in the stack and a depth level,
+;;; push the string representation of the offset to the stack.
+;;;
+;;; Macro-arguments:
+;;; @type
+;;; pkl_ast_node with the type of the value in the stack.
+
+ .macro offset_formater @type
+ ;; Format the offset magnitude
+ .let @unit = PKL_AST_TYPE_O_UNIT (@type)
+ .let @base_type = PKL_AST_TYPE_O_BASE_TYPE (@type)
+ swap ; DEPTH VAL
+ ogetm ; DEPTH VAL MAG
+ rot ; VAL MAG DEPTH
+ .c PKL_PASS_SUBPASS (@base_type);
+ ; VAL STR
+ ;; Separator
+ push "#" ; VAL STR #
+ rot ; STR # VAL
+ ;; Format the offset unit.
+ ;; If the unit has a name, use it.
+ ;; Otherwise, format the unit in decimal.
+ .let @unit_type = PKL_AST_TYPE (@unit)
+ ogetu ; STR # VAL UNIT
+ nip ; STR # UNIT
+ dup ; STR # UNIT UNIT
+ .call _pkl_unit_name ; STR # UNIT STR
+ sel ; STR # UNIT STR SEL
+ bzlu .no_unit_name
+ drop ; STR # UNIT STR
+ nip ; STR # STR
+ ba .unit_name_done
+.no_unit_name:
+ drop2 ; STR # UNIT
+ push int<32>10 ; STR # UNIT 10
+ format @unit_type ; STR # STR
+.unit_name_done:
+ .call _pkl_strcat3 ; STR
+ sel ; STR LEN
+ push ulong<64>0 ; STR LEN IDX
+ swap ; STR IDX LEN
+ push "offset" ; STR IDX LEN CLASS
+ sprops ; STR
+ .end
+
+;;; RAS_MACRO_STRING_FORMATER
+;;; ( VAL DEPTH -- STR )
+;;;
+;;; Given a string value and a depth in the stack, push the
+;;; the string representation to the stack.
+
+ .macro string_formater
+ drop ; VAL
+ .call _pkl_escape_string; VAL
+ push "\"" ; VAL "
+ swap ; " VAL
+ push "\"" ; " VAL "
+ .call _pkl_strcat3 ; STR
+ sel ; STR LEN
+ push ulong<64>0 ; STR LEN IDX
+ swap ; STR IDX LEN
+ push "offset" ; STR IDX LEN CLASS
+ sprops ; STR
+ .end
+
+;;; RAS_MACRO_FORMAT_BOFFSET
+;;; ( ULONG -- STR )
+;;;
+;;; Given a bit-offset in the stack, format it out like a real
+;;; offset in hexadecimal, and push it to the stack .
+
+ .macro format_boffset
+ push int<32>16 ; ULONG 16
+ formatlu 64 ; STR
+ push "0x"
+ swap ; 0x STR
+ sconc
+ nip2 ; STR
+ sel ; STR LEN
+ push ulong<64>0 ; STR LEN IDX
+ swap ; STR IDX LEN
+ push "integer" ; STR IDX LEN CLASS
+ sprops ; STR
+ ;; RAS turns "#b" into "(B_arg)"; so we use '\x62' for 'b'.
+ push "#\x62" ; STR #b
+ sconc
+ nip2 ; STR
+ sel ; STR LEN
+ push ulong<64>0 ; STR LEN IDX
+ swap ; STR IDX LEN
+ push "offset" ; STR IDX LEN CLASS
+ sprops ; STR
+ .end
+
+;;; RAS_FUNCTION_ARRAY_FORMATER @array_type
+;;; ( ARR DEPTH -- STR )
+;;;
+;;; Assemble a function that gets an array value and a depth
+;;; level in the stack and formats the array and push it to
+;;; the stack.
+;;;
+;;; Macro-arguments:
+;;; @array_type
+;;; pkl_ast_node with the type of the array value to print.
+
+ .function array_formater @array_type
+ prolog
+ pushf 1
+ regvar $depth ; ARR
+ sel ; ARR SEL
+ dup
+ regvar $sel
+ ;; Find the number of elems that will be formated: NELEM
+ pushoac ; ARR SEL OACUTOFF
+ bzi .no_cut_off
+ itolu 64
+ nip ; ARR SEL OACUTOFFL
+ ltlu ; ARR SEL OACUTOFFL (SEL<OACUTOFFL)
+ bzi .sel_gte_cutoff
+ nrot ; ARR (SEL<OACUTOFFL) SEL OACUTOFFL
+.sel_gte_cutoff:
+ drop
+ nip ; ARR NELEM
+ push null
+.no_cut_off:
+ drop ; ARR NELEM
+ dup
+ regvar $nelem ; ARR NELEM
+ pushvar $sel
+ eqlu
+ nip2 ; ARR (NELEM==SEL)
+ regvar $no_ellip ; ARR
+ mktys
+ push null
+ mktya ; ARR TYPA
+ push ulong<64>0
+ mka ; ARR SARR
+ push ulong<64>0
+ push "["
+ ains
+ swap ; SARR ARR
+ ;; Iterate on the values stored in the array, formating them
+ ;; in turn.
+ push ulong<64>0 ; SARR ARR IDX
+ dup
+ ;; Temporary variable.
+ regvar $idx
+ .while
+ pushvar $nelem ; SARR ARR IDX NELEM
+ over ; SARR ARR IDX NELEM IDX
+ swap ; SARR ARR IDX IDX NELEM
+ ltlu ; SARR ARR IDX IDX NELEM (IDX<NELEM)
+ nip2 ; SARR ARR IDX (IDX<NELEM)
+ .loop
+ ;; Insert a comma if this is not the first element of the
+ ;; array.
+ push ulong<64>0 ; SARR ARR IDX 0UL
+ eql
+ nip ; SARR ARR IDX (IDX==0UL)
+ bnzi .l1
+ drop ; SARR ARR IDX
+ rot ; ARR IDX SARR
+ sel
+ push ","
+ ains ; ARR IDX SARR
+ nrot ; SARR ARR IDX
+ push null
+.l1:
+ drop ; SARR ARR IDX
+ ;; Now format the array element.
+ .let @array_elem_type = PKL_AST_TYPE_A_ETYPE (@array_type)
+ aref ; SARR ARR IDX EVAL
+ pushvar $depth ; SARR ARR IDX EVAL DEPTH
+ .c PKL_PASS_SUBPASS (@array_elem_type);
+ ; SARR ARR IDX STR
+ swap
+ popvar $idx ; SARR ARR STR
+ rot ; ARR STR SARR
+ sel
+ rot ; ARR SARR SEL STR
+ ains
+ swap ; SARR ARR
+ pushvar $idx
+ ;; Format the element offset if required.
+ pushoo ; SARR ARR IDX OMAPS
+ bzi .l3
+ drop
+ rot ; ARR IDX SARR
+ sel ; ARR IDX SARR SLEN
+ push " @ "
+ ains ; ARR IDX SARR
+ nrot ; SARR ARR IDX
+ arefo ; SARR ARR IDX BOFF
+ .e format_boffset ; SARR ARR IDX STR
+ swap
+ popvar $idx ; SARR ARR STR
+ rot ; ARR STR SARR
+ sel ; ARR STR SARR SLEN
+ rot ; ARR SARR SLEN STR
+ ains ; ARR SARR
+ swap ; SARR ARR
+ pushvar $idx ; SARR ARR IDX
+ push null
+.l3:
+ drop
+ ;; Increase index to process next element.
+ push ulong<64>1
+ addlu
+ nip2 ; SARR ARR (IDX+1)
+ .endloop
+ drop
+ ;; Honor oacutoff.
+ pushvar $no_ellip ; SARR ARR NOELLIP
+ bnzi .push_ket
+ drop
+ push "..."
+ push ulong<64>0
+ push ulong<64>3
+ push "ellipsis"
+ sprops ; SARR ARR ...
+ rot
+ sel ; ARR ... SARR SLEN
+ rot ; ARR SARR SLEN ...
+ ains
+ swap
+ push null
+.push_ket:
+ drop ; SARR ARR
+ swap
+ sel
+ push "]"
+ ains ; ARR SARR
+ ;; Format the array offset if required.
+ pushoo ; ARR SARR OMAPS
+ bzi .done
+ drop
+ sel
+ push " @ "
+ ains
+ swap ; SARR ARR
+ mgeto ; SARR ARR BOFF
+ .e format_boffset ; SARR ARR STR
+ rot ; ARR STR SARR
+ sel ; ARR STR SARR SLEN
+ rot ; ARR SARR SLEN STR
+ ains ; ARR SARR
+ push null
+.done:
+ ;; We are done. Cleanup and bye bye.
+ drop
+ nip ; SARR
+ sel ; SARR SLEN
+ push ulong<64>0 ; SARR SLEN IDX
+ swap ; SARR IDX SLEN
+ .call _pkl_reduce_string_array
+ ; STR
+ sel ; STR LEN
+ push ulong<64>0 ; STR LEN IDX
+ swap ; STR IDX LEN
+ push "array" ; STR IDX LEN CLASS
+ sprops ; STR
+ popf 1
+ return
+ .end
+
+;;; RAS_FUNCTION_STRUCT_FORMATER @struct_type
+;;; ( SCT DEPTH -- STR )
+;;;
+;;; Assemble a function that gets a struct value and a depth
+;;; level in the stack and push the string representation of
+;;; the struct to the stack.
+;;;
+;;; Macro-arguments:
+;;; @struct_type
+;;; pkl_ast_node with the type fo the struct value to format.
+
+ .function struct_formater @struct_type
+ prolog
+ pushf 1
+ regvar $depth ; SCT
+ .let #is_union_p = pvm_make_int(PKL_AST_TYPE_S_UNION_P (@struct_type),
32)
+ ;; Make the string[] which will contain all the formatted struct
+ mktys ; SCT STYP
+ push null
+ mktya ; SCT ATYP
+ push ulong<64>0
+ mka ; SCT SARR
+ swap ; SARR SCT
+ typof ; SARR SCT TYP
+ tysctn ; SARR SCT STR
+ nip
+ bnn .named_struct
+ ;; anonymous struct/union
+ drop
+ push #is_union_p ; SARR SCT INT
+ bnzi .anonymous_union
+ drop
+ push "struct" ; SARR SCT STR
+ ba .named_struct
+.anonymous_union:
+ drop
+ push "union"
+.named_struct:
+ sel
+ push ulong<64>0
+ swap
+ push "struct-type-name" ; SARR SCT STR IDX LEN CLASS
+ sprops ; SARR SCT STR
+ rot ; SCT STR SARR
+ push ulong<64>0 ; SCT STR SARR IDX
+ rot ; SCT SARR IDX STR
+ ains
+ swap ; SARR SCT
+ ;; Stop here if we are past the maximum depth configured in
+ ;; the VM.
+ pushod ; SARR SCT MDEPTH
+ bzi .depth_ok
+ pushvar $depth ; SARR SCT MDEPTH DEPTH
+ lei
+ nip2 ; SARR SCT (MDEPTH<=DEPTH)
+ bzi .depth_ok
+ drop ; SARR SCT
+ push " {...}"
+ rot ; SCT STR SARR
+ sel ; SCT STR SARR IDX
+ rot ; SCT SARR IDX STR
+ ains ; SCT SARR
+ swap
+ ba .body_done
+.depth_ok:
+ drop ; SARR SCT
+ ;; Iterate on the elements stored in the struct, formating them
+ ;; in order.
+ swap ; SCT SARR
+ sel
+ push " {"
+ ains ; SCT SARR
+ swap ; SARR SCT
+ .let @field
+ .c uint64_t i;
+ .c for (i = 0, @field = PKL_AST_TYPE_S_ELEMS (@struct_type);
+ .c @field;
+ .c @field = PKL_AST_CHAIN (@field))
+ .c {
+ .c if (PKL_AST_CODE (@field) != PKL_AST_STRUCT_TYPE_FIELD)
+ .c continue;
+ .label .process_struct_field
+ .label .process_next_alternative
+ .label .l1
+ .label .l2
+ .label .l3
+ .let #i = pvm_make_ulong (i, 64)
+ .let @field_name = PKL_AST_STRUCT_TYPE_FIELD_NAME (@field)
+ .let @field_type = PKL_AST_STRUCT_TYPE_FIELD_TYPE (@field)
+ ;; Get the value of this field. If this an union we have to
+ ;; refer to the field by name, and the first one we found is
+ ;; the only one.
+ push #is_union_p
+ bzi .process_struct_field
+ ;; union
+ drop
+ .let #name_str = pvm_make_string (PKL_AST_IDENTIFIER_POINTER
(@field_name))
+ push #name_str ; SARR SCT STR
+ srefnt ; SARR SCT STR EVAL
+ nip ; SARR SCT EVAL
+ bn .process_next_alternative
+ ba .l2
+.process_struct_field:
+ drop
+ push #i ; SARR SCT I
+ srefi ; SARR SCT I EVAL
+ swap ; SARR SCT EVAL I
+ bzlu .l1
+ drop
+ ;; Insert the separator if this is not the first field.
+ rot ; SCT EVAL SARR
+ sel
+ push ","
+ ains ; SCT EVAL SARR
+ ba .l3
+.l1:
+ drop
+.l2:
+ rot ; SCT EVAL SARR
+.l3:
+ ;; Indent if in tree-mode.
+ sel ; SCT EVAL SARR IDX
+ pushvar $depth ; SCT EVAL SARR IDX DEPTH
+ push int<32>1
+ addi
+ nip2 ; SCT EVAL SARR IDX (DEPTH+1)
+ pushoi ; SCT EVAL SARR IDX (DEPTH+1) ISTEP
+ pushom ; SCT EVAL SARR IDX DEPTH ISTEP OMODE
+ .call _pkl_indentation ; SCT EVAL SARR IDX STR
+ ains ; SCT EVAL SARR
+ ;; Field name
+ .c if (@field_name)
+ .c {
+ .let #field_name_str = pvm_make_string (PKL_AST_IDENTIFIER_POINTER
(@field_name))
+ sel ; SCT EVAL SARR IDX
+ push #field_name_str
+ sel
+ push ulong<64>0
+ swap
+ push "struct-field-name"
+ sprops ; SCT EVAL SARR IDX STR
+ ains ; SCT EVAL SARR
+ sel
+ push "="
+ ains ; SCT EVAL SARR
+ .c }
+ nrot ; SARR SCT EVAL
+ pushvar $depth ; SARR SCT EVAL DEPTH
+ push int<32>1
+ addi
+ nip2 ; SARR SCT EVAL (DEPTH+1)
+ .c PKL_PASS_SUBPASS (@field_type);
+ ; SARR SCT STR
+ rot ; SCT STR SARR
+ sel ; SCT STR SARR IDX
+ rot ; SCT SARR IDX STR
+ ains ; SCT SARR
+ ;; Format the field offset, if required.
+ .label .no_elem_offset
+ pushoo ; SCT SARR OMAPS
+ bzi .no_elem_offset
+ drop ; SCT SARR
+ sel
+ push " @ " ; SCT SARR IDX STR
+ ains
+ swap ; SARR SCT
+ push #i
+ srefio
+ nip ; SARR SCT BOFF
+ .e format_boffset ; SARR SCT STR
+ rot ; SCT STR SARR
+ sel
+ rot ; SCT SARR IDX STR
+ ains
+ push null ; SCT SARR NULL
+.no_elem_offset:
+ drop
+ swap ; SARR SCT
+ push #is_union_p
+ ;; Unions only have one field => we are done.
+ bnzi .fields_done
+.process_next_alternative:
+ drop ; SARR SCT
+ .c i = i + 1;
+ .c }
+ ba .l4
+.fields_done:
+ drop
+.l4:
+ ;; Indent if in tree-mode.
+ pushvar $depth ; SARR SCT DEPTH
+ pushoi ; SARR SCT DEPTH ISTEP
+ pushom ; SARR SCT DEPTH ISTEP OMODE
+ .call _pkl_indentation ; SARR SCT STR
+ rot ; SCT STR SARR
+ sel ; SCT STR SARR IDX
+ rot ; SCT SARR IDX STR
+ ains
+ sel
+ push "}"
+ ains ; SCT SARR
+ swap
+.body_done:
+ ;; Format the struct offset if required.
+ pushoo ; SARR SCT OMAPS
+ bzi .no_omaps
+ drop ; SARR SCT
+ mgeto
+ nip ; SARR BOFF
+ swap ; BOFF SARR
+ sel ; BOFF SARR IDX
+ push " @ " ; BOFF SARR IDX STR
+ ains ; BOFF SARR
+ sel ; BOFF SARR IDX
+ rot ; SARR IDX BOFF
+ .e format_boffset ; SARR IDX STR
+ ains ; SARR
+ ba .done
+.no_omaps:
+ drop2
+.done:
+ ; SARR
+ sel
+ push ulong<64>0
+ swap ; SARR IDX LEN
+ .call _pkl_reduce_string_array
+ ; STR
+ sel
+ push ulong<64>0
+ swap ; STR IDX LEN
+ push "struct"
+ sprops ; STR
+ popf 1
+ return
+ .end
+
;;; RAS_MACRO_PRINT_INT_SUFFIX @type
;;; ( -- )
;;;
diff --git a/libpoke/pkl-insn.def b/libpoke/pkl-insn.def
index 15a5a32a..db3b9838 100644
--- a/libpoke/pkl-insn.def
+++ b/libpoke/pkl-insn.def
@@ -60,9 +60,12 @@ PKL_DEF_INSN(PKL_INSN_PUSH,"v","push")
PKL_DEF_INSN(PKL_INSN_PUSHR,"r","pushr")
PKL_DEF_INSN(PKL_INSN_POPR,"r","popr")
PKL_DEF_INSN(PKL_INSN_DROP,"","drop")
+PKL_DEF_INSN(PKL_INSN_DROP2,"","drop2")
+PKL_DEF_INSN(PKL_INSN_DROP3,"","drop3")
PKL_DEF_INSN(PKL_INSN_SWAP,"","swap")
PKL_DEF_INSN(PKL_INSN_NIP,"","nip")
PKL_DEF_INSN(PKL_INSN_NIP2,"","nip2")
+PKL_DEF_INSN(PKL_INSN_NIP3,"","nip3")
PKL_DEF_INSN(PKL_INSN_DUP,"","dup")
PKL_DEF_INSN(PKL_INSN_OVER,"","over")
PKL_DEF_INSN(PKL_INSN_ROT,"","rot")
@@ -242,6 +245,13 @@ PKL_DEF_INSN(PKL_INSN_SPROPS,"","sprops")
PKL_DEF_INSN(PKL_INSN_SPROPH,"","sproph")
PKL_DEF_INSN(PKL_INSN_SPROPC,"","spropc")
+/* Format instructions. */
+
+PKL_DEF_INSN(PKL_INSN_FORMATI,"n","formati")
+PKL_DEF_INSN(PKL_INSN_FORMATIU,"n","formatiu")
+PKL_DEF_INSN(PKL_INSN_FORMATL,"n","formatl")
+PKL_DEF_INSN(PKL_INSN_FORMATLU,"n","formatlu")
+
/* Offset instructions. */
PKL_DEF_INSN(PKL_INSN_MKO,"","mko")
@@ -548,6 +558,10 @@ PKL_DEF_INSN(PKL_INSN_REV,"n","rev")
PKL_DEF_INSN(PKL_INSN_PRINT,"a","print")
+/* Format macro-instructions. */
+
+PKL_DEF_INSN(PKL_INSN_FORMAT,"a","format")
+
/*
Local variables:
mode:c
diff --git a/libpoke/pkl-lex.l b/libpoke/pkl-lex.l
index 55ba36cd..38c3b38d 100644
--- a/libpoke/pkl-lex.l
+++ b/libpoke/pkl-lex.l
@@ -227,6 +227,7 @@ S ::
"load" { return LOAD; }
"lambda" { return LAMBDA; }
"assert" { return ASSERT; }
+"format" { return FORMAT; }
"__PKL_BUILTIN_RAND__" {
if (yyextra->bootstrapped) REJECT; return BUILTIN_RAND; }
"__PKL_BUILTIN_GET_ENDIAN__" {
diff --git a/libpoke/pkl-pass.c b/libpoke/pkl-pass.c
index 01adbbdd..5f05fea4 100644
--- a/libpoke/pkl-pass.c
+++ b/libpoke/pkl-pass.c
@@ -566,17 +566,22 @@ pkl_do_pass_1 (pkl_compiler compiler,
if (PKL_AST_RAISE_STMT_EXP (node))
PKL_PASS (PKL_AST_RAISE_STMT_EXP (node));
break;
- case PKL_AST_PRINT_STMT_ARG:
- if (PKL_AST_PRINT_STMT_ARG_EXP (node))
- PKL_PASS (PKL_AST_PRINT_STMT_ARG_EXP (node));
+ case PKL_AST_FORMAT_ARG:
+ if (PKL_AST_FORMAT_ARG_EXP (node))
+ PKL_PASS (PKL_AST_FORMAT_ARG_EXP (node));
+ break;
+ case PKL_AST_FORMAT:
+ PKL_PASS (PKL_AST_FORMAT_FMT (node));
+ if (PKL_AST_FORMAT_TYPES (node))
+ PKL_PASS_CHAIN (PKL_AST_FORMAT_TYPES (node));
+ if (PKL_AST_FORMAT_ARGS (node))
+ PKL_PASS_CHAIN (PKL_AST_FORMAT_ARGS (node));
break;
case PKL_AST_PRINT_STMT:
- if (PKL_AST_PRINT_STMT_FMT (node))
- PKL_PASS (PKL_AST_PRINT_STMT_FMT (node));
- if (PKL_AST_PRINT_STMT_TYPES (node))
- PKL_PASS_CHAIN (PKL_AST_PRINT_STMT_TYPES (node));
- if (PKL_AST_PRINT_STMT_ARGS (node))
- PKL_PASS_CHAIN (PKL_AST_PRINT_STMT_ARGS (node));
+ if (PKL_AST_PRINT_STMT_STR_EXP (node))
+ PKL_PASS (PKL_AST_PRINT_STMT_STR_EXP (node));
+ if (PKL_AST_PRINT_STMT_FORMAT (node))
+ PKL_PASS (PKL_AST_PRINT_STMT_FORMAT (node));
break;
case PKL_AST_LAMBDA:
PKL_PASS (PKL_AST_LAMBDA_FUNCTION (node));
diff --git a/libpoke/pkl-promo.c b/libpoke/pkl-promo.c
index 786dd956..54d8dcc8 100644
--- a/libpoke/pkl-promo.c
+++ b/libpoke/pkl-promo.c
@@ -1187,21 +1187,21 @@ PKL_PHASE_BEGIN_HANDLER (pkl_promo_ps_return_stmt)
}
PKL_PHASE_END_HANDLER
-/* Promote arguments to printf. */
+/* Promote arguments to format. */
-PKL_PHASE_BEGIN_HANDLER (pkl_promo_ps_print_stmt)
+PKL_PHASE_BEGIN_HANDLER (pkl_promo_ps_format)
{
- pkl_ast_node print_stmt = PKL_PASS_NODE;
- pkl_ast_node print_stmt_types = PKL_AST_PRINT_STMT_TYPES (print_stmt);
- pkl_ast_node print_stmt_args = PKL_AST_PRINT_STMT_ARGS (print_stmt);
+ pkl_ast_node format = PKL_PASS_NODE;
+ pkl_ast_node format_types = PKL_AST_FORMAT_TYPES (format);
+ pkl_ast_node format_args = PKL_AST_FORMAT_ARGS (format);
pkl_ast_node type, arg;
- for (arg = print_stmt_args, type = print_stmt_types;
+ for (arg = format_args, type = format_types;
arg && type;
arg = PKL_AST_CHAIN (arg), type = PKL_AST_CHAIN (type))
{
- pkl_ast_node arg_exp = PKL_AST_PRINT_STMT_ARG_EXP (arg);
+ pkl_ast_node arg_exp = PKL_AST_FORMAT_ARG_EXP (arg);
/* Skip arguments without associated values. Also skip
arguments with declared type ANY (%v) */
@@ -1211,11 +1211,12 @@ PKL_PHASE_BEGIN_HANDLER (pkl_promo_ps_print_stmt)
int restart;
if (!promote_node (PKL_PASS_AST,
- &PKL_AST_PRINT_STMT_ARG_EXP (arg),
+ &PKL_AST_FORMAT_ARG_EXP (arg),
type, &restart))
{
PKL_ICE (PKL_AST_LOC (arg),
- "couldn't promote printf argument initializer");
+ "couldn't promote %s argument initializer",
+ PKL_AST_FORMAT_NODE_NAME (format));
PKL_PASS_ERROR;
}
@@ -1623,7 +1624,7 @@ struct pkl_phase pkl_phase_promo =
PKL_PHASE_PS_HANDLER (PKL_AST_FUNCALL, pkl_promo_ps_funcall),
PKL_PHASE_PS_HANDLER (PKL_AST_ASS_STMT, pkl_promo_ps_ass_stmt),
PKL_PHASE_PS_HANDLER (PKL_AST_RETURN_STMT, pkl_promo_ps_return_stmt),
- PKL_PHASE_PS_HANDLER (PKL_AST_PRINT_STMT, pkl_promo_ps_print_stmt),
+ PKL_PHASE_PS_HANDLER (PKL_AST_FORMAT, pkl_promo_ps_format),
PKL_PHASE_PS_HANDLER (PKL_AST_IF_STMT, pkl_promo_ps_if_stmt),
PKL_PHASE_PS_HANDLER (PKL_AST_LOOP_STMT, pkl_promo_ps_loop_stmt),
PKL_PHASE_PS_HANDLER (PKL_AST_STRUCT_TYPE_FIELD,
pkl_promo_ps_struct_type_field),
diff --git a/libpoke/pkl-rt.pk b/libpoke/pkl-rt.pk
index f8aa32b8..9535f22e 100644
--- a/libpoke/pkl-rt.pk
+++ b/libpoke/pkl-rt.pk
@@ -251,6 +251,74 @@ fun _pkl_base_prefix = (int<32> base) string:
return "";
}
+/* Concatenate three strings. */
+
+fun _pkl_strcat3 = (string a, string b, string c) string:
+ {
+ var la = a'length,
+ lab = la + b'length,
+ labc = lab + c'length,
+ s = "?" * labc;
+
+ __pkl_unsafe_string_set (s, 0, a);
+ __pkl_unsafe_string_set (s, la, b);
+ __pkl_unsafe_string_set (s, lab, c);
+ return s;
+ }
+
+/* Given a DEPTH, indentation step ISTEP and OMODE, returns a string for
+ indentation. */
+
+fun _pkl_indentation = (int<32> depth, int<32> istep, int<32> omode) string:
+ {
+ if (omode != VM_OMODE_TREE)
+ return "";
+
+ var s = " " * (1 + istep * depth);
+
+ __pkl_unsafe_string_set (s, 0, "\n");
+ return s;
+ }
+
+/* Return the suffix corresponding to the integral type with signedness
+ SIGNED_P and size SIZE. */
+
+fun _pkl_format_int_suffix = (int<32> signed_p, uint<64> size) string:
+ {
+ return (signed_p ? "" : "U") +
+ (size == 4 ? "N" :
+ size == 8 ? "B" :
+ size == 16 ? "H" :
+ size == 64 ? "L" : "");
+ }
+
+/* Reduces an array of string to a single string by concatenting the
+ NELEM elements of ARR starting from specified INDEX. */
+
+fun _pkl_reduce_string_array = (string[] arr,
+ uint<64> index, uint<64> nelem) string:
+ {
+ var slen = 0UL,
+ first = index,
+ last = index + nelem;
+
+ while (first < last)
+ {
+ slen += arr[first]'length;
+ ++first;
+ }
+
+ var s = " " * slen; /* Allocate the final string once. */
+
+ first = index;
+ for (var cursor = 0UL; first < last; ++first)
+ {
+ __pkl_unsafe_string_set (s, cursor, arr[first]);
+ cursor += arr[first]'length;
+ }
+ return s;
+ }
+
/* Return a new string in which all the non-printable characters are replaced
with a escape sequence (\xXX). */
diff --git a/libpoke/pkl-tab.y b/libpoke/pkl-tab.y
index 7713191b..f8ce36c2 100644
--- a/libpoke/pkl-tab.y
+++ b/libpoke/pkl-tab.y
@@ -422,6 +422,7 @@ token <integer> UNION _("keyword `union'")
%token PRINTF _("keyword `printf'")
%token LOAD _("keyword `load'")
%token LAMBDA _("keyword `lambda'")
+%token FORMAT _("keyword `format'")
%token BUILTIN_RAND BUILTIN_GET_ENDIAN BUILTIN_SET_ENDIAN
%token BUILTIN_GET_IOS BUILTIN_SET_IOS BUILTIN_OPEN BUILTIN_CLOSE
%token BUILTIN_IOSIZE BUILTIN_IOFLAGS BUILTIN_IOGETB BUILTIN_IOSETB
@@ -531,6 +532,7 @@ token <integer> UNION _("keyword `union'")
%type <ast> expression expression_list expression_opt primary
%type <ast> identifier bconc map
%type <ast> funcall funcall_arg_list funcall_arg
+%type <ast> format_arg_list format_arg
%type <ast> array array_initializer_list array_initializer
%type <ast> struct_field_list struct_field
%type <ast> typename type_specifier simple_type_specifier cons_type_specifier
@@ -545,7 +547,7 @@ token <integer> UNION _("keyword `union'")
%type <ast> defvar defvar_list deftype deftype_list
%type <ast> defunit defunit_list
%type <ast> function_specifier function_arg_list function_arg
function_arg_initial
-%type <ast> simple_stmt simple_stmt_list comp_stmt stmt_decl_list stmt
print_stmt_arg_list
+%type <ast> simple_stmt simple_stmt_list comp_stmt stmt_decl_list stmt
%type <ast> funcall_stmt funcall_stmt_arg_list funcall_stmt_arg
%type <ast> integral_struct
%type <integer> struct_type_pinned integral_type_sign struct_or_union
@@ -1176,6 +1178,18 @@ primary:
pkl_ast_finish_returns ($3);
$$ = pkl_ast_make_lambda (pkl_parser->ast, $3);
}
+ | FORMAT '(' STR format_arg_list ')'
+ {
+ $$ = pkl_ast_make_format (pkl_parser->ast, $3, $4,
+ 0 /* printf_p */);
+ PKL_AST_TYPE ($$)
+ = ASTREF (pkl_ast_make_string_type (pkl_parser->ast));
+ PKL_AST_LOC ($3) = @3;
+ if (PKL_AST_TYPE ($3))
+ PKL_AST_LOC (PKL_AST_TYPE ($3)) = @3;
+ PKL_AST_LOC ($$) = @$;
+ PKL_AST_LOC (PKL_AST_TYPE ($$)) = @$;
+ }
| expression INC
{
$$ = pkl_ast_make_incrdecr (pkl_parser->ast, $1,
@@ -1211,13 +1225,35 @@ funcall_arg_list:
funcall_arg:
expression
- {
+ {
$$ = pkl_ast_make_funcall_arg (pkl_parser->ast,
$1, NULL /* name */);
PKL_AST_LOC ($$) = @$;
}
;
+format_arg_list:
+ %empty
+ { $$ = NULL; }
+ | format_arg
+ | format_arg_list ',' expression
+ {
+ pkl_ast_node arg
+ = pkl_ast_make_format_arg (pkl_parser->ast, $3);
+ PKL_AST_LOC (arg) = @3;
+
+ $$ = pkl_ast_chainon ($1, arg);
+ }
+ ;
+
+format_arg:
+ expression
+ {
+ $$ = pkl_ast_make_format_arg (pkl_parser->ast, $1);
+ PKL_AST_LOC ($$) = @$;
+ }
+ ;
+
opt_comma:
%empty
| ','
@@ -2176,10 +2212,14 @@ simple_stmt:
$1);
PKL_AST_LOC ($$) = @$;
}
- | PRINTF '(' STR print_stmt_arg_list ')'
+ | PRINTF '(' STR format_arg_list ')'
{
+ pkl_ast_node format =
+ pkl_ast_make_format (pkl_parser->ast, $3, $4,
+ 1 /* printf_p */);
$$ = pkl_ast_make_print_stmt (pkl_parser->ast,
- $3, $4);
+ 1 /* printf_p */, format);
+ PKL_AST_LOC (format) = @$;
PKL_AST_LOC ($3) = @3;
if (PKL_AST_TYPE ($3))
PKL_AST_LOC (PKL_AST_TYPE ($3)) = @3;
@@ -2459,13 +2499,17 @@ stmt:
| PRINT expression ';'
{
$$ = pkl_ast_make_print_stmt (pkl_parser->ast,
- NULL /* fmt */, $2);
+ 0 /* printf_p */, $2);
PKL_AST_LOC ($$) = @$;
}
- | PRINTF STR print_stmt_arg_list ';'
+ | PRINTF STR format_arg_list ';'
{
+ pkl_ast_node format =
+ pkl_ast_make_format (pkl_parser->ast, $2, $3,
+ 1 /* printf_p */);
$$ = pkl_ast_make_print_stmt (pkl_parser->ast,
- $2, $3);
+ 1 /* printf_p */, format);
+ PKL_AST_LOC (format) = @$;
PKL_AST_LOC ($2) = @2;
if (PKL_AST_TYPE ($2))
PKL_AST_LOC (PKL_AST_TYPE ($2)) = @2;
@@ -2473,21 +2517,6 @@ stmt:
}
;
-print_stmt_arg_list:
- %empty
- {
- $$ = NULL;
- }
- | print_stmt_arg_list ',' expression
- {
- pkl_ast_node arg
- = pkl_ast_make_print_stmt_arg (pkl_parser->ast, $3);
- PKL_AST_LOC (arg) = @3;
-
- $$ = pkl_ast_chainon ($1, arg);
- }
- ;
-
funcall_stmt:
primary funcall_stmt_arg_list
{
diff --git a/libpoke/pkl-trans.c b/libpoke/pkl-trans.c
index 2170ac50..82938023 100644
--- a/libpoke/pkl-trans.c
+++ b/libpoke/pkl-trans.c
@@ -643,13 +643,13 @@ PKL_PHASE_BEGIN_HANDLER (pkl_trans1_ps_trimmer)
}
PKL_PHASE_END_HANDLER
-/* Decode format strings in `printf' instructions. */
+/* Decode format strings in `format' and `printf'. */
-PKL_PHASE_BEGIN_HANDLER (pkl_trans1_ps_print_stmt)
+PKL_PHASE_BEGIN_HANDLER (pkl_trans1_ps_format)
{
- pkl_ast_node print_stmt = PKL_PASS_NODE;
- pkl_ast_node args = PKL_AST_PRINT_STMT_ARGS (print_stmt);
- pkl_ast_node print_fmt = PKL_AST_PRINT_STMT_FMT (print_stmt);
+ pkl_ast_node format = PKL_PASS_NODE;
+ pkl_ast_node args = PKL_AST_FORMAT_ARGS (format);
+ pkl_ast_node format_fmt = PKL_AST_FORMAT_FMT (format);
char *fmt, *p;
pkl_ast_node t, arg;
int ntag, nargs = 0;
@@ -663,24 +663,22 @@ PKL_PHASE_BEGIN_HANDLER (pkl_trans1_ps_print_stmt)
/* Calculate the number of arguments. */
for (t = args; t; t = PKL_AST_CHAIN (t))
nargs++;
- PKL_AST_PRINT_STMT_NARGS (print_stmt) = nargs;
+ PKL_AST_FORMAT_NARGS (format) = nargs;
- /* If this is a `print', or if the format string has been already
- processed, then we are done. */
- if (!print_fmt
- || PKL_AST_PRINT_STMT_FMT_PROCESSED_P (print_stmt))
+ /* If the format string has been already processed, then we are done. */
+ if (PKL_AST_FORMAT_FMT_PROCESSED_P (format))
PKL_PASS_DONE;
- fmt = PKL_AST_STRING_POINTER (print_fmt);
+ fmt = PKL_AST_STRING_POINTER (format_fmt);
p = fmt;
/* Process the prefix string, if any. */
if (*p != '%')
{
p = strchrnul (fmt, '%');
- PKL_AST_PRINT_STMT_PREFIX (print_stmt) = strndup (fmt, p - fmt);
- if (!PKL_AST_PRINT_STMT_PREFIX (print_stmt))
- PKL_ICE (PKL_AST_LOC (print_stmt), _("out of memory"));
+ PKL_AST_FORMAT_PREFIX (format) = strndup (fmt, p - fmt);
+ if (!PKL_AST_FORMAT_PREFIX (format))
+ PKL_ICE (PKL_AST_LOC (format), _("out of memory"));
}
/* Process the format string. */
@@ -696,8 +694,9 @@ PKL_PHASE_BEGIN_HANDLER (pkl_trans1_ps_print_stmt)
assert (*p == '%');
if (ntag >= nargs && p[1] != '>' && p[1] != '<')
{
- PKL_ERROR (PKL_AST_LOC (print_stmt),
- "not enough arguments in printf");
+ PKL_ERROR (PKL_AST_LOC (format),
+ "not enough arguments in %s",
+ PKL_AST_FORMAT_NODE_NAME (format));
PKL_TRANS_PAYLOAD->errors++;
PKL_PASS_ERROR;
}
@@ -733,44 +732,44 @@ PKL_PHASE_BEGIN_HANDLER (pkl_trans1_ps_print_stmt)
{
case 'v':
p += 2;
- PKL_AST_PRINT_STMT_ARG_BASE (arg) = 0; /* Arbitrary. */
+ PKL_AST_FORMAT_ARG_BASE (arg) = 0; /* Arbitrary. */
atype = pkl_ast_make_any_type (PKL_PASS_AST);
- PKL_AST_PRINT_STMT_ARG_VALUE_P (arg) = 1;
- PKL_AST_PRINT_STMT_ARG_PRINT_DEPTH (arg)
+ PKL_AST_FORMAT_ARG_VALUE_P (arg) = 1;
+ PKL_AST_FORMAT_ARG_FORMAT_DEPTH (arg)
= (prefix == -1 ? 0 : prefix);
switch (flag)
{
case 'T':
- PKL_AST_PRINT_STMT_ARG_PRINT_MODE (arg)
- = PKL_AST_PRINT_MODE_TREE;
+ PKL_AST_FORMAT_ARG_FORMAT_MODE (arg)
+ = PKL_AST_FORMAT_MODE_TREE;
break;
case 'F':
/* Fallthrough. */
case 0:
- PKL_AST_PRINT_STMT_ARG_PRINT_MODE (arg)
- = PKL_AST_PRINT_MODE_FLAT;
+ PKL_AST_FORMAT_ARG_FORMAT_MODE (arg)
+ = PKL_AST_FORMAT_MODE_FLAT;
break;
default:
msg = _("invalid flag");
goto invalid_tag;
}
- PKL_AST_LOC (atype) = PKL_AST_LOC (print_fmt);
+ PKL_AST_LOC (atype) = PKL_AST_LOC (format_fmt);
types = pkl_ast_chainon (types, atype);
ntag++;
break;
case 's':
p += 2;
- PKL_AST_PRINT_STMT_ARG_BASE (arg) = 10; /* Arbitrary. */
+ PKL_AST_FORMAT_ARG_BASE (arg) = 10; /* Arbitrary. */
atype = pkl_ast_make_string_type (PKL_PASS_AST);
- PKL_AST_LOC (atype) = PKL_AST_LOC (print_fmt);
+ PKL_AST_LOC (atype) = PKL_AST_LOC (format_fmt);
types = pkl_ast_chainon (types, atype);
ntag++;
break;
case 'c':
p += 2;
- PKL_AST_PRINT_STMT_ARG_BASE (arg) = 256; /* Arbitrary */
+ PKL_AST_FORMAT_ARG_BASE (arg) = 256; /* Arbitrary */
atype = pkl_ast_make_integral_type (PKL_PASS_AST, 8, 0);
- PKL_AST_LOC (atype) = PKL_AST_LOC (print_fmt);
+ PKL_AST_LOC (atype) = PKL_AST_LOC (format_fmt);
types = pkl_ast_chainon (types, atype);
ntag++;
break;
@@ -802,12 +801,12 @@ PKL_PHASE_BEGIN_HANDLER (pkl_trans1_ps_print_stmt)
switch (p[base_idx])
{
- case 'b': PKL_AST_PRINT_STMT_ARG_BASE (arg) = 2; break;
- case 'o': PKL_AST_PRINT_STMT_ARG_BASE (arg) = 8; break;
- case 'd': PKL_AST_PRINT_STMT_ARG_BASE (arg) = 10; break;
- case 'x': PKL_AST_PRINT_STMT_ARG_BASE (arg) = 16; break;
+ case 'b': PKL_AST_FORMAT_ARG_BASE (arg) = 2; break;
+ case 'o': PKL_AST_FORMAT_ARG_BASE (arg) = 8; break;
+ case 'd': PKL_AST_FORMAT_ARG_BASE (arg) = 10; break;
+ case 'x': PKL_AST_FORMAT_ARG_BASE (arg) = 16; break;
case 'c':
- PKL_AST_PRINT_STMT_ARG_BASE (arg) = 256;
+ PKL_AST_FORMAT_ARG_BASE (arg) = 256;
if (bits != 8)
{
msg = _("char format only makes sense with 8 bits");
@@ -819,9 +818,14 @@ PKL_PHASE_BEGIN_HANDLER (pkl_trans1_ps_print_stmt)
goto invalid_tag;
}
+ if (bits == 0)
+ {
+ msg = _("invalid bit-width");
+ goto invalid_tag;
+ }
atype = pkl_ast_make_integral_type (PKL_PASS_AST,
bits, p[1] == 'i');
- PKL_AST_LOC (atype) = PKL_AST_LOC (print_fmt);
+ PKL_AST_LOC (atype) = PKL_AST_LOC (format_fmt);
types = pkl_ast_chainon (types, atype);
if (base_idx == 4)
@@ -897,22 +901,22 @@ PKL_PHASE_BEGIN_HANDLER (pkl_trans1_ps_print_stmt)
/* Create the new arg and add it to the list of
arguments. */
- new_arg = pkl_ast_make_print_stmt_arg (PKL_PASS_AST,
+ new_arg = pkl_ast_make_format_arg (PKL_PASS_AST,
NULL);
- PKL_AST_LOC (new_arg) = PKL_AST_LOC (print_fmt);
+ PKL_AST_LOC (new_arg) = PKL_AST_LOC (format_fmt);
if (end_sc)
- PKL_AST_PRINT_STMT_ARG_END_SC (new_arg) = xstrdup (class);
+ PKL_AST_FORMAT_ARG_END_SC (new_arg) = xstrdup (class);
else
- PKL_AST_PRINT_STMT_ARG_BEGIN_SC (new_arg) = class;
+ PKL_AST_FORMAT_ARG_BEGIN_SC (new_arg) = class;
if (arg)
{
- if (arg == PKL_AST_PRINT_STMT_ARGS (print_stmt))
+ if (arg == PKL_AST_FORMAT_ARGS (format))
{
/* Prepend. */
PKL_AST_CHAIN (new_arg) = arg;
- PKL_AST_PRINT_STMT_ARGS (print_stmt)
+ PKL_AST_FORMAT_ARGS (format)
= ASTREF (new_arg);
}
else
@@ -925,12 +929,12 @@ PKL_PHASE_BEGIN_HANDLER (pkl_trans1_ps_print_stmt)
else
{
/* Append. */
- if (!PKL_AST_PRINT_STMT_ARGS (print_stmt))
- PKL_AST_PRINT_STMT_ARGS (print_stmt)
+ if (!PKL_AST_FORMAT_ARGS (format))
+ PKL_AST_FORMAT_ARGS (format)
= ASTREF (new_arg);
else
- PKL_AST_PRINT_STMT_ARGS (print_stmt)
- = pkl_ast_chainon (PKL_AST_PRINT_STMT_ARGS (print_stmt),
+ PKL_AST_FORMAT_ARGS (format)
+ = pkl_ast_chainon (PKL_AST_FORMAT_ARGS (format),
new_arg);
}
@@ -939,7 +943,7 @@ PKL_PHASE_BEGIN_HANDLER (pkl_trans1_ps_print_stmt)
/* The type corresponding to a styling class format
directive is `void'. */
atype = pkl_ast_make_void_type (PKL_PASS_AST);
- PKL_AST_LOC (atype) = PKL_AST_LOC (print_fmt);
+ PKL_AST_LOC (atype) = PKL_AST_LOC (format_fmt);
types = pkl_ast_chainon (types, atype);
break;
@@ -953,9 +957,9 @@ PKL_PHASE_BEGIN_HANDLER (pkl_trans1_ps_print_stmt)
if (*p != '\0' && *p != '%')
{
char *end = strchrnul (p, '%');
- PKL_AST_PRINT_STMT_ARG_SUFFIX (arg) = strndup (p, end - p);
- if (!PKL_AST_PRINT_STMT_ARG_SUFFIX (arg))
- PKL_ICE (PKL_AST_LOC (print_stmt), _("out of memory"));
+ PKL_AST_FORMAT_ARG_SUFFIX (arg) = strndup (p, end - p);
+ if (!PKL_AST_FORMAT_ARG_SUFFIX (arg))
+ PKL_ICE (PKL_AST_LOC (format), _("out of memory"));
p = end;
}
}
@@ -969,19 +973,20 @@ PKL_PHASE_BEGIN_HANDLER (pkl_trans1_ps_print_stmt)
if (nargs > ntag)
{
- PKL_ERROR (PKL_AST_LOC (print_stmt),
- "too many arguments in printf");
+ PKL_ERROR (PKL_AST_LOC (format),
+ "too many arguments in %s",
+ PKL_AST_FORMAT_NODE_NAME (format));
PKL_TRANS_PAYLOAD->errors++;
PKL_PASS_ERROR;
}
- PKL_AST_PRINT_STMT_TYPES (print_stmt) = ASTREF (types);
+ PKL_AST_FORMAT_TYPES (format) = ASTREF (types);
- PKL_AST_PRINT_STMT_FMT_PROCESSED_P (print_stmt) = 1;
+ PKL_AST_FORMAT_FMT_PROCESSED_P (format) = 1;
PKL_PASS_DONE;
invalid_tag:
- PKL_ERROR (PKL_AST_LOC (print_fmt),
+ PKL_ERROR (PKL_AST_LOC (format_fmt),
"invalid %%- tag in format string: %s", msg);
PKL_TRANS_PAYLOAD->errors++;
PKL_PASS_ERROR;
@@ -1163,7 +1168,7 @@ struct pkl_phase pkl_phase_trans1 =
PKL_PHASE_PS_HANDLER (PKL_AST_VAR, pkl_trans1_ps_var),
PKL_PHASE_PS_HANDLER (PKL_AST_FUNC, pkl_trans1_ps_func),
PKL_PHASE_PS_HANDLER (PKL_AST_TRIMMER, pkl_trans1_ps_trimmer),
- PKL_PHASE_PS_HANDLER (PKL_AST_PRINT_STMT, pkl_trans1_ps_print_stmt),
+ PKL_PHASE_PS_HANDLER (PKL_AST_FORMAT, pkl_trans1_ps_format),
PKL_PHASE_PR_HANDLER (PKL_AST_DECL, pkl_trans1_pr_decl),
PKL_PHASE_PS_HANDLER (PKL_AST_DECL, pkl_trans1_ps_decl),
PKL_PHASE_PS_HANDLER (PKL_AST_ARRAY, pkl_trans1_ps_array),
diff --git a/libpoke/pkl-typify.c b/libpoke/pkl-typify.c
index 13f530b6..4f5fd034 100644
--- a/libpoke/pkl-typify.c
+++ b/libpoke/pkl-typify.c
@@ -2240,70 +2240,79 @@ PKL_PHASE_BEGIN_HANDLER
(pkl_typify1_ps_loop_stmt_iterator)
}
PKL_PHASE_END_HANDLER
-/* Type-check `print' and `printf' statements. */
+/* Type-check `format'. */
-PKL_PHASE_BEGIN_HANDLER (pkl_typify1_ps_print_stmt)
+PKL_PHASE_BEGIN_HANDLER (pkl_typify1_ps_format)
{
- pkl_ast_node print_stmt = PKL_PASS_NODE;
- pkl_ast_node print_stmt_args = PKL_AST_PRINT_STMT_ARGS (print_stmt);
- pkl_ast_node print_stmt_types = PKL_AST_PRINT_STMT_TYPES (print_stmt);
- pkl_ast_node print_stmt_fmt = PKL_AST_PRINT_STMT_FMT (print_stmt);
+ pkl_ast_node format = PKL_PASS_NODE;
+ pkl_ast_node format_args = PKL_AST_FORMAT_ARGS (format);
+ pkl_ast_node format_types = PKL_AST_FORMAT_TYPES (format);
+ pkl_ast_node format_fmt = PKL_AST_FORMAT_FMT (format);
+ pkl_ast_node type;
+ pkl_ast_node arg;
- if (print_stmt_fmt)
- {
- /* This is a printf. Make sure the type of the ARGS match the
- types in TYPES. */
+ assert (format_fmt);
- pkl_ast_node type;
- pkl_ast_node arg;
+ /* Make sure the type of the ARGS match the types in TYPES. */
- for (arg = print_stmt_args, type = print_stmt_types;
- arg && type;
- arg = PKL_AST_CHAIN (arg),
- type = PKL_AST_CHAIN (type))
- {
- pkl_ast_node arg_exp = PKL_AST_PRINT_STMT_ARG_EXP (arg);
+ for (arg = format_args, type = format_types;
+ arg && type;
+ arg = PKL_AST_CHAIN (arg),
+ type = PKL_AST_CHAIN (type))
+ {
+ pkl_ast_node arg_exp = PKL_AST_FORMAT_ARG_EXP (arg);
- /* Skip arguments without associated values. */
- if (arg_exp)
- {
- pkl_ast_node arg_type = PKL_AST_TYPE (arg_exp);
+ /* Skip arguments without associated values. */
+ if (!arg_exp)
+ continue;
- if (PKL_AST_TYPE_CODE (arg_type) == PKL_TYPE_ANY)
- {
- PKL_ERROR (PKL_AST_LOC (arg),
- "invalid printf argument of type `any'");
- PKL_TYPIFY_PAYLOAD->errors++;
- PKL_PASS_ERROR;
- }
+ pkl_ast_node arg_type = PKL_AST_TYPE (arg_exp);
- if (!pkl_ast_type_promoteable_p (arg_type, type, 0))
- {
- char *found_type = pkl_type_str (arg_type, 1);
- char *expected_type = pkl_type_str (type, 1);
+ if (PKL_AST_TYPE_CODE (arg_type) == PKL_TYPE_ANY)
+ {
+ PKL_ERROR (PKL_AST_LOC (arg),
+ "invalid %s argument of type `any'",
+ PKL_AST_FORMAT_NODE_NAME (format));
+ PKL_TYPIFY_PAYLOAD->errors++;
+ PKL_PASS_ERROR;
+ }
- PKL_ERROR (PKL_AST_LOC (arg),
- "printf argument is of an invalid type\n\
+ if (!pkl_ast_type_promoteable_p (arg_type, type, 0))
+ {
+ char *found_type = pkl_type_str (arg_type, 1);
+ char *expected_type = pkl_type_str (type, 1);
+
+ PKL_ERROR (PKL_AST_LOC (arg),
+ "%s argument is of an invalid type\n\
expected %s, got %s",
- expected_type, found_type);
- free (found_type);
- free (expected_type);
- PKL_TYPIFY_PAYLOAD->errors++;
- PKL_PASS_ERROR;
- }
- }
+ PKL_AST_FORMAT_NODE_NAME (format),
+ expected_type, found_type);
+ free (found_type);
+ free (expected_type);
+ PKL_TYPIFY_PAYLOAD->errors++;
+ PKL_PASS_ERROR;
}
}
- else
+}
+PKL_PHASE_END_HANDLER
+
+/* Type-check `print' statement. */
+
+PKL_PHASE_BEGIN_HANDLER (pkl_typify1_ps_print_stmt)
+{
+ pkl_ast_node print_stmt = PKL_PASS_NODE;
+ pkl_ast_node print_stmt_sexp = PKL_AST_PRINT_STMT_STR_EXP (print_stmt);
+
+ if (print_stmt_sexp)
{
- /* This is a print. The type of the single element in ARGS
+ /* This is a `print'. The type of the single element in STR_EXP
should be a string. */
- pkl_ast_node arg_type = PKL_AST_TYPE (print_stmt_args);
+ pkl_ast_node sexp_type = PKL_AST_TYPE (print_stmt_sexp);
- if (PKL_AST_TYPE_CODE (arg_type) != PKL_TYPE_STRING)
+ if (PKL_AST_TYPE_CODE (sexp_type) != PKL_TYPE_STRING)
{
- PKL_ERROR (PKL_AST_LOC (arg_type),
+ PKL_ERROR (PKL_AST_LOC (sexp_type),
"expected a string");
PKL_TYPIFY_PAYLOAD->errors++;
PKL_PASS_ERROR;
@@ -2901,6 +2910,7 @@ struct pkl_phase pkl_phase_typify1 =
PKL_PHASE_PS_HANDLER (PKL_AST_STRUCT_REF, pkl_typify1_ps_struct_ref),
PKL_PHASE_PS_HANDLER (PKL_AST_LOOP_STMT, pkl_typify1_ps_loop_stmt),
PKL_PHASE_PS_HANDLER (PKL_AST_LOOP_STMT_ITERATOR,
pkl_typify1_ps_loop_stmt_iterator),
+ PKL_PHASE_PS_HANDLER (PKL_AST_FORMAT, pkl_typify1_ps_format),
PKL_PHASE_PS_HANDLER (PKL_AST_PRINT_STMT, pkl_typify1_ps_print_stmt),
PKL_PHASE_PS_HANDLER (PKL_AST_RAISE_STMT, pkl_typify1_ps_raise_stmt),
PKL_PHASE_PS_HANDLER (PKL_AST_TRY_CATCH_STMT,
pkl_typify1_ps_try_catch_stmt),
diff --git a/libpoke/pvm.jitter b/libpoke/pvm.jitter
index c111d1f3..722104e5 100644
--- a/libpoke/pvm.jitter
+++ b/libpoke/pvm.jitter
@@ -67,6 +67,7 @@ end
wrapped-functions
printf
+ snprintf
pvm_array_insert
pvm_array_set
pvm_assert
@@ -705,6 +706,130 @@ late-header-c
JITTER_DROP_STACK (); \
} while (0)
+/* Macros to implement formati* and formatl* instructions. */
+
+#define PVM_FORMATI(OUT,OUTLEN,TYPE,TYPEC,SIGNED_P,BASE) \
+ do \
+ { \
+ TYPEC val = PVM_VAL_##TYPE (JITTER_UNDER_TOP_STACK ()); \
+ char fmt[16]; /* %0NNd */ \
+ char *iformat = ""; \
+ int n; \
+ uint32_t mask \
+ = JITTER_ARGN0 == 32 ? (uint32_t)-1 \
+ : (((uint32_t)1 << JITTER_ARGN0) - 1); \
+ \
+ fmt[0] = '%'; \
+ fmt[1] = '0'; \
+ fmt[2] = '\0'; \
+ if ((BASE) == 10) \
+ { \
+ iformat = SIGNED_P ? PRIi32 : PRIu32; \
+ strcat (fmt, iformat); \
+ } \
+ else \
+ { \
+ char *basefmt = ""; \
+ int prec = 0; \
+ \
+ if ((BASE) == 256) \
+ { \
+ iformat = "c"; \
+ prec = 1; \
+ } \
+ else if ((BASE) == 16) \
+ { \
+ iformat = PRIx32; \
+ prec = (JITTER_ARGN0 / 4) + ((JITTER_ARGN0 % 4) != 0); \
+ } \
+ else if ((BASE) == 8) \
+ { \
+ basefmt = PRIo32; \
+ prec = (JITTER_ARGN0 / 3) + ((JITTER_ARGN0 % 3) != 0); \
+ } \
+ else if ((BASE) == 2) \
+ { \
+ n = pk_format_binary ((OUT), (OUTLEN), val, JITTER_ARGN0, SIGNED_P);\
+ assert (n == 0); \
+ JITTER_DROP_STACK (); \
+ JITTER_DROP_STACK (); \
+ JITTER_PUSH_STACK (pvm_make_string ((OUT))); \
+ break; \
+ } \
+ \
+ assert (prec != 0); \
+ fmt[2] = '0' + (prec / 10); \
+ fmt[3] = '0' + prec - (prec / 10 * 10); \
+ fmt[4] = '\0'; \
+ strcat (fmt, iformat); \
+ strcat (fmt, basefmt); \
+ } \
+ \
+ n = snprintf ((OUT), (OUTLEN), fmt, (BASE) == 10 ? val : val & mask); \
+ assert (n < (OUTLEN)); \
+ JITTER_DROP_STACK (); \
+ JITTER_DROP_STACK (); \
+ JITTER_PUSH_STACK (pvm_make_string ((OUT))); \
+ } while (0)
+
+#define PVM_FORMATL(OUT,OUTLEN,TYPE,TYPEC,SIGNED_P,BASE) \
+ do \
+ { \
+ TYPEC val = PVM_VAL_##TYPE (JITTER_UNDER_TOP_STACK ()); \
+ char fmt[16]; /* %0NNfff */ \
+ char *iformat = ""; \
+ int n; \
+ uint64_t mask \
+ = JITTER_ARGN0 == 64 ? (uint64_t)-1 \
+ : (((uint64_t)1 << JITTER_ARGN0) - 1); \
+ \
+ fmt[0] = '%'; \
+ fmt[1] = '0'; \
+ fmt[2] = '\0'; \
+ if ((BASE) == 10) \
+ { \
+ iformat = SIGNED_P ? PRIi64 : PRIu64; \
+ strcat (fmt, iformat); \
+ } \
+ else \
+ { \
+ char *basefmt = ""; \
+ int prec = 0; \
+ \
+ if ((BASE) == 16) \
+ { \
+ iformat = PRIx64; \
+ prec = (JITTER_ARGN0 / 4) + ((JITTER_ARGN0 % 4) != 0); \
+ } \
+ else if ((BASE) == 8) \
+ { \
+ basefmt = PRIo64; \
+ prec = (JITTER_ARGN0 / 3) + ((JITTER_ARGN0 % 3) != 0); \
+ } \
+ else if ((BASE) == 2) \
+ { \
+ n = pk_format_binary ((OUT), (OUTLEN), val, JITTER_ARGN0, SIGNED_P);\
+ assert (n == 0); \
+ JITTER_DROP_STACK (); \
+ JITTER_DROP_STACK (); \
+ JITTER_PUSH_STACK (pvm_make_string ((OUT))); \
+ break; \
+ } \
+ \
+ fmt[2] = '0' + (prec / 10); \
+ fmt[3] = '0' + prec - (prec / 10 * 10); \
+ fmt[4] = '\0'; \
+ strcat (fmt, iformat); \
+ strcat (fmt, basefmt); \
+ } \
+ \
+ n = snprintf ((OUT), (OUTLEN), fmt, (BASE) == 10 ? val : val & mask); \
+ assert (n < (OUTLEN)); \
+ JITTER_DROP_STACK (); \
+ JITTER_DROP_STACK (); \
+ JITTER_PUSH_STACK (pvm_make_string ((OUT))); \
+ } while (0)
+
end
end
@@ -1974,6 +2099,81 @@ instruction endsc ()
end
end
+
+## Format Instructions
+
+# In the following instructions the meaning of the argument BASE is
+# the following:
+#
+# 2 - format the number in binary.
+# 8 - format the number in octal.
+# 16 - format the number in hexadecimal.
+# Any other value - format the number in decimal.
+
+# Instruction: formati BITS
+#
+# Given a signed integer and a numeration base in the stack, push the
+# string representation to the stack.
+#
+# Stack: ( INT INT -- STR )
+
+instruction formati (?n)
+ code
+ int base = PVM_VAL_INT (JITTER_TOP_STACK ());
+ char res[32 + 2 /* suffix */ + 1 /* nul */];
+
+ PVM_FORMATI (res, sizeof (res), INT, int32_t, 1 /* signed_p */, base);
+ end
+end
+
+# Instruction: formatiu BITS
+#
+# Given an unsigned integer and a numeration base in the stack, push the
+# string representation to the stack.
+#
+# Stack: ( UINT INT -- STR )
+
+instruction formatiu (?n)
+ code
+ int base = PVM_VAL_INT (JITTER_TOP_STACK ());
+ char res[32 + 2 /* suffix */ + 1 /* nul */];
+
+ PVM_FORMATI (res, sizeof (res), UINT, uint32_t, 0 /* signed_p */, base);
+ end
+end
+
+# Instruction: formatl BITS
+#
+# Given a long and a numeration base in the stack, push the string
+# representation to the stack.
+#
+# Stack: ( LONG INT -- STR )
+
+instruction formatl (?n)
+ code
+ int base = PVM_VAL_INT (JITTER_TOP_STACK ());
+ char res[64 + 2 /* suffix */ + 1 /* nul */];
+
+ PVM_FORMATL (res, sizeof (res), LONG, int64_t, 1 /* signed_p */, base);
+ end
+end
+
+# Instruction: formatlu BITS
+#
+# Given an unsigned long and a numeration base in the stack, push the
+# string representation to the stack.
+#
+# Stack: ( ULONG INT -- STR )
+
+instruction formatlu (?n)
+ code
+ int base = PVM_VAL_INT (JITTER_TOP_STACK ());
+ char res[64 + 2 /* suffix */ + 1 /* nul */];
+
+ PVM_FORMATL (res, sizeof (res), ULONG, uint64_t, 0 /* signed_p */, base);
+ end
+end
+
## Main stack manipulation instructions
@@ -6147,3 +6347,8 @@ rule rot-swap-to-quake rewrite
into
quake
end
+
+rule push-drop-to-nop rewrite
+ push $a; drop
+into
+end
diff --git a/testsuite/Makefile.am b/testsuite/Makefile.am
index a8e8c7ed..f2f4b3a9 100644
--- a/testsuite/Makefile.am
+++ b/testsuite/Makefile.am
@@ -1027,6 +1027,36 @@ EXTRA_DIST = \
poke.pkl/for-in-4.pk \
poke.pkl/for-in-5.pk \
poke.pkl/for-in-int-struct-1.pk \
+ poke.pkl/format-1.pk \
+ poke.pkl/format-2.pk \
+ poke.pkl/format-3.pk \
+ poke.pkl/format-4.pk \
+ poke.pkl/format-5.pk \
+ poke.pkl/format-6.pk \
+ poke.pkl/format-7.pk \
+ poke.pkl/format-8.pk \
+ poke.pkl/format-9.pk \
+ poke.pkl/format-10.pk \
+ poke.pkl/format-11.pk \
+ poke.pkl/format-12.pk \
+ poke.pkl/format-13.pk \
+ poke.pkl/format-14.pk \
+ poke.pkl/format-15.pk \
+ poke.pkl/format-16.pk \
+ poke.pkl/format-17.pk \
+ poke.pkl/format-18.pk \
+ poke.pkl/format-19.pk \
+ poke.pkl/format-20.pk \
+ poke.pkl/format-21.pk \
+ poke.pkl/format-22.pk \
+ poke.pkl/format-23.pk \
+ poke.pkl/format-24.pk \
+ poke.pkl/format-25.pk \
+ poke.pkl/format-26.pk \
+ poke.pkl/format-27.pk \
+ poke.pkl/format-28.pk \
+ poke.pkl/format-29.pk \
+ poke.pkl/format-diag-1.pk \
poke.pkl/formfeedchar.pk \
poke.pkl/fun-types-1.pk \
poke.pkl/fun-types-2.pk \
@@ -1579,6 +1609,8 @@ EXTRA_DIST = \
poke.pkl/redef-1.pk \
poke.pkl/redef-2.pk \
poke.pkl/redef-3.pk \
+ poke.pkl/reduce-array-1.pk \
+ poke.pkl/reduce-array-2.pk \
poke.pkl/return-1.pk \
poke.pkl/return-2.pk \
poke.pkl/return-diag-1.pk \
diff --git a/testsuite/poke.pkl/format-1.pk b/testsuite/poke.pkl/format-1.pk
new file mode 100644
index 00000000..331985f1
--- /dev/null
+++ b/testsuite/poke.pkl/format-1.pk
@@ -0,0 +1,21 @@
+/* { dg-do run } */
+
+var eq = [
+ format("") == "",
+ format("%i1b", 0) == "0",
+ format("%i8b", 1) == "00000001B",
+ format("%i8b", -1) == "11111111B",
+ format("%u8b", 1) == "00000001UB",
+ format("%u8b", -1) == "11111111UB",
+ format("%i13b", -1 as uint<64>) == "1" * 13,
+ format("%i16b", -1) == "1" * 16 + "H",
+ format("%i16b", 0xa5) == "0" * 8 + "10100101H",
+ format("%i16b", 0xa5) == "0" * 8 + "10100101H",
+ format("%u16b", 0xa5) == "0" * 8 + "10100101UH",
+ format("%i32b", 0xdeadbeaf) == "11011110101011011011111010101111",
+ format("%u32b", 0xdeadbeaf) == "11011110101011011011111010101111",
+ format("%u63b", -1 as uint<64>) == "1" * 63,
+ format("%u64b", -1 as uint<64>) == "1" * 64 + "UL",
+];
+
+for (i in eq) printf ("%i32d", i); /* { dg-output "111111111111111" } */
diff --git a/testsuite/poke.pkl/format-10.pk b/testsuite/poke.pkl/format-10.pk
new file mode 100644
index 00000000..e45b9a15
--- /dev/null
+++ b/testsuite/poke.pkl/format-10.pk
@@ -0,0 +1,7 @@
+/* { dg-do run } */
+
+/* { dg-command {vm_set_obase (16)} } */
+/* { dg-command {format("%v", 1UB)} } */
+/* { dg-output {"0x01UB"\n} } */
+/* { dg-command {format("%v", 1B)} } */
+/* { dg-output {"0x01B"\n} } */
diff --git a/testsuite/poke.pkl/format-11.pk b/testsuite/poke.pkl/format-11.pk
new file mode 100644
index 00000000..cbd37163
--- /dev/null
+++ b/testsuite/poke.pkl/format-11.pk
@@ -0,0 +1,7 @@
+/* { dg-do run } */
+
+/* { dg-command {vm_set_obase (16)} } */
+/* { dg-command {format("%v", 1UH)} } */
+/* { dg-output {"0x0001UH"\n} } */
+/* { dg-command {format("%v", 1H)} } */
+/* { dg-output {"0x0001H"\n} } */
diff --git a/testsuite/poke.pkl/format-12.pk b/testsuite/poke.pkl/format-12.pk
new file mode 100644
index 00000000..41cba39d
--- /dev/null
+++ b/testsuite/poke.pkl/format-12.pk
@@ -0,0 +1,7 @@
+/* { dg-do run } */
+
+/* { dg-command {vm_set_obase (16)} } */
+/* { dg-command {format("%v", 1UL)} } */
+/* { dg-output {"0x0000000000000001UL"\n} } */
+/* { dg-command {format("%v", 1L)} } */
+/* { dg-output {"0x0000000000000001L"\n} } */
diff --git a/testsuite/poke.pkl/format-13.pk b/testsuite/poke.pkl/format-13.pk
new file mode 100644
index 00000000..f4a19f8e
--- /dev/null
+++ b/testsuite/poke.pkl/format-13.pk
@@ -0,0 +1,4 @@
+/* { dg-do run } */
+
+/* { dg-command {format("%v", "Hello")} } */
+/* { dg-output {"\\"Hello\\""} } */
diff --git a/testsuite/poke.pkl/format-14.pk b/testsuite/poke.pkl/format-14.pk
new file mode 100644
index 00000000..911dbe81
--- /dev/null
+++ b/testsuite/poke.pkl/format-14.pk
@@ -0,0 +1,4 @@
+/* { dg-do run } */
+
+/* { dg-command {format("%v", "A\x01B")} } */
+/* { dg-output {"\\"A\\\\x01B\\""} } */
diff --git a/testsuite/poke.pkl/format-15.pk b/testsuite/poke.pkl/format-15.pk
new file mode 100644
index 00000000..e0544e15
--- /dev/null
+++ b/testsuite/poke.pkl/format-15.pk
@@ -0,0 +1,4 @@
+/* { dg-do run } */
+
+/* { dg-command {format("%v", int[]())} } */
+/* { dg-output {"\[]"} } */
diff --git a/testsuite/poke.pkl/format-16.pk b/testsuite/poke.pkl/format-16.pk
new file mode 100644
index 00000000..00c8459d
--- /dev/null
+++ b/testsuite/poke.pkl/format-16.pk
@@ -0,0 +1,7 @@
+/* { dg-do run } */
+
+/* { dg-command {vm_set_obase (10)} } */
+/* { dg-command {format("%v", [1,2,3])} } */
+/* { dg-output {"\[1,2,3]"\n} } */
+/* { dg-command {format("%v", [1UB,2UB,3UB])} } */
+/* { dg-output {"\[1UB,2UB,3UB]"\n} } */
diff --git a/testsuite/poke.pkl/format-17.pk b/testsuite/poke.pkl/format-17.pk
new file mode 100644
index 00000000..f4178e02
--- /dev/null
+++ b/testsuite/poke.pkl/format-17.pk
@@ -0,0 +1,7 @@
+/* { dg-do run } */
+
+/* { dg-command {vm_set_obase (16)} } */
+/* { dg-command {format("%v", [1,2,3])} } */
+/* { dg-output {"\[0x00000001,0x00000002,0x00000003]"\n} } */
+/* { dg-command {format("%v", [1UB,2UB,3UB])} } */
+/* { dg-output {"\[0x01UB,0x02UB,0x03UB]"\n} } */
diff --git a/testsuite/poke.pkl/format-18.pk b/testsuite/poke.pkl/format-18.pk
new file mode 100644
index 00000000..54116ddb
--- /dev/null
+++ b/testsuite/poke.pkl/format-18.pk
@@ -0,0 +1,4 @@
+/* { dg-do run } */
+
+/* { dg-command {format("%v", ["GNU", "poke"])} } */
+/* { dg-output {"\[\\"GNU\\",\\"poke\\"]"} } */
diff --git a/testsuite/poke.pkl/format-19.pk b/testsuite/poke.pkl/format-19.pk
new file mode 100644
index 00000000..95c72b04
--- /dev/null
+++ b/testsuite/poke.pkl/format-19.pk
@@ -0,0 +1,5 @@
+/* { dg-do run } */
+
+/* { dg-command {vm_set_oacutoff (4)} } */
+/* { dg-command {format("%v", ["GNU", "poke", "by", "Jose", "Marchesi"])} } */
+/* { dg-output {"\[\\"GNU\\",\\"poke\\",\\"by\\",\\"Jose\\"...]"} } */
diff --git a/testsuite/poke.pkl/format-2.pk b/testsuite/poke.pkl/format-2.pk
new file mode 100644
index 00000000..3ec3c764
--- /dev/null
+++ b/testsuite/poke.pkl/format-2.pk
@@ -0,0 +1,20 @@
+/* { dg-do run } */
+
+var eq = [
+ format("%i1o", 0) == "0",
+ format("%i8o", 0) == "000",
+ format("%i8o", 1) == "001",
+ format("%i8o", -1) == "377",
+ format("%u8o", 1) == "001",
+ format("%u8o", -1) == "377",
+ format("%i13o", -1) == "1" + "7" * 4,
+ format("%i16o", -1) == "1" + "7" * 5,
+ format("%i16o", 0xa5) == "000245",
+ format("%u16o", 0xa5) == "000245",
+ format("%i32o", 0xdeadbeef) == "33653337357",
+ format("%u32o", 0xdeadbeef) == "33653337357",
+ format("%u63o", -1 as uint<64>) == "7" * 21,
+ format("%u64o", -1 as uint<64>) == "1" + "7" * 21,
+];
+
+for (i in eq) printf ("%i32d", i); /* { dg-output "11111111111111" } */
diff --git a/testsuite/poke.pkl/format-20.pk b/testsuite/poke.pkl/format-20.pk
new file mode 100644
index 00000000..debf9214
--- /dev/null
+++ b/testsuite/poke.pkl/format-20.pk
@@ -0,0 +1,7 @@
+/* { dg-do run } */
+
+/* { dg-command {vm_set_obase (10)} } */
+/* { dg-command {vm_set_omaps (1)} } */
+/* { dg-command {vm_set_oacutoff (3)} } */
+/* { dg-command {format("%v", ["GNU", "poke", "by", "Jose", "Marchesi"])} } */
+/* { dg-output {"\[\\"GNU\\" @ 0x0000000000000000#b,\\"poke\\" @
0x0000000000000020#b,\\"by\\" @ 0x0000000000000048#b...] @
0x0000000000000000#b"} } */
diff --git a/testsuite/poke.pkl/format-21.pk b/testsuite/poke.pkl/format-21.pk
new file mode 100644
index 00000000..7717ffd5
--- /dev/null
+++ b/testsuite/poke.pkl/format-21.pk
@@ -0,0 +1,5 @@
+/* { dg-do run } */
+
+/* { dg-command {vm_set_obase (10)} } */
+/* { dg-command {format("%v", E_generic)} } */
+/* { dg-output {"Exception {code=0,msg=\\"generic\\",exit_status=1}"} } */
diff --git a/testsuite/poke.pkl/format-22.pk b/testsuite/poke.pkl/format-22.pk
new file mode 100644
index 00000000..cfd3f371
--- /dev/null
+++ b/testsuite/poke.pkl/format-22.pk
@@ -0,0 +1,5 @@
+/* { dg-do run } */
+
+/* { dg-command {vm_set_obase (10)} } */
+/* { dg-command {format("%Fv", E_generic)} } */
+/* { dg-output {"Exception {code=0,msg=\\"generic\\",exit_status=1}"} } */
diff --git a/testsuite/poke.pkl/format-23.pk b/testsuite/poke.pkl/format-23.pk
new file mode 100644
index 00000000..90f05bff
--- /dev/null
+++ b/testsuite/poke.pkl/format-23.pk
@@ -0,0 +1,5 @@
+/* { dg-do run } */
+
+/* { dg-command {vm_set_obase (10)} } */
+/* { dg-command {format("%Tv", E_generic)} } */
+/* { dg-output {"Exception {\\n code=0,\\n msg=\\"generic\\",\\n
exit_status=1\\n}"} } */
diff --git a/testsuite/poke.pkl/format-24.pk b/testsuite/poke.pkl/format-24.pk
new file mode 100644
index 00000000..f29672c0
--- /dev/null
+++ b/testsuite/poke.pkl/format-24.pk
@@ -0,0 +1,6 @@
+/* { dg-do run } */
+
+/* { dg-command {vm_set_obase (10)} } */
+/* { dg-command {vm_set_oindent (4)} } */
+/* { dg-command {format("%Tv", E_generic)} } */
+/* { dg-output {"Exception {\\n code=0,\\n msg=\\"generic\\",\\n
exit_status=1\\n}"} } */
diff --git a/testsuite/poke.pkl/format-25.pk b/testsuite/poke.pkl/format-25.pk
new file mode 100644
index 00000000..558cc487
--- /dev/null
+++ b/testsuite/poke.pkl/format-25.pk
@@ -0,0 +1,7 @@
+/* { dg-do run } */
+
+/* { dg-command {vm_set_obase (16)} } */
+/* { dg-command {vm_set_oindent (4)} } */
+/* { dg-command {vm_set_omode (VM_OMODE_TREE)} } */ /* No effect. */
+/* { dg-command {format("%v", E_generic)} } */
+/* { dg-output {"Exception
{code=0x00000000,msg=\\"generic\\",exit_status=0x00000001}"} } */
diff --git a/testsuite/poke.pkl/format-26.pk b/testsuite/poke.pkl/format-26.pk
new file mode 100644
index 00000000..7b9dab56
--- /dev/null
+++ b/testsuite/poke.pkl/format-26.pk
@@ -0,0 +1,11 @@
+/* { dg-do run } */
+
+type S = struct
+ {
+ Exception ex;
+ };
+
+/* { dg-command {vm_set_obase (10)} } */
+/* { dg-command {vm_set_odepth (1)} } */ /* No effect. */
+/* { dg-command {format("%v", S{})} } */
+/* { dg-output {"S {ex=Exception {code=0,msg=\\"\\",exit_status=0}}"} } */
diff --git a/testsuite/poke.pkl/format-27.pk b/testsuite/poke.pkl/format-27.pk
new file mode 100644
index 00000000..ca2b7089
--- /dev/null
+++ b/testsuite/poke.pkl/format-27.pk
@@ -0,0 +1,10 @@
+/* { dg-do run } */
+
+type S = struct
+ {
+ Exception ex;
+ };
+
+/* { dg-command {vm_set_obase (10)} } */
+/* { dg-command {format("%1v", S{})} } */
+/* { dg-output {"S {ex=Exception {...}}"} } */
diff --git a/testsuite/poke.pkl/format-28.pk b/testsuite/poke.pkl/format-28.pk
new file mode 100644
index 00000000..c997f938
--- /dev/null
+++ b/testsuite/poke.pkl/format-28.pk
@@ -0,0 +1,11 @@
+/* { dg-do run } */
+
+type S = struct
+ {
+ Exception ex;
+ };
+
+/* { dg-command {vm_set_obase (10)} } */
+/* { dg-command {vm_set_omaps (1)} } */
+/* { dg-command {format("%1v", S{})} } */
+/* { dg-output {S {ex=Exception {...} @ 0x0000000000000000#b @
0x0000000000000000#b} @ 0x0000000000000000#b} } */
diff --git a/testsuite/poke.pkl/format-29.pk b/testsuite/poke.pkl/format-29.pk
new file mode 100644
index 00000000..0dd27cee
--- /dev/null
+++ b/testsuite/poke.pkl/format-29.pk
@@ -0,0 +1,11 @@
+/* { dg-do run } */
+
+type S = struct
+ {
+ int<32>[] i;
+ };
+
+/* { dg-command {vm_set_obase (10)} } */
+/* { dg-command {var s = S{ i=[1,2,3]} } } */
+/* { dg-command {format("%v", s)} } */
+/* { dg-output {"S {i=\[1,2,3]}"} } */
diff --git a/testsuite/poke.pkl/format-3.pk b/testsuite/poke.pkl/format-3.pk
new file mode 100644
index 00000000..2587cb0d
--- /dev/null
+++ b/testsuite/poke.pkl/format-3.pk
@@ -0,0 +1,20 @@
+/* { dg-do run } */
+
+var eq = [
+ format("%i1d", 0) == "0",
+ format("%i8d", 0) == "0",
+ format("%i8d", 1) == "1",
+ format("%i8d", -1) == "-1",
+ format("%u8d", 1) == "1",
+ format("%u8d", -1) == "255",
+ format("%i13d", -1) == "-1",
+ format("%i16d", -1) == "-1",
+ format("%i16d", 0xa5) == "165",
+ format("%u16d", 0xa5) == "165",
+ format("%i32d", 0xdeadbeef) == "-559038737",
+ format("%u32d", 0xdeadbeef) == "3735928559",
+ format("%u63d", -1 as uint<64>) == "9223372036854775807",
+ format("%u64d", -1 as uint<64>) == "18446744073709551615",
+];
+
+for (i in eq) printf ("%i32d", i); /* { dg-output "11111111111111" } */
diff --git a/testsuite/poke.pkl/format-4.pk b/testsuite/poke.pkl/format-4.pk
new file mode 100644
index 00000000..c926402b
--- /dev/null
+++ b/testsuite/poke.pkl/format-4.pk
@@ -0,0 +1,20 @@
+/* { dg-do run } */
+
+var eq = [
+ format("%i1x", 0) == "0",
+ format("%i8x", 0) == "00",
+ format("%i8x", 1) == "01",
+ format("%i8x", -1) == "ff",
+ format("%u8x", 1) == "01",
+ format("%u8x", -1) == "ff",
+ format("%i13x", -1) == "1" + "f" * 3,
+ format("%i16x", -1) == "ffff",
+ format("%i16x", 0xa5) == "00a5",
+ format("%u16x", 0xa5) == "00a5",
+ format("%i32x", 0xdeadbeef) == "deadbeef",
+ format("%u32x", 0xdeadbeef) == "deadbeef",
+ format("%u63x", -1 as uint<64>) == "7" + "f" * 15,
+ format("%u64x", -1 as uint<64>) == "f" * 16,
+];
+
+for (i in eq) printf ("%i32d", i); /* { dg-output "11111111111111" } */
diff --git a/testsuite/poke.pkl/format-5.pk b/testsuite/poke.pkl/format-5.pk
new file mode 100644
index 00000000..08ce7fa1
--- /dev/null
+++ b/testsuite/poke.pkl/format-5.pk
@@ -0,0 +1,4 @@
+/* { dg-do run } */
+
+/* { dg-command {format("Hello")} } */
+/* { dg-output {"Hello"} } */
diff --git a/testsuite/poke.pkl/format-6.pk b/testsuite/poke.pkl/format-6.pk
new file mode 100644
index 00000000..c99d8009
--- /dev/null
+++ b/testsuite/poke.pkl/format-6.pk
@@ -0,0 +1,4 @@
+/* { dg-do run } */
+
+/* { dg-command {format("Hello, %s!", "World")} } */
+/* { dg-output {"Hello, World!"} } */
diff --git a/testsuite/poke.pkl/format-7.pk b/testsuite/poke.pkl/format-7.pk
new file mode 100644
index 00000000..14b6361b
--- /dev/null
+++ b/testsuite/poke.pkl/format-7.pk
@@ -0,0 +1,4 @@
+/* { dg-do run } */
+
+/* { dg-command {format("%s%s%s", "GNU", "", "poke")} } */
+/* { dg-output {"GNUpoke"} } */
diff --git a/testsuite/poke.pkl/format-8.pk b/testsuite/poke.pkl/format-8.pk
new file mode 100644
index 00000000..902a7980
--- /dev/null
+++ b/testsuite/poke.pkl/format-8.pk
@@ -0,0 +1,7 @@
+/* { dg-do run } */
+
+/* { dg-command {vm_set_obase (16)} } */
+/* { dg-command {format("%v", 1)} } */
+/* { dg-output {"0x00000001"\n} } */
+/* { dg-command {format("%v", 1U)} } */
+/* { dg-output {"0x00000001U"\n} } */
diff --git a/testsuite/poke.pkl/format-9.pk b/testsuite/poke.pkl/format-9.pk
new file mode 100644
index 00000000..2048bc27
--- /dev/null
+++ b/testsuite/poke.pkl/format-9.pk
@@ -0,0 +1,7 @@
+/* { dg-do run } */
+
+/* { dg-command {vm_set_obase (16)} } */
+/* { dg-command {format("%v", 1UN)} } */
+/* { dg-output {"0x1UN"\n} } */
+/* { dg-command {format("%v", 1N)} } */
+/* { dg-output {"0x1N"\n} } */
diff --git a/testsuite/poke.pkl/format-diag-1.pk
b/testsuite/poke.pkl/format-diag-1.pk
new file mode 100644
index 00000000..b1b84960
--- /dev/null
+++ b/testsuite/poke.pkl/format-diag-1.pk
@@ -0,0 +1,3 @@
+/* { dg-do compile } */
+
+format("%i0b", 0); /* { dg-error "invalid bit-width" } */
diff --git a/testsuite/poke.pkl/reduce-array-1.pk
b/testsuite/poke.pkl/reduce-array-1.pk
new file mode 100644
index 00000000..8f3b2e68
--- /dev/null
+++ b/testsuite/poke.pkl/reduce-array-1.pk
@@ -0,0 +1,7 @@
+/* {dg-run} */
+
+var a = ["Hello", ", ", "World", "!"];
+var s = _pkl_reduce_string_array (a, 0, a'length);
+
+/* { dg-command {s} } */
+/* { dg-output {"Hello, World!"} } */
diff --git a/testsuite/poke.pkl/reduce-array-2.pk
b/testsuite/poke.pkl/reduce-array-2.pk
new file mode 100644
index 00000000..76a8a947
--- /dev/null
+++ b/testsuite/poke.pkl/reduce-array-2.pk
@@ -0,0 +1,7 @@
+/* {dg-run} */
+
+var a = ["aaa", "bb", "c", "", "d"];
+var s = _pkl_reduce_string_array (a, 2, 3);
+
+/* { dg-command {s} } */
+/* { dg-output {"cd"} } */
--
2.31.1
[PATCH v2 2/3] pkl: Fix codegen of printf, Mohammad-Reza Nabipoor, 2021/06/07