/** 
 * -- miscellaneous useful extra words for TOOLS-EXT
 *
 *  Copyright (C) Tektronix, Inc. 1998 - 2001. All rights reserved.
 *
 *  @see     GNU LGPL
 *  @author  Tektronix CTE              @(#) %derived_by: guidod %
 *  @version %version:  1.15 %
 *    (%date_modified:  Tue Apr 16 11:59:23 2002 %)
 *
 *  @description
 *      Compatiblity with former standards, miscellaneous useful words.
 *      ... for TOOLS-EXT
 */
/*@{*/

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

#define _P4_SOURCE 1

#include <pfe/pfe-base.h>

#include <errno.h>

/** VLIST ( -- )
 *  The VLIST command had been present in FIG and other forth
 *  implementations. It has to list all accessible words. In PFE
 *  it list all words in the search order. Well, the point is,
 *  that we do really just look into the search order and are
 *  then calling WORDS on that Wordl. That way you can see
 *  all accessible words in the order they might be found.
 *  Uses ?CR
 */
FCode (p4_vlist) 
{
    extern int p4_Q_cr (void);
    Wordl **p, **q;
    
    for (p = CONTEXT; p <= &ONLY; p++)
    {
        if (*p == NULL)
            continue;
        for (q = CONTEXT; *q != *p; q++); /* don't search wordl twice */
        if (q != p)
            continue;
        p4_dot_name ((*p)->nfa);
        p4_outs ("WORDS");
        p4_wild_words ((*p), "*", NULL);
        
        if (p < &ONLY) {
            PFE.more = 0; if (p4_Q_cr ()) return; 
        }
    }
}

/** !CSP ( -- )
 * put SP into CSP
 * 
 used in control-words
 */
FCode (p4_store_csp)
{
    CSP = SP;
}

/** ?CSP ( -- )
 * check that SP == CSP otherwise THROW
 * 
 used in control-words
 */
FCode (p4_Q_csp)	
{
    if (SP != CSP)
        p4_throw (P4_ON_CONTROL_MISMATCH);
}

/** ?COMP ( -- )
 * check that the current STATE is compiling
 * otherwise THROW
 * 
 often used in control-words
 */
FCode (p4_Q_comp)		
{
    if (!STATE)
        p4_throw (P4_ON_COMPILE_ONLY);
}

/** ?EXEC ( -- )
 * check that the current STATE is executing
 * otherwise THROW
 * 
 often used in control-words
 */
FCode (p4_Q_exec)		
{
    if (STATE)
        p4_throw (P4_ON_COMPILER_NESTING);
}

/** ?FILE ( file-id -- )
 * check the file-id otherwise (fixme)
 */
FCode (p4_Q_file)
{
    int ior = *SP++;

    if (ior)
        p4_throw (FX_IOR);
}

/** ?LOADING ( -- )
 * check that the currently interpreted text is 
 * from a file/block, otherwise THROW
 */
FCode (p4_Q_loading)
{
    if (BLK == 0)
        p4_throw (P4_ON_INVALID_BLOCK);
}

/** ?PAIRS ( a b -- )
 * if compiling, check that the two magics on
 * the CS-STACK are identical, otherwise throw
 * 
 used in control-words
 */
FCode (p4_Q_pairs)
{
    FX (p4_Q_comp);
    p4_Q_pairs (*SP++);
}

/** ?STACK ( -- )
 * check all stacks for underflow and overflow conditions,
 * and if such an error condition is detected THROW
 */
FCode (p4_Q_stack)
{
#  ifdef P4_RP_IN_VM
    if (RP > PFE.r0)	    p4_throw (P4_ON_RSTACK_UNDER);
    if (RP < PFE.rstack)    p4_throw (P4_ON_RSTACK_OVER);
#  endif
    if (SP > PFE.s0)	    p4_throw (P4_ON_STACK_UNDER);
    if (SP < PFE.stack)	    p4_throw (P4_ON_STACK_OVER);
#  ifndef P4_NO_FP
    if (FP > PFE.f0)	    p4_throw (P4_ON_FSTACK_UNDER);
    if (FP < PFE.fstack)    p4_throw (P4_ON_FSTACK_OVER);
#  endif
    if (PFE.dictlimit - PFE_MINIMAL_UNUSED < PFE.dp) 
        p4_throw (P4_ON_DICT_OVER);  
}

/* ______________________________________________________________________ */
/* definitions checks */

/** [VOID]                ( -- flag )
 *  Immediate FALSE. Used to comment out sections of code.
 *  IMMEDIATE so it can be inside definitions.
 : [VOID] 0 ; immediate
 */

/** DEFINED             ( "name" -- flag )
 *  Search the dictionary for _name_. If _name_ is found,
 *  return TRUE; otherwise return FALSE. Immediate for use in
 *  definitions.
  
 * This word will actually return what FIND returns (the NFA). 
 * does check for the word using find (so it does not throw like ' )
 * and puts it on stack. As it is immediate it does work in compile-mode
 * too, so it places its argument in the cs-stack then. This is most
 * useful with a directly following [IF] clause, so that sth. like
 * an [IFDEF] word can be simulated through [DEFINED] word [IF]

 : DEFINED BL WORD COUNT (FIND-NFA) ; 
 */

/** [DEFINED]             ( [name] -- flag )
 *  Search the dictionary for _name_. If _name_ is found,
 *  return TRUE; otherwise return FALSE. Immediate for use in
 *  definitions.
  
 * This word will actually return what FIND returns (the NFA). 
 * does check for the word using find (so it does not throw like ' )
 * and puts it on stack. As it is immediate it does work in compile-mode
 * too, so it places its argument in the cs-stack then. This is most
 * useful with a directly following [IF] clause, so that sth. like
 * an [IFDEF] word can be simulated through [DEFINED] word [IF]

 : [DEFINED] DEFINED ; IMMEDIATE
 : [DEFINED] BL WORD COUNT (FIND-NFA) ; IMMEDIATE
 */
FCode (p4_defined)
{
    p4_word_parseword (' '); *DP=0; /* PARSE-WORD-NOHERE */
    FX_PUSH (p4_find (PFE.word.ptr, PFE.word.len));
}

/** [UNDEFINED]          ( [name] -- flag )
 *  Search the dictionary for _name_. If _name_ is found,
 *  return FALSE; otherwise return TRUE. Immediate for use in
 *  definitions.
 *
 *  see [DEFINED]
 : [UNDEFINED] DEFINED 0= ; IMMEDIATE
 */
FCode (p4_undefined)
{
    FX (p4_defined);
    FX (p4_zero_equal);
}

/* ______________________________________________________________________ */
/* dictionary limits */

/** (FORGET) ( addr -- )
 * forget everything above addr
 * - used by FORGET
 */
FCode (p4_paren_forget)		
{			
    p4_forget ((char *) *SP++);
}

/** (DICTLIMIT)   ( -- constvalue )
 * the upper limit of the forth writeable memory space,
 * the variable DICTLIMIT must be below this line.
 * stack-space and other space-areas are often allocated
 * above DICTLIMIT upto this constant.
 *
 * DICTFENCE is the lower end of the writeable dictionary
 */
FCode(p4_paren_dictlimit)
{
    FX_PUSH ((((p4char*) PFE_MEM) + PFE_set.total_size));
}

/** (DICTFENCE)   ( -- constvalue )
 * the lower limit of the forth writeable memory space,
 * the variable DICTFENCE must be above this line.
 * Some code-areas are often moved in between DICTFENCE and
 * this constant. To guard normal Forth code from deletion
 * the usual practice goes with the FENCE variable
 *
 * DICTLIMIT is the upper end of the writeable dictionary
 */
FCode(p4_paren_dictfence)
{
    FX_PUSH (PFE_MEM);
}

/** FENCE        ( -- var* )
 * a forth system variable - (FORGET) will not work below
 * this address and any FORGET on a header below this mark
 * will THROW
 */

/** DICTFENCE   ( -- var* )
 * the lower end of usable area - the forth memory block minus the 
 * forth-VM backstore. Note that this is a variable by tradition but
 * you should not move it.
 */

/** DICTLIMIT   ( -- var* )
 * the lower end of usable area - the forth memory block minus the 
 * forth-related DICTALLOCS at the upper end (e.g. POCKET-PAD )
 * Note that this is a variable by tradition but you should not move it.
 */

P4_LISTWORDS (tools_misc) =
{
     (, ),
     (,		),

    /** see !CSP and ?CSP */
     (,		),
     (,		),
     (,		),
     (,		),
     (,		),

    /* state checks */
     (,		),
     (,		),
     (,		),
     (,	),
     (,		),
     (,		),

    /* definition checks */
     (,       ),
     (,      ),
     (,    ),
     (,  ),

     (,	),

    /** dictionary area dividers */
     (,	),
     (,		),       
     (,	),   
     (,	),        
     (,	), 
     (,	), 

    /** implementation specific magic - used by control words */
     (, ),
     (,	),
     (,	),
     (,	),
     (,	),
     (,	),
     (,	),

};
P4_COUNTWORDS (tools_misc, "TOOLS-Misc Compatibility words");

/*@}*/
/* 
 * Local variables:
 * c-file-style: "stroustrup"
 * End:
 */