home *** CD-ROM | disk | FTP | other *** search
/ The CDPD Public Domain Collection for CDTV 3 / CDPDIII.bin / pd / programming / gnuforth / src / forth.c < prev    next >
C/C++ Source or Header  |  1992-05-19  |  5KB  |  240 lines
  1. /*
  2.   C BASED FORTH-83 MULTI-TASKING KERNEL APPLICATION: TILE FORTH
  3.  
  4.   Copyright (C) 1988-1990 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: 26 June 1990
  17.  
  18.   Dependencies:
  19.        (cc) kernel.h, error.h, memory.h, 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 3.33, Copyright (C) 1990, by Mikael Patel\n"
  58.  
  59.  
  60. /* STRUCTURE SIZES */
  61.  
  62. #define DICTIONARYSIZE 1024L * 1024L
  63. #define USERSIZE 1024L
  64. #define PARAMSIZE 256L
  65. #define RETURNSIZE 256L
  66.  
  67.  
  68. /* ACCESS TO APPLICATION ARGUMENTS */
  69.  
  70. static INT32 ARGC;
  71. static PTR32 ARGV;
  72. static INT32 ARGS;
  73. static CSTR  ARGI;
  74.  
  75.  
  76. /* ARGUMENT CHECK AND ACCESS MACROS */
  77.  
  78. #define ARGEQ(i, s) (*argv[i] == *s && *(argv[i] + 1) == *(s + 1))
  79. #define ARGEV(i) (atol(argv[i] + 2))
  80.  
  81.  
  82. /* APPLICATION IO DISPATCH. RUN ON IO-WAIT FOR PERIODICAL ACTIONS */
  83.  
  84. VOID io_dispatch()
  85. {
  86.     /* Any application action which requires periodical attention */
  87. }
  88.  
  89.  
  90. /* EXAMPLE OF APPLICATION VOCABULARY */
  91.  
  92. VOID doarguments()
  93. {
  94.     spush(ARGC - ARGS, INT32);
  95. }
  96.  
  97. NORMAL_CODE(arguments, forth, "argc", doarguments);
  98.  
  99. VOID doargument()
  100. {
  101.     if (!tos.INT32 && !ARGI)
  102.     tos.INT32 = *ARGV;
  103.     else
  104.     tos.INT32 = *((PTR32) (INT32) ARGV + tos.INT32 + ARGS);
  105. }
  106.  
  107. NORMAL_CODE(argument, arguments, "argv", doargument);
  108.  
  109.  
  110. /* MAIN WITH APPLICATION STARTUP OF FORTH TOP-LOOP */
  111.  
  112. main(argc, argv)
  113.     int argc;
  114.     char *argv[];
  115. {
  116.     INT32 i, flag;
  117.     INT32 dictionarysize, usersize, paramsize, returnsize;
  118.  
  119.     /* Initiate default size values */
  120.     dictionarysize = DICTIONARYSIZE;
  121.     usersize = USERSIZE;
  122.     paramsize = PARAMSIZE;
  123.     returnsize = RETURNSIZE;     
  124.  
  125.     /* Check for size arguments */
  126.     i = 1;
  127.     flag = i < argc;
  128.     while (flag) {
  129.     
  130.     /* Assume no more arguments */
  131.     flag = FALSE;
  132.  
  133.     /* Look for dictionary size argument */
  134.     if (ARGEQ(i, "-d")) {
  135.         dictionarysize = ARGEV(i);
  136.         flag = TRUE;
  137.     }
  138.  
  139.     /* Look for parameter stack size argument */
  140.     if (ARGEQ(i, "-p")) {
  141.         paramsize = ARGEV(i);
  142.         flag = TRUE;
  143.     }
  144.  
  145.     /* Look for return stack size argument */
  146.     if (ARGEQ(i, "-r")) {
  147.         returnsize = ARGEV(i);
  148.         flag = TRUE;
  149.     }
  150.  
  151.     /* Look for user area size argument */
  152.     if (ARGEQ(i, "-u")) {
  153.         usersize = ARGEV(i);
  154.         flag = TRUE;
  155.     }
  156.  
  157.     /* Check for more arguments to parse */
  158.     if (flag) {
  159.         i++;
  160.         flag = i < argc;
  161.     }
  162.     }
  163.  
  164.     /* Initiate memory, error, io, and kernel */
  165.     io_initiate(BANNER);
  166.     error_initiate();
  167.     memory_initiate(dictionarysize);
  168.     kernel_initiate((ENTRY) &argument, (ENTRY) &arguments, usersize, paramsize, returnsize);
  169.     
  170.     /* Set up argument counter and pointer */
  171.     ARGC = argc;
  172.     ARGV = (PTR32) argv;
  173.     ARGS = argc - 1;
  174.     ARGI = (CSTR) 0;
  175.     
  176.     /* Load argument files before taking input from standard input */
  177.     for(; i < argc; i++) {
  178.  
  179.     /* Look for argument or start symbol switch */
  180.     if (STREQ(argv[i], "-a")) {
  181.         ARGS = i;
  182.         i = argc;
  183.     }
  184.     else {
  185.         if (STREQ(argv[i], "-s")) {
  186.         ARGI = argv[i + 1];
  187.         ARGS = i + 1;
  188.         i = argc;
  189.         }
  190.         else {
  191.  
  192.         /* Use the argument as an input file name and try loading it*/
  193.         if (io_infile(argv[i]) == IO_UNKNOWN_FILE) {
  194.             (VOID) fprintf(io_errf, "%s: file not found\n", argv[i]);
  195.             kernel_finish();
  196.             io_finish();
  197.             error_finish();
  198.             memory_finish();
  199.             exit(0);
  200.         }
  201.         else 
  202.             doquit();
  203.         }
  204.     }
  205.     }
  206.  
  207.     /* Use standard input as input stream */
  208.     (VOID) io_infile((CSTR) STDIN);
  209.  
  210.     /* Check if there was a start symbol argument */
  211.     if (ARGI) {
  212.  
  213.     /* Find the symbol in the vocabulary */
  214.     verbose = FALSE;
  215.     spush(ARGI, CSTR);
  216.     dofind();
  217.     if (tos.BOOL) {
  218.         dodrop();
  219.         docommand();
  220.     }
  221.     else
  222.         (VOID) fprintf(io_errf, "%s ??\n", ARGI);
  223.     }
  224.     else {
  225.     /* Else start the normal interaction loop */
  226.     verbose = TRUE;
  227.     doquit();
  228.     }
  229.  
  230.     /* Clean up the kernel, io, error and memory package before exit */
  231.     kernel_finish();
  232.     memory_finish();
  233.     error_finish();
  234.     io_finish();
  235.     exit(0);
  236. }
  237.  
  238.  
  239.  
  240.