/** 
   -- Process command line, get memory and start up.
   
    Copyright (C) Tektronix, Inc. 1998 - 2001. All rights reserved.
  
    @see     GNU LGPL
    @author  Tektronix CTE              @(#) %derived_by: guidod %
    @version %version: bln_mpt1!5.49 %
      (%date_modified: Wed Aug 14 16:10:36 2002 %)
  
    @description
    Process command line, get memory and start up the interpret loop of PFE
 */
/*@{*/
#if defined(__version_control__) && defined(__GNUC__)
static char* id __attribute__((unused)) = 
"@(#) $Id: %full_filespec:  main-sub.c~bln_mpt1!5.49:csrc:bln_12xx!1 % $";
#endif

#define	_P4_SOURCE 1


#include <pfe/pfe-base.h>
#include <pfe/def-xtra.h>
 
#include <stdlib.h>
#include <stdarg.h>
#include <string.h>
#ifndef P4_NO_FP
#include <float.h>
#endif
#include <errno.h>
#ifdef PFE_HAVE_LOCALE_H
#include <locale.h>
#endif
#ifdef PFE_HAVE_UNISTD_H
#include <unistd.h>
#endif

#include <pfe/term-sub.h>
#include <pfe/version-sub.h>
#include <pfe/exception-sub.h>
#include <pfe/lined.h>
#include <pfe/_nonansi.h>
#include <pfe/_missing.h>

#include <pfe/option-ext.h>
#include <pfe/logging.h>

#ifndef _export
#define _export
# include <pfe/incl-sub.h>
# include <pfe/def-types.h>
#endif

#include <pfe/def-restore.h>

/************************************************************************/
/* Analyze command line options:                                        */
/************************************************************************/
#ifndef CAPS_ON /* USER-CONFIG: */ #define CAPS_ON 0 /* do you like (faked) caps lock by default? */ #endif #ifndef UPPER_CASE_ON /* USER-CONFIG: */ #define UPPER_CASE_ON 1 /* allow "dup" to find "DUP" by default */ #endif #ifndef LOWER_CASE_ON /* USER-CONFIG: */ #define LOWER_CASE_ON 1 /* allow "Dup" to find "dup" by default */ #endif #ifndef LWRCASE_FN_ON /* USER-CONFIG: */ #define LWRCASE_FN_ON 1 /* convert file names to lower case? */ #endif #ifndef FLOAT_INPUT_ON /* USER-CONFIG: */ #define FLOAT_INPUT_ON 1 /* allow input of floating point numbers */ #endif #ifndef TEXT_COLS /* USER-CONFIG: */ #define TEXT_COLS 80 /* used only in case p4th fails determining */ #endif #ifndef TEXT_ROWS /* USER-CONFIG: */ #define TEXT_ROWS 25 /* the screen size */ #endif #define TOTAL_SIZE (P4_KB*1024) /* the shorthand for default-computations */ #ifndef STACK_SIZE /* USER-CONFIG: */ #define STACK_SIZE 0 /* 0 -> P4_KB*1024 / 32 + 256 */ #endif #ifndef RET_STACK_SIZE /* USER-CONFIG: */ #define RET_STACK_SIZE 0 /* 0 -> P4_KB*1024 / 64 + 256 */ #endif #ifndef ORDER_LEN /* USER-CONFIG: */ #define ORDER_LEN 64 /* maximum wordlists in search order */ #endif #ifndef HISTORY_SIZE /* USER-CONFIG: */ #define HISTORY_SIZE 0x1000 /* size of command line history buffer */ #endif #ifdef _K12_SOURCE #undef LOWER_CASE_ON #define LOWER_CASE_ON 1 #endif
/**
   fill the session struct with precompiled options
 */
_export void
p4_SetOptionsDefault(p4_sessionP set, int len)
{
    if (set) 
{
        memset(set, 0, sizeof(*set));

	set->argv = 0;
	set->argc = 0;
        set->bootname = PFE_PACKAGE;
        set->isnotatty = 0;
        set->stdio = 0;
        set->caps_on = CAPS_ON;
        set->find_any_case = LOWER_CASE_ON;
        set->lower_case_fn = LWRCASE_FN_ON;
        set->upper_case_on = UPPER_CASE_ON;
#       ifndef P4_NO_FP
        set->float_input = FLOAT_INPUT_ON;
#       else
        set->float_input = 0;
#       endif
        set->license = 0;
        set->warranty = 0;
        set->quiet = 0;
        set->verbose = 0;
        set->debug = 0;
        set->bye = 0;
        set->cols = TEXT_COLS;
        set->rows = TEXT_ROWS;
        set->total_size = TOTAL_SIZE;
        /* TOTAL_SIZE dependent defaults are moved to dict_allocate */
        set->stack_size = 0;
        set->ret_stack_size = 0;

	set->prefix = PFE_EPREFIX;
        set->max_files = MAX_FILES;
        set->pockets = POCKETS;
        set->bootcommand = 0;
        set->include_file = 0;
        set->incpaths = PFE_INC_PATH;
        set->incext = PFE_INC_EXTENSIONS;
        set->blkpaths = PFE_BLK_PATH;
        set->blkext = PFE_BLK_EXTENSIONS;
        set->cpus = P4_MP;

#      ifndef _K12_SOURCE
	
{   /* environment scanning */
	    char* t;
	    /*
	     * get special options from environment variables:
	     */
	    if ((t = getenv ("FORTHINCLUDE")) != NULL)
	    
{
		set->incpaths = strdup (t); set->heap.incpaths = 1;
		set->blkpaths = strdup (t); set->heap.blkpaths = 1;
	    }
else if ((t = getenv ("PFEINCLUDE")) != NULL)
{
		set->incpaths = strdup (t); set->heap.incpaths = 1;
		set->blkpaths = strdup (t); set->heap.blkpaths = 1;
	    }
if ((t = getenv ("PFEDIR")) != NULL)
{
		set->prefix = strdup (t); set->heap.prefix = 1;
	    }
}
# endif /* newstyle option-ext support */ set->opt.dict = set->opt.space; set->opt.dp = set->opt.dict; set->opt.last = 0; set->opt.link = 0; if (! len) len = sizeof(*set); set->opt.dictlimit = ((p4char*)set) + len; }
}
/**
   the help_options table is scanned by help_opt for lines starting
   with "-". It then tries to match the directly following longoption,
   ie. the one that starts with the doubled "--" . If it does match,
   the single char at offset +1 is returned. The help_print routine
   will only show the strings upto the first length 0 string, so you
   can have invisible options. This is good for having synonyms of
   longoptions - just map them to the same shortoption. Note that this
   optionsystem does not allow shortoptions to be assembled into a
   single arg-position. Note also that it is a good thing to instruct
   the package user to only use longoptions since the shortoption
   vector may change but any old longoptions can be moved to the 
   invisible section (and have them mapped to the new vector or some
   shortopt vector that would not print well on a terminal, e.g. \8).
 */
static const char* help_options[] = 
{
    ">> Usage: %s [-#bcdefhklrsv] [file] [args..]",
    "-B --prefix DIR       \t prefix installation path to be used",  
    "-C --case-sensitive   \t turn on case-sensitive matching (no upper)",
    "-c --caps-lock        \t turn on CAPS lock",
    "-e --evaluate         \t bootcommand to evaluate",
    "-f --max-files        \t maximum N simultaneously open files",
    "-F --lowercase-fn     \t convert file names to lower case",
    "-G --float-input      \t allow input of floating point numbers",
    "-i --bootfile FILE    \t use FILE as forth script inside boot",
    "-k --total-size SIZE  \t SIZE of system in KBytes",
    "-l --lower-case       \t base system's wordlists are case insensitive",
    "-L --license          \t display license",
    "-p --pockets N        \t number of pockets for S\"",
    "-q --quiet            \t suppress signon message",
    "-r --ret-stack SIZE   \t SIZE of return stack in cells",
    "-s --stack SIZE       \t SIZE of stack in cells",
    "-t --flt-stack SIZE   \t SIZE of floating point stack in items",
    "-T --screen CxR       \t text screen has C/columns and R/rows",
    "-v --verbose          \t verbose",
    "-V --version          \t version string",
    "-W --warranty         \t display warranty. Of course: Absolutely none.",
    "-y --bye              \t non-interactive, exit after running file",
    "-? --help             \t display this message and exit",
    " * Turn option off by appending \"-\" to the letter.",
    " * The given file is loaded initially.",
    "-I  --path <path>     \t add to search path",
    "-P  --pipe            \t run in pipe, just read from stdio",
    "-!  --debug           \t start debugging",
    " * generic options: (transferred into environment-wordlist)",
    " * --OPTION-string=<str>    set string 'OPTION' (without -string suffix)",
    " * --OPTION-value=<val>     set value  'OPTION' (without -value suffix)",
    " * --OPTION-(file|image|command)=<name> set a string value of this name",
    " * --OPTION-path=<name>     append to 'OPTION-PATH' with path-delim",
    " * --OPTION-cells=<val>     set value 'OPTION-CELLS' in size elements",
    " * --OPTION-base=<val>      set value 'OPTION-BASE' as if an offset",
    " * --OPTION-<on|off>        set value 'OPTION' to flag as true or false",
    " * --OPTION-name=<str>      set strng '$OPTION' to the name string",
    " * --OPTION-size=<val[K]>   set value '/OPTION', understands K=1024 etc.",
    " * --max-OPTION=<val[K]>    set value '#OPTION', understands K=1024 etc.",
    "   e.g. --map-base --map-file --dump-file --str-buffer-size",
    "        --load-image --make-image --block-file --boot-file",
    "        --max-locals --max-cpus --max-files --inc-path",
    "        --data-stack-size --fp-stack-size --return-stack-size",
    "        --editor-name",
    "", /* and some invisible options (usually aliases) */
    "-d  --image-file         gforth' --load-image",
    "-D  --appl-image         gforth' --make-image",
    "-s  --data-stack-size    gforth' --stack",
    "-r  --return-stack-size  gforth' --ret-stack",
    "-t  --fp-stack-size      gforth' --flt-stack",
    "-k  --dictionary-size    gforth' --total-size",
    "-c  --caps               old' --caps-lock",
    0
}
;
static void
help_print (p4_sessionP set, FILE* f)
{
    const char** p;
    
    if (! f) f = stderr;
    
    fprintf (f, "%s\n%s\n", p4_version_string (), p4_copyright_string ());
    
    for (p = help_options; *p && **p; p++)
    
{
        if (**p == '-')  fprintf(stderr, "  "); /* indent the options */
        switch ((*p)[1])
        
{
	default:  
	    if ((*p)[1] > ' ') fprintf(f, *p); 
	    else fprintf(f, "  %s", (*p)+2);
	    break;
	case '>': fprintf(f, *p, set->bootname ? set->bootname : "..." ); 
	    break;
	case 'B': fprintf(f, "%s [%s]", *p, set->prefix ? set->prefix : "." );
	    break;
	case 'C': fprintf(f, "%s [%s]", *p, set->upper_case_on ? "OFF":"ON"); 
	    break;
	case 'c': fprintf(f, "%s [%s]", *p, set->caps_on ? "ON":"OFF"); 
	    break;
	case 'G': fprintf(f, "%s [%s]", *p, set->float_input ? "ON":"OFF"); 
	    break;
	case 'f': fprintf(f, "%s [%d]", *p, (int) set->max_files);
	    break;
	case 'F': fprintf(f, "%s [%s]", *p, set->lower_case_fn ? "ON":"OFF");
	    break;
	case 'k': fprintf(f, "%s [%d K]", *p, (int) set->total_size >> 10);
	    break;
	case 'l': fprintf(f, "%s [%s]", *p, set->find_any_case ? "ON":"OFF");
             break;
	case 'p': fprintf(f, "%s [%d]", *p, (int) set->pockets);
	    break;
	case 'r': fprintf(f, "%s [%d]", *p, (int) set->ret_stack_size);
	    break;
	case 's': fprintf(f, "%s [%d]", *p, (int) set->stack_size);
	    break;
	case 'T': fprintf(f, "%s [%ix%i]", *p, 
			  (int) set->cols, (int) set->rows); 
	    break;
        }
fprintf(f, "\n"); }
}
static char
help_opt(const char* str, int l, const char** helptab)
{
    const char** p;
    const char* q;

    if(! str || ! helptab) return 0;

    if (! l) l = strlen(str);
    if (l == 1) return *str;

    for (p=helptab; *p; p++)
    
{
        if (**p != '-') continue;
        q = *p; 
        q++; while (*q && *q != '-') q++; while (*q == '-') q++;
        if (strlen (q) > l && !memcmp (q, str, l) && q[l] == ' ')
            return (*p)[1];
    }
return 0; }
/**
   parse the command-line options and put them into the session-structure
   that is used in thread->set. 
   returns status code (0 == ok, 1 == normal, 2 == error)
  
   note, that these argc/argv are given as references! 
 */ 
_export int
p4_AddOptions (p4_sessionP set, int argc, char* argv[])
{
    int i, optc, flag;		/* count of all options */
    char ** optv;		/* values of these options */
    char *t, *val;

    if (! argc) return 0;

    if (argc && argv[0]) 
	set->bootname = argv[0];

    if (set->argc)
    
{
	/* we have already scanned some options */
	optv = malloc (sizeof(char*) * (set->argc + argc));
	if (!optv) return 2;

	memcpy (&optv[0], set->argv, sizeof(char*) * set->argc);
	memcpy (&optv[set->argc], &argv[1], argc-1);
	optv[set->argc + argc - 1] = 0;
	if (set->heap.optv) free (set->optv);
	set->optv = optv; set->heap.optv = 1;
	optc = set->argc + argc - 1;
    }
else
{
	optv = argv + 1; optc = argc - 1;
    }
/* * process options: */ for (i = set->argc; i < optc; i++)
{
        register int l, k, s;
        const char* p;

        t = optv[i]; /* scan options up to first (include-)file argument */
        if (*t == '-') 
{ t++; }
else
{ set->include_file = t; i++; break; }
if (*t == '-')
{
	    t++; if (*t == '-') 
{ i++; break; }
/* triple => no scriptfile */ if (!*t)
{ /* double => stopscanning, use next arg as scriptfile */
		i++;  if (i < optc) 
{ set->include_file = optv[i]; i++; }
break; }
; }
k = l = strlen(t); p = strchr(t, '='); if (p)
{ k = p-t; }
/* length of key */ s=0; /* skips i - use if val is consumed */ flag = 1; /* ON - may be switched to OFF here...*/ if (k == l && t[k-1] == '-')
{ k--; flag ^= 1; }
if (l >= 4 && !strcmp (t, "no-"))
{ t+=3; k-=3; flag ^= 1; val=t+k; }
else if (k != l)
{ val = t + k + 1; }
/* seperator = or postfix - */ else if (i == optc - 1)
{ val = NULL; }
else
{ val = optv[i+1]; s=1; }
switch (help_opt(t, k, help_options))
{
        case 'V': fprintf (stdout, "%s\n", p4_version_string ());  
						return 1; continue;
	    /*
	     * Simple flag options can be -x or -x- to turn them off.
	     * these can be combined into a single option.
	     */
	case 'c': set->caps_on = flag;         continue;
	case 'C': set->upper_case_on = ! flag; continue;
	case 'l': set->find_any_case = flag;   continue; /* depracated */
	case 'F': set->lower_case_fn = flag;   continue;
	case 'G': set->float_input = flag;     continue;
	case 'L': set->license = flag;	       continue;
	case 'W': set->warranty = flag;        continue;
	case 'q': set->quiet = flag;           continue;
	case 'v': set->verbose = flag;         continue;
	case 'P': set->stdio = flag;           continue;
	case 'y': set->bye = flag;             continue;
	case '!': set->debug = flag;           continue;

             /*
              * Other options have values either following 
              * immediately after the option letter or as 
              * next command line argument:
              */
#       define set__strvar_(VAR) \
	if (set->heap.VAR) free ((void*) set->VAR); \
	set->heap.VAR = 0; set->VAR  
	case 'B': set__strvar_(prefix) = val; 	      i+=s; continue;
	case 'e': set__strvar_(bootcommand) = val;    i+=s; continue;
	case 'k': set->total_size = atoi (val) << 10; i+=s; continue;
	case 'p': set->pockets = atoi (val);	      i+=s; continue;
	case 'r': set->ret_stack_size = atoi (val);   i+=s; continue;
	case 's': set->stack_size = atoi (val);       i+=s; continue;
	case 'f': set->max_files = atoi (val);
	    if (set->max_files < 4) set->max_files = 4;
	    i+=s; continue;
	case 'T':
	    if (sscanf (val, "%dx%d", &set->cols, &set->rows) != 2)
		set->cols = TEXT_COLS, set->rows = TEXT_ROWS;
	    i+=s; continue;

	case 'I': /* this adds the specified string to the internal string */
	
{
	    char* p;
	    static const char delimstr[2] = 
{ PFE_PATH_DELIMITER, '\0' }
; p = malloc (strlen(set->incpaths) + 1 + strlen(val) + 1); if (p)
{ 
		strcpy (p, set->incpaths);
		strcat (p, delimstr);
		strcat (p, val);
		if (set->heap.incpaths) free ((void*) set->incpaths);
		set->incpaths = p; set->heap.incpaths = 1;
	    }
p = malloc (strlen(set->blkpaths) + 1 + strlen(val) + 1); if (p)
{
		strcpy (p, set->blkpaths);
		strcat (p, delimstr);
		strcat (p, val);
		if (set->heap.blkpaths) free ((void*) set->blkpaths);
		set->blkpaths = p; set->heap.blkpaths = 1;
	    }
i+=s; continue; }
# ifdef __move_cpus_code_to_forth_vm_init case 'C':
{  
	    register int cpus = atoi(val);
	    if (0 < cpus && cpus <= P4_MP_MAX) set->cpus = cpus;
	    else 
{ 
		P4_fail2 ("cpus=%d invalid (max %d allowed)", 
			  cpus, P4_MP_MAX); 
	    }
i+=s; continue; }
# endif case '?': help_print (set, stdout); return 1; continue; default:
{
            /* generic option setting via option-ext (into environment-wl) */
            p4char path [256];
            if (k > 6 && !memcmp (t + k - 6, "-value", 6))
            
{
                p4_change_option_value (t, k-6, 
                                        p4_convsize (val, 1), /* direct */
                                        set); 
                i += s;
            }
else if (k > 7 && !memcmp (t + k - 7, "-string", 7))
{
                p4_change_option_string (t, k - 7, val, set); 
                i += s;
            }
else if (k > 5 && !memcmp (t + k - 5, "-path", 5))
{
                int x;
                memset (path, 0, 256);
                strncpy (path, 
                         p4_search_option_string (t, k, "", set), 
                         255);
                if ((x = strlen(path)))
                
{ path[x] = PFE_PATH_DELIMITER; path[x+1] = '\0'; }
strncat (path, val, 255); p4_change_option_string (t, k, path, set); i += s; }
else if (k > 5 && !memcmp (t + k - 5, "-file", 5))
{
                p4_change_option_string (t, k, val, set);
                i += s;
            }
else if (k > 6 && !memcmp (t + k - 6, "-image", 6))
{
                p4_change_option_string (t, k, val, set);
                i += s;
            }
else if (k > 8 && !memcmp (t + k - 8, "-command", 8))
{
                p4_change_option_string (t, k, val, set);
                i += s;
            }
else if (k > 6 && !memcmp (t + k - 6, "-cells", 6))
{
                p4_change_option_value (t, k, 
                                        p4_convsize (val, 1), /* %cells */
                                        set);
                i += s;
            }
else if (k > 5 && !memcmp (t + k - 5, "-base", 5))
{
                p4_change_option_value (t, k, 
                                        p4_convsize (val, 1), /* direct */
                                        set);
                i += s;
            }
else if (k > 5 && !memcmp (t + k - 5, "-size", 5))
{
                /* --pad-size becomes "environment /pad" */
                path[0] = '/'; memcpy (path+1, t, k - 5);
                p4_change_option_value (path, k-4,
                                        p4_convsize (val, 1),
                                        set);
                i += s;
            }
else if (k > 5 && !memcmp (t + k - 5, "-name", 5))
{
                /* --editor-name becomes "environment $editor" */
                path[0] = '$'; memcpy (path+1, t, k - 5);
                p4_change_option_string (path, k-4, val, set);
                i += s;
            }
else if (k > 4 && !memcmp (t , "max-", 4))
{
                /* --max-locals becomes "environment #locals" */
                path[0] = '#'; memcpy (path+1, t + 4, k - 4);
                p4_change_option_value (path, k-3,
                                        p4_convsize (val, 1),
                                        set);
                i += s;
            }
else if (k > 4 && !memcmp (t + k - 4, "-off", 4))
{
                flag ^= 1;
                p4_change_option_value (t, k - 4, flag, set);
            }
else if (k > 3 && !memcmp (t + k - 3, "-on", 3))
{
                p4_change_option_value (t, k - 3, flag, set);
            }
else
{
                help_print (set, stderr);  return 2; 
            }
continue; }
/*default*/ }
/*switch*/ }
/* * Register remaining options (without included file name) in app_ argc/v: */ set->argv = &optv[i]; set->argc = optc - i; return 0; }
/**
   initalize the session struct
  
   => p4_SetOptionsDefault , => p4_AddOptions , => FreeOptions
 */
_export int
p4_SetOptions (p4_sessionP set, int len, int argc, char* argv[])
{
    p4_SetOptionsDefault(set, len);
    return p4_AddOptions (set, argc, argv);
}
/** 
   de-init the session struct
  
   => p4_SetOptions , => p4_AddOptions
 */
_export int
p4_FreeOptions (int returncode, p4_sessionP set)
{
    if (set->heap.include_file) free ((void*) set->include_file);
    if (set->heap.incpaths)	free ((void*) set->incpaths);
    if (set->heap.incext)	free ((void*) set->incext);
    if (set->heap.blkpaths)	free ((void*) set->blkpaths);
    if (set->heap.blkext)	free ((void*) set->blkext);
    if (set->heap.prefix)	free ((void*) set->prefix);
    if (set->heap.bootcommand)	free ((void*) set->bootcommand);
    if (set->heap.optv)		free ((void*) set->optv);
    return returncode;
}
/**
   set prelinked-modules-table
 */
_export int
p4_SetModules (p4_sessionP set, p4Words* modules)
{
    set->modules = modules;
    return 0;
}
/************************************************************************/ /* physical instance of the global system variable: */
/************************************************************************/
#ifndef _export #define _export # ifndef P4_REGTH # ifndef PFE_WITH_STATIC_REGS /* */ extern p4_threadP p4TH; # else /* */ extern struct p4_Thread p4_reg; /* */ extern struct p4_Session p4_opt; # endif # endif #endif #ifndef P4_REGTH # ifndef PFE_WITH_STATIC_REGS /*export*/ p4_threadP p4TH; # else /*export*/ struct p4_Thread p4_reg; /*export*/ struct p4_Session p4_opt; static char allocated_p4_reg = 0; static char allocated_p4_opt = 0; # endif #endif
_export p4_sessionP
p4_NewSessionOptions (int extra)
{
#  ifdef PFE_WITH_STATIC_REGS
    if (allocated_p4_opt)
        return 0;
    p4_SetOptionsDefault (&p4_opt, sizeof(p4_opt));
    allocated_p4_opt = 1;
    return &p4_opt;
#  else
    p4_sessionP ptr = malloc (sizeof(*ptr)+extra);
    p4_SetOptionsDefault (ptr, sizeof(*ptr)+extra);
    return ptr;
#  endif
}
_export p4_threadP
p4_NewThreadOptions (p4_sessionP set)
{
#  ifdef PFE_WITH_STATIC_REGS
    if (allocated_p4_reg)
        return 0;
    p4_reg.set = set;
    allocated_p4_reg = 1;
    return &p4_reg;
#  else
    p4_threadP ptr = malloc (sizeof(*ptr));
    memset (ptr, 0, sizeof(*ptr));
    ptr->set = set;
    return ptr;
#  endif
}
_export p4_threadP
p4_SetThreadOf(p4_threadP ptr, p4_sessionP set)
{
    if (! ptr) return ptr;
    memset (ptr, 0, sizeof (*ptr));
    ptr->set = set;
    return ptr;
}
_export void
p4_FreeSessionPtr (p4_sessionP ptr)
{
#  ifdef PFE_WITH_STATIC_REGS
    if (ptr != &p4_opt)
        return 1;
    return ((allocated_p4_opt = 0));
#  else
    if (ptr) free (ptr);
#  endif
}
_export void
p4_FreeThreadPtr (p4_threadP ptr)
{
#  ifdef PFE_WITH_STATIC_REGS
    if (ptr != &p4_reg)
        return 1;
    return ((allocated_p4_reg = 0));
#  else
    if (ptr) free (ptr);
#  endif
}
/************************************************************************/ /* Initialize memory map: */
/************************************************************************/
void
p4_SetDictMem (p4_threadP thread, void* dictmem, long size)
{
    if (!dictmem) return;
    thread->p[P4_MEM_SLOT] = dictmem;
    thread->moptrs = P4_MEM_SLOT;   /* _cleanup shall not free this one */
    thread->set->total_size = size; /* or any later module mem pointer */
}
static void
init_accept_lined (void)
{
    extern void accept_executes_xt (int);
    static void (*exec[10]) (int) =
    
{
	accept_executes_xt, accept_executes_xt, accept_executes_xt,
	accept_executes_xt, accept_executes_xt, accept_executes_xt,
	accept_executes_xt, accept_executes_xt, accept_executes_xt,
	accept_executes_xt,
    }
; memset (&PFE.accept_lined, 0, sizeof PFE.accept_lined); PFE.accept_lined.history = PFE.history; PFE.accept_lined.history_max = PFE.history_top - PFE.history; PFE.accept_lined.complete = p4_complete_dictionary ; PFE.accept_lined.executes = exec; PFE.accept_lined.caps = PFE_set.caps_on != 0; }
typedef char pock_t[POCKET_SIZE]; /************************************************************************/ /* Here's main() */
/************************************************************************/
static void p4_atexit_cleanup (void); /* distinct for each tread ! */ _export p4_threadP p4_main_threadP = NULL;
/**
   note the argument 
 */
int
p4_main (p4_threadP th)
{
    char const * s;

#  ifdef VXWORKS
    extern int taskVarAdd (int, int*);
    extern int taskIdSelf ();
    taskVarAdd (taskIdSelf (), (int*) &p4_main_threadP);
#  endif
    p4_main_threadP = th;  

#  ifdef PFE_WITH_STATIC_REGS
#  define p4_main_threadP_TO_p4TH 
#  else
#  define p4_main_threadP_TO_p4TH \
   p4TH = p4_main_threadP
#  endif

    p4_main_threadP_TO_p4TH;

#  ifdef PFE_HAVE_LOCALE_H
    setlocale (LC_ALL, "C");
#  endif
#  if defined SYS_EMX
    _control87 (EM_DENORMAL | EM_INEXACT, MCW_EM);
#  endif

    switch (setjmp (PFE.loop))
    
{
    case 'A':
    case 'Q':
	P4_fatal ("Fatal Run Error");
        
{ 
            extern FCode(p4_come_back); /*:debug-ext:*/ 
#         ifdef P4_RP_IN_VM
            if (p4_R0) RP = p4_R0; /* quit_system */
            FX (p4_come_back); 
#         endif
        }
p4_atexit_cleanup (); return -1; case 'X': P4_info ("Exiting"); p4_atexit_cleanup (); return PFE.exitcode; }
/* _______________ terminal settings _____________ */ p4_main_threadP_TO_p4TH; # if !defined __WATCOMC__ if (! isatty (STDIN_FILENO)) PFE_set.stdio = 1; # endif if (PFE_set.stdio) PFE_set.isnotatty = P4_TTY_ISPIPE; else
{
        if (! p4_prepare_terminal ())
	
{
            if (! PFE_set.quiet)
                fputs (
		    "[unknown terminal, "
#                  if defined ASSUME_VT100
		    "assuming vt100"
#                  elif defined ASSUME_DUMBTERM
		    "assuming dumb terminal"
#                  else
		    "running without terminal mode"
#                  endif
		    "]\n", stderr);
#          if !defined ASSUME_VT100 && !defined ASSUME_DUMBTERM
            PFE_set.isnotatty = P4_TTY_ISPIPE;
#          endif
	}
if (PFE_set.bye) PFE_set.isnotatty = P4_TTY_NOECHO; else
{
	    p4_interactive_terminal ();
	    PFE.system_terminal = &p4_system_terminal;
	}
}
if (! PFE_set.debug) p4_install_signal_handlers (); if (! PFE_set.quiet)
{
        p4_outs ("\\ ");
        p4_outs (p4_version_string ());
	if(! PFE_set.include_file) 
	    p4_outs (p4_copyright_string ());
	if (PFE_set.license)
	    p4_outs (p4_license_string ());
	if (PFE_set.warranty)
	    p4_outs (p4_warranty_string ());
        
	if (! PFE_set.bye)
	
{
	    if (! PFE_set.license || ! PFE_set.warranty)
		p4_outs ("\n\nPlease enter LICENSE and WARRANTY. ");
	    else
		p4_outs ("\n\nHi there, enjoy Forth! ");
            
#         ifndef _K12_SOURCE /* BYE does'nt make sense in an embedded system */
                p4_outs ("- To quit say BYE.\n");
#         else
		p4_outs ("- To restart say COLD.\n");
#         endif /* _K12_SOURCE */
	}
}
if (PFE.rows == 0) PFE.rows = PFE_set.rows; if (PFE.cols == 0) PFE.cols = PFE_set.cols; p4TH->atexit_cleanup = &p4_atexit_cleanup; /* _______________ dictionary block __________________ */ # ifdef USE_MMAP if ((s = p4_search_option_string ("map-file", 8, 0, PFE.set)))
{
        p4ucell l = p4_search_option_value ("map-base", 8, 0, PFE.set);
	PFE.mapfile_fd = p4_mmap_creat (s, l, PFE_set.total_size);
	if (! PFE.mapfile_fd)
	
{
	    P4_fail1 ("[%p] mapfile failed", p4TH);
	}
else
{
	    P4_info3 ("[%p] mapped at %8p len %d", 
		      p4TH, PFE_MEM, PFE_set.total_size);
	}
}
# endif if (! PFE_MEM)
{
#      ifndef P4_MIN_KB
#      define P4_MIN_KB 60
#      endif
        unsigned long total_size = 
            p4_search_option_value ("/total", 6, PFE_set.total_size, PFE.set);
        if (total_size < P4_MIN_KB*1024) total_size = P4_MIN_KB*1024;

        PFE_MEM = p4_xcalloc (1, (size_t) total_size);
        if (PFE_MEM)
        
{
            P4_info3 ("[%p] newmem at %p len %lu",
		      p4TH, PFE_MEM, total_size);
        }
else
{
            P4_fail3 ("[%p] FAILED to alloc any base memory (len %lu): %s",
		      p4TH, total_size, 
		      strerror(errno));
        }
if (total_size != PFE_set.total_size)
{
            P4_info3 ("[%p] OVERRIDE total_size %lu -> %lu",
                      p4TH, (unsigned long) PFE_set.total_size, total_size);
            PFE_set.total_size = total_size;
        }
}
/* ________________ initialize _____________ */ PFE.dict = PFE_MEM; PFE.dictlimit = PFE.dict + PFE_set.total_size; p4_dict_allocate (PFE_set.pockets, sizeof(pock_t), sizeof(char), (void**) & PFE.pockets, 0 ); PFE_set.history_size = p4_search_option_value ("/history", 8, HISTORY_SIZE, PFE.set); p4_dict_allocate (PFE_set.history_size, sizeof(char), sizeof(char), (void**) & PFE.history, (void**) & PFE.history_top); p4_dict_allocate (PFE_set.max_files+3, sizeof(File), PFE_ALIGNOF_CELL, (void**) & PFE.files, (void**) & PFE.files_top); p4_dict_allocate (TIB_SIZE, sizeof(char), sizeof(char), (void**) & PFE.tib, (void**) & PFE.tib_end); if (! PFE_set.ret_stack_size) PFE_set.ret_stack_size = p4_search_option_value ( "return-stack-cells", 18, RET_STACK_SIZE ? RET_STACK_SIZE : (PFE_set.total_size / 64 + 256) / sizeof(p4cell), PFE.set); p4_dict_allocate (PFE_set.ret_stack_size, sizeof(p4xt*), PFE_ALIGNOF_CELL, (void**) & PFE.rstack, (void**) & PFE.r0); if (! PFE_set.stack_size) PFE_set.stack_size = p4_search_option_value ( "stack-cells", 11, STACK_SIZE ? STACK_SIZE : (PFE_set.total_size / 32 + 256) / sizeof(p4cell), PFE.set); p4_dict_allocate (PFE_set.stack_size, sizeof(p4cell), PFE_ALIGNOF_CELL, (void**) & PFE.stack, (void**) & PFE.s0); PFE_set.wordlists = p4_search_option_value ("wordlists", 9, ORDER_LEN, PFE.set); p4_dict_allocate (PFE_set.wordlists+1, sizeof(void*), sizeof(void*), (void**) & PFE.context, (void**) 0); p4_dict_allocate (PFE_set.wordlists, sizeof(void*), sizeof(void*), (void**) & PFE.dforder, (void**) 0); if (PFE.dictlimit < PFE.dict + MIN_PAD + MIN_HOLD + 0x4000)
{
	P4_fatal ("impossible memory map");
	PFE.exitcode = 3;
	p4_longjmp_exit ();
    }
init_accept_lined (); /* should be splitted into boot-core exec-bootcommand boot-extensions */ p4_boot_system (); p4_main_threadP_TO_p4TH; /* USER-CONF --load-image=<file> (alias --image-file=<name>) */ s = p4_search_option_string ("image-file", 10, 0, PFE.set); /* gforth's */ s = p4_search_option_string ("load-image", 10, s, PFE.set); /* pfe's */ if (s)
{
        P4_fail2 ("[%p] load wordset image-file not implemented: %s", p4TH, s);
    }
/* _______________ evaluate ________________ */ /* process the boot command: */ if (PFE_set.bootcommand)
{
        p4_evaluate (PFE_set.bootcommand, strlen(PFE_set.bootcommand));
    }
/* Include file from command line: */ if (PFE_set.include_file)
{
        p4_included1 (PFE_set.include_file, strlen (PFE_set.include_file), 0);
    }
/* If running in a pipe, process commands from stdin: */ if (PFE_set.stdio)
{
        p4_include_file (PFE.stdIn);
        PFE.atexit_cleanup ();
        return 0;
    }
/* If it's a turnkey-application, start it: */ if (APPLICATION)
{
        p4_run_forth (APPLICATION);
        PFE.atexit_cleanup ();
        return 0;
    }
if (PFE_set.verbose) FX (p4_dot_memory); if (! PFE_set.bye) p4_interpret_loop (); /* will catch QUIT, ABORT, COLD .. and BYE */ PFE.atexit_cleanup (); return 0; }
/** 
   init and execute the previously allocated forth-maschine,
   e.g. pthread_create(&thread_id,0,p4_Exec,threadP);
 */
_export int 
p4_Exec(p4_threadP th)
{
    auto volatile int retval;
    P4_CALLER_SAVEALL;
    retval = p4_main(th);
    P4_CALLER_RESTORE;
    return retval;
}
static void
p4_atexit_cleanup (void)
{
    extern void p4_cleanup_terminal (void);
    P4_enter ("atexit cleanup");

    PFE.atexit_running = 1;
    p4_forget ((FENCE = PFE_MEM));
    
    if (PFE.system_terminal)    /* call this once, with the first cpu */
        PFE.system_terminal ();
    p4_cleanup_terminal ();

#  ifdef USE_MMAP
    if (PFE.mapfile_fd)
    
{
	p4_mmap_close(PFE.mapfile_fd, PFE_MEM, PFE_set.total_size);
        PFE_MEM = 0; PFE.mapfile_fd = 0;
        P4_info1 ("[%p] unmapped basemem", p4TH);      
    }
# endif
{ /* see if there's some memory chunk still to be freed */
        register int i;
        register int moptrs = PFE.moptrs ? PFE.moptrs : P4_MOPTRS;
        for ( i=0; i < moptrs; i++) 
{
            if (PFE.p[i]) 
{ 
                P4_info3 ("[%p] free %d. %p", p4TH, i, PFE.p[i]);
                p4_xfree (PFE.p[i]); PFE.p[i] = 0; 
            }
}
}
P4_leave ("atexit cleanup done"); }
/*@}*/
/* 
   Local variables:
   c-file-style: "stroustrup"
   End:
 */