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 >
C/C++ Source or Header  |  1990-05-08  |  5KB  |  201 lines
  1. /*
  2.   C BASED FORTH-83 MULTI-TASKING KERNEL APPLICATION: TILE FORTH
  3.  
  4.   Copyright (c) 1989 by Mikael R.K. Patel
  5.  
  6.   Computer Aided Design Laboratory (CADLAB)
  7.   Department of Computer and Information Science
  8.   Linkoping University
  9.   S-581 83 LINKOPING
  10.   SWEDEN
  11.  
  12.   Email: mip@ida.liu.se
  13.   
  14.   Started on: 30 June 1988
  15.  
  16.   Last updated on: 28 November 1989
  17.  
  18.   Dependencies:
  19.        (cc) kernel.h, error.h, memory.h, and io.h
  20.  
  21.   Description:
  22.        A 32-bit Forth-83 Standard written in C. Illustrating the use of
  23.        the multi-tasking forth kernel, memory, io and error packages. 
  24.   
  25.        Allows parameters to be given to forth and selection of inter-
  26.        action symbol. Thus providing the basic interface for making forth
  27.        programs act as compile-and-go applications.
  28.  
  29.   Copying:
  30.        This program is free software; you can redistribute it and/or modify
  31.        it under the terms of the GNU General Public License as published by
  32.        the Free Software Foundation; either version 1, or (at your option)
  33.        any later version.
  34.  
  35.        This program is distributed in the hope that it will be useful,
  36.        but WITHOUT ANY WARRANTY; without even the implied warranty of
  37.        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  38.        GNU General Public License for more details.
  39.  
  40.        You should have received a copy of the GNU General Public License
  41.        along with this program; see the file COPYING.  If not, write to
  42.        the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 
  43.  
  44. */
  45.  
  46.  
  47. /* EXTERNAL DEFINITIONS */
  48.  
  49. #include "kernel.h"
  50. #include "error.h"
  51. #include "memory.h"
  52. #include "io.h"
  53.  
  54.  
  55. /* VERSION BANNER */
  56.  
  57. #define BANNER "TILE Forth version 2.48, Copyright (c) 1989, by Mikael Patel\n"
  58.  
  59.  
  60. /* STRUCTURE SIZES */
  61.  
  62. #define DICTIONARYSIZE 128L * 1024L
  63. #define USERSIZE 1024
  64. #define PARAMSIZE 1024
  65. #define RETURNSIZE 1024
  66.  
  67.  
  68. /* ACCESS TO APPLICATION ARGUMENTS */
  69.  
  70. static long  ARGC;
  71. static long *ARGV;
  72. static long  ARGS;
  73. static char *ARGI;
  74.  
  75.  
  76. /* APPLICATION IO DISPATCH. RUN ON IO-WAIT FOR PERIODICAL ACTIONS */
  77.  
  78. void io_dispatch()
  79. {
  80.     /* Any application action which requires periodical attention */
  81. }
  82.  
  83.  
  84. /* EXAMPLE OF APPLICATION VOCABULARY */
  85.  
  86. void doarguments()
  87. {
  88.     spush(ARGC - ARGS);
  89. }
  90.  
  91. NORMAL_CODE(arguments, forth, "argc", doarguments);
  92.  
  93. void doargument()
  94. {
  95.     if (!tos && !ARGI)
  96.        tos = *(long *) ARGV;
  97.     else
  98.        tos = *((long *) (long) ARGV + tos + ARGS);
  99. }
  100.  
  101. NORMAL_CODE(argument, arguments, "argv", doargument);
  102.  
  103.  
  104. /* MAIN WITH APPLICATION STARTUP OF FORTH TOP-LOOP */
  105.  
  106. main(argc, argv)
  107.     int argc;
  108.     char *argv[];
  109. {
  110.     long i;
  111.     
  112.     /* Initiate memory, error, io, and kernel */
  113.     memory_initiate(DICTIONARYSIZE);
  114.     error_initiate();
  115.     io_initiate(BANNER);
  116.     kernel_initiate(&argument, &arguments, USERSIZE, PARAMSIZE, RETURNSIZE);
  117.     /* Arguments: first, last, user area, parameter and return stack size */
  118.     
  119.     /* Set up argument counter and pointer */
  120.     ARGC = argc;
  121.     ARGV = (long *) argv;
  122.     ARGS = argc - 1;
  123.     ARGI = (char *) 0;
  124.     
  125.     /* Load argument files before taking input from standard input */
  126.     for(i = 1; i < argc; i++) {
  127.  
  128.        /* Look for argument or start symbol switch */
  129.        if (STREQ(argv[i], "-a")) {
  130.            ARGS = i;
  131.            i = argc;
  132.        }
  133.        else {
  134.            if (STREQ(argv[i], "-s")) {
  135.                ARGI = argv[i + 1];
  136.                ARGS = i + 1;
  137.                i = argc;
  138.            }
  139.            else {
  140. #ifdef OSK
  141.              if (STREQ(argv[i], "-?")) {
  142.                 fprintf(stderr,"Syntax   : forth [<opts>] [<file>] [<opts>]\n");
  143.                 fprintf(stderr,"Function : forth interpreter\n");
  144.                 fprintf(stderr,"Options  :\n");
  145.                 fprintf(stderr,"     -a <argument>       access arguments\n");
  146.                 fprintf(stderr,"     -s <start-symbol>   define where to start\n");
  147.                 fprintf(stderr,"Adapted to OS-9/68k by Stephan Paschedag\n");
  148.                 exit(1);
  149.              }
  150.              else {
  151. #endif
  152.  
  153.                /* Use the argument as an input file name and try loading it*/
  154.                if (io_infile(argv[i]) == IO_UNKNOWN_FILE) {
  155.                    (void) printf("%s: file not found\n", argv[i]);
  156.                    kernel_finish();
  157.                    io_finish();
  158.                    error_finish();
  159.                    memory_finish();
  160.                    exit(0);
  161.                }
  162.                else 
  163.                    doquit();
  164. #ifdef OSK
  165.              }
  166. #endif
  167.            }
  168.        }
  169.     }
  170.  
  171.     /* Use standard input as input stream */
  172.     (void) io_infile((char *) STDIN);
  173.  
  174.     /* Check if there was a start symbol argument */
  175.     if (ARGI) {
  176.  
  177.        /* Find the symbol in the vocabulary */
  178.        verbose = FALSE;
  179.        spush((long) ARGI);
  180.        dofind();
  181.        if (tos) {
  182.            dodrop();
  183.            docommand();
  184.        }
  185.        else
  186.            (void) printf("%s ??\n", ARGI);
  187.     }
  188.     else {
  189.        /* Else start the normal interaction loop */
  190.        verbose = TRUE;
  191.        doquit();
  192.     }
  193.  
  194.     /* Clean up the kernel, io, error and memory package before exit */
  195.     kernel_finish();
  196.     io_finish();
  197.     error_finish();
  198.     memory_finish();
  199. }
  200.  
  201.