Re: [PATCH] pkl: split iolist instruction into two instructions

[Jose E. Marchesi]

Hi Mohammad.

Thanks for the patch.
OK for master.

> 2022-10-26  Mohammad-Reza Nabipoor  <mnabipoor@gnu.org>
>
>       * libpoke/pkl-insn.def (iolist): Remove instruction.
>       (ionum): New instruction.
>       (ioref): Likewise.
>       * libpoke/pvm.jitter (iolist): Remove instruction.
>       (ionum): New instruction.
>       (ioref): Likewise.
>       (late-c): Add callback functions to traverse IO space.
>       * libpoke/pkl-rt.pk (iolist): Re-write in terms of new
>       instructions.
> ---
>  ChangeLog            | 12 +++++++
>  libpoke/pkl-insn.def |  3 +-
>  libpoke/pkl-rt.pk    |  7 +++-
>  libpoke/pvm.jitter   | 78 +++++++++++++++++++++++++++++++++-----------
>  4 files changed, 79 insertions(+), 21 deletions(-)
>
> diff --git a/ChangeLog b/ChangeLog
> index 63f63999..ced77d93 100644
> --- a/ChangeLog
> +++ b/ChangeLog
> @@ -1,3 +1,15 @@
> +2022-10-26  Mohammad-Reza Nabipoor  <mnabipoor@gnu.org>
> +
> +     * libpoke/pkl-insn.def (iolist): Remove instruction.
> +     (ionum): New instruction.
> +     (ioref): Likewise.
> +     * libpoke/pvm.jitter (iolist): Remove instruction.
> +     (ionum): New instruction.
> +     (ioref): Likewise.
> +     (late-c): Add callback functions to traverse IO space.
> +     * libpoke/pkl-rt.pk (iolist): Re-write in terms of new
> +     instructions.
> +
>  2022-10-26  Jose E. Marchesi  <jemarch@gnu.org>
>  
>       * etc/poke.rec (Introduce SELF in methods): Removed as DONE.
> diff --git a/libpoke/pkl-insn.def b/libpoke/pkl-insn.def
> index a0bd73a0..4deb8d68 100644
> --- a/libpoke/pkl-insn.def
> +++ b/libpoke/pkl-insn.def
> @@ -460,7 +460,8 @@ PKL_DEF_INSN(PKL_INSN_IOHANDLER,"","iohandler")
>  PKL_DEF_INSN(PKL_INSN_IOFLAGS,"","ioflags")
>  PKL_DEF_INSN(PKL_INSN_IOGETB,"","iogetb")
>  PKL_DEF_INSN(PKL_INSN_IOSETB,"","iosetb")
> -PKL_DEF_INSN(PKL_INSN_IOLIST,"","iolist")
> +PKL_DEF_INSN(PKL_INSN_IONUM,"","ionum")
> +PKL_DEF_INSN(PKL_INSN_IOREF,"","ioref")
>  
>  /* VM instructions.  */
>  
> diff --git a/libpoke/pkl-rt.pk b/libpoke/pkl-rt.pk
> index 963bd193..39a62df0 100644
> --- a/libpoke/pkl-rt.pk
> +++ b/libpoke/pkl-rt.pk
> @@ -71,7 +71,12 @@ immutable fun iobias = (int<32> ios = get_ios) 
> offset<uint<64>,1>:
>  
>  immutable fun iolist = int<32>[]:
>  {
> -  return asm int<32>[]: ("iolist");
> +  var a = int<32>[] (),
> +      n = asm uint<64>: ("ionum");
> +
> +  for (var i = 0UL; i < n; ++i)
> +    apush (a, asm int<32>: ("ioref; nip" : i));
> +  return a;
>  }
>  
>  immutable fun iosetbias = (offset<uint<64>,1> bias = 0#1, int<32> ios = 
> get_ios) void:
> diff --git a/libpoke/pvm.jitter b/libpoke/pvm.jitter
> index 8fe50780..9fa8854d 100644
> --- a/libpoke/pvm.jitter
> +++ b/libpoke/pvm.jitter
> @@ -917,19 +917,38 @@ late-c
>      };
>  #undef E
>  
> -    struct iolist_ctx
> +    struct ionum_ctx
>      {
> -      pvm_val arr_ios;
> +      uint64_t count;
>      };
>  
>      static void
> -    iolist_callback (ios io, void *data)
> +    ionum_callback (ios io, void *data)
>      {
> -      struct iolist_ctx *ctx = data;
> -      pvm_val arr = ctx->arr_ios;
> +      struct ionum_ctx *ctx = data;
>  
> -      (void) pvm_array_insert (arr, PVM_VAL_ARR_NELEM (arr),
> -                               PVM_MAKE_INT (ios_get_id (io), 32));
> +      ++ctx->count;
> +    }
> +
> +    struct ioref_ctx
> +    {
> +      uint64_t index;
> +      int ios_id;
> +    };
> +
> +    static void
> +    ioref_callback (ios io, void *data)
> +    {
> +      struct ioref_ctx *ctx = data;
> +
> +      if (ctx->ios_id != -1)
> +        return;
> +      if (ctx->index == 0)
> +        {
> +          ctx->ios_id = ios_get_id (io);
> +          return;
> +        }
> +      --ctx->index;
>      }
>  
>      static int
> @@ -1812,23 +1831,44 @@ instruction iosize ()
>    end
>  end
>  
> -# Instruction: iolist
> +# Instruction: ionum
>  #
> -# Push an array of open IO spaces (array of signed integers) on the stack.
> -# This array may be empty if no IO space is open.
> +# Pushe the number of IO spaces on the stack.
>  #
> -# Stack: ( -- ARR )
> +# Stack: ( -- ULONG )
>  
> -instruction iolist ()
> +instruction ionum ()
>    code
> -    struct iolist_ctx iolist_ctx;
> -    pvm_val arr = pvm_make_array (pvm_make_integral_type (PVM_MAKE_ULONG 
> (32, 64),
> -                                                          PVM_MAKE_INT (1, 
> 32)),
> -                                  PVM_MAKE_ULONG (0, 64));
> +    struct ionum_ctx ctx;
>  
> -    iolist_ctx.arr_ios = arr;
> -    ios_map (iolist_callback, &iolist_ctx);
> -    JITTER_PUSH_STACK (arr);
> +    ctx.count = 0;
> +    ios_map (ionum_callback, &ctx);
> +    JITTER_PUSH_STACK (PVM_MAKE_ULONG (ctx.count, 64));
> +  end
> +end
> +
> +# Instruction: ioref
> +#
> +# Given an index ULONG, push the descriptor of the IO space on
> +# the stack as a signed integer.
> +#
> +# If the provided index is out of bounds, then raise
> +# PVM_E_OUT_OF_BOUNDS.
> +#
> +# Stack: ( ULONG -- ULONG IOS )
> +# Exceptions: PVM_E_OUT_OF_BOUNDS
> +
> +instruction ioref ()
> +  branching # because of PVM_RAISE_DIRECT
> +  code
> +    struct ioref_ctx ctx;
> +
> +    ctx.index = PVM_VAL_ULONG (JITTER_TOP_STACK ());
> +    ctx.ios_id = -1;
> +    ios_map (ioref_callback, &ctx);
> +    if (ctx.ios_id == -1)
> +      PVM_RAISE_DIRECT (PVM_E_OUT_OF_BOUNDS);
> +    JITTER_PUSH_STACK (PVM_MAKE_INT (ctx.ios_id, 32));
>    end
>  end