home *** CD-ROM | disk | FTP | other *** search
/ The Education Master 1994 (4th Edition) / EDUCATIONS_MASTER_4TH_EDITION.bin / files / progmisc / qparser2 / cskels / skellex.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-11-07  |  21.1 KB  |  843 lines
  1. /*  (skel)lex.c
  2.  
  3.    When run through lr1p with a suitable grammar table file,
  4.      this handles all source file opens and access, service defines,
  5.      skip blanks and comments, fetch characters.  The external
  6.      interface is essentially one of initialization, then calling
  7.      NEXT_TOKEN and READTOKEN (from the parser, mostly), then
  8.      closing the lexical interface.
  9.    Please note that certain conventions are observed in recognizing
  10.      the special tokens <identifier>, <real>, and <string>.  See the
  11.      comments in 'get_symbol', 'get_number' and 'get_string'.
  12.    Define CMODE to cause strings and comments to be handled ala C.
  13.      The default is Pascal mode.
  14.  
  15.    If this file has been extensively modified, we suggest compiling it
  16.      with option -DTEST, which will yield a standalone version.  Pass
  17.      it a sample source file and it will report all the tokens seen
  18.      by name.
  19.  
  20.      */
  21.  
  22. #include <stdio.h>
  23. #include <ctype.h>
  24. #include <string.h>
  25. #include <math.h>
  26. #include "decl.h"
  27.  
  28. /* Definition of an EOF as a character in a scanned line */
  29. #define EOFCH  4
  30.  
  31. /* Definition of the character for start of a comment field
  32.    when <eol> is used in the grammar */
  33. #define COMMENT_START ';'
  34.  
  35. /* Definition of the character that opens and closes a STRING and a
  36.    CHARACTER in C or Pascal */
  37. #ifdef CMODE
  38. #  define STRING_CHAR  '"'
  39. #  define CHAR_QUOTE   '\''
  40. #else   /* Pascal mode */
  41. #  define STRING_CHAR  '\''
  42. #  define CHAR_QUOTE   '\''
  43. #endif
  44.  
  45. /* Definition of break character in a STRING */
  46. #define BREAK_CHAR '\\'
  47.  
  48. /* Number of errors tolerated before quitting */
  49. #define MAXERRORS 10
  50.  
  51. /* Maximum length of any input line */
  52. #define MAXLINELEN 256
  53. static char line[MAXLINELEN];
  54.  
  55. static int lx, err_pos= 0, linenum= 0, show_source= 0;
  56. int errors= 0, err_count= 0;
  57.  
  58. /* Source file */
  59. static FILE *sfile;
  60. static char ch;
  61. int tokenx= 0;
  62. int tokary[2];
  63.  
  64. int token= 0;
  65. semrectype *lsemp, *lsempary[2];
  66.  
  67. /* These limits apply to any particular string or symbol.
  68.    They do not allocate permanent space */
  69. #define MAXSTRINGLEN 256
  70. #define MAXSYMLEN 72
  71.  
  72. /* This is only used internally to skip over debug characters */
  73. #define DEBUG_TOKX -1
  74.  
  75. /* ................. */
  76. static void getline()
  77.   /* read the next source line from sfile, when nextch exhausts
  78.     the current one. */
  79. {
  80.   if (prompt_len) {
  81.     printf("> ");
  82.     fflush(stdout);
  83.     }
  84.   if (fgets(line, MAXLINELEN, sfile)) {
  85.     /* introduces a \n character at the line end */
  86.     if (show_source) printf("%s", line);
  87.     linenum++;
  88.     ch= *line;
  89.     }
  90.   else {  /* end of file */
  91.     if (show_source) printf("EOF\n");
  92.     line[0]= EOFCH;
  93.     line[1]= '\0';
  94.     ch= EOFCH;
  95.     }
  96.   lx= 1;
  97.   }
  98.  
  99. /* lex is the first utility to use these, so we define them here */
  100.  
  101. /* .......... */
  102. void readline(line, maxlen)
  103.   char *line;
  104.   int maxlen;
  105.   /* reads a line from stdin */
  106. { char *lp;
  107.  
  108. #ifdef UNIX
  109.   read(0, line, maxlen);
  110.   if (*line=='\0') *line= '\n';
  111. #else  /* Microsoft on PC */
  112.   fgets(line, maxlen, stdin);
  113. #endif
  114.   lp= strchr(line, '\n');
  115.   *lp= '\0';
  116.   }
  117.  
  118. /* ................ */
  119. char to_upper(ch)
  120.   char ch;
  121. {
  122.   if (islower(ch)) return toupper(ch);
  123.   else return ch;
  124.   }
  125.  
  126. /* ........... */
  127. static int write_anychar(ch)
  128.   char ch;
  129. {
  130.   if (ch >= ' ' && ch <= '~') {
  131.     printf("%c", ch);
  132.     return 1;
  133.     }
  134.   else {
  135.     char msg[20];
  136.  
  137.     sprintf(msg, "<%d>", (int) ch);
  138.     printf(msg);
  139.     return strlen(msg);
  140.     }
  141.   }
  142.  
  143. /* ................ */
  144. static void report_line(pos, line, lstart)
  145.   int pos,   /* position of mark in 'line' */
  146.       lstart;   /* where printing of 'line' starts in current display line */
  147.   char *line;
  148. { char *lp;
  149.   int lpos= 0, newpos= -1;
  150.  
  151.   lp= line;
  152.   while (*lp) {
  153.     if (pos == lp-line) newpos= lpos;
  154.     lpos += write_anychar(*(lp++));
  155.     }
  156.   printf("\n");
  157.   if (newpos < 0) newpos= lpos;
  158.   printf("%*s^\n", newpos+lstart, "");
  159.   }
  160.  
  161. /* ................ */
  162. void report_err(msg)
  163.   char *msg;
  164. {
  165.   printf("%s\nline %3d: ", msg, linenum);
  166.   report_line(err_pos, line, strlen("line ddd: "));
  167.   }
  168.  
  169. #define ABORT_MSG "FATAL ERROR: "
  170.  
  171. /* ................. */
  172. void abort_trap(msg)
  173.   char *msg;
  174. { char *newmsg= (char *) malloc(strlen(msg) + strlen(ABORT_MSG) + 1);
  175.  
  176.   sprintf(newmsg, "%s%s", ABORT_MSG, msg);
  177.   report_err(newmsg);
  178.   printf("quitting...\n");
  179.   exit(1);
  180.   }
  181.  
  182. #define ERROR_MSG "ERROR: "
  183.  
  184. /* ................ */
  185. void error(msg)
  186.   char *msg;
  187. { char *newmsg= (char *) malloc(strlen(msg) + strlen(ERROR_MSG) + 1);
  188.   char rch;
  189.  
  190.   sprintf(newmsg, "%s%s", ERROR_MSG, msg);
  191.   report_err(newmsg);
  192.   errors++;
  193.   if (errors>MAXERRORS)
  194.     abort_trap("Error limit exceeded");
  195.   else {
  196.     rch= resp("...continue? ");
  197.     if (!(rch=='y' || rch=='Y')) exit(1);
  198.     }
  199.   }
  200.  
  201. #define WARN_MSG "WARNING: "
  202.  
  203. /* ................. */
  204. void warn(msg)
  205.   char *msg;
  206. { char *newmsg= (char *) malloc(strlen(msg) + strlen(WARN_MSG) + 1);
  207.  
  208.   sprintf(newmsg, "%s%s", WARN_MSG, msg);
  209.   report_err(newmsg);
  210.   }
  211.  
  212. /* ................. */
  213. void symerror(sym, msg)
  214.   char *sym, *msg;
  215. { char *newmsg= (char *) malloc(strlen(sym) + strlen(msg) + 3);
  216.  
  217.   sprintf(newmsg, "%s: %s", sym, msg);
  218.   report_err(newmsg);
  219.   }
  220.  
  221. /* ............... */
  222. static char peekch()
  223. {  /* return character past current one
  224.         without advancing the read head */
  225.   return line[lx];
  226.   }
  227.  
  228. /* ................. */
  229. static void nextch()
  230.   /* put next character in CH, and advance read head */
  231. {
  232.   if (ch) {
  233.     if (ch==EOFCH) return;
  234.     ch= line[lx++];
  235.     }
  236.   else getline();  /* end of the line */
  237.   }
  238.  
  239. /* ................. */
  240. static void backch()
  241.   /* positions to previous character in line */
  242. {
  243.   if (lx > 1)
  244.     ch= line[(--lx)-1];
  245.   else ch=' ';
  246.   }
  247.  
  248. {## copy(not eolseen) ##}
  249. /* when <eol> has NOT appeared in the grammar */
  250.  
  251. #ifdef CMODE   /* C-style comments */
  252.  
  253. /* .................. */
  254. void skipblanks()
  255.   /* This considers slash-star as an open comment and star-slash
  256.      as a close-comment; comments may run over multiple lines. */
  257. {
  258.   while (1) {
  259.     if (ch == '\0') nextch();
  260.     else if (ch == '/' && peekch()=='*') {  /* open a comment */
  261.       while (!(ch == '*' && peekch()=='/') &&
  262.              ch != EOFCH) nextch();
  263.       if (ch == EOFCH)
  264.         error("unclosed comment");
  265.       else
  266.         nextch();
  267.       }
  268.     else if (!(ch==' ' || ch=='\t' || ch=='\n')) break;
  269.     else nextch();
  270.     }
  271.   }
  272. #else  /* Pascal comments */
  273.  
  274. /* .................. */
  275. void skipblanks()
  276.   /* This considers left brace as an open comment and right brace
  277.     as a close-comment; comments may run over multiple lines. */
  278. {
  279.   while (1) {
  280.     if (ch == '\0') nextch();
  281.     else if (ch == '{') {  /* open a comment */
  282.       while (ch != '}' && ch != EOFCH) nextch();
  283.       if (ch == EOFCH)
  284.         error("unclosed comment");
  285.       else
  286.         nextch();
  287.       }
  288.     else if (!(ch==' ' || ch=='\t' || ch=='\n')) break;
  289.     else nextch();
  290.     }
  291.   }
  292. #endif
  293.  
  294. {## copy(eolseen) ##}
  295. /* when <eol> HAS appeared in the grammar */
  296. /* .................. */
  297. void skipblanks()
  298.   /* This version of skipblanks treats everything from COMMENT_START to the
  299.     end of a line as a comment. */
  300. {
  301.   while (1) {
  302.     if (ch == '\0') nextch();
  303.     else if (ch == COMMENT_START) {
  304.       while (ch != '\n') nextch();
  305.       break;  /* next character is an EOL */
  306.       }
  307.     else if (!(ch == ' ' || ch == '\t')) break;
  308.     else nextch();
  309.     }
  310.   }
  311.  
  312. {## ##}
  313.  
  314. /* .............. */
  315. static void get_symbol()
  316. { char symbol[MAXSYMLEN+1], *sp;
  317.   symtabtype *stp;
  318.  
  319.   sp= symbol;
  320.   /* Keep grabbing identifier characters.
  321.      These follow C standard, except that an identifier cannot
  322.        start with underbar,
  323.        and all letters are upshifted. */
  324.   while (1) {
  325.     if (isalpha(ch)) *(sp++)= to_upper(ch);
  326.     else if (isdigit(ch)) *(sp++)= ch;
  327.     else if (ch=='_') *(sp++)= ch;
  328.     else break;
  329.     nextch();
  330.     }
  331.   *sp= '\0';
  332.  
  333.   /* makesym allocates a copy of symbol from the heap unless
  334.       the thing is alread in the symtol table */
  335.   stp = makesym(symbol, USER);
  336.   if (stp->symt==RESERVED)
  337.     /* a reserved keyword */
  338.     token = stp->usym.tokval;
  339.   else {
  340.     lsemp= new_sem(IDENT, stp->symt);
  341.     lsemp->usem.symp = stp;
  342.     token = IDENT_TOKX;
  343.     }
  344.   }
  345.  
  346. /* ............. */
  347. static long int get_integer()
  348.   /* interpret a non-null sequence of digits as an integer. */
  349. { long int v= 0, sign= 1;
  350.  
  351.   if (ch=='+') nextch();
  352.   else if (ch=='-') {
  353.     nextch();
  354.     sign= -1;
  355.     }
  356.   while (isdigit(ch)) {
  357.     v = 10*v + ch - '0';
  358.     nextch();
  359.     }
  360.   return v*sign;
  361.   }
  362.  
  363. /*................*/
  364. static double get_fraction()
  365. { double v= 0.0, p= 0.1;
  366.  
  367.   while (isdigit(ch)) {
  368.     v = v + p*(ch-'0');
  369.     p = p/10.0;
  370.     nextch();
  371.     }
  372.   return v;
  373.   }
  374.  
  375. /* ............... */
  376. static double pwr10(exp)
  377.   long int exp;
  378. {
  379.   return pow((double) 10.0, (double) exp);
  380.   }
  381.  
  382. /* ............... */
  383. static void get_number()
  384.   /* Accepts a literal integer, decimal or real number. 
  385.      The legal forms are defined by this grammar:
  386.      
  387.      Number -> Integer
  388.             -> Decimal
  389.             -> Integer Exponent
  390.             -> Decimal Exponent
  391.      Decimal -> Integer .
  392.              -> Integer . Integer
  393.      Exponent -> ExpTag Sign Integer
  394.      ExpTag -> E
  395.             -> e
  396.             -> L
  397.             -> l
  398.      Sign -> +
  399.           -> -
  400.           -> <empty>
  401.   
  402.      Note that an initial sign (+/-) is not recognized.  All the
  403.      characters must be run together without spaces on the same line.
  404.      A float is assembled as a 'double' precision value.
  405.      An integer is assembled as a 'long' value.
  406.      The conversion method may fail for certain extreme values.
  407.      The C forms '0xNNN' and '0NNN' for hex and octal are not supported,
  408.        but are easily added.
  409.      */
  410.  
  411. { long int v1;
  412.   double rv;
  413.  
  414.   v1 = get_integer();
  415.   if ((ch=='.'))  {
  416.     /* real number */
  417.     nextch();
  418.     rv = v1 + get_fraction();
  419.     if (ch=='e' || ch=='E' || ch=='l' || ch=='L') {
  420.       nextch();
  421.       rv= rv * pwr10(get_integer());
  422.       }
  423.     token= REAL_TOKX;
  424.     lsemp= new_sem(FLOAT, INTVAR);
  425.     lsemp->usem.rval= rv;
  426.     }
  427.   else if (ch=='e' || ch=='E' || ch=='l' || ch=='L') {
  428.     /* integer followed by exponent part */
  429.     nextch();
  430.     rv= v1 * pwr10(get_integer());
  431.     token= REAL_TOKX;
  432.     lsemp= new_sem(FLOAT, INTVAR);
  433.     lsemp->usem.rval= rv;
  434.     }
  435.   else {
  436.     token = INT_TOKX;
  437.     lsemp=new_sem(FIXED, INTVAR);
  438.     lsemp->usem.numval = v1;
  439.     }
  440.   } /* get_number */
  441.  
  442. #ifdef CMODE
  443.  
  444. /* ............... */
  445. static void get_string()
  446.   /* Scans a string, allocating space for it, returning the pointer.
  447.      The string follows C conventions, opening with the double quote
  448.      mark ".  An embedded double quote is represented as '\"'.
  449.      Other embedded C characters, i.e. \n, etc. are not recognized
  450.      in this simplified scanner.  See directory CGRAM for a full
  451.      C lexical analyzer, with extensions for numbers as well as
  452.      strings -- cgram\skellex.c can be used instead of this file */
  453. { char tstring[MAXSTRINGLEN+1], *tp;
  454.  
  455.   nextch();  /* get past the first quote mark */
  456.   lsemp= new_sem(STRNG, STRVAR);
  457.   tp= tstring;
  458.   while (1) {
  459.     while (ch &&
  460.            !(ch==EOFCH ||
  461.              ch==STRING_CHAR ||
  462.              ch==BREAK_CHAR)) {
  463.       *(tp++)= ch;
  464.       nextch();
  465.       }
  466.     if (ch == STRING_CHAR) {
  467.       nextch();
  468.       break;  /* has to be the end */
  469.       }
  470.     else if (ch == BREAK_CHAR) {
  471.       nextch();
  472.       switch (ch) {
  473.         /* a few are provided as an example --
  474.            add other C break characters here as needed */
  475.         case BREAK_CHAR:  /* these two just get echoed */
  476.         case STRING_CHAR:
  477.           *(tp++)= ch;
  478.           nextch();
  479.           break;
  480.         case 'n':
  481.           *(tp++)= '\n';
  482.           nextch();
  483.           break;
  484.         default:
  485.           error("unrecognized \ option in string");
  486.           nextch();
  487.           break;
  488.         }
  489.       }
  490.     else error("unterminated string within line or define");
  491.     }
  492.   *tp= '\0';
  493.   lsemp->usem.strx= (char *) malloc(tp - tstring + 1);
  494.   strcpy(lsemp->usem.strx, tstring);
  495.   token = STR_TOKX;
  496.   }
  497.  
  498. /* ............... */
  499. static int get_char()
  500.   /* Scans a C character, returning the int value as a SIGNED
  501.       char -127 .. 128.
  502.      +++ This ONLY recognizes simple character forms.  See
  503.          function skellex.c under the CGRAM directory for a complete
  504.          recognizer of C character forms
  505.           */
  506. { int charvalue;
  507.   unsigned char tstring[5], *tp;
  508.  
  509.   nextch();  /* get past the first quote mark */
  510.   if (ch == '\\') {
  511.     nextch();   /* permits \\ and \' as characters */
  512.     charvalue= (int) ch;
  513.     }
  514.   else charvalue= (int) ch;
  515.   nextch();    /* get over the character in quotes */
  516.   if (ch != '\'') error("expecting character quote");
  517.   else nextch();   /* skip the terminating quote */
  518.   lsemp= new_sem(CHAR, CHART);
  519.   lsemp->usem.numval= charvalue;
  520.   token = CHAR_TOKX;
  521.   }
  522.  
  523. #else  /* alternative is PASCAL mode.  A character and a string
  524.           are equivalent, except that a character is a single-char string */
  525.  
  526. /* ............... */
  527. static void get_string()
  528.   /* Scans a string, allocating space for it, returning the pointer.
  529.      The string follows PASCAL conventions, opening with the single quote
  530.      mark '.  An embedded double quote is represented as ''.
  531.      */
  532. { char tstring[MAXSTRINGLEN+1], *tp;
  533.  
  534.   nextch();  /* get past the first quote mark */
  535.   lsemp= new_sem(STRNG, STRVAR);
  536.   tp= tstring;
  537.   while (1) {
  538.     while (ch &&
  539.            !(ch==EOFCH ||
  540.              ch=='\'')) {
  541.       *(tp++)= ch;
  542.       nextch();
  543.       }
  544.     if (ch == '\'') {  /* duplicated quote? */
  545.       nextch();
  546.       if (ch=='\'') {  /* yes, a duplicated quote */
  547.         *(tp++)= ch;
  548.         nextch();  /* then keep reading */
  549.         }
  550.       else break;  /* this is the string end */
  551.       }
  552.     else error("unterminated string within line or define");
  553.     }
  554.   *tp= '\0';
  555.   if (tp-tstring!=1) {
  556.     lsemp->usem.strx= (char *) malloc(tp - tstring + 1);
  557.     strcpy(lsemp->usem.strx, tstring);
  558.     /* use this in case anyone cares about the distinction */
  559.     token = STR_TOKX;
  560.     }
  561.   else {
  562.     lsemp->usem.numval= *tstring;
  563.     token= CHAR_TOKX;
  564.     }
  565.   }
  566.  
  567. #endif
  568.  
  569. /* ..................... */
  570. static int get_special()
  571. {   /*This recognizes all those non-alphanumeric tokens that
  572.            are such that the first character is a prefix of
  573.            some other token.  These are the `is_mult_char' tokens.
  574.          The strategy is to collect all the characters that
  575.            can follow the first character of such tokens, then
  576.            search for the resulting string in the symbol
  577.            table.  The set SPECIAL_FOLSET is formed from the
  578.            but-first characters of this token class.
  579.          This class is loaded into the symbol table in the
  580.            INITTABLES procedure.*/
  581.   char symbol[MAXSYMLEN+1], *sp;
  582.   symtabtype *symp;
  583.  
  584.   sp= symbol;
  585.   *(sp++)= ch;   /* this is the character sent into this thing */
  586.   nextch();
  587.   token= STOP_TOKX;    /* this is just in case */
  588. {## var K, UD: integer;
  589.  
  590.     {This generates a while loop to look for characters in the
  591.       'mult_char_fol' set}
  592.     begin
  593.       indent:=2;
  594.       ud:=udim(mult_char_fol);
  595.       if ud >= ldim(mult_char_fol) then begin
  596.         write('while (');
  597.         for k:=ldim(mult_char_fol) to ud do begin
  598.           write('ch==', qcharacter(mult_char_fol[k]));
  599.           if k<ud then write(' || ');
  600.           end;
  601.         writeln(') {');
  602.         writeln('  *(sp++)= ch;');
  603.         writeln('  nextch();');
  604.         writeln('  }');
  605.         end
  606.       end;  ##}
  607.  
  608.   *sp='\0';  /* terminate the string formed in the loop */
  609.   while (1) {  /* if we can't find the string, reduce it by one
  610.                   character at a time until we can find it */
  611.     symp= findsym(symbol);
  612.     if (symp==NULL ||
  613.         symp->symt!=RESERVED) {
  614.       if (sp - symbol >= 2) {
  615.         *(--sp)= '\0';  /* backup one character */
  616.         backch();
  617.         }
  618.       else return 0;
  619.       }
  620.     else {   /*should be a long non-alphanumeric token*/
  621.       token= symp->usym.tokval;
  622.       return 1;
  623.       }
  624.     }
  625.   }
  626.  
  627. /* .................. */
  628. static void get_token()
  629. /* C-style lexical analyzer -- sets TOKEN to token number */
  630. {
  631.   lsemp= NULL;  /* default case */
  632.   skipblanks();
  633.   err_pos= lx-1;
  634.   if (isalpha(ch)) get_symbol();
  635.   else if (isdigit(ch)) get_number();
  636.   else switch (ch) {
  637.     case STRING_CHAR:  /* C-style string, i.e. "a string" */
  638.       get_string();
  639.       break;
  640. #if CHAR_QUOTE != STRING_CHAR
  641.     /* a C-style character recognizer, i.e. '\n' */
  642.     case CHAR_QUOTE:
  643.       get_char();
  644.       break;
  645. #endif
  646.  
  647. #if DEBUG == 1
  648.     case DEBUG_CHAR: {
  649.       debug_level= 2;
  650.       nextch();
  651.       get_token();
  652.       break;
  653.       }
  654. #endif
  655.  
  656. {##   {the following generates inline case transfers for
  657.          singlet tokens -- those not starting with an alphanumeric, and
  658.          of length = 1}
  659.    var K, L, U: integer;
  660.    begin
  661.      indent:= 4;
  662.      for k:=1 to term_toks do begin
  663.        if is_singlet[k] then begin  {these can be recognized instantly
  664.                         as a single character}
  665.          writeln('case ', qcharacter(tokens[k]), ': token=', k,
  666.                                      '; nextch(); break;');
  667.          end
  668.        end;
  669.  
  670.      {the following generates inline case transfers for the
  671.         multiplet tokens -- those not starting with an alphanumeric, and
  672.         of length > 1 }
  673.      l:=ldim(mult_char_pfx);
  674.      u:=udim(mult_char_pfx);
  675.      if u>=l then begin   {don't do anything if there's no need}
  676.        for k:=l to u do
  677.          writeln('case ', qcharacter(mult_char_pfx[k]), ':');
  678.        copy(true);
  679.        end
  680.      else copy(false);
  681.      end;
  682. ##}
  683.       if (!get_special()) {
  684.         error("illegal token");
  685.         get_token();  /* try again */
  686.         };
  687.       break;
  688. {## ##}
  689.     default:
  690.       if (ch == EOFCH) token = STOP_TOKX;
  691.       else if (ch == '\n') {
  692.         nextch();
  693. {## copy(eolseen) ##}
  694.         token = EOL_TOKX;  /* accept an end-of-line token */
  695. {## copy(not eolseen) ##}
  696.         get_token();  /* go find another (significant) character */
  697. {## ##}
  698.         }
  699.       else {
  700.         error("illegal character");
  701.         nextch();
  702.         get_token();  /* try again */
  703.         }
  704.       break;
  705.     } /* end switch */
  706.   if (err_count>0) err_count--;
  707.   } /* get_token */
  708.  
  709. /* ................. */
  710. void next_token()
  711. {
  712.   if (tokenx>1) {
  713.     tokenx = 1;
  714.     get_token();  /* goes into token, lsemp */
  715.     while (token==DEBUG_TOKX)  get_token();
  716.     tokary[1] = token;
  717.     lsempary[1] = lsemp;
  718.     }
  719.   else {   /*tokenx== 0 or 1*/
  720.     /* is in tokary */
  721.     token = tokary[tokenx];
  722.     lsemp = lsempary[tokenx];
  723.     }
  724.   }
  725.  
  726. /* ...............*/
  727. void tokenread()
  728. {
  729.   tokenx++;
  730.   }
  731.  
  732. /*................*/
  733. static void putsym(str, tv)
  734.   char *str;
  735.   int tv;
  736. { symtabtype *symp= makesym(str, RESERVED);
  737.  
  738.   symp->usym.tokval=tv;
  739.   }
  740.  
  741. /* .................. */
  742. static void init_lex()
  743. {
  744.   lsempary[0]=NULL;
  745.   lsempary[1]=NULL;
  746.   lsemp = NULL;
  747.   tokenx=2;
  748.   getline();
  749.   }
  750.  
  751. /*.................*/
  752. void inittables()
  753. {
  754.   init_sym();     /*initialize symbol table*/
  755.   clevel= -1;
  756. {##
  757.   { generate a list of 'putsym' calls that associate each
  758.      token name with a token number }
  759.   var K: integer;
  760.   begin
  761.     indent:= 2;
  762.     for k:=1 to term_toks do
  763.       if not is_wild[k] and
  764.          (like_ident[k] or is_mult_char[k]) then
  765.         writeln('putsym(', qstring(tokens[k]), ', ', k, ');');
  766.     end;
  767. ##}
  768.   clevel= 0;  /*goes to 0 for global level*/
  769.   }
  770.  
  771. /* ............... */
  772. int open_lex(fname, show_src)
  773.   char *fname;
  774.   int show_src;
  775. {
  776.   if (strcmp(fname, "stdin")==0) sfile= stdin;
  777.   else if ((sfile= fopen(fname, "r"))==NULL) {
  778.     printf("Unable to open %s\n", fname);
  779.     return 0;
  780.     }
  781.   show_source= show_src;
  782.   init_lex();
  783.   return 1;
  784.   }
  785.  
  786. /* ............... */
  787. void close_lex()
  788. {
  789.   if (sfile != stdin) fclose(sfile);
  790.   }
  791.  
  792. #if DEBUG == 1
  793.  
  794. /* The following is used by the debugger to describe tokens and
  795.    lexical states */
  796.  
  797. /* ............. */
  798. void show_lex()
  799. {
  800.   if (lx > 0) report_line(lx-1, line, 0);
  801.   else report_line(0, line, 0);
  802.   printf("Next character CH= ");
  803.   write_anychar(ch);
  804.   printf(", current token= %s\n",
  805.          (token >= 1 && token <= ALL_TOKS ? tokstring[token] : "???"));
  806.   }
  807.  
  808. #endif
  809.  
  810. #ifdef TEST
  811.  
  812. /* When developing a new lexical analyzer through extensive modification
  813.     of this code, we recommend compiling with -DTEST, which makes this
  814.     a standalone program.  Run it with a source file to
  815.     test the lexical analyzer.
  816.     */
  817.  
  818. /* .......... */
  819. main(argc, argv)
  820.   int argc;
  821.   char *argv[];
  822. {  /* takes some file as arg 1, sends out copied strings and token lists */
  823.  
  824.   if (argc != 2) {
  825.     printf("Usage: lex filename\n");
  826.     exit(1);
  827.     }
  828.   if (open_lex(argv[1])) {
  829.     while (1) {
  830.       next_token();
  831.       if (token >= 1 && token <= TERM_TOKS)
  832.         printf("\ntoken= %s", tokstring[token]);
  833.       else printf("\nUNRECOGNIZABLE TOKEN: %d", token);
  834.       if (token==STOP_TOKX) break;
  835.       }
  836.     }
  837.   exit(0);
  838.   }
  839.  
  840. #endif
  841.  
  842.  
  843.