/*  Pfe module:  hfkernel-ext.c
  ^Forth input:  hfkernel.hf
          Date:  26-Nov-2002 09:12:51
    Translator:  0.1.6 
*/

#define _P4_SOURCE 1

/* pfe register variables, etc. */
#include <pfe/def-config.h>

/* Compiler switches for extra registers are NO_EXTRA_REGS,
   HF_TOSREG, and HF_FTOSREG.*/

#if !defined NO_EXTRA_REGS
  #if defined __target_arch_ppc
    register int hf_index asm ("21");  /* top DO ... LOOP params */
    register int hf_limit asm ("22");
    #ifdef HF_TOSREG
      register int TOS asm ("23");
      register int hf_flag asm ("24");
    #endif  /* HF_TOSREG */
    #ifdef HF_FTOSREG
      register double FTOS asm ("f14");
    #endif  /* HF_FTOSREG */
  #elif defined __target_arch_i386
    static int hf_index; /* top DO ... LOOP params */
    static int hf_limit;
    #undef HF_TOSREG
    #ifdef HF_FTOSREG  /* THIS DOES NOT WORK! */
      register double FTOS asm ("%st(7)");
    #endif  /* HF_FTOSREG */
  #elif defined __target_cpu_hppa
    register int hf_index asm ("r11");  /* top DO ... LOOP params */
    register int hf_limit asm ("r10");
    #ifdef HF_TOSREG
      register int TOS asm ("r9");
      register int hf_flag asm ("r8");
    #endif  /* HF_TOSREG */
    #ifdef HF_FTOSREG
      register double FTOS asm ("fr21");
    #endif  /* HF_FTOSREG */
  #else
    #define NO_EXTRA_REGS 1
    #warning Unknown architecture, using no extra register variables.
  #endif
#endif  /* !defined NO_EXTRA_REGS */

#ifdef NO_EXTRA_REGS
  static int hf_index;  /* top DO ... LOOP params */
  static int hf_limit;
  #undef HF_TOSREG
  #undef HF_FTOSREG
#endif  /* NO_EXTRA_REGS */

#ifdef HF_TOSREG
  #define HF_FILL_TOS  TOS = *SP;  /* note ";" in these two */
  #define HF_SPILL_TOS *SP = TOS;
  #define HF_PUSH(A)  *SP-- = TOS; TOS = (A)
  #define HF_POP(A)   (A) = TOS; TOS = *++SP   
  #define HF_DROP1    TOS = *++SP
  #define HF_DROP2    SP += 2; TOS = *SP
  #define HF_IF       HF_POP(hf_flag); if (hf_flag)
  #define HF_NIF      HF_POP(hf_flag); if (!hf_flag)
  #define HF_UNTIL    HF_POP(hf_flag);}while (!hf_flag)
  #define HF_NUNTIL   HF_POP(hf_flag);}while (hf_flag)
#else
  #define TOS *SP
  #define HF_FILL_TOS
  #define HF_SPILL_TOS
  #define HF_PUSH(A)  *--SP = (A)
  #define HF_POP(A)   (A) = *SP++   
  #define HF_DROP1    SP += 1
  #define HF_DROP2    SP += 2
  #define HF_IF       if (*SP++)
  #define HF_NIF      if (!*SP++)
  #define HF_UNTIL    }while (!*SP++)
  #define HF_NUNTIL   }while (*SP++)
  #endif  /* HF_TOSREG */

#ifdef HF_FTOSREG
  #define HF_FILL_FTOS  FTOS = *FP;  /* note ";" in these two */
  #define HF_SPILL_FTOS *FP = FTOS;
  #define HF_FPUSH(A)  *FP-- = FTOS; FTOS = (A)
  #define HF_FPOP(A)   (A) = FTOS; FTOS = *++FP
  #define HF_FDROP1    FTOS = *++FP
  #define HF_FDROP2    FP += 2; FTOS = *FP
  #define HF_FDROP3    FP += 3; FTOS = *FP
#else
  #define FTOS *FP
  #define HF_FILL_FTOS
  #define HF_SPILL_FTOS
  #define HF_FPUSH(A)  *--FP = (A)
  #define HF_FPOP(A)   (A) = *FP++
  #define HF_FDROP1    FP += 1
  #define HF_FDROP2    FP += 2
  #define HF_FDROP3    FP += 3
#endif  /* HF_FTOSREG */

/* The basic pfe include. */
#include <pfe/pfe-base.h>

/* Extra includes. */
#include <pfe/double-sub.h>
#include <string.h>
#define zero 0
FCode (hfi_zero)
{ *--SP = zero; }
#define one 1
FCode (hfi_one)
{ *--SP = one; }
#define two 2
FCode (hfi_two)
{ *--SP = two; }
#define three 3
FCode (hfi_three)
{ *--SP = three; }
#define four 4
FCode (hfi_four)
{ *--SP = four; }
#define five 5
FCode (hfi_five)
{ *--SP = five; }
#define six 6
FCode (hfi_six)
{ *--SP = six; }
#define seven 7
FCode (hfi_seven)
{ *--SP = seven; }
#define eight 8
FCode (hfi_eight)
{ *--SP = eight; }
#define nine 9
FCode (hfi_nine)
{ *--SP = nine; }
#define ten 10
FCode (hfi_ten)
{ *--SP = ten; }
#define sixteen 16
FCode (hfi_sixteen)
{ *--SP = sixteen; }
#define minus_one -1
FCode (hfi_minus_one)
{ *--SP = minus_one; }
#define minus_two -2
FCode (hfi_minus_two)
{ *--SP = minus_two; }
#define minus_three -3
FCode (hfi_minus_three)
{ *--SP = minus_three; }
#define minus_four -4
FCode (hfi_minus_four)
{ *--SP = minus_four; }
#define minus_five -5
FCode (hfi_minus_five)
{ *--SP = minus_five; }
#define bl 32
FCode (hfi_bl)
{ *--SP = bl; }
#define true -1
FCode (hfi_true)
{ *--SP = true; }
#define false 0
FCode (hfi_false)
{ *--SP = false; }
FCode (hfi_cell)
{ HF_FILL_TOS HF_FILL_FTOS 
  HF_PUSH (PFE_SIZEOF_CELL);
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_minus_cell)
{ HF_FILL_TOS HF_FILL_FTOS 
  HF_PUSH (-PFE_SIZEOF_CELL);
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_store_csp)
{ HF_FILL_TOS HF_FILL_FTOS 
  p4_CSP = SP;
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_store)
{ HF_FILL_TOS HF_FILL_FTOS 
  *(p4cell *) TOS = SP[1]; HF_DROP2;
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_fetch)
{ HF_FILL_TOS HF_FILL_FTOS 
  TOS = *(p4cell *) TOS;
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_star)
{ HF_FILL_TOS HF_FILL_FTOS 
  { p4cell res = TOS * SP[1]; SP++; TOS = res; }
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_m_star)
{ HF_FILL_TOS HF_FILL_FTOS 
  { p4dcell d = mmul (TOS, SP[1]); TOS = d.hi; SP[1] = d.lo;}
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_star_slash)
{ HF_FILL_TOS HF_FILL_FTOS 
  { fdiv_t n4 = p4_d_fmdiv (p4_d_mmul (SP[2], SP[1]), TOS);
    SP += 2; TOS = n4.quot;}
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_star_slash_mod)
{ HF_FILL_TOS HF_FILL_FTOS 
  { fdiv_t res = p4_d_fmdiv (p4_d_mmul (SP[2], SP[1]), TOS);
    SP++; TOS = res.quot; SP[1] = res.rem; }
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_plus)
{ HF_FILL_TOS HF_FILL_FTOS 
  { p4cell res = TOS + SP[1]; SP++; TOS = res; }
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_plus_store)
{ HF_FILL_TOS HF_FILL_FTOS 
  *(p4cell *) TOS += SP[1]; HF_DROP2;
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_minus)
{ HF_FILL_TOS HF_FILL_FTOS 
  { p4cell res = SP[1] - TOS; SP++; TOS = res; }
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_minus_store)
{ HF_FILL_TOS HF_FILL_FTOS 
  *(p4cell *) TOS -= SP[1]; HF_DROP2;
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_slash)
{ HF_FILL_TOS HF_FILL_FTOS 
  { fdiv_t n = p4_fdiv (SP[1], TOS); SP++; TOS = n.quot; }
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_slash_mod)
{ HF_FILL_TOS HF_FILL_FTOS 
  { fdiv_t n = p4_fdiv (SP[1], TOS);
    TOS = n.quot; SP[1] = n.rem; }
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_zero_store)
{ HF_FILL_TOS HF_FILL_FTOS 
  *(p4cell *) TOS = 0;  HF_DROP1;
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_zero_less)
{ HF_FILL_TOS HF_FILL_FTOS 
  TOS = P4_FLAG (TOS < 0);
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_zero_equals)
{ HF_FILL_TOS HF_FILL_FTOS 
  TOS = P4_FLAG (TOS == 0);
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_less_than)
{ HF_FILL_TOS HF_FILL_FTOS 
  { p4cell res = P4_FLAG (TOS > SP[1]); SP++; TOS = res; }
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_equals)
{ HF_FILL_TOS HF_FILL_FTOS 
  { p4cell res = P4_FLAG (TOS == SP[1]); SP++; TOS = res; }
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_greater_than)
{ HF_FILL_TOS HF_FILL_FTOS 
  { p4cell res = P4_FLAG (TOS < SP[1]); SP++; TOS = res; }
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_zero_not_equals)
{ HF_FILL_TOS HF_FILL_FTOS 
  TOS = P4_FLAG (TOS != 0);
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_zero_greater)
{ HF_FILL_TOS HF_FILL_FTOS 
  TOS = P4_FLAG (TOS > 0);
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_not_equals)
{ HF_FILL_TOS HF_FILL_FTOS 
  { p4cell res = P4_FLAG (TOS != SP[1]); SP++; TOS = res; }
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_less_than_or_equals)
{ HF_FILL_TOS HF_FILL_FTOS 
  { p4cell res = P4_FLAG (TOS >= SP[1]); SP++; TOS = res; }
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_greater_than_or_equals)
{ HF_FILL_TOS HF_FILL_FTOS 
  { p4cell res = P4_FLAG (TOS <= SP[1]); SP++; TOS = res; }
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_to_r)
{ HF_FILL_TOS HF_FILL_FTOS 
  RP_PUSH (TOS); HF_DROP1;
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (p4_dot);
FCode (hfi_one_plus)
{ HF_FILL_TOS HF_FILL_FTOS 
  ++TOS;
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_one_minus)
{ HF_FILL_TOS HF_FILL_FTOS 
  --TOS;
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_one_plus_store)
{ HF_FILL_TOS HF_FILL_FTOS 
  ++*(p4cell *) TOS; SP++;
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_one_minus_store)
{ HF_FILL_TOS HF_FILL_FTOS 
  --*(p4cell *) TOS; SP++;
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_two_store)
{ HF_FILL_TOS HF_FILL_FTOS 
  *(p4dcell *) TOS = *(p4dcell *) &SP[1];  SP += 3;
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_two_star)
{ HF_FILL_TOS HF_FILL_FTOS 
  TOS <<= 1;
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_two_slash)
{ HF_FILL_TOS HF_FILL_FTOS 
  TOS >>= 1;
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_two_to_r)
{ HF_FILL_TOS HF_FILL_FTOS 
  RP_PUSH (SP[1]);  RP_PUSH (TOS);  HF_DROP2;
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_two_fetch)
{ HF_FILL_TOS HF_FILL_FTOS 
#ifdef HF_TOSREG
  { p4cell *addr = (p4cell *)TOS;
    TOS = *addr; *SP-- = *(addr + 1); }
#else
  { p4dcell *addr = (p4dcell *) *SP--;
    *(p4dcell *) SP = *addr; }
#endif
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_two_drop)
{ HF_FILL_TOS HF_FILL_FTOS 
  HF_DROP2;
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_two_dup)
{ HF_FILL_TOS HF_FILL_FTOS 
#ifdef HF_TOSREG
  SP[0] = TOS; SP -= 2; SP[1] = SP[3];
#else
  SP -= 2;  SP[0] = SP[2];  SP[1] = SP[3];
#endif
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_two_r_from)
{ HF_FILL_TOS HF_FILL_FTOS 
  HF_SPILL_TOS SP -= 2; TOS = RP_POP (); SP[1] = RP_POP ();
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_two_r_fetch)
{ HF_FILL_TOS HF_FILL_FTOS 
  HF_SPILL_TOS SP -= 2; TOS = FX_RP[0];  SP[1] = FX_RP[1];
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_two_r_drop)
{ HF_FILL_TOS HF_FILL_FTOS 
  P4_INCR ( p4RP, p4cell, 2);
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (p4_abort);
FCode (hfi_abs)
{ HF_FILL_TOS HF_FILL_FTOS 
  if (TOS < 0) TOS = -TOS;
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_align)
{ HF_FILL_TOS HF_FILL_FTOS 
  while (!P4_ALIGNED (DP)) *DP++ = 0;
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_aligned)
{ HF_FILL_TOS HF_FILL_FTOS 
  TOS = p4_aligned (TOS);
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_and)
{ HF_FILL_TOS HF_FILL_FTOS 
  { p4cell res = TOS & SP[1]; SP++; TOS = res; }
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_bounds)
{ HF_FILL_TOS HF_FILL_FTOS 
  { p4cell h = SP[1];  SP[1] += TOS;  TOS = h; }
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_c_store)
{ HF_FILL_TOS HF_FILL_FTOS 
  *(char *) TOS = SP[1];  HF_DROP2;
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_c_comma)
{ HF_FILL_TOS HF_FILL_FTOS 
  *DP++ = (p4char) TOS; HF_DROP1;
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_c_fetch)
{ HF_FILL_TOS HF_FILL_FTOS 
  TOS = *(p4char *) TOS;
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_cell_plus)
{ HF_FILL_TOS HF_FILL_FTOS 
  TOS += sizeof (p4cell);
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_two_cells_plus)
{ HF_FILL_TOS HF_FILL_FTOS 
  TOS += 2 * sizeof (p4cell);
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_cell_minus)
{ HF_FILL_TOS HF_FILL_FTOS 
  TOS -= sizeof (p4cell);
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_two_cells_minus)
{ HF_FILL_TOS HF_FILL_FTOS 
  TOS -= 2 * sizeof (p4cell);
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_cells)
{ HF_FILL_TOS HF_FILL_FTOS 
  TOS *= sizeof (p4cell);
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (p4_char);
FCode (hfi_char_plus)
{ HF_FILL_TOS HF_FILL_FTOS 
  TOS += sizeof (char);
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_chars)
{ HF_FILL_TOS HF_FILL_FTOS 
  TOS *= sizeof (char);
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (p4_cr);
FCode (hfi_decimal)
{ HF_FILL_TOS HF_FILL_FTOS 
  p4_BASE = 10;
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_depth)
{ HF_FILL_TOS HF_FILL_FTOS 
#ifdef HF_TOSREG
  *SP = TOS; TOS = p4_S0 - SP; SP--; 
#else 
  { p4cell diff = p4_S0 - SP;
    *--SP = diff; }
#endif
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_drop)
{ HF_FILL_TOS HF_FILL_FTOS 
  HF_DROP1;
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_dup)
{ HF_FILL_TOS HF_FILL_FTOS 
#ifdef HF_TOSREG
 *SP-- = TOS;
#else
  SP--;  SP[0] = SP[1];
#endif
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_q_dup)
{ HF_FILL_TOS HF_FILL_FTOS 
#ifdef HF_TOSREG
  if (TOS) *SP-- = TOS;
#else
  if (*SP) --SP, SP[0] = SP[1];
#endif
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (p4_emit);
FCode (hfi_erase)
{ HF_FILL_TOS HF_FILL_FTOS 
  memset ((void *) SP[1], 0, TOS);  HF_DROP2;
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_fill)
{ HF_FILL_TOS HF_FILL_FTOS 
  memset ((void *) SP[2], TOS, SP[1]);  SP += 3; HF_FILL_TOS
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_f_m_slash_mod)
{ HF_FILL_TOS HF_FILL_FTOS 
  { fdiv_t res = p4_d_fmdiv (*(p4dcell *) &SP[1], TOS);
    SP++; TOS = res.quot; SP[1] = res.rem;}
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_here)
{ HF_FILL_TOS HF_FILL_FTOS 
  HF_PUSH ((p4cell) DP);
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_hex)
{ HF_FILL_TOS HF_FILL_FTOS 
  p4_BASE = 16;
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_invert)
{ HF_FILL_TOS HF_FILL_FTOS 
  TOS = ~TOS;
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_l_shift)
{ HF_FILL_TOS HF_FILL_FTOS 
  SP[1] <<= TOS; HF_DROP1;
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_max)
{ HF_FILL_TOS HF_FILL_FTOS 
  { p4cell res = (TOS > SP[1]) ? TOS : SP[1]; SP++; TOS = res; }
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_min)
{ HF_FILL_TOS HF_FILL_FTOS 
  { p4cell res = (TOS < SP[1]) ? TOS : SP[1]; SP++; TOS = res; }
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_mod)
{ HF_FILL_TOS HF_FILL_FTOS 
  { fdiv_t res = p4_fdiv (SP[1], TOS); SP++; TOS = res.rem; }
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_move)
{ HF_FILL_TOS HF_FILL_FTOS 
  memmove ((void *) SP[1], (void *) SP[2], (size_t) TOS);
  SP += 3; HF_FILL_TOS
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_negate)
{ HF_FILL_TOS HF_FILL_FTOS 
  TOS = -TOS;
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_not)
{ HF_FILL_TOS HF_FILL_FTOS 
  TOS = P4_FLAG (TOS == 0);
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_nip)
{ HF_FILL_TOS HF_FILL_FTOS 
  { p4cell res = TOS; SP++; TOS = res; }
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_nip_nip)
{ HF_FILL_TOS HF_FILL_FTOS 
  { p4cell res = TOS; SP += 2; TOS = res; }
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_or)
{ HF_FILL_TOS HF_FILL_FTOS 
  { p4cell res = TOS | SP[1]; SP++; TOS = res; }
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_over)
{ HF_FILL_TOS HF_FILL_FTOS 
  HF_SPILL_TOS --SP; TOS = SP[2];
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_pad)
{ HF_FILL_TOS HF_FILL_FTOS 
  HF_PUSH ((p4cell) p4_PAD);
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_pick)
{ HF_FILL_TOS HF_FILL_FTOS 
  TOS = SP[TOS + 1];
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_r_from)
{ HF_FILL_TOS HF_FILL_FTOS 
  HF_PUSH (RP_POP());
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_r_fetch)
{ HF_FILL_TOS HF_FILL_FTOS 
  HF_PUSH (*FX_RP);
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_r_drop)
{ HF_FILL_TOS HF_FILL_FTOS 
  P4_INC ( p4RP, p4cell);
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (p4_roll);
FCode (hfi_rot)
{ HF_FILL_TOS HF_FILL_FTOS 
  { p4cell h = SP[2]; SP[2] = SP[1];
    SP[1] = TOS; TOS = h; }
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_r_p_fetch)
{ HF_FILL_TOS HF_FILL_FTOS 
  HF_PUSH ((p4cell) RP);
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_r_shift)
{ HF_FILL_TOS HF_FILL_FTOS 
  *(p4ucell *) &SP[1] >>= TOS; HF_DROP1;
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_s_to_d)
{ HF_FILL_TOS HF_FILL_FTOS 
  HF_SPILL_TOS SP--; TOS = SP[1] < 0 ? -1 : 0;
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_s_m_slash_rem)
{ HF_FILL_TOS HF_FILL_FTOS 
  { fdiv_t res = p4_d_smdiv (*(p4dcell *) &SP[1], TOS);
    SP++; TOS = res.quot; SP[1] = res.rem; }
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (p4_source);
FCode (hfi_s_p_fetch)
{ HF_FILL_TOS HF_FILL_FTOS 
  HF_PUSH ((p4cell) (SP - 1));
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (p4_space);
FCode (p4_spaces);
FCode (hfi_swap)
{ HF_FILL_TOS HF_FILL_FTOS 
  { p4cell h = SP[1]; SP[1] = TOS; TOS = h; }
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_toggle)
{ HF_FILL_TOS HF_FILL_FTOS 
  *(p4cell *) SP[1] ^= TOS; HF_DROP2;
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (p4_type);
FCode (hfi_tuck)
{ HF_FILL_TOS HF_FILL_FTOS 
  { p4cell h = TOS;
    --SP; TOS = h; SP[1] = SP[2]; SP[2] = h; } 
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_u_less_than)
{ HF_FILL_TOS HF_FILL_FTOS 
  { p4cell res = P4_FLAG ((p4ucell) TOS > (p4ucell) SP[1]);
    SP++; TOS = res; }
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_u_less_than_equals)
{ HF_FILL_TOS HF_FILL_FTOS 
  { p4cell res = P4_FLAG ((p4ucell) TOS >= (p4ucell) SP[1]);
    SP++; TOS = res; }
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_u_greater_than)
{ HF_FILL_TOS HF_FILL_FTOS 
  { p4cell res = P4_FLAG ((p4ucell) TOS < (p4ucell) SP[1]);
    SP++; TOS = res; }
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_u_greater_than_equals)
{ HF_FILL_TOS HF_FILL_FTOS 
  { p4cell res = P4_FLAG ((p4ucell) TOS <= (p4ucell) SP[1]);
    SP++; TOS = res; }
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_u_m_star)
{ HF_FILL_TOS HF_FILL_FTOS 
  { p4udcell res = p4_d_ummul ((p4ucell) TOS, (p4ucell) SP[1]);
    TOS = res.hi; SP[1] = res.lo;}
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_u_m_slash_mod)
{ HF_FILL_TOS HF_FILL_FTOS 
  { udiv_t res = p4_d_umdiv (*(p4udcell *) &SP[1], TOS);
    SP++; TOS = res.quot; SP[1] = res.rem;}
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_within)
{ HF_FILL_TOS HF_FILL_FTOS 
  { p4cell res = P4_FLAG ( (p4ucell) (SP[2] - SP[1]) <
                      (p4ucell) (TOS - SP[1]) );
    SP += 2; TOS = res; }
 HF_SPILL_TOS HF_SPILL_FTOS }
FCode (hfi_xor)
{ HF_FILL_TOS HF_FILL_FTOS 
  { p4cell res = TOS ^ SP[1]; SP++; TOS = res; }
 HF_SPILL_TOS HF_SPILL_FTOS }

P4_LISTWORDS (hfkernel) = 
{
 P4_FXco ("ZERO", hfi_zero),
 P4_FXco ("ONE", hfi_one),
 P4_FXco ("TWO", hfi_two),
 P4_FXco ("THREE", hfi_three),
 P4_FXco ("FOUR", hfi_four),
 P4_FXco ("FIVE", hfi_five),
 P4_FXco ("SIX", hfi_six),
 P4_FXco ("SEVEN", hfi_seven),
 P4_FXco ("EIGHT", hfi_eight),
 P4_FXco ("NINE", hfi_nine),
 P4_FXco ("TEN", hfi_ten),
 P4_FXco ("SIXTEEN", hfi_sixteen),
 P4_FXco ("-ONE", hfi_minus_one),
 P4_FXco ("-TWO", hfi_minus_two),
 P4_FXco ("-THREE", hfi_minus_three),
 P4_FXco ("-FOUR", hfi_minus_four),
 P4_FXco ("-FIVE", hfi_minus_five),
 P4_FXco ("BL", hfi_bl),
 P4_FXco ("TRUE", hfi_true),
 P4_FXco ("FALSE", hfi_false),
 P4_FXco ("CELL", hfi_cell),
 P4_FXco ("-CELL", hfi_minus_cell),
 P4_FXco ("!CSP", hfi_store_csp),
 P4_FXco ("!", hfi_store),
 P4_FXco ("@", hfi_fetch),
 P4_FXco ("*", hfi_star),
 P4_FXco ("M*", hfi_m_star),
 P4_FXco ("*/", hfi_star_slash),
 P4_FXco ("*/MOD", hfi_star_slash_mod),
 P4_FXco ("+", hfi_plus),
 P4_FXco ("+!", hfi_plus_store),
 P4_FXco ("-", hfi_minus),
 P4_FXco ("-!", hfi_minus_store),
 P4_FXco ("/", hfi_slash),
 P4_FXco ("/MOD", hfi_slash_mod),
 P4_FXco ("0!", hfi_zero_store),
 P4_FXco ("0<", hfi_zero_less),
 P4_FXco ("0=", hfi_zero_equals),
 P4_FXco ("<", hfi_less_than),
 P4_FXco ("=", hfi_equals),
 P4_FXco (">", hfi_greater_than),
 P4_FXco ("0<>", hfi_zero_not_equals),
 P4_FXco ("0>", hfi_zero_greater),
 P4_FXco ("<>", hfi_not_equals),
 P4_FXco ("<=", hfi_less_than_or_equals),
 P4_FXco (">=", hfi_greater_than_or_equals),
 P4_FXco (">R", hfi_to_r),
 P4_FXco ("1+", hfi_one_plus),
 P4_FXco ("1-", hfi_one_minus),
 P4_FXco ("1+!", hfi_one_plus_store),
 P4_FXco ("1-!", hfi_one_minus_store),
 P4_FXco ("2!", hfi_two_store),
 P4_FXco ("2*", hfi_two_star),
 P4_FXco ("2/", hfi_two_slash),
 P4_FXco ("2>R", hfi_two_to_r),
 P4_FXco ("2@", hfi_two_fetch),
 P4_FXco ("2DROP", hfi_two_drop),
 P4_FXco ("2DUP", hfi_two_dup),
 P4_FXco ("2R>", hfi_two_r_from),
 P4_FXco ("2R@", hfi_two_r_fetch),
 P4_FXco ("2RDROP", hfi_two_r_drop),
 P4_FXco ("ABS", hfi_abs),
 P4_FXco ("ALIGN", hfi_align),
 P4_FXco ("ALIGNED", hfi_aligned),
 P4_FXco ("AND", hfi_and),
 P4_FXco ("BOUNDS", hfi_bounds),
 P4_FXco ("C!", hfi_c_store),
 P4_FXco ("C,", hfi_c_comma),
 P4_FXco ("C@", hfi_c_fetch),
 P4_FXco ("CELL+", hfi_cell_plus),
 P4_FXco ("2CELLS+", hfi_two_cells_plus),
 P4_FXco ("CELL-", hfi_cell_minus),
 P4_FXco ("2CELLS-", hfi_two_cells_minus),
 P4_FXco ("CELLS", hfi_cells),
 P4_FXco ("CHAR+", hfi_char_plus),
 P4_FXco ("CHARS", hfi_chars),
 P4_FXco ("DECIMAL", hfi_decimal),
 P4_FXco ("DEPTH", hfi_depth),
 P4_FXco ("DROP", hfi_drop),
 P4_FXco ("DUP", hfi_dup),
 P4_FXco ("?DUP", hfi_q_dup),
 P4_FXco ("ERASE", hfi_erase),
 P4_FXco ("FILL", hfi_fill),
 P4_FXco ("FM/MOD", hfi_f_m_slash_mod),
 P4_FXco ("HERE", hfi_here),
 P4_FXco ("HEX", hfi_hex),
 P4_FXco ("INVERT", hfi_invert),
 P4_FXco ("LSHIFT", hfi_l_shift),
 P4_FXco ("MAX", hfi_max),
 P4_FXco ("MIN", hfi_min),
 P4_FXco ("MOD", hfi_mod),
 P4_FXco ("MOVE", hfi_move),
 P4_FXco ("NEGATE", hfi_negate),
 P4_FXco ("NOT", hfi_not),
 P4_FXco ("NIP", hfi_nip),
 P4_FXco ("NIP-NIP", hfi_nip_nip),
 P4_FXco ("OR", hfi_or),
 P4_FXco ("OVER", hfi_over),
 P4_FXco ("PAD", hfi_pad),
 P4_FXco ("PICK", hfi_pick),
 P4_FXco ("R>", hfi_r_from),
 P4_FXco ("R@", hfi_r_fetch),
 P4_FXco ("RDROP", hfi_r_drop),
 P4_FXco ("ROT", hfi_rot),
 P4_FXco ("RP@", hfi_r_p_fetch),
 P4_FXco ("RSHIFT", hfi_r_shift),
 P4_FXco ("S>D", hfi_s_to_d),
 P4_FXco ("SM/REM", hfi_s_m_slash_rem),
 P4_FXco ("SP@", hfi_s_p_fetch),
 P4_FXco ("SWAP", hfi_swap),
 P4_FXco ("TOGGLE", hfi_toggle),
 P4_FXco ("TUCK", hfi_tuck),
 P4_FXco ("U<", hfi_u_less_than),
 P4_FXco ("U<=", hfi_u_less_than_equals),
 P4_FXco ("U>", hfi_u_greater_than),
 P4_FXco ("U>=", hfi_u_greater_than_equals),
 P4_FXco ("UM*", hfi_u_m_star),
 P4_FXco ("UM/MOD", hfi_u_m_slash_mod),
 P4_FXco ("WITHIN", hfi_within),
 P4_FXco ("XOR", hfi_xor)
};
P4_COUNTWORDS (hfkernel, "^Forth Kernel Word Set");