/* pkl-asm.c - Macro-assembler for the Poke Virtual Machine.  */

/* Copyright (C) 2019, 2020, 2021, 2022, 2023, 2024 Jose E. Marchesi */

/* This program is free software: you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation, either version 3 of the License, or
 * (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program.  If not, see <http://www.gnu.org/licenses/>.
 */

#include <config.h>

#include <stdarg.h>
#include <string.h>
#include <assert.h>

#include "pvm.h"
#include "pkl.h"
#include "ios.h"

#include "pkl-asm.h"
#include "pkl-env.h"
#include "pvm-alloc.h"
#include "pvm-program.h"

/* Code generated by RAS is used to implement many macro-instructions.
   Configure it to use the right assembler, and include the assembled
   macros.  */
#define RAS_ASM pasm
#include "pkl-asm.pkc"

/* In order to support nested multi-function macros, like conditionals
   and loops, the assembler implements the notion of "nesting levels".
   For example, consider the following conditional code:

      ... top-level ...

      pkl_asm_dotimes (pasm, exp);
      {
         ... level-1 ...

         pkl_asm_if (pasm, exp);
         {
            ... level-2 ...
         }
         pkl_asm_end_if (pasm);
      }
      pkl_asm_end_dotimes (pasm);

   Levels are stacked and managed using the `pkl_asm_pushlevel' and
   `pkl_asm_poplevel' functions defined below.

   CURRENT_ENV identifies what kind of instruction created the level.
   This can be either PKL_ASM_ENV_NULL, PKL_ASM_ENV_CONDITIONAL,
   PKL_ASM_ENV_LOOP, PKL_ASM_ENV_FOR_IN_LOOP, PKL_ASM_ENV_TRY.
   PKL_ASM_ENV_NULL should only be used at the top-level.

   PARENT is the parent level, i.e. the level containing this one.
   This is NULL at the top-level.

   The meaning of the LABEL* and NODE* fields depend on the particular
   kind of environment.  See the details in the implementation of the
   functions below.  */

#define PKL_ASM_ENV_NULL 0
#define PKL_ASM_ENV_CONDITIONAL 1
#define PKL_ASM_ENV_LOOP 2
#define PKL_ASM_ENV_TRY 3
#define PKL_ASM_ENV_FOR_IN_LOOP 4
#define PKL_ASM_ENV_FOR_LOOP 5

struct pkl_asm_level
{
  int current_env;
  struct pkl_asm_level *parent;
  pvm_program_label label1;
  pvm_program_label label2;
  pvm_program_label label3;
  pkl_ast_node node1;
  pkl_ast_node node2;
  int int1;

  pvm_program_label break_label;
  pvm_program_label continue_label;
};

/* An assembler instance.

   COMPILER is the PKL compiler using the macro-assembler.

   PROGRAM is the PVM program being assembled.

   LEVEL is a pointer to the top of a stack of levels.

   AST is for creating ast nodes whenever needed.

   ERROR_LABEL marks the generic error handler defined in the standard
   prologue.  */

#define PKL_ASM_LEVEL(PASM) ((PASM)->level)

struct pkl_asm
{
  pkl_compiler compiler;
  pvm_program program;
  struct pkl_asm_level *level;
  pkl_ast ast;
  pvm_program_label error_label;
};

/* Push a new level to PASM's level stack with ENV.  */

static void
pkl_asm_pushlevel (pkl_asm pasm, int env)
{
  struct pkl_asm_level *level
    = pvm_alloc (sizeof (struct pkl_asm_level));

  memset (level, 0, sizeof (struct pkl_asm_level));
  level->parent = pasm->level;
  level->current_env = env;
  pasm->level = level;
}

/* Pop the innermost level from PASM's level stack.  */

static void __attribute__((unused))
pkl_asm_poplevel (pkl_asm pasm)
{
  struct pkl_asm_level *level = pasm->level;

  pasm->level = level->parent;
}

/* Macro-instruction: ATOA from_type to_type
  ( ARR(from_type) -- ARR(to_type) )

  Generate code to convert an array value from FROM_TYPE to TO_TYPE.
  Both types should be array types, equal but for the boundaries.
  FROM_TYPE can be NULL.  */

static void
pkl_asm_insn_atoa (pkl_asm pasm,
                   pkl_ast_node from_type,
                   pkl_ast_node to_type)
{
  pkl_ast_node to_type_etype = PKL_AST_TYPE_A_ETYPE (to_type);
  pkl_ast_node bound = PKL_AST_TYPE_A_BOUND (to_type);

  pkl_ast_node from_type_etype = NULL;
  pkl_ast_node from_bound = NULL;

  if (from_type)
    {
      from_type_etype = PKL_AST_TYPE_A_ETYPE (from_type);
      from_bound = PKL_AST_TYPE_A_BOUND (from_type);
    }

  /* If the array element is also an array, then convert each of its
     elements, recursively.  */
  if (PKL_AST_TYPE_CODE (to_type_etype) == PKL_TYPE_ARRAY)
    {
      pkl_asm_for_in (pasm, PKL_TYPE_ARRAY, NULL /* selector */);
      {
        /* The array is already in the stack.  */
        pkl_asm_insn (pasm, PKL_INSN_DUP);
      }
      pkl_asm_for_in_where (pasm);
      {
        /* No condition.  */
      }
      pkl_asm_for_in_loop (pasm);
      {
        pkl_asm_insn (pasm, PKL_INSN_PUSHVAR, 0, 0);              /* ELEM */
        pkl_asm_insn_atoa (pasm, from_type_etype, to_type_etype); /* ELEM */
        pkl_asm_insn (pasm, PKL_INSN_DROP);                       /* _ */
      }
      pkl_asm_for_in_endloop (pasm);
    }

  /* Now process the array itself.  */
  if (bound == NULL)
    {
      pvm_val bounder;

      if (from_type && from_bound == NULL)
        /* Both array types are unbounded, hence they are identical =>
           no need to do anything.  */
        return;

      /* No checks are due in this case, but the value itself
         should be typed as an unbound array.  */

      /* Because `bound' is NULL, the bounder closure for `to_type'
         will do the right thing (which is returning PVM_NULL on
         invocation).  We set this bounder in the PVM type of
         the array.  */
      bounder = PKL_AST_TYPE_A_BOUNDER (to_type);

      pkl_asm_insn (pasm, PKL_INSN_TYPOF);          /* ARR TYP */
      pkl_asm_insn (pasm, PKL_INSN_PUSH, bounder);  /* ARR TYP CLS */
      pkl_asm_insn (pasm, PKL_INSN_TYASETB);        /* ARR TYP */
      pkl_asm_insn (pasm, PKL_INSN_DROP);           /* ARR */
    }
  else
    {
      pkl_ast_node bound_type = PKL_AST_TYPE (bound);
      pvm_val bounder = PKL_AST_TYPE_A_BOUNDER (to_type);

      switch (PKL_AST_TYPE_CODE (bound_type))
        {
        case PKL_TYPE_INTEGRAL:
          RAS_MACRO_ARRAY_CONV_SEL (bounder);
          break;
        case PKL_TYPE_OFFSET:
          RAS_MACRO_ARRAY_CONV_SIZ (bounder);
          break;
        default:
        PK_UNREACHABLE ();
        }
    }
}

/* Macro-instruction: BCONC op1_type, op2_type, res_type
   ( VAL VAL -- VAL VAL VAL )

   Generate code to bit-concatenate the arguments.  */

static void
pkl_asm_insn_bconc (pkl_asm pasm,
                    pkl_ast_node op1_type,
                    pkl_ast_node op2_type,
                    pkl_ast_node res_type)
{
  RAS_MACRO_BCONC (pvm_make_uint (PKL_AST_TYPE_I_SIZE (op2_type), 32),
                   op1_type, op2_type, res_type);
}

/* Macro-instruction: NTON from_type, to_type
   ( VAL(from_type) -- VAL(from_type) VAL(to_type) )

   Generate code to convert an integer value from FROM_TYPE to
   TO_TYPE.  Both types should be integral types.  */

static void
pkl_asm_insn_nton  (pkl_asm pasm,
                    pkl_ast_node from_type,
                    pkl_ast_node to_type)
{
  size_t from_type_size = PKL_AST_TYPE_I_SIZE (from_type);
  int from_type_signed_p = PKL_AST_TYPE_I_SIGNED_P (from_type);

  size_t to_type_size = PKL_AST_TYPE_I_SIZE (to_type);
  int to_type_signed_p = PKL_AST_TYPE_I_SIGNED_P (to_type);

  if (from_type_size == to_type_size
      && from_type_signed_p == to_type_signed_p)
    {
      /* Wheee, nothing to convert.  Just dup.  */
      pkl_asm_insn (pasm, PKL_INSN_DUP);
      return;
    }
  else
    {
      static const int cast_table[2][2][2][2] =
        {
         /* Source is int.  */
         {
          /* Destination is int.  */
          {
           {PKL_INSN_IUTOIU, PKL_INSN_IUTOI},
           {PKL_INSN_ITOIU, PKL_INSN_ITOI}
          },
          /* Destination is long. */
          {
           {PKL_INSN_IUTOLU, PKL_INSN_IUTOL},
           {PKL_INSN_ITOLU, PKL_INSN_ITOL}
          },
         },
         /* Source is long.  */
         {
          /* Destination is int.  */
          {
           {PKL_INSN_LUTOIU, PKL_INSN_LUTOI},
           {PKL_INSN_LTOIU, PKL_INSN_LTOI}
          },
          {
           /* Destination is long.  */
           {PKL_INSN_LUTOLU, PKL_INSN_LUTOL},
           {PKL_INSN_LTOLU, PKL_INSN_LTOL}
          },
         }
        };

      int fl = !!((from_type_size - 1) & ~0x1f);
      int fs = from_type_signed_p;
      int tl = !!((to_type_size - 1) & ~0x1f);
      int ts = to_type_signed_p;

      pkl_asm_insn (pasm,
                    cast_table [fl][tl][fs][ts],
                    (unsigned int) to_type_size);
    }
}

/* Macro-instruction: REMAP
   ( VAL -- VAL )

   Given a mapeable PVM value on the TOS, remap it.  */

static void
pkl_asm_insn_remap (pkl_asm pasm)
{
  RAS_MACRO_REMAP;
}

/* Macro-instruction: AREMAP
   ( VAL -- VAL )

   Given a mapeable PVM value on the TOS, remap it if auto-remap
   is enabled.  */

static void
pkl_asm_insn_aremap (pkl_asm pasm)
{
  RAS_MACRO_AREMAP;
}

/* Macro-instruction: WRITE
   ( VAL -- VAL )

   Given a mapeable PVM value on the TOS, invoke its writer.  */

static void
pkl_asm_insn_write (pkl_asm pasm)
{
  RAS_MACRO_WRITE;
}

/* Macro-instruction: PEEK type, endian, nenc
   ( -- VAL )

   Generate code for a peek operation to TYPE, which should be an
   integral type.  */

static void
pkl_asm_insn_peek (pkl_asm pasm, pkl_ast_node type,
                   unsigned int nenc, unsigned int endian)
{
  int type_code = PKL_AST_TYPE_CODE (type);

  if (type_code == PKL_TYPE_INTEGRAL)
    {
      size_t size = PKL_AST_TYPE_I_SIZE (type);
      int sign = PKL_AST_TYPE_I_SIGNED_P (type);

      static const int peek_table[2][2] =
        {
         {PKL_INSN_PEEKIU, PKL_INSN_PEEKI},
         {PKL_INSN_PEEKLU, PKL_INSN_PEEKL}
        };

      int tl = !!((size - 1) & ~0x1f);

      if (sign)
        pkl_asm_insn (pasm, peek_table[tl][sign],
                      nenc, endian,
                      (unsigned int) size);
      else
        pkl_asm_insn (pasm, peek_table[tl][sign],
                      endian,
                      (unsigned int) size);
    }
  else
    PK_UNREACHABLE ();
}

/* Macro-instruction: PEEKD type
   (  -- VAL )

   Generate code for a peek operation to TYPE, which should be an
   integral type.  */

static void
pkl_asm_insn_peekd (pkl_asm pasm, pkl_ast_node type)
{
  int type_code = PKL_AST_TYPE_CODE (type);

  if (type_code == PKL_TYPE_INTEGRAL)
    {
      size_t size = PKL_AST_TYPE_I_SIZE (type);
      int sign = PKL_AST_TYPE_I_SIGNED_P (type);

      static const int peekd_table[2][2] =
        {
         {PKL_INSN_PEEKDIU, PKL_INSN_PEEKDI},
         {PKL_INSN_PEEKDLU, PKL_INSN_PEEKDL}
        };

      int tl = !!((size - 1) & ~0x1f);

      pkl_asm_insn (pasm, peekd_table[tl][sign],
                    (unsigned int) size);
    }
  else
    PK_UNREACHABLE ();
}

/* Macro-instruction: REV depth
   ( VAL1 VAL2 ... VALdepth-1 -- VALdepth-1 ... VAL2 VAL1 )
*/

static void
pkl_asm_insn_rev (pkl_asm pasm, unsigned int depth)
{
  if (depth == 2)
    pkl_asm_insn (pasm, PKL_INSN_SWAP);
  else if (depth == 3)
    {
      pkl_asm_insn (pasm, PKL_INSN_SWAP);
      pkl_asm_insn (pasm, PKL_INSN_ROT);
    }
  else if (depth > 1)
    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
    PK_UNREACHABLE ();
}

/* Macro-instruction: PRINT type
   ( OBASE VAL -- )
*/

static void
pkl_asm_insn_print (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.  */
      pkl_asm_insn (pasm, PKL_INSN_PRINTS);
    }
  else if (type_code == PKL_TYPE_ANY)
    {
      PK_UNREACHABLE ();
    }
  else if (type_code == PKL_TYPE_INTEGRAL)
    {
      size_t size = PKL_AST_TYPE_I_SIZE (type);
      int signed_p = PKL_AST_TYPE_I_SIGNED_P (type);

      static const int print_table[2][2] =
        {
         {PKL_INSN_PRINTIU, PKL_INSN_PRINTI},
         {PKL_INSN_PRINTLU, PKL_INSN_PRINTL}
        };

      int tl = !!((size - 1) & ~0x1f);

      pkl_asm_insn (pasm, print_table[tl][signed_p],
                    (unsigned int) size);
    }
  else
    PK_UNREACHABLE ();
}

/* Macro-instruction: POKE type, endian, nenc
   ( -- VAL )

   Generate code for a poke operation to TYPE, which should be an
   integral type.  */

static void
pkl_asm_insn_poke (pkl_asm pasm, pkl_ast_node type,
                   unsigned int nenc, unsigned int endian)
{
  int type_code = PKL_AST_TYPE_CODE (type);

  if (type_code == PKL_TYPE_INTEGRAL)
    {
      size_t size = PKL_AST_TYPE_I_SIZE (type);
      int signed_p = PKL_AST_TYPE_I_SIGNED_P (type);

      static const int poke_table[2][2] =
        {
         {PKL_INSN_POKEIU, PKL_INSN_POKEI},
         {PKL_INSN_POKELU, PKL_INSN_POKEL}
        };

      int tl = !!((size - 1) & ~0x1f);

      if (signed_p)
        pkl_asm_insn (pasm, poke_table[tl][signed_p],
                      nenc, endian,
                      (unsigned int) size);
      else
        pkl_asm_insn (pasm, poke_table[tl][signed_p],
                      endian,
                      (unsigned int) size);
    }
  else
    PK_UNREACHABLE ();
}


/* Macro-instruction: POKED type
   ( OFF VAL -- )

   Generate code for a poke operation to TYPE, which should be an
   integral type.  */

static void
pkl_asm_insn_poked (pkl_asm pasm, pkl_ast_node type)
{
  int type_code = PKL_AST_TYPE_CODE (type);

  if (type_code == PKL_TYPE_INTEGRAL)
    {
      size_t size = PKL_AST_TYPE_I_SIZE (type);
      int signed_p = PKL_AST_TYPE_I_SIGNED_P (type);

      static const int poked_table[2][2] =
        {
         {PKL_INSN_POKEDIU, PKL_INSN_POKEDI},
         {PKL_INSN_POKEDLU, PKL_INSN_POKEDL}
        };

      int tl = !!((size - 1) & ~0x1f);

      pkl_asm_insn (pasm, poked_table[tl][signed_p],
                    (unsigned int) size);
    }
  else
    PK_UNREACHABLE ();
}

/* Macro-instruction: NEG type
   ( VAL -- VAL )

   Macro-instruction: NEGOF type
   ( VAL -- VAL )

   Macro-instruction: ADD type
   ( VAL VAL -- VAL VAL VAL )

   Macro-instruction: SUB type
   ( VAL VAL -- VAL VAL VAL )

   Macro-instruction: MUL type
   ( VAL VAL -- VAL VAL VAL )

   Macro-instruction: DIV type
   ( VAL VAL -- VAL VAL VAL )

   Macro-instruction: MOD type
   ( VAL VAL -- VAL VAL VAL )

   Macro-instruction: BNOT type
   ( VAL -- VAL VAL VAL )

   Macro-instruction: BAND type
   ( VAL VAL -- VAL VAL VAL )

   Macro-instruction: BOR type
   ( VAL VAL -- VAL VAL VAL )

   Macro-instruction: BXOR type
   ( VAL VAL -- VAL VAL VAL )

   Macro-instruction: SL type
   ( VAL VAL -- VAL VAL VAL )

   Macro-instruction: SR type
   ( VAL VAL -- VAL VAL VAL )

   Macro-instruction: POW type
   ( VAL VAL -- VAL VAL VAL )

   Macro-instruction: ADDOF type
   ( VAL VAL -- VAL VAL VAL )

   Macro-instruction: SUBOF type
   ( VAL VAL -- VAL VAL VAL )

   Macro-instruction: MULOF type
   ( VAL VAL -- VAL VAL VAL )

   Macro-instruction: DIVOF type
   ( VAL VAL -- VAL VAL VAL )

   Macro-instruction: MODOF type
   ( VAL VAL -- VAL VAL VAL )

   Macro-instruction: POWOF type
   ( VAL VAL -- VAL VAL VAL )

   Generate code for performing negation, addition, subtraction,
   multiplication, division, remainder and bit shift to integral and
   offset operands.  Also exponentiation.  Also overflow-checking
   instructions.  INSN identifies the operation to perform, and TYPE
   the type of the operands and the result.  */

static void
pkl_asm_insn_binop (pkl_asm pasm,
                    enum pkl_asm_insn insn,
                    pkl_ast_node type)
{
  if (PKL_AST_TYPE_CODE (type) == PKL_TYPE_INTEGRAL)
    {
      static const int neg_table[2][2] = {{ PKL_INSN_NEGIU, PKL_INSN_NEGI },
                                    { PKL_INSN_NEGLU, PKL_INSN_NEGL }};

      static const int add_table[2][2] = {{ PKL_INSN_ADDIU, PKL_INSN_ADDI },
                                    { PKL_INSN_ADDLU, PKL_INSN_ADDL }};

      static const int sub_table[2][2] = {{ PKL_INSN_SUBIU, PKL_INSN_SUBI },
                                    { PKL_INSN_SUBLU, PKL_INSN_SUBL }};

      static const int mul_table[2][2] = {{ PKL_INSN_MULIU, PKL_INSN_MULI },
                                    { PKL_INSN_MULLU, PKL_INSN_MULL }};

      static const int div_table[2][2] = {{ PKL_INSN_DIVIU, PKL_INSN_DIVI },
                                    { PKL_INSN_DIVLU, PKL_INSN_DIVL }};

      static const int mod_table[2][2] = {{ PKL_INSN_MODIU, PKL_INSN_MODI },
                                    { PKL_INSN_MODLU, PKL_INSN_MODL }};

      static const int bnot_table[2][2] = {{ PKL_INSN_BNOTIU, PKL_INSN_BNOTI },
                                     { PKL_INSN_BNOTLU, PKL_INSN_BNOTL }};

      static const int band_table[2][2] = {{ PKL_INSN_BANDIU, PKL_INSN_BANDI },
                                     { PKL_INSN_BANDLU, PKL_INSN_BANDL }};

      static const int bor_table[2][2] = {{ PKL_INSN_BORIU, PKL_INSN_BORI },
                                    { PKL_INSN_BORLU, PKL_INSN_BORL }};

      static const int bxor_table[2][2] = {{ PKL_INSN_BXORIU, PKL_INSN_BXORI },
                                     { PKL_INSN_BXORLU, PKL_INSN_BXORL }};

      static const int sl_table[2][2] = {{ PKL_INSN_SLIU, PKL_INSN_SLI },
                                   { PKL_INSN_SLLU, PKL_INSN_SLL }};

      static const int sr_table[2][2] = {{ PKL_INSN_SRIU, PKL_INSN_SRI },
                                   { PKL_INSN_SRLU, PKL_INSN_SRL }};

      static const int pow_table[2][2] = {{ PKL_INSN_POWIU, PKL_INSN_POWI },
                                    { PKL_INSN_POWLU, PKL_INSN_POWL }};

      static const int negof_table[2][2] = {{ PKL_INSN_NEGIU, PKL_INSN_NEGIOF },
                                            { PKL_INSN_NEGLU, PKL_INSN_NEGLOF }};

      static const int addof_table[2][2] = {{ PKL_INSN_NOP, PKL_INSN_ADDIOF },
                                            { PKL_INSN_NOP, PKL_INSN_ADDLOF }};

      static const int subof_table[2][2] = {{ PKL_INSN_NOP, PKL_INSN_SUBIOF },
                                            { PKL_INSN_NOP, PKL_INSN_SUBLOF }};

      static const int mulof_table[2][2] = {{ PKL_INSN_NOP, PKL_INSN_MULIOF },
                                            { PKL_INSN_NOP, PKL_INSN_MULLOF }};

      static const int divof_table[2][2] = {{ PKL_INSN_NOP, PKL_INSN_DIVIOF },
                                            { PKL_INSN_NOP, PKL_INSN_DIVLOF }};

      static const int modof_table[2][2] = {{ PKL_INSN_NOP, PKL_INSN_MODIOF },
                                            { PKL_INSN_NOP, PKL_INSN_MODLOF }};

      static const int powof_table[2][2] = {{ PKL_INSN_NOP, PKL_INSN_POWIOF },
                                            { PKL_INSN_NOP, PKL_INSN_POWLOF }};

      uint64_t size = PKL_AST_TYPE_I_SIZE (type);
      int signed_p = PKL_AST_TYPE_I_SIGNED_P (type);
      int tl = !!((size - 1) & ~0x1f);

      /* Check for division-by-zero before operations that require
         it.  */
      if (insn == PKL_INSN_DIV || insn == PKL_INSN_MOD)
        {
          pvm_program_label div_by_zero_ok
            = pvm_program_fresh_label (pasm->program);

          pkl_asm_insn (pasm, PKL_INSN_BNZ, type, div_by_zero_ok);
          pkl_asm_insn (pasm, PKL_INSN_PUSH,
                        pvm_make_exception (PVM_E_DIV_BY_ZERO, PVM_E_DIV_BY_ZERO_NAME,
                                            PVM_E_DIV_BY_ZERO_ESTATUS, NULL, NULL));
          pkl_asm_insn (pasm, PKL_INSN_RAISE);
          pkl_asm_label (pasm, div_by_zero_ok);
        }

      /* In left-shift instructions, the shift count operand is checked
         to make sure it doesn't cause UB in the PVM.  */
      if (insn == PKL_INSN_SL)
        {
          pvm_program_label count_is_ok
            = pvm_program_fresh_label (pasm->program);

          /* VAL UINT */
          pkl_asm_insn (pasm, PKL_INSN_IUTOL, 64); /* VAL UINT ULONG */
          pkl_asm_insn (pasm, PKL_INSN_ROT);       /* UINT ULONG VAL */
          pkl_asm_insn (pasm, PKL_INSN_SIZ);       /* UINT ULONG VAL SIZ */
          pkl_asm_insn (pasm, PKL_INSN_QUAKE);     /* UINT VAL ULONG SIZ */
          pkl_asm_insn (pasm, PKL_INSN_LTLU);      /* UINT VAL ULONG SIZ (ULONG<SIZ) */
          pkl_asm_insn (pasm, PKL_INSN_BNZI, count_is_ok);
          pkl_asm_insn (pasm, PKL_INSN_PUSH,
                        pvm_make_exception (PVM_E_OUT_OF_BOUNDS, PVM_E_OUT_OF_BOUNDS_NAME,
                                            PVM_E_OUT_OF_BOUNDS_ESTATUS, NULL, NULL));
          pkl_asm_insn (pasm, PKL_INSN_RAISE);
          pkl_asm_label (pasm, count_is_ok);
          pkl_asm_insn (pasm, PKL_INSN_DROP3); /* UINT VAL */
          pkl_asm_insn (pasm, PKL_INSN_SWAP);  /* VAL UINT */
        }

      /* Check for overflow before signed arithmetic instructions
         that may overflow.  */
      if (signed_p)
        {
          pvm_program_label of_check_done
            = pvm_program_fresh_label (pasm->program);

          switch (insn)
            {
            case PKL_INSN_NEG:
              pkl_asm_insn (pasm, PKL_INSN_NEGOF, type);
              break;
            case PKL_INSN_ADD:
              pkl_asm_insn (pasm, PKL_INSN_ADDOF, type);
              break;
            case PKL_INSN_SUB:
              pkl_asm_insn (pasm, PKL_INSN_SUBOF, type);
              break;
            case PKL_INSN_MUL:
              pkl_asm_insn (pasm, PKL_INSN_MULOF, type);
              break;
            case PKL_INSN_DIV:
              pkl_asm_insn (pasm, PKL_INSN_DIVOF, type);
              break;
            case PKL_INSN_MOD:
              pkl_asm_insn (pasm, PKL_INSN_MODOF, type);
              break;
            case PKL_INSN_POW:
              pkl_asm_insn (pasm, PKL_INSN_POWOF, type);
              break;
            default:
              pkl_asm_insn (pasm, PKL_INSN_PUSH, pvm_make_int (0, 32));
              break;
            }

          /* Emit an exception if the operation would result on
             overflow.  Otherwise, continue with the operation.  */
          pkl_asm_insn (pasm, PKL_INSN_BZI, of_check_done);
          pkl_asm_insn (pasm, PKL_INSN_PUSH,
                        pvm_make_exception (PVM_E_OVERFLOW, PVM_E_OVERFLOW_NAME,
                                            PVM_E_OVERFLOW_ESTATUS, NULL, NULL));
          pkl_asm_insn (pasm, PKL_INSN_RAISE);
          pkl_asm_label (pasm, of_check_done);
          pkl_asm_insn (pasm, PKL_INSN_DROP);
        }

      /* Now assemble the instruction.  */
      switch (insn)
        {
        case PKL_INSN_NEG:
          pkl_asm_insn (pasm, neg_table[tl][signed_p]);
          break;
        case PKL_INSN_ADD:
          pkl_asm_insn (pasm, add_table[tl][signed_p]);
          break;
        case PKL_INSN_SUB:
          pkl_asm_insn (pasm, sub_table[tl][signed_p]);
          break;
        case PKL_INSN_MUL:
          pkl_asm_insn (pasm, mul_table[tl][signed_p]);
          break;
        case PKL_INSN_DIV:
          pkl_asm_insn (pasm, div_table[tl][signed_p]);
          break;
        case PKL_INSN_MOD:
          pkl_asm_insn (pasm, mod_table[tl][signed_p]);
          break;
        case PKL_INSN_BNOT:
          pkl_asm_insn (pasm, bnot_table[tl][signed_p]);
          break;
        case PKL_INSN_BAND:
          pkl_asm_insn (pasm, band_table[tl][signed_p]);
          break;
        case PKL_INSN_BOR:
          pkl_asm_insn (pasm, bor_table[tl][signed_p]);
          break;
        case PKL_INSN_BXOR:
          pkl_asm_insn (pasm, bxor_table[tl][signed_p]);
          break;
        case PKL_INSN_SL:
          pkl_asm_insn (pasm, sl_table[tl][signed_p]);
          break;
        case PKL_INSN_SR:
          pkl_asm_insn (pasm, sr_table[tl][signed_p]);
          break;
        case PKL_INSN_POW:
          pkl_asm_insn (pasm, pow_table[tl][signed_p]);
          break;
        case PKL_INSN_NEGOF:
          assert (signed_p);
          pkl_asm_insn (pasm, negof_table[tl][signed_p]);
          break;
        case PKL_INSN_ADDOF:
          assert (signed_p);
          pkl_asm_insn (pasm, addof_table[tl][signed_p]);
          break;
        case PKL_INSN_SUBOF:
          assert (signed_p);
          pkl_asm_insn (pasm, subof_table[tl][signed_p]);
          break;
        case PKL_INSN_MULOF:
          assert (signed_p);
          pkl_asm_insn (pasm, mulof_table[tl][signed_p]);
          break;
        case PKL_INSN_DIVOF:
          assert (signed_p);
          pkl_asm_insn (pasm, divof_table[tl][signed_p]);
          break;
        case PKL_INSN_MODOF:
          assert (signed_p);
          pkl_asm_insn (pasm, modof_table[tl][signed_p]);
          break;
        case PKL_INSN_POWOF:
          assert (signed_p);
          pkl_asm_insn (pasm, powof_table[tl][signed_p]);
          break;
        default:
          PK_UNREACHABLE ();
        }
    }
  else if (PKL_AST_TYPE_CODE (type) == PKL_TYPE_OFFSET)
    {
      pkl_ast_node base_type = PKL_AST_TYPE_O_BASE_TYPE (type);
      pkl_ast_node unit = PKL_AST_TYPE_O_UNIT (type);

      if (insn == PKL_INSN_NEG || insn == PKL_INSN_BNOT)
        {
          pkl_asm_insn (pasm, PKL_INSN_OGETM);        /* OFF OMAG */
          pkl_asm_insn_binop (pasm, insn, base_type); /* OFF OMAG NOMAG */
          pkl_asm_insn (pasm, PKL_INSN_NIP);          /* OFF NOMAG */
          pkl_asm_insn (pasm, PKL_INSN_PUSH,
                        pvm_make_ulong (PKL_AST_INTEGER_VALUE (unit), 64));
                                                      /* OFF NOMAG RUNIT */
          pkl_asm_insn (pasm, PKL_INSN_MKOQ);         /* OFF ROFF */
        }
      else if (insn == PKL_INSN_SL
               || insn == PKL_INSN_SR
               || insn == PKL_INSN_POW)
        {
          pkl_asm_insn (pasm, PKL_INSN_OVER);         /* OFF UINT OFF */
          pkl_asm_insn (pasm, PKL_INSN_OGETM);        /* OFF UINT OFF OMAG */
          pkl_asm_insn (pasm, PKL_INSN_NIP);          /* OFF UINT OMAG */
          pkl_asm_insn (pasm, PKL_INSN_SWAP);         /* OFF OMAG UINT */
          pkl_asm_insn_binop (pasm, insn, base_type); /* OFF OMAG UINT NOMAG */
          pkl_asm_insn (pasm, PKL_INSN_ROT);          /* OFF UINT NOMAG OMAG */
          pkl_asm_insn (pasm, PKL_INSN_DROP);         /* OFF UINT NOMAG */
          pkl_asm_insn (pasm, PKL_INSN_PUSH,
                        pvm_make_ulong (PKL_AST_INTEGER_VALUE (unit), 64));
                                                      /* OFF UINT NOMAG RUNIT */
          pkl_asm_insn (pasm, PKL_INSN_MKOQ);         /* OFF1 OFF2 ROFF */
        }
      else
        {
          pkl_asm_insn (pasm, PKL_INSN_OVER);         /* OFF1 OFF2 OFF1 */
          pkl_asm_insn (pasm, PKL_INSN_OVER);         /* OFF1 OFF2 OFF1 OFF2 */
          pkl_asm_insn (pasm, PKL_INSN_OGETM);        /* ... OFF1 OFF2 OMAG2 */
          pkl_asm_insn (pasm, PKL_INSN_NIP);          /* ... OFF1 OMAG2 */
          pkl_asm_insn (pasm, PKL_INSN_SWAP);         /* ... OMAG2 OFF1 */
          pkl_asm_insn (pasm, PKL_INSN_OGETM);        /* ... OMAG2 OFF1 OMAG1 */
          pkl_asm_insn (pasm, PKL_INSN_NIP);          /* ... OMAG2 OMAG1 */
          pkl_asm_insn (pasm, PKL_INSN_SWAP);         /* ... OMAG1 OMAG2 */
          pkl_asm_insn_binop (pasm, insn, base_type); /* ... OMAG1 OMAG2 RMAG */
          pkl_asm_insn (pasm, PKL_INSN_NIP2);         /* OFF1 OFF2 RMAG */
          pkl_asm_insn (pasm, PKL_INSN_PUSH,
                        pvm_make_ulong (PKL_AST_INTEGER_VALUE (unit), 64));
                                                      /* OFF1 OFF2 RMAG RUNIT */
          pkl_asm_insn (pasm, PKL_INSN_MKOQ);         /* OFF1 OFF2 ROFF */
        }
    }
  else
    PK_UNREACHABLE ();
}

/*
  Macro-instruction: CDIV type
  ( VAL VAL -- VAL VAL VAL )
*/

static void
pkl_asm_insn_cdiv (pkl_asm pasm,
                   enum pkl_asm_insn insn,
                   pkl_ast_node type)
{
  pvm_val one = pvm_make_integral (1,
                                   PKL_AST_TYPE_I_SIZE (type),
                                   PKL_AST_TYPE_I_SIGNED_P (type));

  RAS_MACRO_CDIV (one, type);
}

/*
  Macro-instruction: CDIVO type
  ( VAL VAL -- VAL VAL VAL )
*/

static void
pkl_asm_insn_cdivo (pkl_asm pasm,
                    enum pkl_asm_insn insn,
                    pkl_ast_node base_type)
{
  RAS_MACRO_CDIVO (base_type);
}

/* Macro-instruction: EQ type
   ( VAL VAL -- INT )

   Macro-instruction: NE type
   ( VAL VAL -- INT )

   Macro-instruction: LT type
   ( VAL VAL -- INT )

   Macro-instruction: GT type
   ( VAL VAL -- INT )

   Macro-instruction: GE type
   ( VAL VAL -- INT )

   Macro-instruction: LE type
   ( VAL VAL -- INT )

   Generate code for performing a comparison operation.  INSN
   identifies the operation to perform, and TYPE the type of the
   operands.  */

static void
pkl_asm_insn_cmp (pkl_asm pasm,
                  enum pkl_asm_insn insn,
                  pkl_ast_node type)
{
  enum pkl_asm_insn oinsn;

  /* Decide what instruction to assembly.  */
  if (PKL_AST_TYPE_CODE (type) == PKL_TYPE_STRING)
    {
      switch (insn)
        {
        case PKL_INSN_EQ: oinsn = PKL_INSN_EQS; break;
        case PKL_INSN_NE: oinsn = PKL_INSN_NES; break;
        case PKL_INSN_LT: oinsn = PKL_INSN_LTS; break;
        case PKL_INSN_GT: oinsn = PKL_INSN_GTS; break;
        case PKL_INSN_GE: oinsn = PKL_INSN_GES; break;
        case PKL_INSN_LE: oinsn = PKL_INSN_LES; break;
        default:
          PK_UNREACHABLE ();
        }

      /* Assembly the instruction.  */
      pkl_asm_insn (pasm, oinsn);
    }
  else if (PKL_AST_TYPE_CODE (type) == PKL_TYPE_INTEGRAL)
    {
      static const int eq_table[2][2] = {{ PKL_INSN_EQIU, PKL_INSN_EQI },
                                   { PKL_INSN_EQLU, PKL_INSN_EQL }};

      static const int ne_table[2][2] = {{ PKL_INSN_NEIU, PKL_INSN_NEI },
                                   { PKL_INSN_NELU, PKL_INSN_NEL }};
      static const int lt_table[2][2] = {{ PKL_INSN_LTIU, PKL_INSN_LTI },
                                   { PKL_INSN_LTLU, PKL_INSN_LTL }};

      static const int gt_table[2][2] = {{ PKL_INSN_GTIU, PKL_INSN_GTI },
                                   { PKL_INSN_GTLU, PKL_INSN_GTL }};

      static const int ge_table[2][2] = {{ PKL_INSN_GEIU, PKL_INSN_GEI },
                                   { PKL_INSN_GELU, PKL_INSN_GEL }};

      static const int le_table[2][2] = {{ PKL_INSN_LEIU, PKL_INSN_LEI },
                                   { PKL_INSN_LELU, PKL_INSN_LEL }};

      uint64_t size = PKL_AST_TYPE_I_SIZE (type);
      int signed_p = PKL_AST_TYPE_I_SIGNED_P (type);
      int tl = !!((size - 1) & ~0x1f);

      switch (insn)
        {
        case PKL_INSN_EQ: oinsn = eq_table[tl][signed_p]; break;
        case PKL_INSN_NE: oinsn = ne_table[tl][signed_p]; break;
        case PKL_INSN_LT: oinsn = lt_table[tl][signed_p]; break;
        case PKL_INSN_GT: oinsn = gt_table[tl][signed_p]; break;
        case PKL_INSN_GE: oinsn = ge_table[tl][signed_p]; break;
        case PKL_INSN_LE: oinsn = le_table[tl][signed_p]; break;
        default:
          PK_UNREACHABLE ();
          break;
        }

      /* Assembly the instruction.  */
      pkl_asm_insn (pasm, oinsn);
    }
  else if (PKL_AST_TYPE_CODE (type) == PKL_TYPE_OFFSET)
    {
      pkl_ast_node base_type = PKL_AST_TYPE_O_BASE_TYPE (type);

      pkl_asm_insn (pasm, PKL_INSN_SWAP);  /* OFF2 OFF1 */
      pkl_asm_insn (pasm, PKL_INSN_OGETM); /* OFF2 OFF1 OFF1M */
      pkl_asm_insn (pasm, PKL_INSN_ROT);   /* OFF1 OFF1M OFF2 */
      pkl_asm_insn (pasm, PKL_INSN_OGETM); /* OFF1 OFF1M OFF2 OFF2M */
      pkl_asm_insn (pasm, PKL_INSN_ROT);   /* OFF1 OFF2 OFF2M OFF1M */
      pkl_asm_insn (pasm, PKL_INSN_SWAP);  /* OFF1 OFF2 OFF1M OFF2M */
      pkl_asm_insn (pasm, insn, base_type);
      pkl_asm_insn (pasm, PKL_INSN_NIP2);  /* OFF1 OFF2 (OFF1M?OFF2M) */
    }
  else if (PKL_AST_TYPE_CODE (type) == PKL_TYPE_ARRAY)
    {
      assert (insn == PKL_INSN_EQ || insn == PKL_INSN_NE);

      RAS_MACRO_EQA (PKL_AST_TYPE_A_ETYPE (type));
      if (insn == PKL_INSN_NE)
        {
          pkl_asm_insn (pasm, PKL_INSN_NOT);
          pkl_asm_insn (pasm, PKL_INSN_NIP);
        }
    }
  else if (PKL_AST_TYPE_CODE (type) == PKL_TYPE_STRUCT)
    {
      pvm_val struct_comparator = PKL_AST_TYPE_S_COMPARATOR (type);

      assert (insn == PKL_INSN_EQ || insn == PKL_INSN_NE);

      /* Call the comparator of the struct type, which must exist at
         this point.  */
      assert (struct_comparator != PVM_NULL);
      pkl_asm_insn (pasm, PKL_INSN_OVER); /* SCT1 SCT2 SCT1 */
      pkl_asm_insn (pasm, PKL_INSN_OVER); /* SCT1 SCT2 SCT1 SCT2 */
      pkl_asm_insn (pasm, PKL_INSN_PUSH, struct_comparator); /* SCT1 SCT2 SCT1 SCT2 CLS */
      pkl_asm_insn (pasm, PKL_INSN_CALL); /* SCT1 SCT2 INT */

      if (insn == PKL_INSN_NE)
        {
          pkl_asm_insn (pasm, PKL_INSN_NOT);
          pkl_asm_insn (pasm, PKL_INSN_NIP);
        }
    }
  else if (PKL_AST_TYPE_CODE (type) == PKL_TYPE_FUNCTION)
    {
      if (insn == PKL_INSN_EQ)
        pkl_asm_insn (pasm, PKL_INSN_EQC);
      else if (insn == PKL_INSN_NE)
        pkl_asm_insn (pasm, PKL_INSN_NEC);
      else
        PK_UNREACHABLE ();
    }
  else if (PKL_AST_TYPE_CODE (type) == PKL_TYPE_ANY)
    {
      assert (insn == PKL_INSN_EQ || insn == PKL_INSN_NE);

      pkl_asm_insn (pasm, PKL_INSN_OVER);
      pkl_asm_insn (pasm, PKL_INSN_OVER);
      pkl_asm_call (pasm, pkl_get_env (pasm->compiler), "_pkl_eq_any");
      if (insn == PKL_INSN_NE)
        {
          pkl_asm_insn (pasm, PKL_INSN_NOT);
          pkl_asm_insn (pasm, PKL_INSN_NIP);
        }
    }
  else
    PK_UNREACHABLE ();
}

/* Macro-instruction: ASETC array_type
   ( ARR ULONG VAL -- ARR )

   Given an array, an index in the array and a value, set the array
   element at that index to the given element.

   This is a checked operation:
   - If the specified index is out of range in the array, then
     PVM_E_OUT_OF_BOUNDS is raised.
   - If the array type is bounded by size and the new value makes the
     total size of the array to change, then PVM_E_CONV is raised.
*/

static void
pkl_asm_insn_asetc (pkl_asm pasm, pkl_ast_node array_type)
{
  RAS_MACRO_ASETC (array_type);
}

/* Macro-instruction: SSETC struct_type
   ( SCT STR VAL -- SCT )

   Given a struct, a string containing the name of a struct element,
   and a value, set the value to the referred element.  If setting the
   element causes a problem with the integrity of the data stored in
   the struct (for example, a constraint expression fails) then the
   operation is aborted and PVM_E_CONSTRAINT is raised.  */

static void
pkl_asm_insn_ssetc (pkl_asm pasm, pkl_ast_node struct_type)
{
  RAS_MACRO_SSETC (struct_type);
}

/* Macro-instruction: ACONC array_elem_type
   ( ARR ARR -- ARR ARR ARR )

   Given two arrays of the same type (but with potentially different
   bounds) generate code to push a new array value with the
   concatenation of the elements of both arrays.  */

static void
pkl_asm_insn_aconc (pkl_asm pasm)
{
  RAS_MACRO_ACONC;
}

/* Macro-instruction: AFILL
   ( ARR VAL -- ARR VAL )

   Given an array and a value of the right type, set all the
   elements of the array to the given value.  */

static void
pkl_asm_insn_afill (pkl_asm pasm)
{
  RAS_MACRO_AFILL;
}

/* Macro-instruction: GCD type
   ( VAL VAL -- VAL VAL )

   Calculate the greatest common divisor of the integral values at the
   TOS, which should be of type TYPE.  */

static void
pkl_asm_insn_gcd (pkl_asm pasm, pkl_ast_node type)
{
  RAS_MACRO_GCD (type);
}

/* Macro-instruction: ADDO base_type
   ( OFF OFF -- OFF OFF OFF )

   Add the two given offsets in the stack, which must be of the given
   base type.

   The base type of the result is BASE_TYPE.  */

static void
pkl_asm_insn_addo (pkl_asm pasm, pkl_ast_node base_type,
                   pkl_ast_node unit)
{
  RAS_MACRO_ADDO (base_type,
                  pvm_make_ulong (PKL_AST_INTEGER_VALUE (unit), 64));
}

/* Macro-instruction: SUBO base_type
   ( OFF OFF -- OFF OFF OFF )

   Subtract the two given offsets in the stack, which must be of the given
   base type.

   The base type of the result is BASE_TYPE.  */

static void
pkl_asm_insn_subo (pkl_asm pasm, pkl_ast_node base_type,
                   pkl_ast_node unit)
{
  RAS_MACRO_SUBO (base_type,
                  pvm_make_ulong (PKL_AST_INTEGER_VALUE (unit), 64));
}

/* Macro-instruction: MULO base_type
   ( OFF VAL -- OFF VAL OFF )

   Multiply an offset with a magnitude.  The types of both the offset
   base type and the magnitude type is BASE_TYPE.  */

static void
pkl_asm_insn_mulo (pkl_asm pasm, pkl_ast_node base_type)
{
  RAS_MACRO_MULO (base_type);
}

/* Macro-instruction: DIVO base_type
   ( OFF OFF -- OFF OFF VAL )

   Divide an offset by another offset.  The result of the operation is
   a magnitude.  The types of both the offsets base type and the
   magnitude type is BASE_TYPE.  */

static void
pkl_asm_insn_divo (pkl_asm pasm, pkl_ast_node base_type)
{
  RAS_MACRO_DIVO (base_type);
}

/* Macro-instruction: MODO base_type
   ( OFF OFF -- OFF OFF OFF )

   Calculate the modulus of two offsets.  The result of the operation
   is an offset.  */

static void
pkl_asm_insn_modo (pkl_asm pasm, pkl_ast_node base_type,
                   pkl_ast_node unit)
{
  RAS_MACRO_MODO (base_type,
                  pvm_make_ulong (PKL_AST_INTEGER_VALUE (unit), 64));
}


/* Macro-instruction: SWAPGT type
   ( VAL VAL -- VAL VAL )

   Swap the integral values at the top of the stack, of type TYPE, if
   the value at the under-top is greater than the value at the
   top.  */

static void
pkl_asm_insn_swapgt (pkl_asm pasm, pkl_ast_node type)
{
  static const int swapgt_table[2][2] = {{PKL_INSN_SWAPGTIU, PKL_INSN_SWAPGTI},
                                   {PKL_INSN_SWAPGTLU, PKL_INSN_SWAPGTL}};

  size_t size = PKL_AST_TYPE_I_SIZE (type);
  int signed_p = PKL_AST_TYPE_I_SIGNED_P (type);

  int tl = !!((size - 1) & ~0x1f);
  pkl_asm_insn (pasm, swapgt_table[tl][signed_p]);
}

/* Macro-instruction: BZ type, label
   ( -- )

   Branch to LABEL if the integer value of type TYPE at the top of the
   stack is zero.  */

static void
pkl_asm_insn_bz (pkl_asm pasm,
                 pkl_ast_node type,
                 pvm_program_label label)
{
  static const int bz_table[2][2] = {{PKL_INSN_BZIU, PKL_INSN_BZI},
                               {PKL_INSN_BZLU, PKL_INSN_BZL}};

  size_t size = PKL_AST_TYPE_I_SIZE (type);
  int signed_p = PKL_AST_TYPE_I_SIGNED_P (type);

  int tl = !!((size - 1) & ~0x1f);

  pkl_asm_insn (pasm, bz_table[tl][signed_p], label);
}

/* Macro-instruction: BNZ type, label
   ( -- )

   Branch to LABEL if the integer value of type TYPE at the top of the
   stack is not zero.  */

static void
pkl_asm_insn_bnz (pkl_asm pasm,
                  pkl_ast_node type,
                  pvm_program_label label)
{
  static const int bnz_table[2][2] = {{PKL_INSN_BNZIU, PKL_INSN_BNZI},
                                {PKL_INSN_BNZLU, PKL_INSN_BNZL}};

  size_t size = PKL_AST_TYPE_I_SIZE (type);
  int signed_p = PKL_AST_TYPE_I_SIGNED_P (type);

  int tl = !!((size - 1) & ~0x1f);

  pkl_asm_insn (pasm, bnz_table[tl][signed_p], label);
}

/* Macro-instruction: AIS type
   ( VAL ARR -- VAL ARR BOOL )

   Push 0 (false) if the given VAL is not found in the container ARR.
   Push 1 (true) otherwise.  */

static void
pkl_asm_insn_ais (pkl_asm pasm, pkl_ast_node atype)
{
  RAS_MACRO_AIS (PKL_AST_TYPE_A_ETYPE (atype));
}

/* Create a new instance of an assembler.  This initializes a new
   routine.  */

pkl_asm
pkl_asm_new (pkl_ast ast, pkl_compiler compiler,
             int prologue)
{
  pkl_asm pasm = pvm_alloc (sizeof (struct pkl_asm));
  pvm_program program = pvm_program_new ();

  memset (pasm, 0, sizeof (struct pkl_asm));
  pkl_asm_pushlevel (pasm, PKL_ASM_ENV_NULL);

  pasm->compiler = compiler;
  pasm->ast = ast;
  pasm->error_label = pvm_program_fresh_label (program);
  pasm->program = program;

  if (prologue)
    {
      /* Standard prologue.  */
      pkl_asm_note (pasm, "#begin prologue");

      /* Install the stack canary.  */
      pkl_asm_insn (pasm, PKL_INSN_CANARY);

      /* Install the default exception handler.  */
      pkl_asm_insn (pasm, PKL_INSN_PUSH,
                    pvm_make_exception (PVM_E_GENERIC, PVM_E_GENERIC_NAME,
                                        PVM_E_GENERIC_ESTATUS, NULL, NULL));
      pkl_asm_insn (pasm, PKL_INSN_PUSHE, pasm->error_label);
      pkl_asm_note (pasm, "#end prologue");
    }

  return pasm;
}

/* Finish the assembly of the current program and return it.  This
   function frees all resources used by the assembler instance, and
   `pkl_asm_new' should be called again in order to assemble another
   program.  */

pvm_program
pkl_asm_finish (pkl_asm pasm, int epilogue)
{
  pvm_program program = pasm->program;

  if (epilogue)
    {
      pkl_asm_note (pasm, "#begin epilogue");

      /* Successful program finalization.  */
      pkl_asm_insn (pasm, PKL_INSN_POPE);
      pkl_asm_insn (pasm, PKL_INSN_PUSH, pvm_make_int (PVM_EXIT_OK, 32));
      pkl_asm_insn (pasm, PKL_INSN_EXIT);

      pvm_program_append_label (pasm->program, pasm->error_label);

      /* Default exception handler.  */
      if (pkl_bootstrapped_p (pasm->compiler))
        {
          pkl_asm_insn (pasm, PKL_INSN_PUSH,
                        pvm_make_string ("exit_status")); /* EXC STR */
          pkl_asm_insn (pasm, PKL_INSN_SREF);             /* EXC STR VAL */
          pkl_asm_insn (pasm, PKL_INSN_NIP);              /* EXC VAL */
          pkl_asm_insn (pasm, PKL_INSN_SWAP);             /* VAL EXC */
          pkl_asm_insn (pasm, PKL_INSN_POPEXITE);         /* VAL */
        }
      else
        {
          pkl_asm_insn (pasm, PKL_INSN_DROP); /* Discard the exception.  */
          pkl_asm_insn (pasm, PKL_INSN_PUSH,
                        pvm_make_string ("unhandled exception while bootstrapping\n"));
          pkl_asm_insn (pasm, PKL_INSN_PRINTS);
          pkl_asm_insn (pasm, PKL_INSN_PUSH, pvm_make_int (PVM_EXIT_ERROR, 32));
        }

      /* The exit status is now on the stack.  Add the result value of
         the execution, which in this case is null. */
      pkl_asm_insn (pasm, PKL_INSN_PUSH, PVM_NULL);
      pkl_asm_insn (pasm, PKL_INSN_SWAP);

      pkl_asm_insn (pasm, PKL_INSN_EXIT);
      pkl_asm_note (pasm, "#end epilogue");
    }

  /* Free the first level.  */
  pkl_asm_poplevel (pasm);

  /* Free the assembler instance and return the assembled program to
     the user.  */
  return program;
}

/* Assemble an instruction INSN and append it to the program being
   assembled in PASM.  If the instruction takes any argument, they
   follow after INSN.  */

void
pkl_asm_insn (pkl_asm pasm, enum pkl_asm_insn insn, ...)
{
  static const char *insn_names[] =
    {
#define PKL_DEF_INSN(SYM, ARGS, NAME) NAME,
#  include "pkl-insn.def"
#undef PKL_DEF_INSN
    };

  static const char *insn_args[] =
    {
#define PKL_DEF_INSN(SYM, ARGS, NAME) ARGS,
#  include "pkl-insn.def"
#undef PKL_DEF_INSN
    };

  va_list valist;

  if (insn == PKL_INSN_PUSH)
    {
      pvm_val val;

      va_start (valist, insn);
      val = va_arg (valist, pvm_val);
      va_end (valist);

      pvm_program_append_push_instruction (pasm->program, val);
    }
  else if (insn < PKL_INSN_MACRO)
    {
      /* This is a PVM instruction.  Process its arguments and append
         it to the PVM program.  */

      const char *insn_name = insn_names[insn];
      const char *p;

      pvm_program_append_instruction (pasm->program, insn_name);

      va_start (valist, insn);
      for (p = insn_args[insn]; *p != '\0'; ++p)
        {
          char arg_class = *p;

          switch (arg_class)
            {
            case 'v':
              {
                pvm_val val = va_arg (valist, pvm_val);

                /* This is to be removed when Jitter is fixed so it
                   can use 64-bit elements in 32-bit machines.  We
                   have hacks to prevent the assert below in both
                   pkl_asm_note and the push instructions.  */
#if defined POKE_HOST_32BIT
                PK_UNREACHABLE ();
#endif
                pvm_program_append_val_parameter (pasm->program, val);
                break;
              }
            case 'n':
              {
                unsigned int n = va_arg (valist, unsigned int);
                pvm_program_append_unsigned_parameter (pasm->program, n);
                break;
              }
            case 'l':
              {
                pvm_program_label label
                  = va_arg (valist, pvm_program_label);
                pvm_program_append_label_parameter (pasm->program, label);
                break;
              }
            case 'r':
              {
                pvm_register reg = va_arg (valist, pvm_register);
                pvm_program_append_register_parameter (pasm->program, reg);
                break;
              }
            case 'a':
              /* Fallthrough.  */
            case 'i':
              PK_UNREACHABLE ();
              break;
            }
        }
      va_end (valist);
    }
  else
    {
      /* This is a macro-instruction.  Dispatch to the corresponding
         macro-instruction handler.  */

      switch (insn)
        {
        case PKL_INSN_BCONC:
          {
            pkl_ast_node op1_type, op2_type;
            pkl_ast_node res_type;

            va_start (valist, insn);
            op1_type = va_arg (valist, pkl_ast_node);
            op2_type = va_arg (valist, pkl_ast_node);
            res_type = va_arg (valist, pkl_ast_node);
            va_end (valist);

            pkl_asm_insn_bconc (pasm, op1_type, op2_type, res_type);
            break;
          }
        case PKL_INSN_NTON:
        case PKL_INSN_ATOA:
          {
            pkl_ast_node from_type;
            pkl_ast_node to_type;

            va_start (valist, insn);
            from_type = va_arg (valist, pkl_ast_node);
            to_type = va_arg (valist, pkl_ast_node);
            va_end (valist);

            if (insn == PKL_INSN_NTON)
              pkl_asm_insn_nton (pasm, from_type, to_type);
            else if (insn == PKL_INSN_ATOA)
              pkl_asm_insn_atoa (pasm, from_type, to_type);
            break;
          }
        case PKL_INSN_PEEK:
        case PKL_INSN_POKE:
          {
            pkl_ast_node type;
            unsigned int endian, nenc;

            va_start (valist, insn);
            type = va_arg (valist, pkl_ast_node);
            nenc = va_arg (valist, unsigned int);
            endian = va_arg (valist, unsigned int);
            va_end (valist);

            if (insn == PKL_INSN_PEEK)
              pkl_asm_insn_peek (pasm, type, nenc, endian);
            else
              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;

            va_start (valist, insn);
            type = va_arg (valist, pkl_ast_node);
            va_end (valist);

            pkl_asm_insn_print (pasm, type);
            break;
          }
        case PKL_INSN_REV:
          {
            unsigned int depth;

            va_start (valist, insn);
            depth = va_arg (valist, unsigned int);
            va_end (valist);

            pkl_asm_insn_rev (pasm, depth);
            break;
          }
        case PKL_INSN_PEEKD:
        case PKL_INSN_POKED:
          {
            pkl_ast_node integral_type;

            va_start (valist, insn);
            integral_type = va_arg (valist, pkl_ast_node);
            va_end (valist);

            if (insn == PKL_INSN_PEEKD)
              pkl_asm_insn_peekd (pasm, integral_type);
            else
              pkl_asm_insn_poked (pasm, integral_type);
            break;
          }
        case PKL_INSN_BZ:
          {
            pkl_ast_node type;
            pvm_program_label label;

            va_start (valist, insn);
            type = va_arg (valist, pkl_ast_node);
            label = va_arg (valist, pvm_program_label);
            va_end (valist);

            pkl_asm_insn_bz (pasm, type, label);
            break;
          }
        case PKL_INSN_BNZ:
          {
            pkl_ast_node type;
            pvm_program_label label;

            va_start (valist, insn);
            type = va_arg (valist, pkl_ast_node);
            label = va_arg (valist, pvm_program_label);
            va_end (valist);

            pkl_asm_insn_bnz (pasm, type, label);
            break;
          }
        case PKL_INSN_SWAPGT:
          {
            pkl_ast_node type;

            va_start (valist, insn);
            type = va_arg (valist, pkl_ast_node);
            va_end (valist);

            pkl_asm_insn_swapgt (pasm, type);
            break;
          }
        case PKL_INSN_AIS:
          {
            pkl_ast_node atype;

            va_start (valist, insn);
            atype = va_arg (valist, pkl_ast_node);
            va_end (valist);

            pkl_asm_insn_ais (pasm, atype);
            break;
          }
        case PKL_INSN_NEG:
        case PKL_INSN_ADD:
        case PKL_INSN_SUB:
        case PKL_INSN_MUL:
        case PKL_INSN_DIV:
        case PKL_INSN_MOD:
        case PKL_INSN_BNOT:
        case PKL_INSN_BAND:
        case PKL_INSN_BOR:
        case PKL_INSN_BXOR:
        case PKL_INSN_SL:
        case PKL_INSN_SR:
        case PKL_INSN_POW:
        case PKL_INSN_NEGOF:
        case PKL_INSN_ADDOF:
        case PKL_INSN_SUBOF:
        case PKL_INSN_MULOF:
        case PKL_INSN_DIVOF:
        case PKL_INSN_MODOF:
        case PKL_INSN_POWOF:
          {
            pkl_ast_node type;

            va_start (valist, insn);
            type = va_arg (valist, pkl_ast_node);
            va_end (valist);

            pkl_asm_insn_binop (pasm, insn, type);
            break;
          }
        case PKL_INSN_CDIV:
        case PKL_INSN_CDIVO:
          {
            pkl_ast_node type;

            va_start (valist, insn);
            type = va_arg (valist, pkl_ast_node);
            va_end (valist);

            if (insn == PKL_INSN_CDIV)
              pkl_asm_insn_cdiv (pasm, insn, type);
            else
              pkl_asm_insn_cdivo (pasm, insn, type);
            break;
          }
        case PKL_INSN_EQ:
        case PKL_INSN_NE:
        case PKL_INSN_LT:
        case PKL_INSN_GT:
        case PKL_INSN_GE:
        case PKL_INSN_LE:
          {
            pkl_ast_node type;

            va_start (valist, insn);
            type = va_arg (valist, pkl_ast_node);
            va_end (valist);

            pkl_asm_insn_cmp (pasm, insn, type);
            break;
          }
        case PKL_INSN_GCD:
          {
            pkl_ast_node type;

            va_start (valist, insn);
            type = va_arg (valist, pkl_ast_node);
            va_end (valist);

            pkl_asm_insn_gcd (pasm, type);
            break;
          }
        case PKL_INSN_ADDO:
        case PKL_INSN_SUBO:
        case PKL_INSN_MULO:
        case PKL_INSN_DIVO:
        case PKL_INSN_MODO:
          {
            pkl_ast_node base_type;
            pkl_ast_node unit = NULL;

            va_start (valist, insn);
            base_type = va_arg (valist, pkl_ast_node);
            if (insn == PKL_INSN_ADDO || insn == PKL_INSN_SUBO
                || insn == PKL_INSN_MODO)
              unit = va_arg (valist, pkl_ast_node);
            va_end (valist);

            if (insn == PKL_INSN_ADDO)
              pkl_asm_insn_addo (pasm, base_type, unit);
            else if (insn == PKL_INSN_SUBO)
              pkl_asm_insn_subo (pasm, base_type, unit);
            else if (insn == PKL_INSN_MULO)
              pkl_asm_insn_mulo (pasm, base_type);
            else if (insn == PKL_INSN_DIVO)
              pkl_asm_insn_divo (pasm, base_type);
            else if (insn == PKL_INSN_MODO)
              pkl_asm_insn_modo (pasm, base_type, unit);
            else
              PK_UNREACHABLE ();
            break;
          }
        case PKL_INSN_REMAP:
          pkl_asm_insn_remap (pasm);
          break;
        case PKL_INSN_AREMAP:
          pkl_asm_insn_aremap (pasm);
          break;
        case PKL_INSN_WRITE:
          pkl_asm_insn_write (pasm);
          break;
        case PKL_INSN_ACONC:
          pkl_asm_insn_aconc (pasm);
          break;
        case PKL_INSN_AFILL:
          pkl_asm_insn_afill (pasm);
          break;
        case PKL_INSN_ASETC:
          {
            pkl_ast_node array_type;

            va_start (valist, insn);
            array_type = va_arg (valist, pkl_ast_node);
            va_end (valist);

            pkl_asm_insn_asetc (pasm, array_type);
            break;
          }
        case PKL_INSN_SSETC:
          {
            pkl_ast_node struct_type;

            va_start (valist, insn);
            struct_type = va_arg (valist, pkl_ast_node);
            va_end (valist);

            pkl_asm_insn_ssetc (pasm, struct_type);
            break;
          }
        case PKL_INSN_MACRO:
        default:
          PK_UNREACHABLE ();
        }
    }
}

/* Emit a .note directive with STR as its contents.  */

void
pkl_asm_note (pkl_asm pasm, const char *str)
{
  /* note doesn't work in 32-bit because of jitter's inability to pass
     64-bit pointers as arguments to instructions in 32-bit.  */
#if !defined POKE_HOST_32BIT
  pkl_asm_insn (pasm, PKL_INSN_NOTE, pvm_make_string (str));
#endif
}

/* The following functions implement conditional constructions.  The
   code generated is:

        ... condition expression ...
        BZ label1;
        POP the condition expression
        ... then body ...
        BA label2;
     label1:
        POP the condition expression
        ... else body ...
     label2:

     Thus, conditionals use two labels.  */

void
pkl_asm_if (pkl_asm pasm, pkl_ast_node exp)
{
  pkl_asm_pushlevel (pasm, PKL_ASM_ENV_CONDITIONAL);

  pasm->level->label1 = pvm_program_fresh_label (pasm->program);
  pasm->level->label2 = pvm_program_fresh_label (pasm->program);
  pasm->level->node1 = ASTREF (exp);
}

void
pkl_asm_then (pkl_asm pasm)
{
  assert (pasm->level->current_env == PKL_ASM_ENV_CONDITIONAL);

  pkl_asm_insn (pasm, PKL_INSN_BZ,
                PKL_AST_TYPE (pasm->level->node1),
                pasm->level->label1);
  /* Pop the expression condition from the stack.  */
  pkl_asm_insn (pasm, PKL_INSN_DROP);
}

void
pkl_asm_else (pkl_asm pasm)
{
  assert (pasm->level->current_env == PKL_ASM_ENV_CONDITIONAL);

  pkl_asm_insn (pasm, PKL_INSN_BA, pasm->level->label2);
  pvm_program_append_label (pasm->program, pasm->level->label1);
  /* Pop the expression condition from the stack.  */
  pkl_asm_insn (pasm, PKL_INSN_DROP);
}

void
pkl_asm_endif (pkl_asm pasm)
{
  assert (pasm->level->current_env == PKL_ASM_ENV_CONDITIONAL);
  pvm_program_append_label (pasm->program, pasm->level->label2);

  /* Cleanup and pop the current level.  */
  pkl_ast_node_free (pasm->level->node1);
  pkl_asm_poplevel (pasm);
}

/* The following functions implement try-catch blocks.  The code
   generated is:

     PUSH-REGISTERS
     PUSHE label1
     ... code ...
     POPE
     POP-REGISTERS
     BA label2
   label1:
     ... handler ...
   label2:

   Thus, try-catch blocks use two labels.

   Note that pkl_asm_try expects to find an Exception at the top of
   the main stack.  */

void
pkl_asm_try (pkl_asm pasm, pkl_ast_node arg)
{
  pkl_asm_pushlevel (pasm, PKL_ASM_ENV_TRY);

  if (arg)
    pasm->level->node1 = ASTREF (arg);
  pasm->level->label1 = pvm_program_fresh_label (pasm->program);
  pasm->level->label2 = pvm_program_fresh_label (pasm->program);

  /* pkl_asm_note (pasm, "PUSH-REGISTERS"); */
  pkl_asm_insn (pasm, PKL_INSN_PUSHE, pasm->level->label1);
}

void
pkl_asm_catch (pkl_asm pasm)
{
  assert (pasm->level->current_env == PKL_ASM_ENV_TRY);

  pkl_asm_insn (pasm, PKL_INSN_POPE);
  pkl_asm_insn (pasm, PKL_INSN_BA, pasm->level->label2);
  pvm_program_append_label (pasm->program, pasm->level->label1);

  /* At this point the Exception is at the top of the stack.  If the
     catch block received an argument, push a new environment and set
     it as a local.  Otherwise, just discard it.  */

  if (pasm->level->node1)
    {
      pkl_asm_insn (pasm, PKL_INSN_PUSHF, 1);
      pkl_asm_insn (pasm, PKL_INSN_REGVAR);
    }
  else
    pkl_asm_insn (pasm, PKL_INSN_DROP);
}

void
pkl_asm_endtry (pkl_asm pasm)
{
  assert (pasm->level->current_env == PKL_ASM_ENV_TRY);

  /* Pop the catch frame if it is was created.  */
  if (pasm->level->node1)
    pkl_asm_insn (pasm, PKL_INSN_POPF, 1);

  pvm_program_append_label (pasm->program, pasm->level->label2);

  /* Cleanup and pop the current level.  */
  pkl_ast_node_free (pasm->level->node1);
  pkl_asm_poplevel (pasm);
}

/* The following functions implement simple unrestricted loops.  The
   code generated is:

   label1:
   ... loop body ...
   continue_label:
   SYNC
   BA label1;
   break_label:
*/

void
pkl_asm_loop (pkl_asm pasm)
{
  pkl_asm_pushlevel (pasm, PKL_ASM_ENV_LOOP);

  pasm->level->label1 = pvm_program_fresh_label (pasm->program);
  pasm->level->break_label = pvm_program_fresh_label (pasm->program);
  pasm->level->continue_label = pvm_program_fresh_label (pasm->program);
  pvm_program_append_label (pasm->program, pasm->level->label1);
}

void
pkl_asm_endloop (pkl_asm pasm)
{
  pvm_program_append_label (pasm->program, pasm->level->continue_label);
  pkl_asm_insn (pasm, PKL_INSN_SYNC);
  pkl_asm_insn (pasm, PKL_INSN_BA, pasm->level->label1);
  pvm_program_append_label (pasm->program, pasm->level->break_label);

  /* Cleanup and pop the current level.  */
  pkl_asm_poplevel (pasm);
}

/* The following functions implement while loops.  The code generated
   is:

   label1:
   ... loop condition expression ...
   BZ label2;
   POP the condition expression
   ... loop body ...
   continue_label:
   SYNC
   BA label1;
   label2:
   POP the condition expression
   break_label:

   Thus, loops use two labels.  */

void
pkl_asm_while (pkl_asm pasm)
{
  pkl_asm_pushlevel (pasm, PKL_ASM_ENV_LOOP);

  pasm->level->label1 = pvm_program_fresh_label (pasm->program);
  pasm->level->label2 = pvm_program_fresh_label (pasm->program);
  pasm->level->break_label = pvm_program_fresh_label (pasm->program);
  pasm->level->continue_label = pvm_program_fresh_label (pasm->program);

  pvm_program_append_label (pasm->program, pasm->level->label1);
}

void
pkl_asm_while_loop (pkl_asm pasm, pkl_ast_node condition_type)
{
  if (condition_type)
    pkl_asm_insn (pasm, PKL_INSN_BZ, condition_type, pasm->level->label2);
  else
    pkl_asm_insn (pasm, PKL_INSN_BZI, pasm->level->label2);
  /* Pop the loop condition from the stack.  */
  pkl_asm_insn (pasm, PKL_INSN_DROP);
}

void
pkl_asm_while_endloop (pkl_asm pasm)
{
  pvm_program_append_label (pasm->program,
                            pasm->level->continue_label);
  pkl_asm_insn (pasm, PKL_INSN_SYNC);
  pkl_asm_insn (pasm, PKL_INSN_BA, pasm->level->label1);
  pvm_program_append_label (pasm->program, pasm->level->label2);
  /* Pop the loop condition from the stack.  */
  pkl_asm_insn (pasm, PKL_INSN_DROP);

  pvm_program_append_label (pasm->program, pasm->level->break_label);

  /* Cleanup and pop the current level.  */
  pkl_asm_poplevel (pasm);
}

/* The following functions implement for loops.  The code generated
   is:

   FOR (HEAD; CONDITION; TAIL) { BODY }

     PUHSF
     ... HEAD ...
   label1:
     ... condition ...
   label2:
     ... BODY ...
   continue_label:
     ... TAIL ...
     BA label1
   label3:
     DROP
   break_label:
     POPF
*/

void
pkl_asm_for (pkl_asm pasm, pkl_ast_node head)
{
  pkl_asm_pushlevel (pasm, PKL_ASM_ENV_FOR_LOOP);

  pasm->level->node1 = ASTREF (head);
  pasm->level->label1 = pvm_program_fresh_label (pasm->program);
  pasm->level->label2 = pvm_program_fresh_label (pasm->program);
  pasm->level->label3 = pvm_program_fresh_label (pasm->program);
  pasm->level->continue_label = pvm_program_fresh_label (pasm->program);
  pasm->level->break_label = pvm_program_fresh_label (pasm->program);

  if (head)
    pkl_asm_insn (pasm, PKL_INSN_PUSHF, 0);
}

void
pkl_asm_for_condition (pkl_asm pasm)
{
  pvm_program_append_label (pasm->program, pasm->level->label1);
}

void
pkl_asm_for_loop (pkl_asm pasm, pkl_ast_node cond_type)
{
  if (cond_type)
    pkl_asm_insn (pasm, PKL_INSN_BZ, cond_type, pasm->level->label2);
  else
    pkl_asm_insn (pasm, PKL_INSN_BZI, pasm->level->label2);
  /* Pop the loop condition from the stack.  */
  pkl_asm_insn (pasm, PKL_INSN_DROP);
}

void
pkl_asm_for_tail (pkl_asm pasm)
{
  pvm_program_append_label (pasm->program, pasm->level->continue_label);
}

void
pkl_asm_for_endloop (pkl_asm pasm)
{
  pkl_asm_insn (pasm, PKL_INSN_SYNC);
  pkl_asm_insn (pasm, PKL_INSN_BA, pasm->level->label1);
  pvm_program_append_label (pasm->program, pasm->level->label2);
  pkl_asm_insn (pasm, PKL_INSN_DROP); /* The condition boolean */
  pvm_program_append_label (pasm->program, pasm->level->break_label);

  if (pasm->level->node1)
    pkl_asm_insn (pasm, PKL_INSN_POPF, 1);

  /* Cleanup and pop the current level.  */
  pkl_ast_node_free (pasm->level->node1);
  pkl_asm_poplevel (pasm);
}

/* The following functions implement for-in-where loops.  The code
   generated is:

   FOR (VAR in CONTAINER where CONDITION) { BODY }

   State to keep: CONTAINER length. index in CONTAINER.

              ; CONTAINER
 label1:
   PUSHF
   PUSH NULL  ; CONTAINER NULL
   REGVAR     ; CONTAINER
   SEL        ; CONTAINER NELEMS
   PUSH 0UL   ; CONTAINER NELEMS 0
   SWAP       ; CONTAINER 0 NELEMS
   PUSH NULL  ; CONTAINER 0 NELEMS NULL
 label2:
   DROP       ; CONTAINER I NELEMS
   EQLU       ; CONTAINER I NELEMS BOOL
   BNZI label3
   POP        ; CONTAINER I NELEMS
   ; Set the iterator for this iteration.
   ROT        ; I NELEMS CONTAINER
   ROT        ; NELEMS CONTAINER I
   AREF|STRREF ; NELEMS CONTAINER I IVAL
   POPVAR 0,0 ; NELEMS CONTAINER I
   ROT        ; CONTAINER I NELEMS
   ; Increase the iterator counter
   SWAP       ; CONTAINER NELEMS I
   PUSH 1UL   ; CONTAINER NELEMS I 1
   ADDLU      ; CONTAINER NELEMS I 1 (I+1)
   NIP2       ; CONTAINER NELEMS (I+1)
   SWAP       ; CONTAINER (I+1) NELEMS
#if SELECTOR
   ; Evaluate the selector and skip this iteration if it is
   ; not true

   ... CONDITION ... ; CONTAINER (I+1) NELEMS BOOL
   BZ label2;
   DROP       ; CONTAINER (I+1) NELEMS
#endif

   ... BODY ...

 continue_label:
   PUSH null ; CONTAINER (I+1) NELEMS null
   BA label2
 label3:
   DROP       ; CONTAINER I NELEMS
 break_label:
   DROP       ; CONTAINER I
   DROP       ; CONTAINER
   DROP       ; _
   POPF 1
*/

void
pkl_asm_for_in (pkl_asm pasm, int container_type,
                pkl_ast_node selector)
{
  pkl_asm_pushlevel (pasm, PKL_ASM_ENV_FOR_IN_LOOP);

  pasm->level->label1 = pvm_program_fresh_label (pasm->program);
  pasm->level->label2 = pvm_program_fresh_label (pasm->program);
  pasm->level->label3 = pvm_program_fresh_label (pasm->program);
  pasm->level->break_label = pvm_program_fresh_label (pasm->program);
  pasm->level->continue_label = pvm_program_fresh_label (pasm->program);

  if (selector)
    pasm->level->node1 = ASTREF (selector);
  assert (container_type == PKL_TYPE_ARRAY
          || container_type == PKL_TYPE_STRING);
  pasm->level->int1 = container_type;
}

void
pkl_asm_for_in_where (pkl_asm pasm)
{
  pvm_program_append_label (pasm->program, pasm->level->label1);

  pkl_asm_insn (pasm, PKL_INSN_PUSHF, 1);
  pkl_asm_insn (pasm, PKL_INSN_PUSH, PVM_NULL);
  pkl_asm_insn (pasm, PKL_INSN_REGVAR);
  pkl_asm_insn (pasm, PKL_INSN_SEL);
  pkl_asm_insn (pasm, PKL_INSN_PUSH, pvm_make_ulong (0, 64));
  pkl_asm_insn (pasm, PKL_INSN_SWAP);
  pkl_asm_insn (pasm, PKL_INSN_PUSH, PVM_NULL);

  pvm_program_append_label (pasm->program, pasm->level->label2);

  pkl_asm_insn (pasm, PKL_INSN_DROP);
  pkl_asm_insn (pasm, PKL_INSN_EQLU);
  pkl_asm_insn (pasm, PKL_INSN_BNZI, pasm->level->label3);
  pkl_asm_insn (pasm, PKL_INSN_DROP);

  /* Set the iterator for this iteration.  */
  pkl_asm_insn (pasm, PKL_INSN_ROT);
  pkl_asm_insn (pasm, PKL_INSN_ROT);
  if (pasm->level->int1 == PKL_TYPE_ARRAY)
    pkl_asm_insn (pasm, PKL_INSN_AREF);
  else
    pkl_asm_insn (pasm, PKL_INSN_STRREF);
  pkl_asm_insn (pasm, PKL_INSN_POPVAR, 0, 0);
  pkl_asm_insn (pasm, PKL_INSN_ROT);

  /* Increase the iterator counter.  */
  pkl_asm_insn (pasm, PKL_INSN_SWAP);
  pkl_asm_insn (pasm, PKL_INSN_PUSH, pvm_make_ulong (1, 64));
  pkl_asm_insn (pasm, PKL_INSN_ADDLU);
  pkl_asm_insn (pasm, PKL_INSN_NIP2);
  pkl_asm_insn (pasm, PKL_INSN_SWAP);
}

void
pkl_asm_for_in_loop (pkl_asm pasm)
{
  if (pasm->level->node1)
    {
      /* A selector condition has been evaluated and it is at the top
         of the stack.  */
      pkl_asm_insn (pasm, PKL_INSN_BZ,
                    PKL_AST_TYPE (pasm->level->node1),
                    pasm->level->label2);
      pkl_asm_insn (pasm, PKL_INSN_DROP);
    }
}

void
pkl_asm_for_in_endloop (pkl_asm pasm)
{
  pvm_program_append_label (pasm->program,
                            pasm->level->continue_label);
  pkl_asm_insn (pasm, PKL_INSN_SYNC);
  pkl_asm_insn (pasm, PKL_INSN_PUSH, PVM_NULL);
  pkl_asm_insn (pasm, PKL_INSN_BA, pasm->level->label2);

  pvm_program_append_label (pasm->program, pasm->level->label3);

  /* Cleanup the stack, and pop the current frame from the
     environment.  */
  pkl_asm_insn (pasm, PKL_INSN_DROP);
  pvm_program_append_label (pasm->program, pasm->level->break_label);
  pkl_asm_insn (pasm, PKL_INSN_DROP);
  pkl_asm_insn (pasm, PKL_INSN_DROP);
  pkl_asm_insn (pasm, PKL_INSN_DROP);
  pkl_asm_insn (pasm, PKL_INSN_POPF, 1);

  /* Cleanup and pop the current level.  */
  pkl_ast_node_free (pasm->level->node1);
  pkl_asm_poplevel (pasm);
}

void
pkl_asm_call (pkl_asm pasm, pkl_env env, const char *funcname)
{
  int back, over;
  pkl_ast_node tmp;

  assert (pkl_env_toplevel_p (env));

  tmp = pkl_env_lookup (env, PKL_ENV_NS_MAIN,
                        funcname, &back, &over);
  assert (tmp != NULL);
  assert (back == 0);

  pkl_asm_insn (pasm, PKL_INSN_PUSHTOPVAR, over);
  pkl_asm_insn (pasm, PKL_INSN_CALL);
}

static pvm_program_label
pkl_asm_break_label_1 (struct pkl_asm_level *level)
{
  switch (level->current_env)
    {
    case PKL_ASM_ENV_LOOP:
    case PKL_ASM_ENV_FOR_LOOP:
    case PKL_ASM_ENV_FOR_IN_LOOP:
      return level->break_label;
      break;
    default:
      return pkl_asm_break_label_1 (level->parent);
      break;
    }

  /* The compiler must guarantee this does NOT happen.  */
  PK_UNREACHABLE ();
}

pvm_program_label
pkl_asm_break_label (pkl_asm pasm)
{
  return pkl_asm_break_label_1 (pasm->level);
}

/* XXX avoid code duplication with the break statement.  */
static pvm_program_label
pkl_asm_continue_label_1 (struct pkl_asm_level *level)
{
  switch (level->current_env)
    {
    case PKL_ASM_ENV_LOOP:
    case PKL_ASM_ENV_FOR_LOOP:
    case PKL_ASM_ENV_FOR_IN_LOOP:
      return level->continue_label;
      break;
    default:
      return pkl_asm_continue_label_1 (level->parent);
      break;
    }

  /* The compiler must guarantee this does NOT happen.  */
  PK_UNREACHABLE ();
}

pvm_program_label
pkl_asm_continue_label (pkl_asm pasm)
{
  return pkl_asm_continue_label_1 (pasm->level);
}

pvm_program_label
pkl_asm_fresh_label (pkl_asm pasm)
{
  return pvm_program_fresh_label (pasm->program);
}

void
pkl_asm_label (pkl_asm pasm, pvm_program_label label)
{
  pvm_program_append_label (pasm->program, label);
}

char *
pkl_asm_from_string (pkl_asm pasm, const char *str)
{
  char *expanded_template
    = pvm_program_expand_asm_template (str);

  char *ret
    = pvm_program_parse_from_string (expanded_template, pasm->program);
  free (expanded_template);

  return ret;
}
