home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Icon 8.1 / msm-1 / icont.sit / llex.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-09-19  |  8.1 KB  |  381 lines  |  [TEXT/MPS ]
  1. /*
  2.  * llex.c -- lexical analysis routines.
  3.  */
  4.  
  5. #ifdef CRAY
  6. #include <stdlib.h>
  7. #endif                    /* CRAY */
  8.  
  9. #include "link.h"
  10. #include "tproto.h"
  11. #include "globals.h"
  12. #include "opcode.h"
  13.  
  14. int nlflag = 0;        /* newline last seen */
  15.  
  16. #if MACINTOSH
  17. #if MPW
  18. #include <CursorCtl.h>
  19. #define CURSORINTERVAL 100
  20. #endif                    /* MPW */
  21. #endif                    /* MACINTOSH */
  22.  
  23. #if !EBCDIC
  24. #define tonum(c)    (isdigit(c) ? (c - '0') : ((c & 037) + 9))
  25. #endif                    /* !EBCDIC */
  26.  
  27. #if !EBCDIC
  28. /*
  29.  * getopc - get an opcode from infile, return the opcode number (via
  30.  *  binary search of opcode table), and point id at the name of the opcode.
  31.  */
  32. int getopc(id)
  33. char **id;
  34.    {
  35.    register char *s;
  36.    register struct opentry *p;
  37.    register int test;
  38.    word indx;
  39.    int low, high, cmp;
  40.  
  41.    indx = getstr();
  42.    if (indx == -1)
  43.       return EOF;
  44.    s = &lsspace[indx];
  45.    low = 0;
  46.    high = NOPCODES;
  47.    do {
  48.       test = (low + high) / 2;
  49.       p = &optable[test];
  50.       if ((cmp = strcmp(p->op_name, s)) < 0)
  51.          low = test + 1;
  52.       else if (cmp > 0)
  53.          high = test;
  54.       else {
  55.          *id = p->op_name;
  56.          return (p->op_code);
  57.          }
  58.       } while (low < high);
  59.    *id = s;
  60.    return 0;
  61.    }
  62. #else                    /* !EBCDIC */
  63. /*
  64.  * getopc - get an opcode from infile, return the opcode number (via
  65.  * sequential search of opcode table) and point id at the name of the opcode.
  66.  */
  67.  
  68. int getopc(id)
  69. char **id;
  70.    {
  71.    register char *s;
  72.    register struct opentry *p;
  73.    register int test;
  74.  
  75.    indx = getstr();
  76.    if (indx == -1)
  77.       return EOF;
  78.    s = &lsspace[indx];
  79.    for(test=0;test < NOPCODES; test++) {
  80.        p = &optable[test];
  81.        if( strcmp(p->op_name, s) == 0) {
  82.            *id = p->op_name;
  83.            return (p->op_code);
  84.        }
  85.    }
  86.    *id = s;
  87.    return 0;
  88.    }
  89. #endif                    /* !EBCDIC */
  90.  
  91. /*
  92.  * getid - get an identifier from infile, put it in the identifier
  93.  *  table, and return a index to it.
  94.  */
  95. word getid()
  96.    {
  97.    word indx;
  98.  
  99.    indx = getstr();
  100.    if (indx == -1)
  101.       return EOF;
  102.    return putident((int)strlen(&lsspace[indx])+1);
  103.    }
  104.  
  105. /*
  106.  * getstr - get an identifier from infile and return an index to it.
  107.  */
  108. word getstr()
  109.    {
  110.    register int c;
  111.    register word indx;
  112.  
  113. #if MACINTOSH
  114. #if MPW
  115.    {
  116.    static short cursorcount = CURSORINTERVAL;
  117.    if (--cursorcount == 0) {
  118.       RotateCursor(-32);
  119.       cursorcount = CURSORINTERVAL;
  120.       }
  121.    }
  122. #endif                    /* MPW */
  123. #endif                    /* MACINTOSH */
  124.  
  125.    indx = lsfree;
  126.    while ((c = getc(infile)) == ' ' || c == '\t') ;
  127.    if (c == EOF)
  128.       return -1;
  129.  
  130. #if MSDOS && INTEL_386
  131.    /*
  132.     * Code Builder lets carriage returns through sometimes.
  133.     */
  134.    while (c != ' ' && c != '\t' && c != '\n' && c != '\r' && c != ',' &&
  135.       c != EOF) {
  136. #else                    /* MSDOS && INTEL_386 */
  137.    while (c != ' ' && c != '\t' && c != '\n' && c != ',' && c != EOF) {
  138. #endif                    /* MSDOS && INTEL_386 */
  139.  
  140.       if (indx >= stsize)
  141.          lsspace = (char *)trealloc(lsspace, NULL, &stsize, 1, 1,
  142.             "string space");
  143.       lsspace[indx++] = c;
  144.       c = getc(infile);
  145.       }
  146.    lsspace[indx] = '\0';
  147.    nlflag = (c == '\n');
  148.    return lsfree;
  149.    }
  150.  
  151. /*
  152.  * getrest - get the rest of the line from infile, put it in the identifier
  153.  *  table, and return its index in the string space.
  154.  */
  155. word getrest()
  156.    {
  157.    register int c;
  158.    register word indx;
  159.  
  160.    indx = lsfree;
  161.  
  162. #if MSDOS && INTEL_386
  163.    /*
  164.     * Code Builder lets carriage returns through on occasion
  165.     */
  166.    while ((c = getc(infile)) != '\n' && c != '\r' && c != EOF) {
  167. #else                    /* MSDOS && INTEL_386 */
  168.    while ((c = getc(infile)) != '\n' && c != EOF) {
  169. #endif                    /* MSDOS && INTEL_386 */
  170.  
  171.       if (indx >= stsize)
  172.          lsspace = (char *)trealloc(lsspace, NULL, &stsize, 1, 1,
  173.             "string space");
  174.       lsspace[indx++] = c;
  175.       }
  176.    lsspace[indx++] = '\0';
  177.    nlflag = (c == '\n');
  178.    return putident((int)(indx - lsfree));
  179.    }
  180.  
  181. /*
  182.  * getdec - get a decimal integer from infile, and return it.
  183.  */
  184. int getdec()
  185.    {
  186.    register int c, n;
  187.    int sign = 1, rv;
  188.  
  189.    n = 0;
  190.    while ((c = getc(infile)) == ' ' || c == '\t') ;
  191.    if (c == EOF)
  192.       return 0;
  193.    if (c == '-') {
  194.       sign = -1;
  195.       c = getc(infile);
  196.       }
  197.    while (c >= '0' && c <= '9') {
  198.       n = n * 10 + (c - '0');
  199.       c = getc(infile);
  200.       }
  201.    nlflag = (c == '\n');
  202.    rv = n * sign;
  203.    return rv;                    /* some compilers ... */
  204.    }
  205.  
  206. /*
  207.  * getoct - get an octal number from infile, and return it.
  208.  */
  209. int getoct()
  210.    {
  211.    register int c, n;
  212.  
  213.    n = 0;
  214.    while ((c = getc(infile)) == ' ' || c == '\t') ;
  215.    if (c == EOF)
  216.       return 0;
  217.    while (c >= '0' && c <= '7') {
  218.       n = (n << 3) | (c - '0');
  219.       c = getc(infile);
  220.       }
  221.    nlflag = (c == '\n');
  222.    return n;
  223.    }
  224.  
  225. /*
  226.  *  Get integer, but if it's too large for a long, put the string via wp
  227.  *   and return -1.
  228.  */
  229. long getint(j,wp)
  230.    int j;
  231.    word *wp;
  232.    {
  233.    register int c;
  234.    int over = 0;
  235.    register word indx;
  236.    double result = 0;
  237.    long lresult = 0;
  238.    double radix;
  239.  
  240.    ++j;   /* incase we need to add a '\0' and make it into a string */
  241.    if (lsfree + j >= stsize)
  242.       lsspace = (char *)trealloc(lsspace, NULL, &stsize, 1, j, "string space");
  243.    indx = lsfree;
  244.    
  245.    while ((c = getc(infile)) >= '0' && c <= '9') {
  246.       lsspace[indx++] = c;
  247.       result = result * 10 + (c - '0');
  248.       lresult = lresult * 10 + (c - '0');
  249.       if (result <= MinLong || result >= MaxLong) {
  250.          over = 1;            /* flag overflow */
  251.          result = 0;            /* reset to avoid fp exception */
  252.          }
  253.       }
  254.    if (c == 'r' || c == 'R') {
  255.       lsspace[indx++] = c;
  256.       radix = result;
  257.       lresult = 0;
  258.       result = 0;
  259.       while (c = getc(infile)) {
  260.          lsspace[indx++] = c;
  261.          if (isdigit(c) || isalpha(c))
  262.             c = tonum(c);
  263.          else
  264.             break;
  265.          result = result * radix + c;
  266.          lresult = lresult * radix + c;
  267.          if (result <= MinLong || result >= MaxLong) {
  268.             over = 1;            /* flag overflow */
  269.             result = 0;            /* reset to avoid fp exception */
  270.             }
  271.          }
  272.       }
  273.    nlflag = (c == '\n');
  274.    if (!over)
  275.       return lresult;            /* integer is small enough */
  276.    else {                /* integer is too large */
  277.       lsspace[indx++] = '\0';
  278.       *wp = putident((int)(indx - lsfree));/* convert integer to string */
  279.       return -1;            /* indicate integer is too big */
  280.       }
  281.    }
  282.  
  283. /*
  284.  * getreal - get an Icon real number from infile, and return it.
  285.  */
  286. double getreal()
  287.    {
  288.    double n;
  289.    register int c, d, e;
  290.    int esign;
  291.    register char *s, *ep;
  292.    char cbuf[128];
  293.  
  294.    s = cbuf;
  295.    d = 0;
  296.    while ((c = getc(infile)) == '0')
  297.       ;
  298.    while (c >= '0' && c <= '9') {
  299.       *s++ = c;
  300.       d++;
  301.       c = getc(infile);
  302.       }
  303.    if (c == '.') {
  304.       if (s == cbuf)
  305.          *s++ = '0';
  306.       *s++ = c;
  307.       while ((c = getc(infile)) >= '0' && c <= '9')
  308.          *s++ = c;
  309.       }
  310.    ep = s;
  311.    if (c == 'e' || c == 'E') {
  312.       *s++ = c;
  313.       if ((c = getc(infile)) == '+' || c == '-') {
  314.          esign = (c == '-');
  315.          *s++ = c;
  316.          c = getc(infile);
  317.          }
  318.       e = 0;
  319.       while (c >= '0' && c <= '9') {
  320.          e = e * 10 + c - '0';
  321.          *s++ = c;
  322.          c = getc(infile);
  323.          }
  324.       if (esign) e = -e;
  325.       e += d - 1;
  326.       if (abs(e) >= LogHuge)
  327.          *ep = '\0';
  328.       }
  329.    *s = '\0';
  330.    n = atof(cbuf);
  331.    nlflag = (c == '\n');
  332.    return n;
  333.    }
  334.  
  335. /*
  336.  * getlab - get a label ("L" followed by a number) from infile,
  337.  *  and return the number.
  338.  */
  339.  
  340. int getlab()
  341.    {
  342.    register int c;
  343.  
  344.    while ((c = getc(infile)) != 'L' && c != EOF && c != '\n') ;
  345.    if (c == 'L')
  346.       return getdec();
  347.    nlflag = (c == '\n');
  348.    return 0;
  349.    }
  350.  
  351. /*
  352.  * getstrlit - get a string literal from infile, as a string
  353.  *  of octal bytes, and return its index into the string table.
  354.  */
  355. word getstrlit(l)
  356. register int l;
  357.    {
  358.    register word indx;
  359.  
  360.    if (lsfree + l >= stsize)
  361.       lsspace = (char *)trealloc(lsspace, NULL, &stsize, 1, l, "string space");
  362.    indx = lsfree;
  363.    while (!nlflag && l--)
  364.       lsspace[indx++] = getoct();
  365.    lsspace[indx++] = '\0';
  366.    return putident((int)(indx-lsfree));
  367.    }
  368.  
  369. /*
  370.  * newline - skip to next line.
  371.  */
  372. novalue newline()
  373.    {
  374.    register int c;
  375.  
  376.    if (!nlflag) {
  377.       while ((c = getc(infile)) != '\n' && c != EOF) ;
  378.       }
  379.    nlflag = 0;
  380.    }
  381.