home *** CD-ROM | disk | FTP | other *** search
- /*
- * This file is part of the portable Forth environment written in ANSI C.
- * Copyright (C) 1995 Dirk Uwe Zoller
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Library General Public
- * License as published by the Free Software Foundation; either
- * version 2 of the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
- * See the GNU Library General Public License for more details.
- *
- * You should have received a copy of the GNU Library General Public
- * License along with this library; if not, write to the Free
- * Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- *
- * This file is version 0.9.13 of 17-July-95
- * Check for the latest version of this package via anonymous ftp at
- * roxi.rz.fht-mannheim.de:/pub/languages/forth/pfe-VERSION.tar.gz
- * or sunsite.unc.edu:/pub/languages/forth/pfe-VERSION.tar.gz
- * or ftp.cygnus.com:/pub/forth/pfe-VERSION.tar.gz
- *
- * Please direct any comments via internet to
- * duz@roxi.rz.fht-mannheim.de.
- * Thank You.
- */
- /*
- * main.c --- Process command line, get memory and start up.
- * (duz 15Jul93)
- */
-
- #include "forth.h"
- #include "support.h"
- #include "term.h"
- #include "lined.h"
- #include "help.h"
-
- #include <stdlib.h>
- #include <stdarg.h>
- #include <string.h>
- #include <float.h>
- #ifdef HAVE_LOCALE_H
- #include <locale.h>
- #endif
-
- #include "nonansi.h"
- #include "missing.h"
-
- /************************************************************************/
- /* physical instances of global system variables: */
- /************************************************************************/
- /* *INDENT-OFF* */
- #ifndef REGIP
- Xt * ip; /* the instruction pointer */
- #endif
-
- #ifndef REGSP
- Cell * sp; /* the stack pointer */
- #endif
-
- #ifndef REGRP
- Xt ** rp; /* the return stack pointer */
- #endif
-
- #if !defined W && !defined REGW
- Xt W; /* used inside the inner interpreter */
- #endif
-
- #ifndef REGLP
- Cell * lp; /* pointer to local variables */
- #endif
-
- #ifndef REGFP
- double *fp; /* the floating point stack pointer */
- #endif
- /* *INDENT-ON* */
-
- struct memory membot; /* start of each area */
- struct memory memtop; /* end of each area */
- struct memsiz memsiz; /* size of each area in cells */
- struct sysvar sys; /* all other FORTH variables */
-
- char host_system[] = HOST_SYSTEM;
- int _argc; /* exported command line options */
- char **_argv;
- int app_argc; /* exported application cmdline options */
- char **app_argv;
- int exitcode = 0;
-
- /* very simple error handling for fatal errors */
-
- void
- fatal (const char *msg,...)
- {
- char buf[128];
- va_list p;
-
- va_start (p, msg);
- vsprintf (buf, msg, p);
- fprintf (stderr, "\n%s: %s (fatal)\n", (char *) _argv[0], buf);
- eXit (2);
- }
-
- /************************************************************************/
- /* Analyze command line options: */
- /************************************************************************/
-
- struct options option = /* initialized with defaults */
- {
- CAPS_ON, /* caps_on */
- LOWER_CASE_ON, /* lower_case_on */
- LWRCASE_FN_ON, /* lower_case_fn */
- FLOAT_INPUT_ON, /* float_input */
- 0, /* license */
- 0, /* warranty */
- 0, /* quiet */
- 0, /* verbose */
- 0, /* canonical */
- 0, /* stdio */
- 0, /* debug */
-
- TEXT_COLS, /* cols */
- TEXT_ROWS, /* rows */
-
- TOTAL_SIZE, /* total_size of system in bytes */
-
- #if defined HPUX68K && !defined __GNUC__
- (TOTAL_SIZE / 8) / CELLSIZE,
- (TOTAL_SIZE / 16) / DFLOATSIZE,
- (TOTAL_SIZE / 16) / CELLSIZE,
- #else
- STACK_SIZE /* stack size in cells */
- ? STACK_SIZE
- : (TOTAL_SIZE / 8) / CELLSIZE,
- FLT_STACK_SIZE /* floating point stack size in items */
- ? FLT_STACK_SIZE
- : (TOTAL_SIZE / 16) / DFLOATSIZE,
- RET_STACK_SIZE /* return stack size in items */
- ? RET_STACK_SIZE
- : (TOTAL_SIZE / 16) / CELLSIZE,
- #endif
-
- MAX_FILES, /* max_files */
- POCKETS, /* pockets */
- NULL, /* save_dict */
- NULL, /* load_dict */
- PFERC_FILE, /* pferc_file */
- DEFAULT_BLKFILE, /* block_file */
- NULL, /* include_file */
- INC_PATHS, /* incpath */
- INC_EXTENSIONS, /* incext */
- BLK_PATHS, /* blkpath */
- BLK_EXTENSIONS, /* blkext */
- EDITOR /* preferred text file editor */
- };
-
- static void
- howto (void)
- {
- fprintf (stderr,
- "%s\n%s\n"
- "Usage: %s [-bcdefhklrsv] [file]\n"
- " -b FILE" "\tuse FILE as block device\n"
- " -c\t" "\tturn on CAPS lock [%s]\n"
- " -d FILE" "\treload dictionary image from FILE\n"
- " -D FILE" "\tbuild dictionary image and exit\n"
- " -e NAME" "\tNAME of preferred ASCII text editor [%s]\n"
- " -E\t" "\tallow input of floating point numbers [%s]\n"
- " -fN\t" "\tmaximum N simultaneously open files [%d]\n"
- " -F\t" "\tconvert file names to lower case [%s]\n"
- " -h\t" "\tdisplay this message and exit\n"
- " -k SIZE" "\tSIZE of system in KBytes [%d K]\n"
- " -l\t" "\tallow input of lower case words [%s]\n"
- " -L\t" "\tdisplay license\n"
- " -p SIZE" "\tSIZE of floating point stack in items [%d]\n"
- " -PN" "\tnumber of pockets for S\" [%d]\n"
- " -q\t" "\tsuppress signon message\n"
- " -r SIZE" "\tSIZE of return stack in cells [%d]\n"
- " -s SIZE" "\tSIZE of stack in cells [%d]\n"
- " -t CxR" "\ttext screen has C [%d] columns and R [%d] rows\n"
- " -v\t" "\tverbose\n"
- " -W\t" "\tdisplay warranty. Of course: Absolutely none.\n"
- "Turn option off by appending \"-\" to the letter.\n"
- "The given file is loaded initially.\n\n",
- version_string, copyright_string,
- _argv[0],
- option.caps_on ? "ON" : "OFF",
- option.editor,
- option.float_input ? "ON" : "OFF",
- (int) option.max_files,
- option.lower_case_fn ? "ON" : "OFF",
- (int) option.total_size >> 10,
- option.lower_case_on ? "ON" : "OFF",
- (int) option.flt_stack_size,
- (int) option.pockets,
- (int) option.ret_stack_size,
- (int) option.stack_size,
- (int) option.cols, (int) option.rows);
- eXit (1);
- }
-
- static void
- get_options (int argc, char *argv[])
- {
- char env_opt[0x400]; /* options from environment variable */
- int i, optc, flag; /* count of all options */
- char *optv[100]; /* values of all options */
- char opt, *t, *val;
-
- /*
- * get special options from environment variables:
- */
- if ((t = getenv ("PFEINCLUDE")) != NULL)
- option.incpaths = strdup (t),
- option.blkpaths = strdup (t);
- if ((t = getenv ("EDITOR")) != NULL)
- option.editor = strdup (t);
-
- /*
- * merge options from environment variable with those from command line:
- */
- optc = 0;
- if ((t = getenv ("PFEOPTIONS")) != NULL)
- {
- strcpy (env_opt, t);
- t = strtok (env_opt, " ");
- do
- {
- optv[optc++] = t;
- t = strtok (NULL, " ");
- }
- while (t);
- }
- app_argc = optc;
- for (i = 1; i < argc; i++)
- optv[optc++] = argv[i];
-
- /*
- * process options:
- */
- for (i = 0; i < optc; i++)
- {
- t = optv[i];
- if (*t != '-')
- break;
- opt = *++t;
- /*
- * Simple flag options can be -x or -x- to turn them off:
- */
- flag = t[1] != '-';
- switch (opt)
- {
- /* *INDENT-OFF* */
- case 'c': option.caps_on = flag; continue;
- case 'l': option.lower_case_on = flag; continue;
- case 'F': option.lower_case_fn = flag; continue;
- case 'E': option.float_input = flag; continue;
- case 'L': option.license = flag; continue;
- case 'W': option.warranty = flag; continue;
- case 'q': option.quiet = flag; continue;
- case 'v': option.verbose = flag; continue;
- case 'B': option.debug = flag; continue;
- /* *INDENT-ON* */
- }
- /*
- * Other options have values either following immediately after
- * the option letter or as next command line argument:
- */
- if (*++t)
- val = t;
- else if (i == optc - 1)
- val = NULL;
- else
- val = optv[++i];
- switch (opt)
- {
- /* *INDENT-OFF* */
- default:
- case 'h': howto (); continue;
- case 'b': option.block_file = val; continue;
- case 'D': option.save_dict = val; continue;
- case 'd': option.load_dict = val; continue;
- case 'e': option.editor = val; continue;
- case 'k': option.total_size = atoi (val) << 10; continue;
- case 'p': option.flt_stack_size = atoi (val); continue;
- case 'P': option.pockets = atoi (val); continue;
- case 'r': option.ret_stack_size = atoi (val); continue;
- case 's': option.stack_size = atoi (val); continue;
- /* *INDENT-ON* */
- case 'f':
- option.max_files = atoi (val);
- if (option.max_files < 4)
- option.max_files = 4;
- continue;
- case 't':
- if (sscanf (val, "%dx%d", &option.cols, &option.rows) != 2)
- option.cols = TEXT_COLS, option.rows = TEXT_ROWS;
- continue;
- case 'I':
- t = option.incpaths + strlen (option.incpaths);
- *t++ = PATH_DELIMITER;
- strcpy (t, val);
- t = option.blkpaths + strlen (option.incpaths);
- *t++ = PATH_DELIMITER;
- strcpy (t, val);
- continue;
- }
- }
- if (i < optc)
- option.include_file = optv[i++];
-
- /*
- * Register options starting from included file name in app_argc/v:
- */
- app_argc = i - app_argc;
- app_argv = &argv[app_argc];
- app_argc = argc - app_argc;
- }
-
- /************************************************************************/
- /* Initialize memory map: */
- /************************************************************************/
-
- struct lined accept_lined;
-
- 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 (&accept_lined, 0, sizeof accept_lined);
- accept_lined.history = membot.history;
- accept_lined.history_max = memsiz.history;
- accept_lined.complete = complete_dictionary;
- accept_lined.executes = exec;
- accept_lined.caps = option.caps_on != 0;
- }
-
- static void
- allocate (void *p, uCell size)
- /* Allocates all memory areas in a continuous buffer at p with given size. */
- {
- void *q = (char *) p + size;
- typedef char pock_t[POCKET_SIZE];
- /* *INDENT-OFF* */
- #define ALLOC(TYPE,ALIGN,AREA,SIZE) \
- ( \
- memtop.AREA = (TYPE *) ((size_t)q & ~((size_t)(ALIGN) - 1)), \
- memsiz.AREA = (SIZE) * sizeof (TYPE), \
- ADD (q, -(SIZE) * sizeof (TYPE)), \
- membot.AREA = (TYPE *)q \
- )
-
- ALLOC (File, CELL_ALIGN, files, option.max_files + 3);
- ALLOC (char, 1, history, HISTORY_SIZE);
- ALLOC (char, 1, tib, TIB_SIZE);
- ALLOC (pock_t, 1, pocket, option.pockets);
- ALLOC (Xt *, CELL_ALIGN, rstack, option.ret_stack_size);
- ALLOC (double, DFLOAT_ALIGN, fstack, option.flt_stack_size);
- ALLOC (Cell, CELL_ALIGN, stack, option.stack_size);
- #undef ALLOC
- /* *INDENT-ON* */
-
- if ((char *) q < (char *) p + MIN_PAD + MIN_HOLD + 0x4000)
- fatal ("impossible memory map");
- membot.dict = (Byte *) p;
- memtop.dict = (Byte *) q;
- memsiz.dict = (char *) q - (char *) p;
- init_accept_lined ();
- }
-
- /************************************************************************/
- /* Here's main() */
- /************************************************************************/
-
- int
- main (int argc, char *argv[])
- {
- _argc = argc; /* pass arguments to Forth words */
- _argv = argv; /* ARGC and ARGV in misc.c */
-
- #ifdef HAVE_LOCALE_H
- setlocale (LC_ALL, "C");
- #endif
- #if defined EMX
- _control87 (EM_DENORMAL | EM_INEXACT, MCW_EM);
- #endif
- if (setjmp (abort_dest) || setjmp (quit_dest))
- fatal ("Error setting up");
-
- get_options (argc, argv);
- install_signal_handlers ();
- #if !defined __WATCOMC__
- if (!isatty (STDIN_FILENO))
- option.stdio = 1;
- else
- #endif
- {
- option.stdio = 0;
- if (!prepare_terminal ())
- {
- if (!option.quiet)
- fputs ("[unknown terminal, "
- #if defined ASSUME_VT100
- "assuming vt100"
- #else
- "running in canonical mode"
- #endif
- "]\n", stderr);
- #if !defined ASSUME_VT100
- option.canonical = 1;
- #endif
- }
- interactive_terminal ();
- atexit (system_terminal);
- }
- if (!option.quiet)
- {
- outs (version_string);
- outs (copyright_string);
- if (!option.license || !option.warranty)
- outs (" Please enter LICENSE and WARRANTY.");
- if (option.license)
- outs (license_string);
- if (option.warranty)
- outs (warranty_string);
- outs ("\n\nTo quit say BYE."
- "\n\nHi there, enjoy Forth!\n");
- }
- if (rows == 0)
- rows = option.rows;
- if (cols == 0)
- cols = option.cols;
- allocate ((char *) getmem ((size_t) option.total_size),
- option.total_size);
-
- initialize_system ();
-
- /* If a dictionary image was built and saved, quit now: */
- if (option.save_dict)
- return 0;
-
- /* If running in a pipe, process commands from stdin: */
- if (option.stdio)
- {
- include_file (sys.stdIn);
- return 0;
- }
-
- /* If it's a turnkey-application, start it: */
- if (APPLICATION)
- {
- run_forth (APPLICATION);
- return 0;
- }
- if (option.verbose)
- dot_memory_ ();
- do_abort ();
- return 0;
- }
-