/** 
 *  Compile definitions, load-time with load-wordl, runtime with compile-comma
 *
 *  Copyright (C) Tektronix, Inc. 1998 - 2001. All rights reserved.
 *
 *  @see     GNU LGPL
 *  @author  Tektronix CTE              @(#) %derived_by: guidod %
 *  @version %version: 1.21 %
 *    (%date_modified: Tue Jul 23 18:18:51 2002 %)
 */
/*@{*/

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

#define _P4_SOURCE 1

#include <pfe/pfe-base.h>

#include <string.h>

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

/* ---------------------------------------------------------------------- *
 * initial dictionary setup                                             
 */

FCode_RT (p4_forget_wordset_RT)
{   FX_USE_BODY_ADDR {
    FX_POP_BODY_ADDR_UNUSED;
    /* do nothing so far, forget_wordset_RT_ is just a type-marker */
}}

extern int p4_slot_use (int*); 

/* FIXME: move to header file ? */

extern int p4_slot_unuse (int*); 

/* FIXME: move to header file ? */

static FCode_RT (p4_forget_slot_RT)
{   FX_USE_BODY_ADDR {
    int* slot = (int*)(FX_POP_BODY_ADDR[0]);
    P4_info1 ("unuse load-slot '%i'", *slot);
   
    if (slot && *slot && PFE.p[*slot]) 
    {
        p4_xfree (PFE.p[*slot]); PFE.p[*slot] = 0;
    }
   
    p4_slot_unuse (slot);
}}

static void
p4_load_slot_open (int* slot)
{
    int e;
    if (!slot) return;
                
    if ((e=p4_slot_use (slot))) 
    {
        P4_fail2 ("load-slot %i failed : %s", *slot, strerror(-e));
        return; 
    }
}

static void
p4_load_slot_init (int* slot, p4ucell size)
{
    if (!slot || !*slot || size < 4)
        return;

    if (!(PFE.p)[*slot]) 
    {
        (PFE.p)[*slot] = p4_calloc (1, size);
        P4_info3 ("load-slot %i size %lu alloc (%p)", 
                  *slot, (unsigned long)size, (PFE.p)[*slot]);
    }else{ 
        P4_warn2 ("load-slot %i already allocated (%p)", 
                  *slot, (PFE.p)[*slot]);
    }
    
    p4_forget_word ("(load-slot: %i)", *slot, 
                    PFX (p4_forget_slot_RT), (p4cell) slot);
}

static void
p4_load_into (const char* vocname)
{
    Wordl* voc;
    if (! vocname) return;

    voc = p4_find_wordlist (vocname, strlen(vocname));
    if (voc) 
    {
        {    
            register int i;
            for (i=PFE_set.wordlists; --i > 0; )
                if (CONTEXT[i] == voc) 
                {
                    P4_info1 ("search also '%s' : already there", 
                              vocname);
                    return;
                }
        }
        FX (p4_also);    /* the top-of-order (CONTEXT) isn't changed */
        CONTEXT [1] = voc; /* instead we place it under-the-top */
        P4_info1 ("search also '%s' : done", vocname);
    }else{
        P4_warn2 ("search also failed: no '%s' vocabulary (%lu)", 
                  vocname, (unsigned long) strlen(vocname));
    }
}

static void p4_exception_string (const char* name, p4cell id)
{
    /* FIXME: instead of compiling to the forth-dict we should better
       create a way to let functions search the loaded wordset tables
    */
    p4_Exception* expt = (void*) DP; DP += sizeof(*expt);
    if (id < PFE.next_exception) PFE.next_exception = id - 1;
    expt->next = PFE.exception_link; PFE.exception_link = expt;
    expt->name = name; expt->id = id;
}

static void FXCode(illegal_RT)              
{                                  /* written to cfa following header_comma */
    /* NO BODY_ADDR */             /* to give an error msg when calling */
    p4_throw (P4_ON_INVALID_NAME); /* a word without execution semantics */
}

P4RUNTIMES1_RT(illegal, P4_ONLY_CODE1);

_export void
p4_load_words (const p4Words* ws, p4_Wordl* wid, int unused)
{
    Wordl* save_current = CURRENT;
    int k = ws->n;
    const p4Word* w = ws->w;
    char dictname[NFACNTMAX+1]; char* dn;
    int* slot = 0;

    if (!wid) wid = CURRENT;
    
    if (ws->name) 
    {  
        P4_info1 ("load '%s'", (ws->name));
        strncpy (dictname, ws->name, NFACNTMAX);
        dictname[NFACNTMAX] = '\0';
        if ((dn= strchr (dictname, ' '))
            ||  (dn= strchr (dictname, '(')))
            *dn = '\0';
    }else{
        sprintf (dictname, "%p", DP);
    }
    
    p4_forget_word ("wordset:%s", (p4cell) dictname,
                    PFX (p4_forget_wordset_RT), 
                    (p4cell) (ws));
    
    for ( ; --k >= 0; w++)
    {
        wid = CURRENT;
        if (w)
        {
            /* the C-name is really type-byte + count-byte away */
            char type = *w->name;
            const char* name = w->name+2;
            int len = strlen (w->name+2);
            void* ptr = w->ptr;
            Wordl* wid = CURRENT;

            /* and paste over make_word inherited from pre 0.30.28 times */
            p4xt  cfa;

            /* part 1: specials... */

            switch (type)
            {
            case p4_LOAD:
                if (ptr)
                    p4_load_words ((p4Words*) ptr, 0, 0); /* RECURSION !! */
                continue;
            case p4_INTO:
            {
                register void* p;
                p = p4_find_wordlist (name, strlen (name));
                if (p) 
                {   
                    P4_debug1 (13, "load into old '%s'", name);
                    CURRENT = p;
                }else{
                    Wordl* current = 0;
                    if (ptr) {
                        current = p4_find_wordlist (ptr, strlen(ptr));
                        if (! current) 
                            P4_warn1 ("could not find also-voc %s", 
				      (char*)(ptr));
                    }
                    if (! current) current = CURRENT;
                    P4_info1 ("load into new '%s'", name);
		    p4_header_comma (name, strlen(name), current);
                    P4_info1 ("did comma '%p'", LAST);
                    FX_RUNTIME1 (p4_vocabulary);  FX_IMMEDIATE;
                    P4_info1 ("done runtime '%p'", LAST);
                    CURRENT = p4_make_wordlist (LAST);
                    P4_info1 ("load into current '%p'", CURRENT);
                }

                if (ptr) 
                {
                    if (! CURRENT->also)
                        CURRENT->also = p4_find_wordlist (ptr, strlen(ptr));

                    p4_load_into (name); /* search-also */
                }
            } continue;
            case p4_SLOT:
                slot = (int*) ptr;
                p4_load_slot_open (slot);
                continue;
            case p4_SSIZ:
                p4_load_slot_init (slot, (p4ucell)(ptr));
                continue;
            case p4_EXPT:
                p4_exception_string(name, (p4cell)(ptr));
                continue;
            case p4_XXCO: /* constructors are registered in => LOADED */
                wid = PFE.atexit_wl;
                break;
            case p4_DVAH:
            {
                register void* last = LAST;
                register void* p = p4_find (name, strlen(name));
                if (! p) /* need to create this chain */
                {
                    if (! ptr) { 
                        P4_fail1 (
                            "trying to append to non-existant chain %s",
                                 name); 
                        continue; 
                    }
                    p4_header_comma (name, len, wid); 
                    FX_RUNTIME1_RT(p4_dictvar);
                    FX_UCOMMA (ptr);
                    FX_PCOMMA (0); 
                    { /* FX_LINK_COMMA (PFE.chain_link); */
                        register void* here = DP; 
                        FX_PCOMMA(PFE.chain_link); PFE.chain_link = here;
                    }
                    p = LAST;
                }
                /* we know it is a threaded dictvar */
                p = ((char *) p4TH + *P4_TO_BODY(p4_name_from(p)));
                if (last)
                {  /* chain the last word created just before this one*/
                    register void* here = DP;
                    FX_PCOMMA (*(void**)p); 
                    *(void**)p = here;
                    FX_PCOMMA (p4_name_from(last));
                }
            } continue;
            } /*switch*/

            /* part 2: general... CREATE a name and setup its CFA field */

	    p4_header_comma (name, len, wid); FX_RUNTIME1_RT (illegal);
            if ('A' <= type && type <= 'Z')
                FX_IMMEDIATE;
            cfa = P4_BODY_FROM(DP);
#         ifndef PFE_CALL_THREADING
            switch (type)
            {
            case p4_SXCO:
#             ifndef HOST_WIN32
                *cfa = ((p4_Semant *) ptr) ->comp;
                if (! ((p4_Semant *)ptr) ->name)
                    P4_VAR(char*, ((p4_Semant *)ptr) ->name) = name-1; 
                /* discard const */
                /* BEWARE: the arg' name must come from a wordset entry to
                   be both static and have byte in front that could be 
                   a maxlen
                */
#             else
		/* on WIN32, the ptr is a function that returns a SemantP */
		*cfa = ((p4_Semant*(*)())ptr) () -> comp;
                if (! ((p4_Semant *(*)())ptr) () ->name)
                    (char*) ((p4_Semant *(*)())ptr) () ->name = name-1; 
#             endif
                continue;
            case p4_RTCO:
#             ifndef HOST_WIN32
                *cfa = ((p4_Runtime2 *) ptr) ->comp;
		/* and start registering the runtimes centrally FIXME:
		   FX_COMMA(PFE.runtime); PFE.runtime = p4_HERE;
		   FX_COMMA(ptr);
		   but that sys-link should be honoured in p4_forget too
		*/
#             else
		/* on WIN32, the ptr is a function that returns a RuntimeP */
		*cfa = ((p4_Runtime2*(*)())ptr) () -> comp;
#             endif
                continue;
            case p4_IXCO:
            case p4_FXCO:
                *cfa = (p4code) ptr;
                continue;
            case p4_XXCO:
                *cfa = (p4code) ptr;
                ((p4code)ptr) ();     /* runs *now* !! no checks !! */
                continue;
            case p4_IVOC:
            case p4_OVOC:
                /* creating a VO before IN will make sure that the */
                /* other words will go in there. Nice stuff, eh ;-) */
                *cfa = p4_vocabulary_RT_ ;
                /* (((WList*) ptr)->wid = p4_make_wordlist (nfa)); */
                continue;
            case p4_DVAH:
            case p4_DVAR:
                *cfa = p4_dictvar_RT_ ;
                break;
            case p4_DCON:
                *cfa = p4_dictget_RT_ ;
                break;
            case p4_DSET:
                *cfa = p4_dictset_RT_ ;
                break;
            case p4_OVAR:
            case p4_IVAR:
                *cfa = p4_variable_RT_ ;
                break;
            case p4_OVAL:
            case p4_IVAL:
                *cfa = p4_value_RT_ ;
                break;
            case p4_OCON:
            case p4_ICON:
                *cfa = p4_constant_RT_ ;
                break;
            case p4_OFFS:
                *cfa = p4_offset_RT_ ;
                break;
	    case p4_iOLD:
	    case p4_xOLD:
		*cfa = p4_obsoleted_RT_;
		if (p4_LogMask && p4_LogMask^P4_LOG_FATAL) goto synonym;
            case p4_SNYM:
            case p4_FNYM:
                *cfa = p4_synonym_RT_ ;
	    synonym:
		ptr = p4_find (ptr, strlen(ptr));
		if (ptr) ptr = p4_name_from (ptr);
		else P4_fail3 ("could not resolve SYNONYM %.*s %s",
			       NFACNT(*LAST), LAST+1, (char*)w->ptr);
		break;
            default:
                P4_fail3 ("unknown typecode for loadlist entry: "
                          "0x%x -> \"%.*s\"", 
                          type, len, name);
            }
#         else
            /* CALL_THREADING */
            switch (type)
            {
            case p4_XXCO:
# if 1
                ((p4code)ptr) ();     /* runs *now* !! no checks !! */
		/* fallthrough */
# endif
            case p4_IXCO:
            case p4_FXCO:
            case p4_IVOC:
            case p4_OVOC:
            case p4_DVAH:
            case p4_DVAR:
            case p4_DCON:
            case p4_DSET:
            case p4_OVAR:
            case p4_IVAR:
            case p4_OVAL:
            case p4_IVAL:
            case p4_OCON:
            case p4_ICON:
            case p4_OFFS:
            case p4_SXCO:
            case p4_RTCO:
	    case p4_iOLD:
	    case p4_xOLD:
		cfa->word = (p4Word*)w; /* discard "const" here */
                break;
            case p4_SNYM:
            case p4_FNYM:  { 
		ptr = p4_find (ptr, strlen(ptr));
		if (ptr) ptr = p4_name_from (ptr);
		else P4_fail3 ("could not resolve SYNONYM %.*s %s",
			       NFACNT(*LAST), LAST+1, (char*)w->ptr);
		if (ptr) cfa->word = ((p4xt)ptr)->word;
		continue;
	    }
            default:
                P4_fail3 ("unknown typecode for loadlist entry: "
                          "0x%x -> \"%.*s\"", 
                          type, len, name);
            }
#         endif /* not CALL_THREADING */
            FX_VCOMMA (ptr);
            continue;
        } /* if(w) */
    } /* for w in ws->w */

    CURRENT = save_current; /* should save_current moved to the caller? */
}

/* ------------------------------------------------------------------- */

#ifdef _export
extern p4xcode* p4_compile_comma (p4xcode* at, p4xt);
extern p4xcode* p4_compile_xcode (p4xcode* at, p4xcode);
extern p4xcode* p4_compile_xcode_CODE (p4xcode* at, p4xcode);
extern p4xcode* p4_compile_xcode_BODY (p4xcode* at, p4xcode, p4cell*);
#endif

# ifdef PFE_CALL_THREADING

typedef struct { const char* name; const p4xcode xcode; }

 const loader_t;

static loader_t * loader (p4char c)
{
    static loader_t trampoline = { "trampoline", 0 };
    static loader_t primitive = { "primitive", 0 };
    static loader_t compiling = { "compiling-prim", 0 };
    static loader_t creating =  { "creating-prim", 0 };
    static loader_t createdW = { "created-word", 0 };
    static loader_t vocabulary = { "vocabulary", PFX (p4_vocabulary_RT) };
    static loader_t dictvar = { "system-variable", PFX(p4_dictvar_RT) };
    static loader_t dictget = { "system-constant", PFX(p4_dictget_RT) };
    static loader_t dictset = { "system-set-value", PFX(p4_dictset_RT) };
    static loader_t variable = { "variable", PFX(p4_variable_RT) };
    static loader_t valuevar = { "valuevar", PFX(p4_value_RT) };
    static loader_t constant = { "constant", PFX(p4_constant_RT) };
    static loader_t offsetW = { "offset-word", PFX(p4_offset_RT) };
    static loader_t obsoleted = { "obsolete-word", PFX(p4_obsoleted_RT) };
    static loader_t unknown = { "unknown-typecode", 0 };

    switch (c)
    {
    case 0:	  return & trampoline;
    case p4_FXCO:
    case p4_IXCO: 
    case p4_XXCO: return & primitive;
    case p4_SXCO: return & compiling;
    case p4_RTCO: return & creating;
    case p4_ITEM: return & createdW;
    case p4_IVOC: 
    case p4_OVOC: return & vocabulary;
    case p4_DVAR: return & dictvar;
    case p4_DCON: return & dictget;
    case p4_DSET: return & dictset;
    case p4_OVAR: 
    case p4_IVAR: return & variable;
    case p4_OVAL: 
    case p4_IVAL: return & valuevar;
    case p4_OCON: 
    case p4_ICON: return & constant;
    case p4_OFFS: return & offsetW;
    case p4_iOLD: 
    case p4_xOLD: return & obsoleted ;
    default:	  return & unknown;
    }
}

p4xcode* p4_compile_xcode(p4xcode* at, p4code code)
{
    FX_COMPILE1_CALL (at, code);
    return at;
}

p4xcode* p4_compile_xcode_BODY(p4xcode* at, p4code code, p4cell* body)
{
    FX_ARG_BODY_ADDR (at, body);
    FX_COMPILE1_CALL (at, code);
    FX_PUT_BODY_ADDR (at, body);
    return at;
}

p4xcode* p4_compile_xcode_CODE(p4xcode* at, p4code code)
{
    FX_ARG_CODE_ADDR (at);
    FX_COMPILE1_CALL (at, code);
    FX_PUT_CODE_ADDR (at);
    return at;
}

/* the const here will hint where possibly sth. woudl write to code-mem */
const p4xcode* p4_to_code(p4xt xt)
{
    static p4xcode vocabulary = PFX(p4_vocabulary_RT);
    static p4xcode dictvar =    PFX(p4_dictvar_RT);
    static p4xcode dictget =    PFX(p4_dictget_RT);
    static p4xcode dictset =    PFX(p4_dictset_RT);
    static p4xcode variable =   PFX(p4_variable_RT);
    static p4xcode value =      PFX(p4_value_RT);
    static p4xcode constant =   PFX(p4_constant_RT);
    static p4xcode offset =     PFX(p4_offset_RT);
    static p4xcode obsoleted =  PFX(p4_obsoleted_RT);

    switch (*xt->type->def)
    {
    case 0: /* the "" string indicates a trampoline */
    case p4_FXCO:
    case p4_IXCO:
    case p4_XXCO:	return & xt->word->ptr;
    case p4_SXCO:	return & ((p4_Semant*)xt->word->ptr)->comp;
    case p4_RTCO:	return & ((p4_Runtime2*)xt->word->ptr)->comp;
    case p4_ITEM:	return & xt->call->exec[0];
    case p4_IVOC:
    case p4_OVOC:	return & vocabulary;
    case p4_DVAR:	return & dictvar ;
    case p4_DCON:	return & dictget ;
    case p4_DSET:	return & dictset ;
    case p4_OVAR:
    case p4_IVAR:	return & variable ;
    case p4_OVAL:
    case p4_IVAL:	return & value ;
    case p4_OCON:
    case p4_ICON:	return & constant ;
    case p4_OFFS:	return & offset ;
    case p4_iOLD:
    case p4_xOLD:	return & obsoleted;
    default:
	P4_fail2 ("<!unknown execution code!(%c:%s)>", 
                  *xt->type->def, loader(*xt->type->def)->name);
	/* not yet supported */
	return 0;
    }
    /* unreachable */
}

/* simplest form of compilation */
p4xcode* p4_compile_comma(p4xcode* at, p4xt xt)
{
    switch (*xt->type->def)
    {
    case 0: /* the "" string indicates a trampoline */
    case p4_FXCO:
    case p4_IXCO:
    case p4_XXCO:
	return p4_compile_xcode (at,xt->word->ptr);
    case p4_SXCO:
	return p4_compile_xcode (at,((p4_Semant*)xt->word->ptr)->comp);
    case p4_RTCO:
	return p4_compile_xcode (at,((p4_Runtime2*)xt->word->ptr)->comp);
    case p4_ITEM:
	if (! xt->call->flag & P4_ONLY_CODE1) 
	    return p4_compile_xcode_BODY (at,xt->call->exec[0],P4_TO_BODY(xt));
	else
	    return p4_compile_xcode (at, xt->call->exec[0]);
    case '~': /* a destroyer-trampoline */
	return p4_compile_xcode_BODY (at, xt->word->ptr, P4_TO_BODY(xt));
    case '_': /* a CODE trampoline */
	return p4_compile_xcode (at, (p4xcode)(xt+1));
    case p4_IVOC:
    case p4_OVOC:	
    case p4_DVAR:      
    case p4_DCON:     
    case p4_DSET:               /* all these are not primitives */
    case p4_OVAR:               /* their runtimes will fetch the */
    case p4_IVAR:               /* body-ptr being compiled here */
    case p4_OVAL:
    case p4_IVAL:  
    case p4_OCON:
    case p4_ICON:
    case p4_OFFS: 
	/* P4_fail5 ("<!word type=%c:%s xt=%p code=%p body=%p!>",
	 *           *xt->type->def, loader(*xt->type->def)->name, xt, 
	 *           *p4_to_code(xt), P4_TO_BODY(xt));
	 */
	return p4_compile_xcode_BODY (at, *p4_to_code(xt), P4_TO_BODY(xt));
    default:
	P4_fail2 ("<!unknown compile code!(%c:%s)>", 
                  *xt->type->def, loader(*xt->type->def)->name);
	/* not yet supported */
	return at;
    }
    /* unreachable */
}

# if defined PFE_SBR_CALL_THREADING

/* ... and here are the SBR snippets needed to call an XT from C ... */

# if defined PFE_SBR_CALL_ARG_THREADING

/* defeat the compiler which wishes to optimize arg away for being unused */

#  if defined PFE_HOST_ARCH_I386

/*  the i386 architecture is so heavily register-starved that it does
 *  quite always setup a local frame which however breaks the ret-jmp
 *  asm-code presented. So what, we make another subroutine for which
 *  hopefully the compiler will not try to build an extra locals frame */

#   define __call(X,Y) { \
     register void* _v P4_SBR_TAKE_BODY; \
     _v = (X);        asm volatile ("push %0":: "r" (_v)); \
     _v = P4_TO_BODY (Y); asm volatile ("ret":: "r" (_v)); }
#   define _call(X,Y) p4_sbr_call_arg((X),(Y),(Y)) 
    

void p4_sbr_call_arg(void* code, void* xt1, void*xt2) { __call(code,xt1); }

#  elif defined PFE_HOST_ARCH_M68K
#   define _call(X,Y) { \
     register p4xcode _x asm ("%a0") = (X); \
     register void* _y asm ("%a1") = P4_TO_BODY (Y); \
     asm volatile ("jsr %0@":: "r" (_x), "r" (_y)); }
#  elif defined PFE_HOST_ARCH_POWERPC
#   define _call(X,Y) { \
     register p4xcode _x asm ("0") = (X); \
     register p4xcode _y P4_SBR_TAKE_BODY = P4_TO_BODY (Y); \
     asm volatile ("mtlr %0" :: "r" (_x)); \
     asm volatile ("blrl" :: "r" (_y)); }

#  else
#   error need to define asm p4_sbr_call for this architecture
#  endif /* PFE_HOST_* */
# endif /* PFE_SBR_CALL_ARG_THREADING */

_export void p4_sbr_call (p4xt xt)
{
# if defined PFE_SBR_CALL_ARG_THREADING
    /* and here, we have to recreate the variants of our compile_xcode
     * routines, in this case however, we just want to have the register effect
     * immediatly that the compiled code would have, and jump to the target
     * xcode - it is almost easy with sbr-arg threading since we just need
     * to setup the arg-register correctly, and then call the actual routine.
     */

    switch (*xt->type->def)
    {
    case 0: /* the "" string indicates a trampoline */
    case p4_FXCO:
    case p4_IXCO:
    case p4_XXCO:
        xt->word->ptr (); return; 
        /* p4_compile_xcode (at,xt->word->ptr); */
    case p4_SXCO:
        ((p4_Semant*)xt->word->ptr)->comp (); return;
	/* p4_compile_xcode (at,((p4_Semant*)xt->word->ptr)->comp); */
    case p4_RTCO:
        ((p4_Runtime2*)xt->word->ptr)->comp (); return;
	/* p4_compile_xcode (at,((p4_Runtime2*)xt->word->ptr)->comp);*/
    case p4_ITEM:
        _call (xt->call->exec[0], xt); return;
	/* if (! xt->call->flag & P4_ONLY_CODE1) 
         *  return p4_compile_xcode_BODY (at,xt->call->exec[0],P4_TO_BODY(xt));
         * else
         *  return p4_compile_xcode (at, xt->call->exec[0]);
         */
    case '~': /* a destroyer-trampoline */
        _call (xt->word->ptr, xt); return;
	/* p4_compile_xcode_BODY (at, xt->word->ptr, P4_TO_BODY(xt)); */
    case '_': /* a CODE trampoline */
        ((p4xcode)(xt+1)) (); return;
	/* p4_compile_xcode (at, (p4xcode)(xt+1)); */
    case p4_IVOC:
    case p4_OVOC:	
    case p4_DVAR:      
    case p4_DCON:     
    case p4_DSET:               /* all these are not primitives */
    case p4_OVAR:               /* their runtimes will fetch the */
    case p4_IVAR:               /* body-ptr being compiled here */
    case p4_OVAL:
    case p4_IVAL:  
    case p4_OCON:
    case p4_ICON:
    case p4_OFFS: 
	/* P4_note5 ("<!word type=%c:%s xt=%p code=%p body=%p!>",
	 *           *xt->type->def, loader(*xt->type->def)->name, xt, 
	 *           *p4_to_code(xt), P4_TO_BODY(xt));
	 */
        
        _call (*p4_to_code(xt), P4_TO_BODY(xt)); return; 
	/* p4_compile_xcode_BODY (at, *p4_to_code(xt), P4_TO_BODY(xt)); */
    default:
	P4_fail2 ("<!unknown execute code!(%c:%s)>", 
                  *xt->type->def, loader(*xt->type->def)->name);
	/* not yet supported */
	return;
    }
    /* unreachable */
# elif defined PFE_HOST_ARCH_I386 /* && ! SBR_CALL_ARG */
    /* the modern RISC architectures do not quite like it when some memory
     * area is modified and executed right away. It emerges to be a variant
     * of the problems about self-modifiying code. Even a jump via register
     * did not help it. So far, only the i386 processors can stand the
     * following simple code that is based on the compile_comma code
     */

    /* sbr-stub, xt-code, xt-data, sbr-exit */
    p4xcode list[6] /* = { 0,0,0,0,0,0 } */;
    void** p = p4_compile_comma(list, xt);
    PFE_SBR_COMPILE_EXIT(p);
    ((p4code) (list))();
    return;

    /* note however, that quite some i386-type processors do not honour
     * such conditions lightly - they might not just only flush the
     * the instruction pipeline, they might even flush the L1 cache when
     * there are different L1 caches for data and code. You don't want that.
     */

# else /* other HOST_* && ! SBR_CALL_ARG */
    /* for the case of sbr-call no-arg, we will need to do it quite
     * differently. Here we have to lie about the return-code that is
     * on the stack and which will be used to return later on. Instead
     * of setting an arg-register, we set a memory cell and take the
     * address of it to be pushed on the return-stack as the return
     * address for the items with an call-body, the other items can
     * just be called as is. Then we JUMP into the routine instead of
     * CALL to the routine, which will execute that routine and let
     * it return via the ret-code that follows the data area. However,
     * this is not tested - I'm not sure if it works on superpipelined
     * RISC machines although I guess it should. For the work at the
     * Tek labs, the no-arg sbr-threaded mode is not used anyway. Feel
     * free to add it. Otherwise this area will be left incomplete
     * as its support is only academic - for commercial grade developments
     * all the cpu docs are at hand, so it should be always possible to
     * define the bits to use sbr-call-arg threading.
     */
    P4_fail2 ("<!sbr-call no-arg is not supported on this platform,"
              " can not handle execute code!(%c:%s)>", 
              *xt->type->def, loader(*xt->type->def)->name);
    return;
# endif
}

/* _SBR_CALL_THREADING */

# endif

/* _CALL_THREADING */

#endif

/*@}*/

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