/** 
 * --  The Optional Search Order Word Set
 * 
 *  Copyright (C) Tektronix, Inc. 1998 - 2001. All rights reserved.
 *
 *  @see     GNU LGPL
 *  @author  Tektronix CTE             @(#) %derived_by: guidod %
 *  @version %version: bln_mpt1!5.14 %
 *    (%date_modified: Mon Mar 25 14:27:20 2002 %)
 *
 *  @description
 *    	The Search Order Word Set as defined by the Standard.
 *
 *      Note that there a some extensions in the Portable 
 *      Forth Environment. Wordlists can be made case-sensitive
 *      always or only at request. Wordlists can be linear
 *      or hashed vocabularies. There are other words to 
 *      recursivly search an implicit vocabulary along with another.
 */
/*@{*/

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

#define _P4_SOURCE 1

#include <pfe/pfe-base.h>
#include <pfe/def-xtra.h>

#include <string.h>

#include <pfe/option-ext.h>
#include <pfe/def-comp.h>
#include <pfe/_missing.h>

/** DEFINITIONS ( -- )
 * make the current context-vocabulary the definition-vocabulary,
 * that is where new names are declared in. see ORDER
 */
FCode (p4_definitions)
{
    CURRENT = CONTEXT[0];
}

/** GET-CURRENT ( -- voc )
 * return the current definition vocabulary, see DEFINITIONS
 */
FCode (p4_get_current)
{
    FX_PUSH (CURRENT);
}

/** GET-ORDER ( -- vocn ... voc1 n )
 * get the current search order onto the stack, see SET-ORDER
 */
FCode (p4_get_order)
{
    Wordl **p;
    p4cell n = 0;

    for (p = &CONTEXT[PFE_set.wordlists]; --p >= CONTEXT;)
        if (*p)
        { FX_PUSH(*p); n++; }

    FX_PUSH (n);
}

/** SEARCH-WORDLIST ( str-ptr str-len voc -- 0 | xt 1 | xt -1 )
 * almost like FIND or (FIND) -- but searches only the
 * specified vocabulary.
 */
FCode (p4_search_wordlist)
{
    char *nfa;

    nfa = p4_search_wordlist ((char *) SP[2], SP[1], (Wordl *) SP[0]);
    if (nfa == NULL)
    {
        SP += 2;
        SP[0] = 0;
    }else{
        SP += 1;
        SP[0] = *_FFA(nfa) & P4xIMMEDIATE ? 1 : -1;
        SP[1] = (p4cell) p4_name_from (nfa);
    }
}

/** SET-CURRENT ( voc -- )
 * set the definition-vocabulary. see DEFINITIONS
 */
FCode (p4_set_current)
{
    CURRENT = (Wordl *) FX_POP;
}

/** SET-ORDER ( vocn ... voc1 n -- )
 * set the search-order -- probably saved beforehand using
 * GET-ORDER
 */
FCode (p4_set_order)
{
    p4cell i, n = FX_POP;

    if (n == -1)			/* minimum search order */
        n = 0;			/* equals cleared search order */
    if ((p4ucell) n > PFE_set.wordlists)
        p4_throw (P4_ON_SEARCH_OVER);
    for (i = 0; i < n; i++)
        CONTEXT[i] = (Wordl *) FX_POP;
    for (; i < PFE_set.wordlists; i++)
        CONTEXT[i] = NULL;
}

/** WORDLIST ( -- voc )
 * return a new vocabulary-body for private definitions.
 */
FCode (p4_wordlist)
{
    FX_PUSH  (p4_make_wordlist (0));
}

/* Search order extension words ============================================ */

/** ALSO ( -- )
 * a DUP on the search ORDER - each named vocabulary
 * replaces the topmost ORDER vocabulary. Using ALSO
 * will make it fixed to the search-order. (but it is 
 * not nailed in trap-conditions as if using DEFAULT-ORDER )
 order:   vocn ... voc2 voc1 -- vocn ... voc2 voc1 voc1
 */
FCode (p4_also)
{
  int i;

  if (CONTEXT[PFE_set.wordlists - 1])
      p4_throw (P4_ON_SEARCH_OVER);
  for (i = PFE_set.wordlists; --i > 0;)
      CONTEXT[i] = CONTEXT[i - 1];
}

/** ORDER ( -- )
 * show the current search-order, followed by 
 * the CURRENT DEFINITIONS vocabulary 
 * and the ONLY base vocabulary
 */
FCode (p4_order)
{
    int i;

    FX (p4_get_order);
    for (i = FX_POP; --i >= 0;)
    {
        Wordl *w = (Wordl *) FX_POP;
        p4_dot_name (w->nfa);
    }
    FX (p4_cr);
    p4_dot_name (CURRENT->nfa);
    p4_outs ("DEFINITIONS           ");
    p4_dot_name (ONLY->nfa);
}

/** PREVIOUS ( -- )
 * the invers of ALSO , does a DROP on the search ORDER
 * of vocabularies.
 order: vocn ... voc2 voc1 -- vocn ... voc2 
 example: ALSO PRIVATE-VOC DEFINTIONS (...do some...) PREVIOUS DEFINITIONS
 */
FCode (p4_previous)
{
    int i;

    for (i = 0; i < PFE_set.wordlists - 1; i++)
        CONTEXT[i] = CONTEXT[i + 1];
    CONTEXT[i] = NULL;
    for (i = 0; i < PFE_set.wordlists; i++)
        if (CONTEXT[i])
            return;
    p4_throw (P4_ON_SEARCH_UNDER); /* all CONTEXT-entries are null */
}

/** DEFAULT-ORDER ( -- )
 * nail the current search ORDER so that it will even
 * survive a trap-condition. This default-order can be
 * explicitly loaded with RESET-ORDER
 */
FCode (p4_default_order)
{
    memcpy (p4_DFORDER, p4_CONTEXT, PFE_set.wordlists);
    p4_DFCURRENT = p4_CURRENT;
}

/** RESET-ORDER ( -- )
 * load the DEFAULT-ORDER into the current search ORDER
 * - this is implicitly done when a trap is encountered.
 */
FCode (p4_reset_order)
{
    memcpy (p4_CONTEXT, p4_DFORDER, PFE_set.wordlists);
    p4_CURRENT = p4_DFCURRENT;
}

/**  ENVIRONMENT WORDLISTS  ( -- value )
 * the maximum number of wordlists in the search order
 */

FCode (p4_search_init)
{
#if 0 /*FIXME*/
    p4_create_option_value ("WORDLISTS", 9, PFE_set.wordlists, PFE.set);
#else
    p4_header_comma ("WORDLISTS", 9, CURRENT);
    FX_RUNTIME1(p4_value); FX_COMMA(PFE_set.wordlists);
#endif
}

/** FORTH-WORDLIST ( -- voc )
 * return the voc-address of the base FORTH-vocabulary
 * (quite often the actual name is not FORTH )
 */

P4_LISTWORDS (search) =
{
     (, ),
     (,		),
     (,		),
     (,		),
     (,		),
     (,		),
     (,		),
     (,		),
     (,			),
     (,			),
     (,		),
     (,		),

    /* hook to activate pfe extensions: */
     (, ),
     (,		),
     (,		),
     (,          ),

     (,  ),
     (,	 ), 
     (,		 ),
     (,           ),
};
P4_COUNTWORDS (search, "Search-order + extensions");

/*@}*/