[mirror_edk2.git] / EdkCompatibilityPkg / Other / Maintained / Tools / Pccts / sorcerer / lib / astlib.c

/*\r
 * astlib.c\r
 *\r
 * SOFTWARE RIGHTS\r
 *\r
 * We reserve no LEGAL rights to SORCERER -- SORCERER is in the public\r
 * domain.  An individual or company may do whatever they wish with\r
 * source code distributed with SORCERER or the code generated by\r
 * SORCERER, including the incorporation of SORCERER, or its output, into\r
 * commerical software.\r
 *\r
 * We encourage users to develop software with SORCERER.  However, we do\r
 * ask that credit is given to us for developing SORCERER.  By "credit",\r
 * we mean that if you incorporate our source code into one of your\r
 * programs (commercial product, research project, or otherwise) that you\r
 * acknowledge this fact somewhere in the documentation, research report,\r
 * etc...  If you like SORCERER and have developed a nice tool with the\r
 * output, please mention that you developed it using SORCERER.  In\r
 * addition, we ask that this header remain intact in our source code.\r
 * As long as these guidelines are kept, we expect to continue enhancing\r
 * this system and expect to make other tools available as they are\r
 * completed.\r
 *\r
 * SORCERER 1.00B\r
 * Terence Parr\r
 * AHPCRC, University of Minnesota\r
 * 1992-1994\r
 */\r
\r
#include <stdio.h>\r
#include "pcctscfg.h"\r
#include <ctype.h>\r
\r
#define SORCERER_TRANSFORM\r
\r
#include "CASTBase.h"\r
#include "astlib.h"\r
\r
#ifdef PCCTS_USE_STDARG\r
#include <stdarg.h>\r
#else\r
#include <varargs.h>\r
#endif\r
\r
               /* String Scanning/Parsing Stuff */\r
\r
#define StringScanMaxText  50\r
\r
typedef struct stringlexer {\r
#ifdef __USE_PROTOS\r
      signed int c;\r
#else\r
      int c;\r
#endif\r
      char *input;\r
      char *p;\r
      char text[StringScanMaxText];\r
    } StringLexer;\r
\r
#define LPAREN      1\r
#define RPAREN      2\r
#define PERCENT      3\r
#define INT        4\r
#define COLON      5\r
#define POUND      6\r
#define PERIOD      7\r
#define StringScanEOF  -1\r
#define VALID_SCAN_TOKEN(t)    (t>=LPAREN && t<=PERIOD)\r
\r
static char *scan_token_tbl[] = {\r
  "invalid",  /*  0 */\r
  "LPAREN",  /*  1 */\r
  "RPAREN",  /*  2 */\r
  "PERCENT",  /*  3 */\r
  "INT",    /*  4 */\r
  "COLON",  /*  5 */\r
  "POUND",  /*  6 */\r
  "PERIOD",  /*  7 */\r
};\r
\r
char *\r
#ifdef __USE_PROTOS\r
scan_token_str(int t)\r
#else\r
scan_token_str(t)\r
int t;\r
#endif\r
{\r
  if ( VALID_SCAN_TOKEN(t) ) return scan_token_tbl[t];\r
  else if ( t==StringScanEOF ) return "<end-of-string>";\r
  else return "<invalid-token>";\r
}\r
\r
typedef struct stringparser {\r
      int token;\r
      StringLexer *lexer;\r
      int num_labels;\r
    } StringParser;\r
\r
          /* This type ONLY USED by ast_scan() */\r
\r
typedef struct _scanast {\r
            struct _scanast *right, *down;\r
            int token;\r
      int label_num;\r
        } ScanAST;\r
\r
#ifdef __USE_PROTOS\r
static void stringlexer_init(StringLexer *scanner, char *input);\r
static void stringparser_init(StringParser *, StringLexer *);\r
static ScanAST *stringparser_parse_scanast(char *templ, int *n);\r
static ScanAST *stringparser_parse_tree(StringParser *parser);\r
static ScanAST *stringparser_parse_element(StringParser *parser);\r
static void stringscan_advance(StringLexer *scanner);\r
static int stringscan_gettok(StringLexer *scanner);\r
#else\r
static void stringlexer_init();\r
static void stringparser_init();\r
static ScanAST *stringparser_parse_scanast();\r
static ScanAST *stringparser_parse_tree();\r
static ScanAST *stringparser_parse_element();\r
static void stringscan_advance();\r
static int stringscan_gettok();\r
#endif\r
\r
/* build a tree (root child1 child2 ... NULL)\r
 * If root is NULL, simply make the children siblings and return ptr\r
 * to 1st sibling (child1).  If root is not single node, return NULL.\r
 *\r
 * Siblings that are actually sibling lists themselves are handled\r
 * correctly.  For example #( NULL, #( NULL, A, B, C), D) results\r
 * in the tree ( NULL A B C D ).\r
 *\r
 * Requires at least two parameters with the last one being NULL.  If\r
 * both are NULL, return NULL.\r
 *\r
 * The ast_down and ast_right down/right pointers are used to make the tree.\r
 */\r
SORAST *\r
#ifdef PCCTS_USE_STDARG\r
ast_make(SORAST *rt, ...)\r
#else\r
ast_make(va_alist)\r
va_dcl\r
#endif\r
{\r
  va_list ap;\r
  register SORAST *child, *sibling=NULL, *tail = NULL, *w;\r
  SORAST *root;\r
\r
#ifdef PCCTS_USE_STDARG\r
  va_start(ap, rt);\r
  root = rt;\r
#else\r
  va_start(ap);\r
  root = va_arg(ap, SORAST *);\r
#endif\r
\r
  if ( root != NULL )\r
    if ( root->ast_down != NULL ) return NULL;\r
  child = va_arg(ap, SORAST *);\r
  while ( child != NULL )\r
  {\r
    /* find end of child */\r
    for (w=child; w->ast_right!=NULL; w=w->ast_right) {;}\r
    if ( sibling == NULL ) {sibling = child; tail = w;}\r
    else {tail->ast_right = child; tail = w;}\r
    child = va_arg(ap, SORAST *);\r
  }\r
  if ( root==NULL ) root = sibling;\r
  else root->ast_down = sibling;\r
  va_end(ap);\r
  return root;\r
}\r
\r
/* The following push and pop routines are only used by ast_find_all() */\r
\r
static void\r
#ifdef __USE_PROTOS\r
_push(SORAST **st, int *sp, SORAST *e)\r
#else\r
_push(st, sp, e)\r
SORAST **st;\r
int *sp;\r
SORAST *e;\r
#endif\r
{\r
  (*sp)--;\r
  require((*sp)>=0, "stack overflow");\r
  st[(*sp)] = e;\r
}\r
\r
static SORAST *\r
#ifdef __USE_PROTOS\r
_pop(SORAST **st, int *sp)\r
#else\r
_pop(st, sp)\r
SORAST **st;\r
int *sp;\r
#endif\r
{\r
  SORAST *e = st[*sp];\r
  (*sp)++;\r
  require((*sp)<=MaxTreeStackDepth, "stack underflow");\r
  return e;\r
}\r
\r
/* Is 'u' a subtree of 't' beginning at the root? */\r
int\r
#ifdef __USE_PROTOS\r
ast_match_partial(SORAST *t, SORAST *u)\r
#else\r
ast_match_partial(t, u)\r
SORAST *t, *u;\r
#endif\r
{\r
  SORAST *sib;\r
\r
  if ( u==NULL ) return 1;\r
  if ( t==NULL ) if ( u!=NULL ) return 0; else return 1;\r
\r
  for (sib=t; sib!=NULL&&u!=NULL; sib=sib->ast_right, u=u->ast_right)\r
  {\r
    if ( sib->token != u->token ) return 0;\r
    if ( sib->ast_down!=NULL )\r
      if ( !ast_match_partial(sib->ast_down, u->ast_down) ) return 0;\r
  }\r
  return 1;\r
}\r
\r
/* Find all occurrences of u in t.\r
 * 'cursor' must be initialized to 't'.  It eventually\r
 * returns NULL when no more occurrences of 'u' are found.\r
 */\r
SORAST *\r
#ifdef __USE_PROTOS\r
ast_find_all(SORAST *t, SORAST *u, SORAST **cursor)\r
#else\r
ast_find_all(t, u, cursor)\r
SORAST *t, *u, **cursor;\r
#endif\r
{\r
  SORAST *sib;\r
  static SORAST *template_stack[MaxTreeStackDepth];\r
  static int tsp = MaxTreeStackDepth;\r
\r
  if ( *cursor == NULL ) return NULL;\r
  if ( *cursor!=t ) sib = *cursor;\r
  else {\r
    /* else, first time--start at top of template 't' */\r
    tsp = MaxTreeStackDepth;\r
    sib = t;\r
    /* bottom of stack is always a NULL--"cookie" indicates "done" */\r
    _push(template_stack, &tsp, NULL);\r
  }\r
\r
keep_looking:\r
  if ( sib==NULL )  /* hit end of sibling list */\r
  {\r
    sib = _pop(template_stack, &tsp);\r
    if ( sib == NULL ) { *cursor = NULL; return NULL; }\r
  }\r
\r
  if ( sib->token != u->token )\r
  {\r
    /* look for another match */\r
    if ( sib->ast_down!=NULL )\r
    {\r
      if ( sib->ast_right!=NULL ) _push(template_stack, &tsp, sib->ast_right);\r
      sib=sib->ast_down;\r
      goto keep_looking;\r
    }\r
    /* nothing below to try, try next sibling */\r
    sib=sib->ast_right;\r
    goto keep_looking;\r
  }\r
\r
  /* found a matching root node, try to match what's below */\r
  if ( ast_match_partial(sib, u) )\r
  {\r
    /* record sibling cursor so we can pick up next from there */\r
    if ( sib->ast_down!=NULL )\r
    {\r
      if ( sib->ast_right!=NULL ) _push(template_stack, &tsp, sib->ast_right);\r
      *cursor = sib->ast_down;\r
    }\r
    else if ( sib->ast_right!=NULL ) *cursor = sib->ast_right;\r
    else *cursor = _pop(template_stack, &tsp);\r
    return sib;\r
  }\r
\r
  /* no match, keep searching */\r
  if ( sib->ast_down!=NULL )\r
  {\r
    if ( sib->ast_right!=NULL ) _push(template_stack, &tsp, sib->ast_right);\r
    sib=sib->ast_down;\r
  }\r
  else sib = sib->ast_right;  /* else, try to right if zip below */\r
  goto keep_looking;\r
}\r
\r
/* are two trees exactly alike? */\r
int\r
#ifdef __USE_PROTOS\r
ast_match(SORAST *t, SORAST *u)\r
#else\r
ast_match(t, u)\r
SORAST *t, *u;\r
#endif\r
{\r
  SORAST *sib;\r
\r
  if ( t==NULL ) if ( u!=NULL ) return 0; else return 1;\r
  if ( u==NULL ) return 0;\r
\r
  for (sib=t; sib!=NULL&&u!=NULL; sib=sib->ast_right, u=u->ast_right)\r
  {\r
    if ( sib->token != u->token ) return 0;\r
    if ( sib->ast_down!=NULL )\r
      if ( !ast_match(sib->ast_down, u->ast_down) ) return 0;\r
  }\r
  return 1;\r
}\r
\r
static int\r
#ifdef __USE_PROTOS\r
ast_scanmatch(ScanAST *t, SORAST *u, SORAST **labels[], int *n)\r
#else\r
ast_scanmatch(t, u, labels, n)\r
ScanAST *t;\r
SORAST *u;\r
SORAST **labels[];\r
int *n;\r
#endif\r
{\r
  ScanAST *sib;\r
\r
  if ( t==NULL ) if ( u!=NULL ) return 0; else return 1;\r
  if ( u==NULL ) return 0;\r
\r
  for (sib=t; sib!=NULL&&u!=NULL; sib=sib->right, u=u->ast_right)\r
  {\r
    /* make sure tokens match; token of '0' means wildcard match */\r
    if ( sib->token != u->token && sib->token!=0 ) return 0;\r
    /* we have a matched token here; set label pointers if exists */\r
    if ( sib->label_num>0 )\r
    {\r
      require(labels!=NULL, "label found in template, but no array of labels");\r
      (*n)++;\r
      *(labels[sib->label_num-1]) = u;\r
    }\r
    /* match what's below if something there and current node is not wildcard */\r
    if ( sib->down!=NULL && sib->token!=0 )\r
      if ( !ast_scanmatch(sib->down, u->ast_down, labels, n) ) return 0;\r
  }\r
  return 1;\r
}\r
\r
void\r
#ifdef __USE_PROTOS\r
ast_insert_after(SORAST *a, SORAST *b)\r
#else\r
ast_insert_after(a, b)\r
SORAST *a,*b;\r
#endif\r
{\r
  SORAST *end;\r
  require(a!=NULL, "ast_insert_after: NULL input tree");\r
  if ( b==NULL ) return;\r
  /* find end of b's child list */\r
  for (end=b; end->ast_right!=NULL; end=end->ast_right) {;}\r
  end->ast_right = a->ast_right;\r
  a->ast_right = b;\r
}\r
\r
void\r
#ifdef __USE_PROTOS\r
ast_append(SORAST *a, SORAST *b)\r
#else\r
ast_append(a, b)\r
SORAST *a,*b;\r
#endif\r
{\r
  SORAST *end;\r
  require(a!=NULL&&b!=NULL, "ast_append: NULL input tree");\r
  /* find end of child list */\r
  for (end=a; end->ast_right!=NULL; end=end->ast_right) {;}\r
  end->ast_right = b;\r
}\r
\r
SORAST *\r
#ifdef __USE_PROTOS\r
ast_tail(SORAST *a)\r
#else\r
ast_tail(a)\r
SORAST *a;\r
#endif\r
{\r
  SORAST *end;\r
  require(a!=NULL, "ast_tail: NULL input tree");\r
  /* find end of child list */\r
  for (end=a; end->ast_right!=NULL; end=end->ast_right) {;}\r
  return end;\r
}\r
\r
SORAST *\r
#ifdef __USE_PROTOS\r
ast_bottom(SORAST *a)\r
#else\r
ast_bottom(a)\r
SORAST *a;\r
#endif\r
{\r
  SORAST *end;\r
  require(a!=NULL, "ast_bottom: NULL input tree");\r
  /* find end of child list */\r
  for (end=a; end->ast_down!=NULL; end=end->ast_down) {;}\r
  return end;\r
}\r
\r
SORAST *\r
#ifdef __USE_PROTOS\r
ast_cut_between(SORAST *a, SORAST *b)\r
#else\r
ast_cut_between(a, b)\r
SORAST *a,*b;\r
#endif\r
{\r
  SORAST *end, *ret;\r
  require(a!=NULL&&b!=NULL, "ast_cut_between: NULL input tree");\r
  /* find node pointing to b */\r
  for (end=a; end->ast_right!=NULL&&end->ast_right!=b; end=end->ast_right)\r
    {;}\r
  require(end->ast_right!=NULL, "ast_cut_between: a,b not connected");\r
  end->ast_right = NULL;  /* don't want it point to 'b' anymore */\r
  ret = a->ast_right;\r
  a->ast_right = b;\r
  return ret;\r
}\r
\r
SList *\r
#ifdef __USE_PROTOS\r
ast_to_slist(SORAST *t)\r
#else\r
ast_to_slist(t)\r
SORAST *t;\r
#endif\r
{\r
  SList *list=NULL;\r
  SORAST *p;\r
\r
  for (p=t; p!=NULL; p=p->ast_right)\r
  {\r
    slist_add(&list, p);\r
  }\r
  return list;\r
}\r
\r
SORAST *\r
#ifdef __USE_PROTOS\r
slist_to_ast(SList *list)\r
#else\r
slist_to_ast(list)\r
SList *list;\r
#endif\r
{\r
  SORAST *t=NULL, *last=NULL;\r
  SList *p;\r
\r
  for (p = list->next; p!=NULL; p=p->next)\r
  {\r
    SORAST *u = (SORAST *)p->elem;\r
    if ( last==NULL ) last = t = u;\r
    else { last->ast_right = u; last = u; }\r
  }\r
  return t;\r
}\r
\r
void\r
#ifdef __USE_PROTOS\r
ast_free(SORAST *t)\r
#else\r
ast_free(t)\r
SORAST *t;\r
#endif\r
{\r
    if ( t == NULL ) return;\r
    ast_free( t->ast_down );\r
    ast_free( t->ast_right );\r
    free( t );\r
}\r
\r
int\r
#ifdef __USE_PROTOS\r
ast_nsiblings(SORAST *t)\r
#else\r
ast_nsiblings(t)\r
SORAST *t;\r
#endif\r
{\r
  int n=0;\r
\r
  while ( t!=NULL )\r
  {\r
    n++;\r
    t = t->ast_right;\r
  }\r
  return n;\r
}\r
\r
SORAST *\r
#ifdef __USE_PROTOS\r
ast_sibling_index(SORAST *t, int i)\r
#else\r
ast_sibling_index(t,i)\r
SORAST *t;\r
int i;\r
#endif\r
{\r
  int j=1;\r
  require(i>0, "ast_sibling_index: i<=0");\r
\r
  while ( t!=NULL )\r
  {\r
    if ( j==i ) return t;\r
    j++;\r
    t = t->ast_right;\r
  }\r
  return NULL;\r
}\r
\r
static void\r
#ifdef __USE_PROTOS\r
scanast_free(ScanAST *t)\r
#else\r
scanast_free(t)\r
ScanAST *t;\r
#endif\r
{\r
    if ( t == NULL ) return;\r
    scanast_free( t->down );\r
    scanast_free( t->right );\r
    free( t );\r
}\r
\r
/*\r
 * ast_scan\r
 *\r
 * This function is like scanf(): it attempts to match a template\r
 * against an input tree.  A variable number of tree pointers\r
 * may be set according to the '%i' labels in the template string.\r
 * For example:\r
 *\r
 *   ast_scan("#( 6 #(5 %1:4 %2:3) #(1 %3:3 %4:3) )",\r
 *            t, &w, &x, &y, &z);\r
 *\r
 * Naturally, you'd want this converted from\r
 *\r
 *   ast_scan("#( RangeOp #(Minus %1:IConst %2:Var) #(Plus %3:Var %4Var) )",\r
 *        t, &w, &x, &y, &z);\r
 *\r
 * by SORCERER.\r
 *\r
 * This function call must be done withing a SORCERER file because SORCERER\r
 * must convert the token references to the associated token number.\r
 *\r
 * This functions parses the template and creates trees which are then\r
 * matched against the input tree.  The labels are set as they are\r
 * encountered; hence, partial matches may leave some pointers set\r
 * and some NULL.  This routines initializes all argument pointers to NULL\r
 * at the beginning.\r
 *\r
 * This function returns the number of labels matched.\r
 */\r
int\r
#ifdef PCCTS_USE_STDARG\r
ast_scan(char *templ, SORAST *tree, ...)\r
#else\r
ast_scan(va_alist)\r
va_dcl\r
#endif\r
{\r
  va_list ap;\r
  ScanAST *t;\r
  int n, i, found=0;\r
  SORAST ***label_ptrs=NULL;\r
\r
#ifdef PCCTS_USE_STDARG\r
  va_start(ap, tree);\r
#else\r
  char *templ;\r
  SORAST *tree;\r
\r
  va_start(ap);\r
  templ = va_arg(ap, char *);\r
  tree = va_arg(ap, SORAST *);\r
#endif\r
\r
  /* make a ScanAST tree out of the template */\r
  t = stringparser_parse_scanast(templ, &n);\r
\r
  /* make an array out of the labels */\r
  if ( n>0 )\r
  {\r
    label_ptrs = (SORAST ***) calloc(n, sizeof(SORAST **));\r
    require(label_ptrs!=NULL, "ast_scan: out of memory");\r
    for (i=1; i<=n; i++)\r
    {\r
      label_ptrs[i-1] = va_arg(ap, SORAST **);\r
      *(label_ptrs[i-1]) = NULL;\r
    }\r
  }\r
\r
  /* match the input tree against the template */\r
  ast_scanmatch(t, tree, label_ptrs, &found);\r
\r
  scanast_free(t);\r
  free(label_ptrs);\r
\r
  return found;\r
}\r
\r
static ScanAST *\r
#ifdef __USE_PROTOS\r
new_scanast(int tok)\r
#else\r
new_scanast(tok)\r
int tok;\r
#endif\r
{\r
    ScanAST *p = (ScanAST *) calloc(1, sizeof(ScanAST));\r
    if ( p == NULL ) {fprintf(stderr, "out of mem\n"); exit(-1);}\r
  p->token = tok;\r
  return p;\r
}\r
\r
static ScanAST *\r
#ifdef __USE_PROTOS\r
stringparser_parse_scanast(char *templ, int *num_labels)\r
#else\r
stringparser_parse_scanast(templ, num_labels)\r
char *templ;\r
int *num_labels;\r
#endif\r
{\r
  StringLexer lex;\r
  StringParser parser;\r
  ScanAST *t;\r
\r
  stringlexer_init(&lex, templ);\r
  stringparser_init(&parser, &lex);\r
  t = stringparser_parse_tree(&parser);\r
  *num_labels = parser.num_labels;\r
  return t;\r
}\r
\r
static void\r
#ifdef __USE_PROTOS\r
stringparser_match(StringParser *parser, int token)\r
#else\r
stringparser_match(parser, token)\r
StringParser *parser;\r
int token;\r
#endif\r
{\r
  if ( parser->token != token ) sorcerer_panic("bad tree in ast_scan()");\r
}\r
\r
/*\r
 * Match a tree of the form:\r
 *    (root child1 child2 ... childn)\r
 * or,\r
 *    node\r
 *\r
 * where the elements are integers or labeled integers.\r
 */\r
static ScanAST *\r
#ifdef __USE_PROTOS\r
stringparser_parse_tree(StringParser *parser)\r
#else\r
stringparser_parse_tree(parser)\r
StringParser *parser;\r
#endif\r
{\r
  ScanAST *t=NULL, *root, *child, *last = NULL;\r
\r
  if ( parser->token != POUND )\r
  {\r
    return stringparser_parse_element(parser);\r
  }\r
  stringparser_match(parser,POUND);\r
  parser->token = stringscan_gettok(parser->lexer);\r
  stringparser_match(parser,LPAREN);\r
  parser->token = stringscan_gettok(parser->lexer);\r
  root = stringparser_parse_element(parser);\r
  while ( parser->token != RPAREN )\r
  {\r
    child = stringparser_parse_element(parser);\r
    if ( t==NULL ) { t = child; last = t; }\r
    else { last->right = child; last = child; }\r
  }\r
  stringparser_match(parser,RPAREN);\r
  parser->token = stringscan_gettok(parser->lexer);\r
  root->down = t;\r
  return root;\r
}\r
\r
static ScanAST *\r
#ifdef __USE_PROTOS\r
stringparser_parse_element(StringParser *parser)\r
#else\r
stringparser_parse_element(parser)\r
StringParser *parser;\r
#endif\r
{\r
  static char ebuf[100];\r
  int label = 0;\r
\r
  if ( parser->token == POUND )\r
  {\r
    return stringparser_parse_tree(parser);\r
  }\r
  if ( parser->token == PERCENT )\r
  {\r
    parser->token = stringscan_gettok(parser->lexer);\r
    stringparser_match(parser,INT);\r
    label = atoi(parser->lexer->text);\r
    parser->num_labels++;\r
    if ( label==0 ) sorcerer_panic("%%0 is an invalid label");\r
    parser->token = stringscan_gettok(parser->lexer);\r
    stringparser_match(parser,COLON);\r
    parser->token = stringscan_gettok(parser->lexer);\r
    /* can label tokens and wildcards */\r
    if ( parser->token != INT && parser->token != PERIOD )\r
      sorcerer_panic("can only label tokens");\r
  }\r
  if ( parser->token == INT )\r
  {\r
    ScanAST *p = new_scanast(atoi(parser->lexer->text));\r
    parser->token = stringscan_gettok(parser->lexer);\r
    p->label_num = label;\r
    return p;\r
  }\r
  if ( parser->token == PERIOD )\r
  {\r
    ScanAST *p = new_scanast(0);  /* token of 0 is wildcard */\r
    parser->token = stringscan_gettok(parser->lexer);\r
    p->label_num = label;\r
    return p;\r
  }\r
  sprintf(ebuf, "mismatch token in ast_scan(): %s", scan_token_str(parser->token));\r
  sorcerer_panic(ebuf);\r
    return NULL; /* MR20 make -Wall happy */\r
}\r
\r
static void\r
#ifdef __USE_PROTOS\r
stringparser_init(StringParser *parser, StringLexer *input)\r
#else\r
stringparser_init(parser, input)\r
StringParser *parser;\r
StringLexer *input;\r
#endif\r
{\r
  parser->lexer = input;\r
  parser->token = stringscan_gettok(parser->lexer);\r
  parser->num_labels = 0;\r
}\r
\r
static void\r
#ifdef __USE_PROTOS\r
stringlexer_init(StringLexer *scanner, char *input)\r
#else\r
stringlexer_init(scanner, input)\r
StringLexer *scanner;\r
char *input;\r
#endif\r
{\r
  scanner->text[0]='\0';\r
  scanner->input = input;\r
  scanner->p = input;\r
  stringscan_advance(scanner);\r
}\r
\r
static void\r
#ifdef __USE_PROTOS\r
stringscan_advance(StringLexer *scanner)\r
#else\r
stringscan_advance(scanner)\r
StringLexer *scanner;\r
#endif\r
{\r
  if ( *(scanner->p) == '\0' ) scanner->c = StringScanEOF;\r
  scanner->c = *(scanner->p)++;\r
}\r
\r
static int\r
#ifdef __USE_PROTOS\r
stringscan_gettok(StringLexer *scanner)\r
#else\r
stringscan_gettok(scanner)\r
StringLexer *scanner;\r
#endif\r
{\r
  char *index = &scanner->text[0];\r
  static char ebuf[100];\r
\r
  while ( isspace(scanner->c) ) { stringscan_advance(scanner); }\r
  if ( isdigit(scanner->c) )\r
  {\r
    int tok = INT;\r
    while ( isdigit(scanner->c) ) {\r
      *index++ = scanner->c;\r
      stringscan_advance(scanner);\r
    }\r
    *index = '\0';\r
    return tok;\r
  }\r
  switch ( scanner->c )\r
  {\r
    case '#' : stringscan_advance(scanner); return POUND;\r
    case '(' : stringscan_advance(scanner); return LPAREN;\r
    case ')' : stringscan_advance(scanner); return RPAREN;\r
    case '%' : stringscan_advance(scanner); return PERCENT;\r
    case ':' : stringscan_advance(scanner); return COLON;\r
    case '.' : stringscan_advance(scanner); return PERIOD;\r
    case '\0' : return StringScanEOF;\r
    case StringScanEOF : return StringScanEOF;\r
    default  :\r
      sprintf(ebuf, "invalid char in ast_scan: '%c'", scanner->c);\r
      sorcerer_panic(ebuf);\r
            return 0; /* MR20 Make -Wall happy */\r
  }\r
}\r