/*
 * PROGRAM    : dismod.c
 *
 * PURPOSE    : re-creates global declarations of a module
 *              from it's interface file.
 *
 * AUTHOR     : Bertram Barth   (first version : October 1990)
 *
{*  last modification:  12.12.91  16:24   }
 *
*/
 
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <ctype.h>
#include <time.h>
 
#include "defs.h"
		   /* importiert LINT_ARGS */
		   /*    #define LINT_ARGS */
 
 
#define global          static
 
#define issign(c)       (c=='+' or  c=='-')
 
#define is_leap(year)   (year%4 == 0  and  year%100 != 0  or year%400 == 0)
 
/*---------------------------*/
 
#define prog_name       "PASCAL-XSC  Interface-discompiler  Version 2.0"
#define do_nothing      /*_is_used_in_while_loops_*/
 
#define scmnt           "{"     /* Start of Comment */
#define ecmnt           "}"     /* End   of Comment */
 
#define MAX_NAMELENGTH  80
 
#define MAX_ERRORS      10
 
/*---------------------------*/
 
/*---------------------------*/
 
int      errors          = 0;
 
char     on_rebuild      = 0;
char     on_hidden       = 0;
char     on_code_display = 0;
 
char     runt_name[MAX_NAMELENGTH];             /* runtime-name of functions */
 
char     param_name[20];                        /* is used by b_parlist to   */
char    *param_id = "param_";                   /* create parameter-names.   */
 
typedef  struct idrec *idptr;                   /* These data are used as    */
typedef  struct idrec {                         /* buffers when reading      */
           char psym[MAX_NAMELENGTH];           /* names of identifiers out  */
           char csym[MAX_NAMELENGTH];           /* of the interface-file.    */
         } idrec;
 
int      tabs;
int      infline;
 
FILE    *infile;
FILE    *outfile;
 
/*---------------------------*/
 
#ifdef LINT_ARGS
 
int      eval_args      (int argc, char *argv[]);
char    *b_conv_time    (int t[4], char *s);
int      next           (void);
char    *getstr         (void);
idptr    getid          (void);
char    *getopsym       (int c);
int      b_header       (void);
int      b_body         (void);
int      b_const        (void);
int      b_typedecl     (void);
int      b_parlist      (void);
int      b_leftside     (void);
int      b_symbols      (void);
 
int      constpart      (void);
int      varpart        (void);
int      casepart       (void);
 
void     code_init      (void);
int      id_setcode     (idptr id);
int      id_getcode     (idptr id);
idptr    id_decod       (int c);
 
int      b_print        (char *str);
int      b_printline    (void);
int      b_putc         (int c);
 
#else
 
int      eval_args      ( );
char    *b_conv_time    ( );
int      next           ( );
char    *getstr         ( );
idptr    getid          ( );
char    *getopsym       ( );
int      b_header       ( );
int      b_body         ( );
int      b_const        ( );
int      b_typedecl     ( );
int      b_parlist      ( );
int      b_leftside     ( );
int      b_symbols      ( );
 
int      constpart      ( );
int      varpart        ( );
int      casepart       ( );
 
void     code_init      ( );
int      id_setcode     ( );
int      id_getcode     ( );
idptr    id_decod       ( );
 
int      b_print        ( );
int      b_printline    ( );
int      b_putc         ( );
 
#endif
 
 
/*****************************************************************************/
/*****************************************************************************/
 
#ifdef LINT_ARGS
int main (int argc, char *argv[])
#else
int main (argc, argv)
  int  argc;
  char *argv[];
#endif
{
  eval_args (argc, argv);
 
  b_header ();                  /* evaluates e.g. name and date of interface */
 
  code_init ();                 /* initializes ic_code-table and b_optab */
  b_body ();                    /* evaluates data of interface */
 
  if (on_rebuild) {
    b_printline ();
    b_print ("end.");
    b_printline ();
  }
  b_printline ();
 
  fclose (infile);
  if (outfile != stdout)
    fclose (outfile);
 
  return (0);
}
 
/*****************************************************************************/
/*****************************************************************************/
 
#ifdef LINT_ARGS
int b_print (char *str)
#else
int b_print (str)
  char *str ;
#endif
{
  fprintf (outfile, str);
  return (0);
}
 
#ifdef LINT_ARGS
int b_printline (void)
#else
int b_printline ()
#endif
{
  fprintf (outfile, "\n");
  return (0);
}
 
#ifdef LINT_ARGS
int b_putc (int c)
#else
int b_putc (c)
  int c ;
#endif
{
  fputc (c, outfile);
  return (0);
}
 
#ifdef LINT_ARGS
int b_printcode (int c)
#else
int b_printcode (c)
  int c ;
#endif
{
  if (on_code_display)
    fprintf (outfile, "%s%d%s", scmnt, c, ecmnt);
  return (0);
}
 
#ifdef LINT_ARGS
int b_check (int c)
#else
int b_check (c)
  int c ;
#endif
{
  int i;
  if ((i=fgetc(infile)) != c) {
    fprintf (stderr, "Syntax-Error : %c expected, %c (%d) found\n", c, i, i);
    if (++errors > MAX_ERRORS) {
      fprintf (stderr, "too many errors\n");
      fprintf (stderr, "execution aborted\n");
      exit (errors);
    }
  }
  return (0);
}
 
/*---------------------------------------------------------------------------*/
/*-----------------------    SUB-ROUTINES     -------------------------------*/
/*---------------------------------------------------------------------------*/
 
#ifdef LINT_ARGS
int eval_args (int argc, char *argv[])
#else
int eval_args (argc, argv)
  int  argc;
  char *argv[];
#endif
BEGIN (eval_args)
  int   i;
  char  s[255];
  char *p;
 
  fprintf (stderr, "%s\n", prog_name);
 
  if (argc < 2) {
    fprintf (stderr, "Syntax is : dismod [ options ] filename       \n");
/*  fprintf (stderr, "            -x- = turn switch x off\n");          */
/*  fprintf (stderr, "            -x  = turn switch x on \n");          */
/*  fprintf (stderr, "\n");                                             */
    fprintf (stderr, " -r    : rebuild input file for PXSC-Compiler \n");
    fprintf (stderr, " -h    : display hidden informations          \n");
    fprintf (stderr, " -c    : display values of byte-codes         \n");
    fprintf (stderr, " -oxxx : output to file xxx                   \n");
    fprintf (stderr, "\n");
 
    exit (0);
  }
 
  infile  = NULL;
  outfile = NULL;
 
  for (i=1; i<argc-1; i++) {
    strcpy (s, argv[i]);
    if (*s == '-') {
      p = s+1;
      switch (*p) {
        case 'r' :
            on_rebuild = 1;
          break;
        case 'h' :
            on_hidden  = 1;
          break;
        case 'c' :
            on_code_display = 1;
          break;
        case 'o' :
            outfile = fopen (p+1, "w");
            if (not outfile)
              fprintf (stderr, "cant open output-file %s\n", p+1);
          break;
        default :
            fprintf (stderr, "unexpected option %s\n", s);
          break;
      }
    }
    else
      fprintf (stderr, "command-line syntax :  %s  is ignored \n", s);
  }
 
  strcpy (s, argv[argc-1]);             /* name of input-file */
  p = s;
  while (*p != '\0')                    /* move p to the end of the string */
    p++;
  p--;                                  /* p points at the last character */
  while (isalnum(*p)  or  *p == '_')
    p--;                                /* p points at start of extension */
  if (*p != '.')                        /* or at start of filename */
    strcat (s, ".mod");
 
  infile = fopen (s, "rb");
  if (not infile) {
    fprintf (stderr, "can't open input-file %s\n", s);
    exit (-3);
  }
  if (outfile == NULL)
    outfile = stdout;
 
  return (0);
 
END /* eval_args */
 
 
 
/*---------------------------------------------------------------------------*/
 
#define form_error(c) /**/
 
#ifdef LINT_ARGS
int b_header (void)
#else
int b_header ()
#endif
{
  int   i;
  int   c;
  char  buffer[255];
  int   i_time[4];
 
  if ((c=fgetc(infile)) != '#')
    ungetc (c, infile);
  fscanf (infile, "%s", buffer);
 
  if (on_rebuild) {
    b_print ("module ");
    b_print (buffer);
    b_putc (';');
    b_printline ();
    b_printline ();
 
    return (0);
  }
  /* ELSE */
 
  b_printline ();
  b_print ("module name : ");
  b_print (buffer);
  b_printline ();
 
  if (c == '#') {
    b_print ("module is a standart-module");
    b_printline ();
  }
  b_printline ();
 
  while ((c=fgetc(infile)) != 'i'  and  c != EOF)
    do_nothing;
  if ((c=fgetc(infile)) != 't')
    form_error (c);
  if ((c=fgetc(infile)) != '=')
    form_error (c);
  for (i=0; i<4; i++)
    fscanf (infile, "%d.", &i_time[i]);
 
  b_print ("time of last update : ");
  b_conv_time (i_time, buffer);
  b_print (buffer);
  b_printline ();
 
  if ((c=fgetc(infile)) == '\n') {
    ungetc (c, infile);
    c = 1;
  }
  sprintf (buffer, "Interface compatibility number is %d", c);
  b_print (buffer);
  b_printline ();
  b_printline ();
  b_printline ();
 
  return (0);
}
 
/*---------------------------------------------------------------------------*/
 
#ifdef LINT_ARGS
int b_body (void)
#else
int b_body ()
#endif
{
  int   c;
  int   op;
  idptr id;
 
  while ((c=next()) != EOF) {
    switch (c) {
 
      case 'u' :
      case 'U' :
        b_print ("use ");
        if (c == 'U')
          b_print ("global ");
        b_print (getstr());
        b_putc  (';');
        b_printline ();
      break;
 
      case 'R' :
        b_print ("realconstantconversion ");
        id = getid ();
        b_print (id->psym);
        b_putc (';');
        b_printline ();
      break;
 
      case 'C' :
        b_print ("global const ");
        b_leftside ();
        b_print (" = ");
        b_check (':');
        b_const ();
        b_putc  (';');
        b_printline ();
      break;
 
      case 'T' :
      case 'G' :
      case 'L' :
        id_setcode (id=getid());
        if (c != 'L')
          b_print ("global ");
        b_print ("type ");
        b_print (id->psym);
        b_printcode (id_getcode(id));
        b_print (" = ");
        b_check (':');
        if (c == 'G')
          b_print ("global ");
        b_typedecl ();
        b_putc (';');
        b_printline ();
      break;
 
      case 'V' :
        b_print ("global var ");
        b_leftside ();
        b_check (':');
        b_print (" : ");
        b_typedecl ();
        b_putc (';');
        b_printline ();
      break;
 
      case 'F' :
        b_print ("global function ");
        id = getid ();
        b_print (id->psym);
        if (on_rebuild)
          strcpy (runt_name, id->csym);
        b_parlist ();
        b_check (':');
        b_print (" : ");
        b_typedecl ();
        b_putc (';');
        if (on_rebuild) {
          b_printline ();
          b_print ("    external ");
          b_print (runt_name);
          b_putc (';');
        }
        b_printline ();
      break;
 
      case 'P' :
        b_print ("global procedure ");
        id = getid ();
        b_print (id->psym);
        if (on_rebuild)
          strcpy (runt_name, id->csym);
        b_parlist ();
        b_print (";");
        if (on_rebuild) {
          b_printline ();
          b_print ("    external ");
          b_print (runt_name);
          b_putc (';');
        }
        b_printline ();
      break;
 
      case 'O' :
        b_print ("global operator ");
        switch (op = fgetc(infile)) {
          case 'i' :                      /* operator is identifier */
            c = fgetc (infile);               /* read priority-symbol */
            if (on_hidden) {
              b_print (scmnt);
              b_print ("prio:");
              b_print (getopsym(c));
              b_print (ecmnt);
              b_putc (' ');
            }
            id = getid ();                /* read pascal- and C-name */
            b_print (id->psym);
            strcpy (runt_name, id->csym);
          break;
          case 'a' :                         /* operator is assign-operator */
            b_print (":= ");
            strcpy (runt_name, getstr());  /* read C-name of this operator */
          break;
          case 'o' :                        /* operator is a symbol */
            c = fgetc (infile);
            b_print (getopsym(c));
            strcpy (runt_name, getstr());
          break;
        }
        b_parlist ();
        if (op != 'a') {
          b_check (':');
          b_print (" result : ");
          b_typedecl ();
        }
        b_putc (';');
        if (on_rebuild) {
          b_printline ();
          b_print ("    external ");
          b_print (runt_name);
          b_putc (';');
        }
        b_printline ();
      break;
    }
  }
 
  return (0);
}
 
/*---------------------------------------------------------------------------*/
 
#ifdef LINT_ARGS
char *b_conv_time (int i_time[4], char *str)
#else
char *b_conv_time (i_time, str)
  int  i_time[4];
  char *str;
#endif
{
  static char  daytab[2][13] = {
                {0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31},
                {0, 31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31}
        };
  static char *month_name[13] = {
                "illegal month",
                "January", "February", "March",
                "April", "May", "June",
                "July", "August", "September",
                "October", "November", "December"
        };
  static char *day_name[7] = {
                "Sunday", "Monday", "Tuesday", "Wednesday",
                "Thursday", "Friday", "Sameday"
        };
 
  int   i;
  int   leap;
 
  int   b_year;
  int   b_month;
  int   b_mday;
  int   b_wday;
 
  char  buffer[255];
 
 
  b_year = 1900 + i_time[0];            /* i_time[0] is years since 1900 */
 
  b_wday = 1;                           /* 01.01.1900 was Monday (== 1) */
  if (b_year > 1900)
    for (i=1900; i<b_year; i++)         /* leap: 366%7 = 2, else 365%7 = 1 */
      b_wday += is_leap(i)  ?  2  :  1;
  b_wday += i_time[1];                  /* i_time[1] is days since January 1 */
  b_wday %= 7;                          /* b_wday = days since 1.1.1900 % 7 */
 
  leap = is_leap (b_year);              /* used to index daytab-array */
  for (i = 1;  i_time[1] >= daytab[leap][i]; i++)
    i_time[1] -= daytab[leap][i];
  b_month = i;
  b_mday  = i_time[1] + 1;              /* i_time[1] means days since first */
                                        /* day of the month, b_mday is the  */
  strcpy (str, day_name[b_wday]);       /* number of the day in the month */
  strcat (str, "  ");
  strcat (str, month_name[b_month]);
  sprintf (buffer, "  %d  %d  %2d:%.2d h\n",
           b_mday, b_year, i_time[2], i_time[3]);
  strcat (str, buffer);                 /* i_time[2] is hours since midnight */
                                        /* i_time[3] is minutes after the hour */
  return (str);
}
 
/*---------------------------------------------------------------------------*/
 
#ifdef LINT_ARGS
int next (void)
#else
int next ()
#endif
{
  int c;
 
  while ((c=fgetc(infile)) != '\n'  and  c != EOF)
    do_nothing;
 
  return (c==EOF ? c : fgetc(infile));
}
 
/*---------------------------------------------------------------------------*/
 
#ifdef LINT_ARGS
char *getstr (void)
#else
char *getstr ()
#endif
{
  int  c;
  int  i;
  static char b_str[255];
 
  i = 0;
  while ((c=fgetc(infile))=='_'
  or isalnum(c) or c=='+' or c=='-')
    b_str[i++] = (char) c;
  b_str[i] ='\0';
  ungetc(c, infile);
 
  return (b_str);
}
 
/*---------------------------------------------------------------------------*/
 
#ifdef LINT_ARGS
idptr getid (void)
#else
idptr getid ()
#endif
{
  int  c;
  int  i;
  static idrec b_id;
 
  if ((c=fgetc(infile)) < 31) {
    return (id_decod(fgetc(infile)));
  }
  /* ELSE */
 
  b_id.psym[0] = c;
  i = 1;
  while ((c=fgetc(infile)) != '=' and c != EOF)
    b_id.psym[i++] = c;
  b_id.psym[i] = '\0';
 
  if (isalpha(c=fgetc(infile)) or c=='_') {
    b_id.csym[0] = c;
    i = 1;
    while ((c=fgetc(infile))=='_' or isalnum(c))
      b_id.csym[i++] = c;
    b_id.csym[i] = '\0';
    ungetc (c, infile);
  }
  else {
    ungetc (c, infile);
    strcpy (b_id.csym, b_id.psym);
  }
 
  return (& b_id);
}
 
/*---------------------------------------------------------------------------*/
 
#ifdef LINT_ARGS
int constpart (void)
#else
int constpart ()
#endif
{
  int  i;
  int  c;
 
  if ((c=fgetc(infile)) == '?') {           /* empty constpart of record is */
    ungetc (c, infile);                     /* possible only if varpart of  */
    return (0);                             /* record exists (is not empty) */
  }
 
  /* ELSE */
  ungetc (c, infile);
 
  while ((c=fgetc(infile))!=EOF and isalpha(c)) {
    ungetc (c, infile);
    for (i=0; i<tabs; i++)
      b_putc (' ');
    b_symbols ();
    b_check (':');
    b_print (" : ");
    b_typedecl ();
    if ((c=fgetc(infile)) != ';')
      ungetc (c, infile);
    b_putc (';');
    b_printline ();
  }
  if (c == '?'  or  c == '!') {        /* '!' means end of record, '?' means */
    ungetc (c, infile);                   /* start of variant part. both are */
  }                                       /* needed or deleted by varpart(). */
  else if (c == ')') {
    ungetc (c, infile);                /* ')' ends subrecords of case-labels */
  }                                       /* in the variant parts of records */
  else {
    b_print ("\'!\' \'?\' or \')\' expected");
    b_printline ();
    ungetc (c, infile);
    b_check (' ');
  }
 
  return (0);
}
 
/*---------------------------------------------------------------------------*/
 
#ifdef LINT_ARGS
int varpart (void)
#else
int varpart ()
#endif
{
  int c;
  int i;
 
  if ((c=fgetc(infile)) == '!')                 /* '!' means end of record. */
    return (0);                                 /* variant-part is empty. */
  else if (c != '?') {
    ungetc (c, infile);
    b_check ('?');
    return (0);
  }
  /* ELSE */
 
  for (i=0; i<tabs; i++)
    b_putc (' ');
  b_print ("variant part :  { ");
  b_symbols ();
  if ((c=fgetc(infile)) == '=') {     /* '=' starts Tagfield */
          /* evaluate tag-field, not yet implemented */
  }
  else {          /* if no tag-field is specified, the second '?' was read */
    ungetc (c, infile);
    b_check ('?');
  }
  b_print (" }");
  b_printline ();
  tabs += 2;
 
  while ((c=fgetc(infile)) != '!' and c != EOF) {
    ungetc (c, infile);
    for (i=0; i<tabs; i++)
      b_putc (' ');
 
    casepart ();
 
    for (i=0; i<tabs; i++)
      b_putc (' ');
    b_print (");");
    b_printline ();
  }
  tabs -= 2;
 
  return (0);
}
 
/*---------------------------------------------------------------------------*/
 
#ifdef LINT_ARGS
int casepart (void)
#else
int casepart ()
#endif
{
  int c;
 
  b_print (" { ");
  b_symbols ();
 
  if ((c=fgetc(infile)) == '=') {              /* next is case-label */
    if ((c=fgetc(infile)) == '(') {            /* else-part found */
      b_print (" }");
      b_print ("else (");
    }
  }
  else if (c == '(') {                         /* no case-label was exported */
    b_print (" }");
    b_print (" case : (");
  }
  else {
    b_print ("  syntax ??  ");
  }
 
  b_printline ();
  tabs += 2;
  constpart ();
  b_check (')');
  tabs -= 2;
 
  return (0);
}
 
/*---------------------------------------------------------------------------*/
 
#ifdef LINT_ARGS
int b_typedecl (void)
#else
int b_typedecl ()
#endif
{
  int   i;
  int   c;
  idptr id;
 
  switch (c=fgetc(infile)) {
 
    case '#' :      /* size of */
    break;
 
    case '(' :      /* enumeration type */
      b_putc ('(');
      id = getid ();
      b_print (id->psym);
      while ((c=fgetc(infile)) != ')' and c != EOF) {
        b_print (", ");
        id = getid ();
        b_print (id->psym);
      }
      b_putc (')');
    break;
 
    case '^' :      /* pointer */
      b_putc ('^');
      b_typedecl ();
    break;
 
    case '}' :      /* set */
      b_print ("set of ");
      b_typedecl ();
    break;
 
    case '|' :      /* file */
      b_print ("file of ");
      b_typedecl ();
    break;
 
    case ':' :      /* subrange */
      b_const ();
      b_print ("..");
      b_check (',');
      b_const ();
    break;
 
    case '[' :      /* array, dynamic or static */
      if ((c=fgetc(infile)) == '[') {
        b_print ("dynamic ");
      }
      else {
        ungetc (c, infile);
      }
      b_print ("array [");
      b_typedecl ();
      while ((c=fgetc(infile)) != ']'  and  c != EOF) {
        ungetc (c, infile);
        b_check (';');
        b_print (", ");
        b_typedecl ();
      }
      b_print ("] of ");
      b_typedecl ();
    break;
 
    case '&' :      /* record */
      b_print ("record ");
      b_printline ();
      tabs += 4;
 
      constpart ();
      varpart ();
 
      tabs -= 4;
      for (i=0; i<tabs; i++)
        b_putc (' ');
      b_print ("end");
    break;
 
    case '*' :
      b_putc ('*');
    break;
 
    default :
      if (c < 31) {
        id = id_decod (c=fgetc(infile));
        b_print (id->psym);
        b_printcode (c);
      }
      else {
        ungetc (c, infile);
        id = getid ();
        id_setcode (id);
        b_print (id->psym);
        b_printcode (id_getcode(id));
      }
    break;
  }
 
  return (0);
}
 
/*---------------------------------------------------------------------------*/
 
#ifdef LINT_ARGS
int b_parlist (void)
#else
int b_parlist ()
#endif
{
  int   c;
  int   param_number = 0;
 
  b_check ('(');
  b_print (" (");
 
  while ((c=fgetc(infile)) != ')' and c != EOF) {
 
    param_number++;
    sprintf (param_name, "%s%02d", param_id, param_number);
 
    switch (c) {
      case 'R':                 /* call by (R)eference, va(R)-parameter */
        b_print ("var ");
      case 'V' :                /* call by (V)alue */
      case 'L' :                /* va(L)-parameter */
        b_print (param_name);
        b_putc (':');
        b_typedecl ();
      break;
 
      case 'P' :
        b_print ("PROCEDURE ");
        b_print (param_name);
        b_parlist ();
      break;
 
      case 'F' :
        b_print ("FUNCTION ");
        b_print (param_name);
        b_parlist ();
        b_check (':');
        b_print (" : ");
        b_typedecl ();
      break;
 
      default :
        b_check ('*');
      break;
    }
 
    if ((c=fgetc(infile)) == ')')
      ungetc (c, infile);
    else {
      ungetc (c, infile);
      b_check (';');
      b_print ("; ");
    }
  }
  ungetc (c, infile);           /* put back the ')' */
 
  b_check (')');
  b_putc  (')');
 
  return (0);
}
 
/*---------------------------------------------------------------------------*/
 
/*
 * b_const() : evaluates constants.
 * ----------  The next byte in the interface-file indicates the kind
 * of the following constant (boolean, char, integer, real, string).
 * boolean- and character-constants are represented as one byte, integer-
 * constants by one or more decimal digits, and real- and string-constants
 * by one BYTE containing the string-length and a string.
*/
#ifdef LINT_ARGS
int b_const (void)
#else
int b_const ()
#endif
{
  int  c;
  int  i;
 
  switch (c=fgetc(infile)) {
    case 'b' :
      b_print (fgetc(infile) == 0  ?  "FALSE"  :  "TRUE");
    break;
 
    case 'c' :
      b_putc('\'');
      b_putc(c=fgetc(infile));
      if (c == '\'');
        b_putc('\'');
      b_putc('\'');
    break;
 
    case 'i' :
      while ((c=fgetc(infile))!= EOF
      and (isdigit(c) or issign(c)))
        b_putc(c);
      ungetc (c, infile);
    break;
 
    case 'r' :
      c = fgetc (infile);
      for (i=0; i<c; i++)
        b_putc (fgetc(infile));
    break;
 
    case 's' :
      b_putc ('\'');
      c = fgetc (infile);
      for (i=0; i<c; i++)
        b_putc (fgetc(infile));
      b_putc ('\'');
    break;
  }
 
  return (0);
}
/*---------------------------------------------------------------------------*/
 
/*
 *  b_leftside evaluates the identifiers on the left side of type- and
 *  variable-declarations. Identifier are exported as two strings, one
 *  containing the pascal-name and the other containing the C-name, separated
 *  by the Assign-character ('='). Two or more identifiers are separated
 *  by colons.
 **********/
 
#ifdef LINT_ARGS
int b_leftside (void)
#else
int b_leftside ()
#endif
{
  int   c;
  idptr id;
 
  id = getid ();
  b_print (id->psym);
  while ((c=fgetc(infile)) == ',') {
    b_print (", ");
    id = getid ();
    b_print (id->psym);
  }
  ungetc (c, infile);
 
  return (0);
}
 
/*---------------------------------------------------------------------------*/
 
/************
 *  Different to identifiers cSYMBOLS are exported only with their pascal-name,
 *  they get no C-name. Because of that they are treated as strings in the
 *  interface-file. If there are two or more symbols (e.g. enumeration types,
 *  left sides of record-components), they are separated by colons.
 ************/
 
#ifdef LINT_ARGS
int b_symbols (void)
#else
int b_symbols ()
#endif
{
  int   c;
  char *s;
 
  b_print (getstr());                      /* read and print PASCAL-symbol */
 
  if ((c=fgetc(infile)) == '=') {          /* '=' indicates renamed symbol */
    s = getstr();                                     /* read runtime-name */
    if (on_hidden) {
      b_print (scmnt);
      b_print (s);                                   /* print runtime-name */
      b_print (ecmnt);
    }
  }
  else
    ungetc (c, infile);
 
  if ((c=fgetc(infile)) == ',') {         /* ',' indicates list of symbols */
    b_print (", ");
    b_symbols ();                         /* list is evaluated recursively */
  }
  else
    ungetc (c, infile);
 
  return (0);
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
 
 
 
/*---------------------------------------------------------------------------*/
/*--------------    DATA AND FUNCTIONS FOR CODIFICATION    ------------------*/
/*---------------------------------------------------------------------------*/
 
#define PRESET_ANZ      21              /* Number of preset-type-identifiers */
#define MAX_OPSYM       37              /* Number of preset operator-symbols */
 
idrec   id_code_table[256];             /* table with byte-codes for ids.  */
int     act_code;                       /* actual highest coded identifier */
 
char    b_optab[50][4];                 /* table with 50 operator-symbols */
 
/*---------------------------------------------------------------------------*/
 
 
#ifdef LINT_ARGS                                        /*-------------------*/
 void code_init (void)	                                /* c o d e _ i n i t */
#else
 void code_init ()
#endif
BEGIN (code_reset)
  int  i;
 
  act_code = PRESET_ANZ;
 
#define b_setcode(i,pname,cname)  strcpy(id_code_table[i].psym, pname),    \
                                  strcpy(id_code_table[i].csym, cname);
 
       /* initialisation of identifier-code-table with preset-identifiers */
  b_setcode ( 1, "INTEGER",      "INTEGER"     );
  b_setcode ( 2, "REAL",         "REAL"        );
  b_setcode ( 3, "BOOLEAN",      "BOOLEAN"     );
  b_setcode ( 4, "CHAR",         "CHAR"        );
  b_setcode ( 5, "", ""        /* LITERAL */   );
  b_setcode ( 6, "STRING",       "STRING"      );
  b_setcode ( 7, "TEXT",         "TEXT"        );
  b_setcode ( 8, "DOTPRECISION", "DOTPRECISION");
  b_setcode ( 9, "COMPLEX",      "COMPLEX"     );
  b_setcode (10, "INTERVAL",     "INTERVAL"    );
  b_setcode (11, "CINTERVAL",    "CINTERVAL"   );
  b_setcode (12, "RVECTOR",      "RVECTOR"     );
  b_setcode (13, "CVECTOR",      "CVECTOR"     );
  b_setcode (14, "IVECTOR",      "IVECTOR"     );
  b_setcode (15, "CIVECTOR",     "CIVECTOR"    );
  b_setcode (16, "RMATRIX",      "RMATRIX"     );
  b_setcode (17, "CMATRIX",      "CMATRIX"     );
  b_setcode (18, "IMATRIX",      "IMATRIX"     );
  b_setcode (19, "CIMATRIX",     "CIMATRIX"    );
  b_setcode (20, "", ""        /* puffer */    );
  b_setcode (21, "", ""        /* puffer */    );
        /* end of preset-initialisation */
        /* 21 identifiers are predefined */
        /* 21 = PRESET_ANZ */
 
 
 
  i = 0;
  strcpy (b_optab[i++], ":= ");     /*  0 cAssign */
 
  strcpy (b_optab[i++], "IN ");     /*  1 cIN     */
  strcpy (b_optab[i++], "=  ");     /*  2 cEQ     */
  strcpy (b_optab[i++], "<> ");     /*  3 cNE     */
  strcpy (b_optab[i++], ">= ");     /*  4 cGE     */
  strcpy (b_optab[i++], ">  ");     /*  5 cGT     */
  strcpy (b_optab[i++], "<= ");     /*  6 cLE     */
  strcpy (b_optab[i++], "<  ");     /*  7 cLT     */
/*strcpy (b_optab[i++], "*  ");     /* /* cStar */
  strcpy (b_optab[i++], "+  ");     /*  8 cPlus   */
  strcpy (b_optab[i++], "-  ");     /*  9 cMinus  */
  strcpy (b_optab[i++], "*  ");     /* 10 cMult   */
  strcpy (b_optab[i++], "/  ");     /* 11 cDiv    */
  strcpy (b_optab[i++], ">< ");     /* 12 cDisj   */
  strcpy (b_optab[i++], "** ");     /* 13 cConj   */
  strcpy (b_optab[i++], "+* ");     /* 14 cCohu   */
  strcpy (b_optab[i++], "+< ");     /* 15 cPlusD  */
  strcpy (b_optab[i++], "-< ");     /* 16 cMinusD */
  strcpy (b_optab[i++], "*< ");     /* 17 cMultD  */
  strcpy (b_optab[i++], "/< ");     /* 18 cDivD   */
  strcpy (b_optab[i++], "+> ");     /* 19 cPlusU  */
  strcpy (b_optab[i++], "-> ");     /* 20 cMinusU */
  strcpy (b_optab[i++], "*> ");     /* 21 cMultU  */
  strcpy (b_optab[i++], "/> ");     /* 22 cDivU   */
  strcpy (b_optab[i++], "OR ");     /* 23 cOR     */
  strcpy (b_optab[i++], "AND");     /* 24 cAND    */
  strcpy (b_optab[i++], "DIV");     /* 25 cDIV    */
  strcpy (b_optab[i++], "MOD");     /* 26 cMOD    */
  strcpy (b_optab[i++], "+  ");     /* 27 cMPlus  */
  strcpy (b_optab[i++], "-  ");     /* 28 cMMinus */
  strcpy (b_optab[i++], "   ");     /* 29 cAdres  */
  strcpy (b_optab[i++], "NOT");     /* 30 cNOT    */
 
  strcpy (b_optab[i++], " = ");     /* 31 cReldmy */
  strcpy (b_optab[i++], " + ");     /* 32 cAdddmy */
  strcpy (b_optab[i++], " * ");     /* 33 cMuldmy */
  strcpy (b_optab[i++], " = ");     /* 34 cRelop  */      /* userdef */
  strcpy (b_optab[i++], " + ");     /* 35 cAddop  */      /* userdef */
  strcpy (b_optab[i++], " * ");     /* 36 cMulop  */      /* userdef */
  strcpy (b_optab[i++], " ^ ");     /* 37 cMonop  */      /* userdef */
 
  /* MAX_OPSYM = 37 operator-symbols in b_optab */
 
                                                        /* c o d e _ i n i t */
END /* code_init */                                     /*-------------------*/
 
 
 
 
#ifdef LINT_ARGS                                      /*---------------------*/
 int id_setcode (idptr id)	                      /* i d _ s e t c o d e */
#else
 int id_setcode (id)
  idptr id;
#endif
BEGIN (id_setcode)
  int  i;
 
  for (i=PRESET_ANZ+1; i<=act_code; i++) {
    if (strcmp (id_code_table[i].psym, id->psym) == 0)
      break;
  }
 
  if (i > act_code) {                   /* identifier was not found */
    id_code_table[++act_code] = *id;
 
    if (act_code > 255) {
      printf ("too much identifiers for coding in 8 Bits\n");
      exit (-999);
    }
  }
  return (i);
                                                      /* i d _ s e t c o d e */
END /* id_setcode */                                  /*---------------------*/
 
 
 
 
#ifdef LINT_ARGS                                      /*---------------------*/
 int id_getcode (idptr id)	                      /* i d _ g e t c o d e */
#else
 int id_getcode (id)
  idptr id;
#endif
BEGIN (id_getcode)
  int  i;
 
  for (i=1; i<=act_code; i++) {
    if (strcmp (id_code_table[i].psym, id->psym) == 0)
      break;
  }
 
  if (i <= act_code)    /* idptr was found */
    return (i);         /* valid values are : 1...act_code */
  else
    return (0);         /* 0 means : not found */
 
                                                      /* i d _ g e t c o d e */
END /* id_getcode */                                  /*---------------------*/
 
 
 
#ifdef LINT_ARGS                                        /*-------------------*/
 idptr id_decod (int nr)	                        /*  i d _ d e c o d  */
#else
 idptr id_decod (nr)
  int nr;
#endif
BEGIN (id_decod)
 
  if (nr <= act_code)
    return (&id_code_table[nr]);
  else
    return (NULL);
                                                        /*  i d _ d e c o d  */
END /* id_decod */                                      /*-------------------*/
 
 
 
#ifdef LINT_ARGS                                        /*-------------------*/
 char *getopsym (int nr)	                        /*  i d _ d e c o d  */
#else
 char *getopsym (nr)
  int nr;
#endif
BEGIN (getopsym)
 
  if (nr > MAX_OPSYM) {
    printf ("\nundeclared operator symbol: nr = %d\n", nr);
  }
 
  return (b_optab[nr]);
                                                        /*  i d _ d e c o d  */
END /* getopsym */                                      /*-------------------*/
 
 
 
/*---------------------------------------------------------------------------*/
/*--------------         END OF PROGRAM  DISCOMP.C      ---------------------*/
/*---------------------------------------------------------------------------*/
