home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
rtsi.com
/
2014.01.www.rtsi.com.tar
/
www.rtsi.com
/
OS9
/
OSK
/
EFFO
/
pd6.lzh
/
SRC
/
forth.c
< prev
next >
Wrap
C/C++ Source or Header
|
1990-05-08
|
5KB
|
201 lines
/*
C BASED FORTH-83 MULTI-TASKING KERNEL APPLICATION: TILE FORTH
Copyright (c) 1989 by Mikael R.K. Patel
Computer Aided Design Laboratory (CADLAB)
Department of Computer and Information Science
Linkoping University
S-581 83 LINKOPING
SWEDEN
Email: mip@ida.liu.se
Started on: 30 June 1988
Last updated on: 28 November 1989
Dependencies:
(cc) kernel.h, error.h, memory.h, and io.h
Description:
A 32-bit Forth-83 Standard written in C. Illustrating the use of
the multi-tasking forth kernel, memory, io and error packages.
Allows parameters to be given to forth and selection of inter-
action symbol. Thus providing the basic interface for making forth
programs act as compile-and-go applications.
Copying:
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 1, or (at your option)
any later version.
This program 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 General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; see the file COPYING. If not, write to
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*/
/* EXTERNAL DEFINITIONS */
#include "kernel.h"
#include "error.h"
#include "memory.h"
#include "io.h"
/* VERSION BANNER */
#define BANNER "TILE Forth version 2.48, Copyright (c) 1989, by Mikael Patel\n"
/* STRUCTURE SIZES */
#define DICTIONARYSIZE 128L * 1024L
#define USERSIZE 1024
#define PARAMSIZE 1024
#define RETURNSIZE 1024
/* ACCESS TO APPLICATION ARGUMENTS */
static long ARGC;
static long *ARGV;
static long ARGS;
static char *ARGI;
/* APPLICATION IO DISPATCH. RUN ON IO-WAIT FOR PERIODICAL ACTIONS */
void io_dispatch()
{
/* Any application action which requires periodical attention */
}
/* EXAMPLE OF APPLICATION VOCABULARY */
void doarguments()
{
spush(ARGC - ARGS);
}
NORMAL_CODE(arguments, forth, "argc", doarguments);
void doargument()
{
if (!tos && !ARGI)
tos = *(long *) ARGV;
else
tos = *((long *) (long) ARGV + tos + ARGS);
}
NORMAL_CODE(argument, arguments, "argv", doargument);
/* MAIN WITH APPLICATION STARTUP OF FORTH TOP-LOOP */
main(argc, argv)
int argc;
char *argv[];
{
long i;
/* Initiate memory, error, io, and kernel */
memory_initiate(DICTIONARYSIZE);
error_initiate();
io_initiate(BANNER);
kernel_initiate(&argument, &arguments, USERSIZE, PARAMSIZE, RETURNSIZE);
/* Arguments: first, last, user area, parameter and return stack size */
/* Set up argument counter and pointer */
ARGC = argc;
ARGV = (long *) argv;
ARGS = argc - 1;
ARGI = (char *) 0;
/* Load argument files before taking input from standard input */
for(i = 1; i < argc; i++) {
/* Look for argument or start symbol switch */
if (STREQ(argv[i], "-a")) {
ARGS = i;
i = argc;
}
else {
if (STREQ(argv[i], "-s")) {
ARGI = argv[i + 1];
ARGS = i + 1;
i = argc;
}
else {
#ifdef OSK
if (STREQ(argv[i], "-?")) {
fprintf(stderr,"Syntax : forth [<opts>] [<file>] [<opts>]\n");
fprintf(stderr,"Function : forth interpreter\n");
fprintf(stderr,"Options :\n");
fprintf(stderr," -a <argument> access arguments\n");
fprintf(stderr," -s <start-symbol> define where to start\n");
fprintf(stderr,"Adapted to OS-9/68k by Stephan Paschedag\n");
exit(1);
}
else {
#endif
/* Use the argument as an input file name and try loading it*/
if (io_infile(argv[i]) == IO_UNKNOWN_FILE) {
(void) printf("%s: file not found\n", argv[i]);
kernel_finish();
io_finish();
error_finish();
memory_finish();
exit(0);
}
else
doquit();
#ifdef OSK
}
#endif
}
}
}
/* Use standard input as input stream */
(void) io_infile((char *) STDIN);
/* Check if there was a start symbol argument */
if (ARGI) {
/* Find the symbol in the vocabulary */
verbose = FALSE;
spush((long) ARGI);
dofind();
if (tos) {
dodrop();
docommand();
}
else
(void) printf("%s ??\n", ARGI);
}
else {
/* Else start the normal interaction loop */
verbose = TRUE;
doquit();
}
/* Clean up the kernel, io, error and memory package before exit */
kernel_finish();
io_finish();
error_finish();
memory_finish();
}