/**
 * PFE Extension:  Execution primitives
 *          File:  execution-ext.c
 *        Author:  David N. Williams
 *       License:  LGPL
 *       Version:  0.6.2
 * Last revision:  August 2, 2006
 *
 * This word set contains primitives for execution methods,
 * ported from our ^Forth Motorola 680x0 4th.a code, last
 * revised on March 21, 1998.
 *
 * It is an external pfe module, not part of the pfe
 * distribution.
 *
 * Copyright (C) 2001, 2002 David N. Williams
 *
 * This library is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Lesser General Public
 * License as published by the Free Software Foundation; either
 * version 2.1 of the License, or (at your option) any later
 * version.
 *
 * This library 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 Lesser General Public License for more
 * details.
 *
 * Please see the file POLITENESS included with this
 * distribution.
 */
 
#define _P4_SOURCE 1
#include <pfe/pfe-base.h>
#include <pfe/def-xtra.h>

#include <pfe/dict-sub.h>	/* p4_header() */
#include <pfe/core-ext.h>	/* p4_colon_RT_ */

#include "execution-ext.h"

/** CREATE-EXEC		( "name" -- )
 * Create a named word in the current word list without alloting
 * a parameter field, just like =>"CREATE" does.  The run-time
 * semantics of the created word, instead of leaving the DFA,
 * executes the Forth word subsequently compiled there.
 */
FCode (p4_create_exec)
{
  FX_HEADER;
  FX_RUNTIME1(p4_colon);
}
P4RUNTIME1(p4_colon, p4_colon_RT);

/** (I-EXEC)		( i*x i -- j*x )
 * A primitive to be compiled by an execution array word [e.g.,
 * }CREATE-EXECS in qdexeca.fs] which fetches the i-th xt and
 * executes it.  The data field consists of cell.0, cell.1, ...,
 * cell.[n-1].
 */
FCode (p4_paren_i_exec)
{
  int i = *SP++;

  PFE.execute ((p4xt) IP[i]);
  IP = *RP++;
}

/** (IJ-EXEC)		( i*x i j -- j*x )
 * A primitive to be compiled by a square execution array word
 * [e.g., }}CREATE-EXECS in qdexeca.fs] which fetches the ij-th
 * xt and executes it. The data field consists of dim, cell.00,
 * cell.01, ..., cell.[n-1][n-1].
 */
FCode (p4_paren_ij_exec)
{
  int i = SP[1], j = SP[0];

  SP += 2;
  PFE.execute ((p4xt) IP[(int) *IP * i + j + 1]);
  IP = *RP++;
}

/** ISQRT 		( u -- sqrt[u] )
 *  Leave the square root of the small integer u.  ABORT if u is
 *  not a perfect square or too large.
 */
FCode (p4_isqrt)
{
  unsigned int u = SP[0];

  switch (u)
  {
    case   4:  SP[0] =  2; return;
    case   9:  SP[0] =  3; return;
    case  16:  SP[0] =  4; return;
    case  25:  SP[0] =  5; return;
    case  36:  SP[0] =  6; return;
    case  49:  SP[0] =  7; return;
    case  64:  SP[0] =  8; return;
    case  81:  SP[0] =  9; return;
    case 100:  SP[0] = 10; return;
    case 121:  SP[0] = 11; return;
    case 144:  SP[0] = 12; return;
    case 169:  SP[0] = 13; return;
    case 196:  SP[0] = 14; return;
    case 225:  SP[0] = 15; return;
    case 256:  SP[0] = 16; return;
    default:   p4_throws (P4_ON_ABORT_QUOTE,
                 (p4char*) " Integer not a perfect square or too large.", 0);
  }
}

P4_LISTWORDS (execution) =
{
  P4_FXco ("CREATE-EXEC",	p4_create_exec),
  P4_FXco ("(I-EXEC)",		p4_paren_i_exec),
  P4_FXco ("(IJ-EXEC)",		p4_paren_ij_exec),
  P4_FXco ("ISQRT",		p4_isqrt)
};
P4_COUNTWORDS (execution, "execution primitives");