Initial commit

1 files changed, 416 insertions, 0 deletions

diff --git a/support/ltx2x/l2xisymt.c b/support/ltx2x/l2xisymt.c
new file mode 100644
index 0000000000..2c69f735fe
--- /dev/null
+++ b/support/ltx2x/l2xisymt.c
@@ -0,0 +1,416 @@
+/* l2xisymt.c  LTX2X interpreter symbol table code */
+/* BASED ON: symtab.c  (common names altered) */
+/*           added PRINT and PRINTLN to init_symtab */
+
+#include <stdio.h>
+#include <time.h>
+#include "l2xicmon.h"
+#include "l2xierr.h"
+#include "l2xisymt.h"
+#include "l2xiidbg.h"
+#include "l2xiexec.h"
+
+
+/* EXTERNALS */
+
+extern int level;
+
+extern int DEBUG;
+
+/* GLOBALS */
+
+SYMTAB_NODE_PTR symtab_display[MAX_NESTING_LEVEL];
+
+TYPE_STRUCT_PTR integer_typep, real_typep,   /* predefined types */
+                boolean_typep;
+TYPE_STRUCT_PTR logical_typep, string_typep,
+                binary_typep, generic_typep,
+                any_typep;
+
+SYMTAB_NODE_PTR false_idp, true_idp, unknown_idp; /* logical constants */
+SYMTAB_NODE_PTR conste_idp, pi_idp;               /* real constants */
+SYMTAB_NODE_PTR undef_idp;                        /* `?' constant */
+SYMTAB_NODE_PTR day_idp, month_idp, year_idp;
+
+SYMTAB_NODE_PTR string_idp;
+
+TYPE_STRUCT dummy_type = {              /* for bad type defs */
+  NO_FORM, /* form */
+  0,       /* size */
+  NULL     /* type id */
+  };
+
+
+/***************************************************************************/
+/* search_symtab(name, np)  Search for a name in the symbol table.         */
+/* return pointer to entry if found, else NULL.                            */
+
+SYMTAB_NODE_PTR search_symtab(name, np)
+char *name;                       /* name to look for */
+SYMTAB_NODE_PTR np;               /* pointer to symtab root */
+{
+  int cmp;
+  entry_debug("search_symtab");
+
+  /* loop to check each node. If not found, continue down the left */
+  /* or right subtree. Return when a match */
+
+  while (np != NULL) {
+    cmp = strcmp(name, np->name);
+    if (cmp == 0) {                 /* got it */
+      exit_debug("search_symtab at found");
+      return(np);    
+    }
+    np = cmp < 0 ? np->left : np->right;  /* continue */
+  }
+
+  exit_debug("search_symtab at not found");
+  return(NULL);  /* not found */
+}                                                     /* end search_symtab */
+/***************************************************************************/
+
+
+
+/***************************************************************************/
+/* search_symtab_display(name)  Search all the symbol tables in the        */
+/*                              symbol table display for a name.           */
+/* return the pointer to the entry if found, else NULL                     */
+
+SYMTAB_NODE_PTR search_symtab_display(name) 
+char *name;
+{
+  short i;
+  SYMTAB_NODE_PTR np;    /* pointer to symbol table node */
+  entry_debug("search_symtab_display");
+
+  for (i = level; i >= 0; --i) {
+    np =search_symtab(name, symtab_display[i]);
+    if (np != NULL) {
+      exit_debug("search_symtab_display at found");
+      return(np);
+    }
+  }
+
+  exit_debug("search_symtab_display at not found");
+  return(NULL);
+}                                             /* end search_symtab_display */
+/***************************************************************************/
+
+
+
+/***************************************************************************/
+/* enter_symtab(name, npp) Enter a name into the symtab                    */
+/* return pointer to the entry                                             */
+
+SYMTAB_NODE_PTR enter_symtab(name, npp)
+char *name;                             /* name to enter */
+SYMTAB_NODE_PTR *npp;                   /* ptr to ptr to symtab root */
+{
+  int cmp;                        /* result of strcmp */
+  SYMTAB_NODE_PTR new_nodep;      /* ptr to new entry */
+  SYMTAB_NODE_PTR np;             /* ptr to node to test */
+  entry_debug("enter_symtab");
+
+  /* create the new node for name */
+  new_nodep = alloc_struct(SYMTAB_NODE);
+  new_nodep->name = alloc_bytes(strlen(name) + 1);
+  strcpy(new_nodep->name, name);
+  new_nodep->left = new_nodep->right = new_nodep->next = NULL;
+  new_nodep->info = NULL;
+  new_nodep->defn.key = UNDEFINED;
+  new_nodep->typep = NULL;   
+  new_nodep->level = level;
+  new_nodep->label_index = 0;
+
+  /* loop to find the insertion point (binary tree) */
+  while ((np = *npp) != NULL) {
+    cmp = strcmp(name, np->name);
+    npp = cmp < 0 ? &(np->left) : &(np->right);
+  }
+  *npp = new_nodep;    /* replace */
+
+  exit_debug("enter_symtab");
+  return(new_nodep);
+}                                                      /* end enter_symtab */
+/***************************************************************************/
+
+
+
+/***************************************************************************/
+/* init_symtab()  Initialise the symtab with predefined identifiers,       */
+/*                types, and routines                                      */
+
+init_symtab()   /* ---------------------- in final */
+{
+  SYMTAB_NODE_PTR integer_idp, real_idp, boolean_idp;
+  SYMTAB_NODE_PTR logical_idp, binary_idp,
+                  generic_idp, anytype_idp;
+
+  int temp;
+  time_t tp1, tp2;
+  struct tm *ts;
+
+  /* temporarily switch off any debugging output */
+  temp = DEBUG;
+  DEBUG = 0;
+
+  /* initialise the level 0 (the global?) symbol table */
+  symtab_display[0] = NULL; 
+
+  /* predefined Pascal types */
+  enter_name_local_symtab(integer_idp, "integer");
+  enter_name_local_symtab(real_idp, "real");
+  enter_name_local_symtab(boolean_idp, "boolean");
+  /* and extra EXPRESS types */
+  enter_name_local_symtab(logical_idp, "logical");
+  enter_name_local_symtab(string_idp, "string");
+  enter_name_local_symtab(binary_idp, "binary");
+  enter_name_local_symtab(generic_idp, "generic");
+  enter_name_local_symtab(anytype_idp, "???????");
+
+  integer_typep = alloc_struct(TYPE_STRUCT);
+  real_typep = alloc_struct(TYPE_STRUCT);
+  boolean_typep = alloc_struct(TYPE_STRUCT);
+  logical_typep = alloc_struct(TYPE_STRUCT);
+  string_typep = alloc_struct(TYPE_STRUCT);
+  binary_typep = alloc_struct(TYPE_STRUCT);
+  generic_typep = alloc_struct(TYPE_STRUCT);
+  any_typep = alloc_struct(TYPE_STRUCT);
+
+  integer_idp->defn.key = TYPE_DEFN;
+  integer_idp->typep = integer_typep;
+  integer_typep->form = SCALAR_FORM;
+  integer_typep->size = sizeof(STACK_ITEM);
+  integer_typep->type_idp = integer_idp;
+
+  real_idp->defn.key = TYPE_DEFN;
+  real_idp->typep = real_typep;
+  real_typep->form = SCALAR_FORM;
+  real_typep->size = sizeof(STACK_ITEM);
+  real_typep->type_idp = real_idp;
+
+  boolean_idp->defn.key = TYPE_DEFN;
+  boolean_idp->typep = boolean_typep;
+  boolean_typep->form = ENUM_FORM;
+  boolean_typep->size = sizeof(STACK_ITEM);
+  boolean_typep->type_idp = boolean_idp;
+  boolean_typep->info.enumeration.max = 1;
+  boolean_idp->typep->info.enumeration.const_idp = false_idp;
+
+  logical_idp->defn.key = TYPE_DEFN;
+  logical_idp->typep = boolean_typep;
+  logical_typep->form = ENUM_FORM;
+  logical_typep->size = sizeof(STACK_ITEM);
+  logical_typep->type_idp = logical_idp;
+  logical_typep->info.enumeration.max = 2;
+  logical_idp->typep->info.enumeration.const_idp = unknown_idp;
+
+  string_idp->defn.key = TYPE_DEFN;
+  string_idp->typep = string_typep;
+  string_typep->form = STRING_FORM;
+  string_typep->size = sizeof(STACK_ITEM);
+  string_typep->type_idp = string_idp;
+  string_typep->info.string.max_length = MAX_EXPRESS_STRING;
+  string_typep->info.string.length = 0;
+
+  binary_idp->defn.key = TYPE_DEFN;
+  binary_idp->typep = binary_typep;
+  binary_typep->form = SCALAR_FORM;
+  binary_typep->size = sizeof(STACK_ITEM);
+  binary_typep->type_idp = binary_idp;
+
+  generic_idp->defn.key = TYPE_DEFN;
+  generic_idp->typep = generic_typep;
+  generic_typep->form = SCALAR_FORM;
+  generic_typep->size = sizeof(STACK_ITEM);
+  generic_typep->type_idp = generic_idp;
+
+  anytype_idp->defn.key = TYPE_DEFN;
+  anytype_idp->typep = any_typep;
+  any_typep->form = SCALAR_FORM;
+  any_typep->size = sizeof(STACK_ITEM);
+  any_typep->type_idp = anytype_idp;
+  
+
+  /* predefined constants */
+
+  enter_name_local_symtab(false_idp, "false");
+  enter_name_local_symtab(true_idp, "true");
+  enter_name_local_symtab(unknown_idp, "unknown");
+  enter_name_local_symtab(pi_idp, "pi");
+  enter_name_local_symtab(conste_idp, "const_e");
+  enter_name_local_symtab(undef_idp, "?");
+  enter_name_local_symtab(day_idp, "the_day");
+  enter_name_local_symtab(month_idp, "the_month");
+  enter_name_local_symtab(year_idp, "the_year");
+  
+
+  false_idp->defn.key = CONST_DEFN;
+  false_idp->defn.info.constant.value.integer = FALSE_REP;
+  false_idp->typep = logical_typep;
+  false_idp->next = unknown_idp;
+
+  unknown_idp->defn.key = CONST_DEFN;
+  unknown_idp->defn.info.constant.value.integer = UNKNOWN_REP;
+  unknown_idp->typep = logical_typep;
+  unknown_idp->next = true_idp;
+
+  true_idp->defn.key = CONST_DEFN;
+  true_idp->defn.info.constant.value.integer = TRUE_REP;
+  true_idp->typep = logical_typep;
+
+  pi_idp->defn.key = CONST_DEFN;
+  pi_idp->typep = real_typep;
+  pi_idp->defn.info.constant.value.real = 3.141592654;
+
+  conste_idp->defn.key = CONST_DEFN;
+  conste_idp->typep = real_typep;
+  conste_idp->defn.info.constant.value.real = 2.718281828;
+
+  undef_idp->defn.key = CONST_DEFN;
+  undef_idp->typep = any_typep;
+  undef_idp->defn.info.constant.value.character = '\?';
+
+     /* do the current date */
+  tp1 = time(&tp2);
+  ts = localtime(&tp1);
+  sprintf(dbuffer, "year = %d, month = %d, day = %d\n",
+                   (ts->tm_year+1900), (ts->tm_mon+1), (ts->tm_mday));
+  debug_print(dbuffer);
+
+  day_idp->defn.key = CONST_DEFN;
+  day_idp->typep = integer_typep;
+  day_idp->defn.info.constant.value.integer = ts->tm_mday;
+
+  month_idp->defn.key = CONST_DEFN;
+  month_idp->typep = integer_typep;
+  month_idp->defn.info.constant.value.integer = ts->tm_mon + 1;
+
+  year_idp->defn.key = CONST_DEFN;
+  year_idp->typep = integer_typep;
+  year_idp->defn.info.constant.value.integer = ts->tm_year + 1900;
+
+
+  /* standard routines */
+
+  enter_standard_routine("read", READ, PROC_DEFN);
+  enter_standard_routine("readln", READLN, PROC_DEFN);
+  enter_standard_routine("write", WRITE, PROC_DEFN);
+  enter_standard_routine("writeln", WRITELN, PROC_DEFN);
+
+  enter_standard_routine("abs", ABS, FUNC_DEFN);
+  enter_standard_routine("cos", COS, FUNC_DEFN);
+  enter_standard_routine("eof", EOFF, FUNC_DEFN);
+  enter_standard_routine("eoln", EOLN, FUNC_DEFN);
+  enter_standard_routine("exp", EXP, FUNC_DEFN);
+  enter_standard_routine("odd", ODD, FUNC_DEFN);
+  enter_standard_routine("round", ROUND, FUNC_DEFN);
+  enter_standard_routine("sin", SIN, FUNC_DEFN);
+  enter_standard_routine("sqrt", SQRT, FUNC_DEFN);
+  enter_standard_routine("trunc", TRUNC, FUNC_DEFN);
+
+  /* extra for ltx2x */
+  enter_standard_routine("print", L2XPRINT, PROC_DEFN);
+  enter_standard_routine("println", L2XPRINTLN, PROC_DEFN);
+  enter_standard_routine("system", L2XSYSTEM, PROC_DEFN);
+  enter_standard_routine("rexpr", L2XREXPR, FUNC_DEFN);
+
+  /* extra for EXPRESS */
+  enter_standard_routine("acos", XACOS, FUNC_DEFN);
+  enter_standard_routine("asin", XASIN, FUNC_DEFN);
+  enter_standard_routine("atan", XATAN, FUNC_DEFN);
+  enter_standard_routine("log", XLOG, FUNC_DEFN);
+  enter_standard_routine("log2", XLOG2, FUNC_DEFN);
+  enter_standard_routine("log10", XLOG10, FUNC_DEFN);
+  enter_standard_routine("tan", XTAN, FUNC_DEFN);
+  enter_standard_routine("blength", XBLENGTH, FUNC_DEFN);
+  enter_standard_routine("exists", XEXISTS, FUNC_DEFN);
+  enter_standard_routine("format", XFORMAT, FUNC_DEFN);
+  enter_standard_routine("hibound", XHIBOUND, FUNC_DEFN);
+  enter_standard_routine("hiindex", XHIINDEX, FUNC_DEFN);
+  enter_standard_routine("length", XLENGTH, FUNC_DEFN);
+  enter_standard_routine("lobound", XLOBOUND, FUNC_DEFN);
+  enter_standard_routine("loindex", XLOINDEX, FUNC_DEFN);
+  enter_standard_routine("nvl", XNVL, FUNC_DEFN);
+  enter_standard_routine("rolesof", XROLESOF, FUNC_DEFN);
+  enter_standard_routine("sizeof", XSIZEOF, FUNC_DEFN);
+  enter_standard_routine("typeof", XTYPEOF, FUNC_DEFN);
+  enter_standard_routine("usedin", XUSEDIN, FUNC_DEFN);
+  enter_standard_routine("value", XVALUE, FUNC_DEFN);
+  enter_standard_routine("value_in", XVALUE_IN, FUNC_DEFN);
+  enter_standard_routine("value_unique", XVALUE_UNIQUE, FUNC_DEFN);
+  enter_standard_routine("insert", XINSERT, PROC_DEFN);
+  enter_standard_routine("remove", XREMOVE, PROC_DEFN);
+
+  /* restore debugging */
+  DEBUG = temp;
+  return;
+}                                                       /* end init_symtab */
+/***************************************************************************/
+
+
+
+/***************************************************************************/
+/* enter_standard_routine(name, routine_key, defn_key)  Enter a standard   */
+/*                procedure or function name into the symtab               */
+
+enter_standard_routine(name, routine_key, defn_key)
+char *name;     /* name string */
+ROUTINE_KEY routine_key;
+DEFN_KEY defn_key;
+{
+  SYMTAB_NODE_PTR rtn_idp = enter_name_local_symtab(rtn_idp, name);
+
+  rtn_idp->defn.key = defn_key;
+  rtn_idp->defn.info.routine.key = routine_key;
+  rtn_idp->defn.info.routine.parms = NULL;
+  rtn_idp->defn.info.routine.local_symtab = NULL;
+  rtn_idp->typep = NULL;
+
+}                                            /* end enter_standard_routine */
+/***************************************************************************/
+
+
+
+/***************************************************************************/
+/* enter_scope(symtab_root)  Enter a new nesting level by creating a new   */
+/*             scope. Push the given symbol table onto the display stack   */
+
+enter_scope(symtab_root)              
+SYMTAB_NODE_PTR symtab_root;
+{
+  entry_debug("enter_scope");
+  if (++level >= MAX_NESTING_LEVEL) {
+    error(NESTING_TOO_DEEP);
+    exit(-NESTING_TOO_DEEP);
+  }
+  symtab_display[level] = symtab_root;
+
+  exit_debug("enter_scope");
+  return;
+}                                                       /* end enter_scope */
+/***************************************************************************/
+
+
+
+/***************************************************************************/
+/* exit_scope(symtab_root)  Exit the current new nesting level by closing  */
+/*             the current scope. Pop the current symbol table off the     */
+/*             display stack, and return a pointer to it                   */
+
+SYMTAB_NODE_PTR exit_scope()          
+{
+  SYMTAB_NODE_PTR symtab_root = symtab_display[level--];
+  entry_debug("exit_scope");
+  exit_debug("exit_scope");
+  return(symtab_root);
+}                                                       /* end enter_scope */
+/***************************************************************************/
+
+
+
+
+
+
+
+