/** 
 * -- SPY nest threading extension
 *
 *  Copyright (C) Tektronix, Inc. 2000 - 2001. All rights reserved.
 *
 *  @see     GNU LGPL
 *  @author  Tektronix CTE              @(#) %derived_by: guidod %
 *  @version %version: bln_mpt1!1.13 %
 *    (%date_modified: Wed Jun 12 17:15:05 2002 %)
 *
 *  @description
 *              These words are of old Tek CTE/MPT usage - it is
 *              quite useful for debugging, but in a portable
 *              environment it just means a minor speed penalty
 *              even if SPY_OFF and a great speed penalty
 *              if SPY_ON. The default should be to not include
 *              it but some special Tek builds.
 *
 *              To use it: enable the SPY' vocabulary when compiling
 *              colon words with spy-support. Later on, enable the
 *              spy-routine with SPY_ON and disable with SPY_OFF.
 *              The default spy-routine will print each word on enter
 *              and leave along with the stack contents at that point.
 *              You can attach customized entries into VALUEs named
 *              SPY-ENTER and SPY-LEAVE. Within a token-threaded
 *              environment, the CFA of the current entry can be gotten
 *              with 
 *                                  R> DUP >R CELL - @
 *              and most entries will give you a good >NAME for it.
 */
/*@{*/

#if defined(__version_control__) && defined(__GNUC__)
static char* id __attribute__((unused)) = 
"@(#) $Id: %full_filespec: with-spy.c~bln_mpt1!1.13:csrc:bln_12xx!1 % $";
#endif

#define _P4_SOURCE 1
#include <pfe/pfe-base.h>

#if defined PFE_WITH_SPY
#include <pfe/def-restore.h>

# ifndef PFE_SBR_CALL_THREADING

static void p4_spy_execute (p4xt V) 
{ 
    void (*saved)(int);
    P4_CALLER_MKSAVED; 
    saved = PFE.spy_nest; PFE.spy_nest = 0;
    p4_call (V);       PFE.spy_nest = saved;
    P4_CALLER_RESTORE; 
}

# endif 

/*
 * runtime portion callback. This routine is
 * called at the end of a => (NEST) that is
 * compiled by => : - it will print the name
 * of the colon word along with the current
 * param stack.
 */
static void p4_spy_nest(int enter)
{
#  if !defined PFE_SBR_CALL_THREADING
    if (p4_OUT) FX (p4_cr);
    if (enter) {
        if (PFE.spy_enter) { p4_spy_execute (PFE.spy_enter); return; }
    }else{
        if (PFE.spy_leave) { p4_spy_execute (PFE.spy_leave); return; }
    }

    { /* colon word name lookup */
        static const char spaces[] = "                           ";
#  if defined PFE_CALL_THREADING
        if (enter) {
#  endif 
            p4char* nfa = p4_to_name ((*RP)[-1]);
            int len = NFACNT(*nfa);  if (len > 27) len = 27;
            p4_outf ("[%02d%s] %.*s%.*s ", p4_R0-RP, enter ? ">>" : "<<",
              len, nfa+1, 28-len, spaces);
#  if defined PFE_CALL_THREADING
        } else { p4_outf("[%02d<<]----------------------------", p4_R0-RP); }
#  endif
    }
    {  /* parameter stack */
        int len = p4_S0 - SP;
        if (len) p4_outf ("[%02d@] ", len);
        if (len > 6) len = 6;
        while (--len >= 0)
        {
            p4_outf("%x ", p4SP[len]);
        }
        p4_outs ("\n");
    }
#  endif
}

/** SPY_ON ( -- )
 * change the runtime-code of (NEST) 
 * to call a special word that prints info
 * to the screen whenever a colon word is 
 * entered. It will print the name and
 * the current stack, and results in a kind
 * of execution trace over SPY' :-colon nested
 * words.
 */
FCode (p4_spy_on)
{
    PFE.spy_nest = p4_spy_nest;
}

/** SPY_OFF ( -- )
 * disable SPY_ON nest-trace.
 */
FCode (p4_spy_off)
{
    PFE.spy_nest = 0;
}

/** "SPY' (NEST)" ( -- ) 
 * compiled by :
 */ 
FCode_RT (p4_spy_colon_RT)
{   FX_USE_BODY_ADDR {
#  if ! defined PFE_CALL_THREADING
    FX_PUSH_RP = IP; IP = (p4xt *) FX_POP_BODY_ADDR;
    if (PFE.spy_nest) PFE.spy_nest(1);
#  elif ! defined PFE_SBR_CALL_THREADING
    FX_POP_BODY_ADDR_p4_BODY;
    FX_PUSH_RP = IP; IP = (p4xcode *) p4_BODY;
    if (PFE.spy_nest) PFE.spy_nest(1);
#  else
    p4code c = (p4code) FX_POP_BODY_ADDR;
    if (PFE.spy_nest) PFE.spy_nest(1);
    c ();
#  endif
}}

/**  SPY' :  ( name -- )
 * SPY:
 */

/**  SPY:  ( name -- ) 
 * create a header for a nesting word and go to compiling
 * mode then. This word is usually ended with ; but
 * the execution of the resulting colon-word can also 
 * return with EXIT
 * this is the spy-version SPY_ON
 */
FCode (p4_spy_colon)
{
    FX (p4_Q_exec);
    FX_RUNTIME_HEADER; FX_SMUDGED;
    FX_RUNTIME1 (p4_spy_colon);
    FX (p4_store_csp);
    STATE = P4_TRUE;
    PFE.locals = NULL;
    PFE.semicolon_code = PFX(p4_colon_EXIT);
}

P4RUNTIME1(p4_spy_colon, p4_spy_colon_RT);

/** "SPY' ((SPY;))" ( -- ) 
 * compiled by ; and maybe ;AND --
 * it will perform an EXIT
 * this is the SPY-version
 */                                /*"((SPY;))"*/
FCode_XE (p4_spy_semicolon_execution)
{
    FX_USE_CODE_ADDR;
    if (PFE.spy_nest) PFE.spy_nest(0); 
    IP = *RP++;
    FX_USE_CODE_EXIT;
}

/**  SPY' ;  ( -- )
 * ;SPY
 */

/**  ;SPY  ( -- ) 
 * compiles ((;)) which does EXIT the current
 * colon-definition. It does then end compile-mode
 * and returns to execute-mode. See : and :NONAME
 */
FCode (p4_spy_semicolon)
{
    if (PFE.locals)
    {
        FX_COMPILE2 (p4_spy_semicolon);
        PFE.locals = NULL;
    }
    else
        FX_COMPILE1 (p4_spy_semicolon);

    if (PFE.semicolon_code)
    {
        PFE.semicolon_code ();
    }else{
        PFE.state = P4_FALSE; /* atleast switch off compiling mode */
    }
}

P4COMPILES2 (p4_spy_semicolon, 
  p4_spy_semicolon_execution, p4_locals_exit_execution,
  P4_SKIPS_NOTHING, P4_SEMICOLON_STYLE);

/**  SPY' EXIT  ( -- )
 * SPY-EXIT
 */

/**  SPY-EXIT  ( -- )
 * will unnest the current colon-word so it will actually
 * return the word calling it. This can be found in the
 * middle of a colon-sequence between : and ;
 */
FCode (p4_spy_exit)
{
    if (PFE.locals)
        FX_COMPILE2 (p4_spy_exit);
    else
        FX_COMPILE1 (p4_spy_exit);
}

P4COMPILES2 (p4_spy_exit, p4_spy_semicolon_execution, p4_locals_exit_execution,
	   P4_SKIPS_NOTHING, P4_DEFAULT_STYLE);

P4_LISTWORDS (with_spy) =
{
     (, ),
     (,      ),
     (,          ),
     (,          ),
     (,	      ),
     (,       ),
     (,     ),
     (,     ),

     (, ),
     (,             ),
     (,             ),
     (,          ),
};
P4_COUNTWORDS (with_spy, "WITH-SPY kernel extension");

#endif
    

/*PFE_WITH_SPY*/

/*@}*/