开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > 编译器/解释器 > 查看源码
lex.c.2
资源名称：pascal2c.tar.Z　[点击查看]
上传用户：upcnvip
上传日期：2007-01-06
资源大小：474k
文件大小：36k
源码类别：

编译器/解释器

开发平台：

C/C++

lex.c.2：源码内容
  1.                         if (cp != closing)
  2.                             return 0;
  3.                         strlist_remove((Strlist **)rctable[i].ptr, namebuf);
  4.                     } else {
  5.                         if (!isspace(*cp) && *cp != '=')
  6.                             return 0;
  7.                         skipspc(cp);
  8.                         if (*cp == '=') {
  9.                             cp++;
  10.                             skipspc(cp);
  11.                         }
  12.                         if (chgmode == '=' || isspace(chgmode))
  13.                             strlist_remove((Strlist **)rctable[i].ptr, namebuf);
  14.                         sp = strlist_append((Strlist **)rctable[i].ptr, namebuf);
  15.                         if (tempopt)
  16.                             strlist_insert(&tempoptionlist, namebuf)->value = i;
  17.                         cp2 = namebuf;
  18.                         while (*cp && cp != closing && !isspace(*cp))
  19.                             *cp2++ = *cp++;
  20.                         *cp2++ = 0;
  21.                         skipspc(cp);
  22.                         if (cp != closing)
  23.                             return 0;
  24.                         sp->value = (long)stralloc(namebuf);
  25.                     }
  26.                     inbufptr = after;
  27.                     if (lex_initialized)
  28.                         handle_nameof();        /* as good a place to do this as any! */
  29.                     return 1;
  31.                 case 3:     /* Synonym parameter */
  32.     if (isspace(*cp) || *cp == '=' ||
  33. *cp == '+' || *cp == '-') {
  34. chgmode = *cp++;
  35. skipspc(cp);
  36. cp2 = namebuf;
  37. while (isalnum(*cp) || *cp == '_' ||
  38.        *cp == '$' || *cp == '%')
  39.     *cp2++ = *cp++;
  40. *cp2++ = 0;
  41. if (!*namebuf)
  42.     return 0;
  43. skipspc(cp);
  44. if (!pascalcasesens)
  45.     upc(namebuf);
  46. sym = findsymbol(namebuf);
  47. if (chgmode == '-') {
  48.     if (cp != closing)
  49. return 0;
  50.     sym->flags &= ~SSYNONYM;
  51.     inbufptr = after;
  52.     return 1;
  53. }
  54. if (*cp == '=') {
  55.     cp++;
  56.     skipspc(cp);
  57. }
  58. cp2 = namebuf;
  59. while (isalnum(*cp) || *cp == '_' ||
  60.        *cp == '$' || *cp == '%')
  61.     *cp2++ = *cp++;
  62. *cp2++ = 0;
  63. skipspc(cp);
  64. if (cp != closing)
  65.     return 0;
  66. sym->flags |= SSYNONYM;
  67. if (!pascalcasesens)
  68.     upc(namebuf);
  69. if (*namebuf)
  70.     strlist_append(&sym->symbolnames, "===")->value =
  71. (long)findsymbol(namebuf);
  72. else
  73.     strlist_append(&sym->symbolnames, "===")->value=0;
  74. inbufptr = after;
  75. return 1;
  76.     }
  77.     return 0;
  79.             }
  80.             return 0;
  82.     }
  83.     return 0;
  84. }
  88. Static void comment(starparen)
  89. int starparen;    /* 0={ }, 1=(* *), 2=C comments*/
  90. {
  91.     register char ch;
  92.     int nestcount = 1, startlnum = inf_lnum, trailing;
  93.     int i, cmtindent, cmtindent2;
  94.     char *cp;
  96.     cp = inbuf;
  97.     while (isspace(*cp))
  98. cp++;
  99.     trailing = (*cp != '{' && ((*cp != '(' && *cp != '/') || cp[1] != '*'));
  100.     cmtindent = inbufindent;
  101.     cmtindent2 = cmtindent + 1 + (starparen != 0);
  102.     cp = inbufptr;
  103.     while (isspace(*cp))
  104. cmtindent2++, cp++;
  105.     cp = curtokbuf;
  106.     for (;;) {
  107.         ch = *inbufptr++;
  108.         switch (ch) {
  110.             case '}':
  111.                 if ((!starparen || nestedcomments == 0) &&
  112.     starparen != 2 &&
  113.                     --nestcount <= 0) {
  114.                     *cp = 0;
  115.     if (!commenting_flag)
  116. commentline(trailing ? CMT_TRAIL : CMT_POST);
  117.                     return;
  118.                 }
  119.                 break;
  121.             case '{':
  122.                 if (nestedcomments == 1 && starparen != 2)
  123.                     nestcount++;
  124.                 break;
  126.             case '*':
  127.                 if ((*inbufptr == ((starparen == 2) ? '/' : ')') &&
  128.      (starparen || nestedcomments == 0)) &&
  129.                     --nestcount <= 0) {
  130.                     inbufptr++;
  131.                     *cp = 0;
  132.     if (!commenting_flag)
  133. commentline(trailing ? CMT_TRAIL : CMT_POST);
  134.                     return;
  135.                 }
  136.                 break;
  138.             case '(':
  139.                 if (*inbufptr == '*' && nestedcomments == 1 &&
  140.     starparen != 2) {
  141.     *cp++ = ch;
  142.     ch = *inbufptr++;
  143.                     nestcount++;
  144. }
  145.                 break;
  147.             case 0:
  148.                 *cp = 0;
  149.         if (commenting_flag)
  150.     saveinputcomment(inbufptr-1);
  151. else
  152.     commentline(CMT_POST);
  153. trailing = 0;
  154.                 getline();
  155. i = 0;
  156. for (;;) {
  157.     if (*inbufptr == ' ') {
  158. inbufptr++;
  159. i++;
  160.     } else if (*inbufptr == 't') {
  161. inbufptr++;
  162. i++;
  163. if (intabsize)
  164.     i = (i / intabsize + 1) * intabsize;
  165.     } else
  166. break;
  167. }
  168. cp = curtokbuf;
  169. if (*inbufptr) {
  170.     if (i == cmtindent2 && !starparen)
  171. cmtindent--;
  172.     cmtindent2 = -1;
  173.     if (i >= cmtindent) {
  174. *cp++ = '02';
  175. i -= cmtindent;
  176.     } else {
  177. *cp++ = '03';
  178.     }
  179.     while (--i >= 0)
  180. *cp++ = ' ';
  181. } else
  182.     *cp++ = '03';
  183.                 continue;
  185.             case EOFMARK:
  186.                 error(format_d("Runaway comment from line %d", startlnum));
  187.                 return;     /* unnecessary */
  189.         }
  190.         *cp++ = ch;
  191.     }
  192. }
  196. char *getinlinepart()
  197. {
  198.     char *cp, *buf;
  200.     for (;;) {
  201.         if (isspace(*inbufptr)) {
  202.             inbufptr++;
  203.         } else if (!*inbufptr) {
  204.             getline();
  205.         } else if (*inbufptr == '{') {
  206.             inbufptr++;
  207.             comment(0);
  208.         } else if (*inbufptr == '(' && inbufptr[1] == '*') {
  209.             inbufptr += 2;
  210.             comment(1);
  211.         } else
  212.             break;
  213.     }
  214.     cp = inbufptr;
  215.     while (isspace(*cp) || isalnum(*cp) ||
  216.            *cp == '_' || *cp == '$' || 
  217.            *cp == '+' || *cp == '-' ||
  218.            *cp == '<' || *cp == '>')
  219.         cp++;
  220.     if (cp == inbufptr)
  221.         return "";
  222.     while (isspace(cp[-1]))
  223.         cp--;
  224.     buf = format_s("%s", inbufptr);
  225.     buf[cp-inbufptr] = 0;     /* truncate the string */
  226.     inbufptr = cp;
  227.     return buf;
  228. }
  233. Static int getflag()
  234. {
  235.     int res = 1;
  237.     gettok();
  238.     if (curtok == TOK_IDENT) {
  239.         res = (strcmp(curtokbuf, "OFF") != 0);
  240.         gettok();
  241.     }
  242.     return res;
  243. }
  248. char getchartok()
  249. {
  250.     if (!*inbufptr) {
  251.         warning("Unexpected end of line [236]");
  252.         return ' ';
  253.     }
  254.     if (isspace(*inbufptr)) {
  255.         warning("Whitespace not allowed here [237]");
  256.         return ' ';
  257.     }
  258.     return *inbufptr++;
  259. }
  263. char *getparenstr(buf)
  264. char *buf;
  265. {
  266.     int count = 0;
  267.     char *cp;
  269.     if (inbufptr < buf)    /* this will get most bad cases */
  270.         error("Can't handle a line break here");
  271.     while (isspace(*buf))
  272.         buf++;
  273.     cp = buf;
  274.     for (;;) {
  275.         if (!*cp)
  276.             error("Can't handle a line break here");
  277.         if (*cp == '(')
  278.             count++;
  279.         if (*cp == ')')
  280.             if (--count < 0)
  281.                 break;
  282.         cp++;
  283.     }
  284.     inbufptr = cp + 1;
  285.     while (cp > buf && isspace(cp[-1]))
  286.         cp--;
  287.     return format_ds("%.*s", (int)(cp - buf), buf);
  288. }
  292. void leadingcomments()
  293. {
  294.     for (;;) {
  295.         switch (*inbufptr++) {
  297.             case 0:
  298.                 getline();
  299.                 break;
  301.             case ' ':
  302.             case 't':
  303.             case 26:
  304.                 /* ignore whitespace */
  305.                 break;
  307.             case '{':
  308.                 if (!parsecomment(1, 0)) {
  309.                     inbufptr--;
  310.                     return;
  311.                 }
  312.                 break;
  314.     case '(':
  315. if (*inbufptr == '*') {
  316.     inbufptr++;
  317.     if (!parsecomment(1, 1)) {
  318. inbufptr -= 2;
  319. return;
  320.     }
  321.     break;
  322. }
  323. /* fall through */
  325.             default:
  326.                 inbufptr--;
  327.                 return;
  329.         }
  330.     }
  331. }
  336. void get_C_string(term)
  337. int term;
  338. {
  339.     char *cp = curtokbuf;
  340.     char ch;
  341.     int i;
  343.     while ((ch = *inbufptr++)) {
  344.         if (ch == term) {
  345.             *cp = 0;
  346.             curtokint = cp - curtokbuf;
  347.             return;
  348.         } else if (ch == '\') {
  349.             if (isdigit(*inbufptr)) {
  350.                 i = (*inbufptr++) - '0';
  351.                 if (isdigit(*inbufptr))
  352.                     i = i*8 + (*inbufptr++) - '0';
  353.                 if (isdigit(*inbufptr))
  354.                     i = i*8 + (*inbufptr++) - '0';
  355.                 *cp++ = i;
  356.             } else {
  357.                 ch = *inbufptr++;
  358.                 switch (tolower(ch)) {
  359.                     case 'n':
  360.                         *cp++ = 'n';
  361.                         break;
  362.                     case 't':
  363.                         *cp++ = 't';
  364.                         break;
  365.                     case 'v':
  366.                         *cp++ = 'v';
  367.                         break;
  368.                     case 'b':
  369.                         *cp++ = 'b';
  370.                         break;
  371.                     case 'r':
  372.                         *cp++ = 'r';
  373.                         break;
  374.                     case 'f':
  375.                         *cp++ = 'f';
  376.                         break;
  377.                     case '\':
  378.                         *cp++ = '\';
  379.                         break;
  380.                     case ''':
  381.                         *cp++ = ''';
  382.                         break;
  383.                     case '"':
  384.                         *cp++ = '"';
  385.                         break;
  386.                     case 'x':
  387.                         if (isxdigit(*inbufptr)) {
  388.                             if (isdigit(*inbufptr))
  389.                                 i = (*inbufptr++) - '0';
  390.                             else
  391.                                 i = (toupper(*inbufptr++)) - 'A' + 10;
  392.                             if (isdigit(*inbufptr))
  393.                                 i = i*16 + (*inbufptr++) - '0';
  394.                             else if (isxdigit(*inbufptr))
  395.                                 i = i*16 + (toupper(*inbufptr++)) - 'A' + 10;
  396.                             *cp++ = i;
  397.                             break;
  398.                         }
  399.                         /* fall through */
  400.                     default:
  401.                         warning("Strange character in C string [238]");
  402.                 }
  403.             }
  404.         } else
  405.             *cp++ = ch;
  406.     }
  407.     *cp = 0;
  408.     curtokint = cp - curtokbuf;
  409.     warning("Unterminated C string [239]");
  410. }
  416. void begincommenting(cp)
  417. char *cp;
  418. {
  419.     if (!commenting_flag) {
  420. commenting_ptr = cp;
  421.     }
  422.     commenting_flag++;
  423. }
  426. void saveinputcomment(cp)
  427. char *cp;
  428. {
  429.     if (commenting_ptr)
  430. sprintf(curtokbuf, "%.*s", (int)(cp - commenting_ptr), commenting_ptr);
  431.     else
  432. sprintf(curtokbuf, "03%.*s", (int)(cp - inbuf), inbuf);
  433.     commentline(CMT_POST);
  434.     commenting_ptr = NULL;
  435. }
  438. void endcommenting(cp)
  439. char *cp;
  440. {
  441.     commenting_flag--;
  442.     if (!commenting_flag) {
  443. saveinputcomment(cp);
  444.     }
  445. }
  450. int peeknextchar()
  451. {
  452.     char *cp;
  454.     cp = inbufptr;
  455.     while (isspace(*cp))
  456. cp++;
  457.     return *cp;
  458. }
  463. #ifdef LEXDEBUG
  464. Static void zgettok();
  465. void gettok()
  466. {
  467.     zgettok();
  468.     if (tokentrace) {
  469.         printf("gettok() found %s", tok_name(curtok));
  470.         switch (curtok) {
  471.             case TOK_HEXLIT:
  472.             case TOK_OCTLIT:
  473.             case TOK_INTLIT:
  474.             case TOK_MININT:
  475.                 printf(", curtokint = %d", curtokint);
  476.                 break;
  477.             case TOK_REALLIT:
  478.             case TOK_STRLIT:
  479.                 printf(", curtokbuf = %s", makeCstring(curtokbuf, curtokint));
  480.                 break;
  481.     default:
  482. break;
  483.         }
  484.         putchar('n');
  485.     }
  486. }
  487. Static void zgettok()
  488. #else
  489. void gettok()
  490. #endif
  491. {
  492.     register char ch;
  493.     register char *cp;
  494.     char ch2;
  495.     char *startcp;
  496.     int i;
  498.     debughook();
  499.     for (;;) {
  500.         switch ((ch = *inbufptr++)) {
  502.             case 0:
  503.         if (commenting_flag)
  504.     saveinputcomment(inbufptr-1);
  505.                 getline();
  506. cp = curtokbuf;
  507. for (;;) {
  508.     inbufindent = 0;
  509.     for (;;) {
  510. if (*inbufptr == 't') {
  511.     inbufindent++;
  512.     if (intabsize)
  513. inbufindent = (inbufindent / intabsize + 1) * intabsize;
  514. } else if (*inbufptr == ' ')
  515.     inbufindent++;
  516. else if (*inbufptr != 26)
  517.     break;
  518. inbufptr++;
  519.     }
  520.     if (!*inbufptr && !commenting_flag) {   /* blank line */
  521. *cp++ = '01';
  522. getline();
  523.     } else
  524. break;
  525. }
  526. if (cp > curtokbuf) {
  527.     *cp = 0;
  528.     commentline(CMT_POST);
  529. }
  530.                 break;
  532.             case 't':
  533.             case ' ':
  534.             case 26:    /* ignore ^Z's in Turbo files */
  535.                 while (*inbufptr++ == ch) ;
  536.                 inbufptr--;
  537.                 break;
  539.             case '$':
  540. if (dollar_idents)
  541.     goto ident;
  542.                 if (dollar_flag) {
  543.                     dollar_flag = 0;
  544.                     curtok = TOK_DOLLAR;
  545.                     return;
  546. }
  547. startcp = inbufptr-1;
  548. while (isspace(*inbufptr))
  549.     inbufptr++;
  550. cp = inbufptr;
  551. while (isxdigit(*cp))
  552.     cp++;
  553. if (cp > inbufptr && cp <= inbufptr+8 && !isalnum(*cp)) {
  554.     while (isspace(*cp))
  555. cp++;
  556.     if (!isdigit(*cp) && *cp != ''') {
  557. cp = curtokbuf;    /* Turbo hex constant */
  558. while (isxdigit(*inbufptr))
  559.     *cp++ = *inbufptr++;
  560. *cp = 0;
  561. curtok = TOK_HEXLIT;
  562. curtokint = my_strtol(curtokbuf, NULL, 16);
  563. return;
  564.     }
  565.                 }
  566. dollar_flag++;     /* HP Pascal compiler directive */
  567. do {
  568.     gettok();
  569.     if (curtok == TOK_IF) {             /* $IF expr$ */
  570. Expr *ex;
  571. Value val;
  572. if (!skipping_module) {
  573.     if (!setup_complete)
  574. error("$IF$ not allowed at top of program");
  576.     /* Even though HP Pascal doesn't let these nest,
  577.        there's no harm in supporting it. */
  578.     if (if_flag) {
  579. skiptotoken(TOK_DOLLAR);
  580. if_flag++;
  581. break;
  582.     }
  583.     gettok();
  584.     ex = p_expr(tp_boolean);
  585.     val = eval_expr_consts(ex);
  586.     freeexpr(ex);
  587.     i = (val.type == tp_boolean && val.i);
  588.     free_value(&val);
  589.     if (!i) {
  590. if (curtok != TOK_DOLLAR) {
  591.     warning("Syntax error in $IF$ expression [240]");
  592.     skiptotoken(TOK_DOLLAR);
  593. }
  594. begincommenting(startcp);
  595. if_flag++;
  596. while (if_flag > 0)
  597.     gettok();
  598. endcommenting(inbufptr);
  599.     }
  600. } else {
  601.     skiptotoken(TOK_DOLLAR);
  602. }
  603.     } else if (curtok == TOK_END) {     /* $END$ */
  604. if (if_flag) {
  605.     gettok();
  606.     if (!wexpecttok(TOK_DOLLAR))
  607. skiptotoken(TOK_DOLLAR);
  608.     curtok = TOK_ENDIF;
  609.     if_flag--;
  610.     return;
  611. } else {
  612.     gettok();
  613.     if (!wexpecttok(TOK_DOLLAR))
  614. skiptotoken(TOK_DOLLAR);
  615. }
  616.     } else if (curtok == TOK_IDENT) {
  617. if (!strcmp(curtokbuf, "INCLUDE") &&
  618.      !if_flag && !skipping_module) {
  619.     char *fn;
  620.     gettok();
  621.     if (curtok == TOK_IDENT) {
  622. fn = stralloc(curtokcase);
  623. gettok();
  624.     } else if (wexpecttok(TOK_STRLIT)) {
  625. fn = stralloc(curtokbuf);
  626. gettok();
  627.     } else
  628. fn = "";
  629.     if (!wexpecttok(TOK_DOLLAR)) {
  630. skiptotoken(TOK_DOLLAR);
  631.     } else {
  632. if (handle_include(fn))
  633.     return;
  634.     }
  635. } else if (ignore_directives ||
  636.    if_flag ||
  637.    !strcmp(curtokbuf, "SEARCH") ||
  638.    !strcmp(curtokbuf, "REF") ||
  639.    !strcmp(curtokbuf, "DEF")) {
  640.     skiptotoken(TOK_DOLLAR);
  641. } else if (!strcmp(curtokbuf, "SWITCH_STRPOS")) {
  642.     switch_strpos = getflag();
  643. } else if (!strcmp(curtokbuf, "SYSPROG")) {
  644.     if (getflag())
  645. sysprog_flag |= 1;
  646.     else
  647. sysprog_flag &= ~1;
  648. } else if (!strcmp(curtokbuf, "MODCAL")) {
  649.     if (getflag())
  650. sysprog_flag |= 2;
  651.     else
  652. sysprog_flag &= ~2;
  653. } else if (!strcmp(curtokbuf, "PARTIAL_EVAL")) {
  654.     if (shortcircuit < 0)
  655. partial_eval_flag = getflag();
  656. } else if (!strcmp(curtokbuf, "IOCHECK")) {
  657.     iocheck_flag = getflag();
  658. } else if (!strcmp(curtokbuf, "RANGE")) {
  659.     if (getflag()) {
  660. if (!range_flag)
  661.     note("Range checking is ON [216]");
  662. range_flag = 1;
  663.     } else {
  664. if (range_flag)
  665.     note("Range checking is OFF [216]");
  666. range_flag = 0;
  667.     }
  668. } else if (!strcmp(curtokbuf, "OVFLCHECK")) {
  669.     if (getflag()) {
  670. if (!ovflcheck_flag)
  671.     note("Overflow checking is ON [219]");
  672. ovflcheck_flag = 1;
  673.     } else {
  674. if (ovflcheck_flag)
  675.     note("Overflow checking is OFF [219]");
  676. ovflcheck_flag = 0;
  677.     }
  678. } else if (!strcmp(curtokbuf, "STACKCHECK")) {
  679.     if (getflag()) {
  680. if (!stackcheck_flag)
  681.     note("Stack checking is ON [217]");
  682. stackcheck_flag = 1;
  683.     } else {
  684. if (stackcheck_flag)
  685.     note("Stack checking is OFF [217]");
  686. stackcheck_flag = 0;
  687.     }
  688. }
  689. skiptotoken2(TOK_DOLLAR, TOK_COMMA);
  690.     } else {
  691. warning("Mismatched '$' signs [241]");
  692. dollar_flag = 0;    /* got out of sync */
  693. return;
  694.     }
  695. } while (curtok == TOK_COMMA);
  696.                 break;
  698.             case '"':
  699. if (C_lex) {
  700.     get_C_string(ch);
  701.     curtok = TOK_STRLIT;
  702.     return;
  703. }
  704. goto stringLiteral;
  706.             case '#':
  707. if (modula2) {
  708.     curtok = TOK_NE;
  709.     return;
  710. }
  711. cp = inbufptr;
  712. while (isspace(*cp)) cp++;
  713. if (!strcincmp(cp, "INCLUDE", 7)) {
  714.     char *cp2, *cp3;
  715.     cp += 7;
  716.     while (isspace(*cp)) cp++;
  717.     cp2 = cp + strlen(cp) - 1;
  718.     while (isspace(*cp2)) cp2--;
  719.     if ((*cp == '"' && *cp2 == '"' && cp2 > cp) ||
  720. (*cp == '<' && *cp2 == '>')) {
  721. inbufptr = cp2 + 1;
  722. cp3 = stralloc(cp + 1);
  723. cp3[cp2 - cp - 1] = 0;
  724. if (handle_include(cp3))
  725.     return;
  726. else
  727.     break;
  728.     }
  729. }
  730. /* fall through */
  732.             case ''':
  733.                 if (C_lex && ch == ''') {
  734.                     get_C_string(ch);
  735.                     if (curtokint != 1)
  736.                         warning("Character constant has length != 1 [242]");
  737.                     curtokint = *curtokbuf;
  738.                     curtok = TOK_CHARLIT;
  739.                     return;
  740.                 }
  741.       stringLiteral:
  742.                 cp = curtokbuf;
  743. ch2 = (ch == '"') ? '"' : ''';
  744.                 do {
  745.                     if (ch == ch2) {
  746.                         while ((ch = *inbufptr++) != 'n' &&
  747.                                ch != EOF) {
  748.                             if (ch == ch2) {
  749.                                 if (*inbufptr != ch2 || modula2)
  750.                                     break;
  751.                                 else
  752.                                     inbufptr++;
  753.                             }
  754.                             *cp++ = ch;
  755.                         }
  756.                         if (ch != ch2)
  757.                             warning("Error in string literal [243]");
  758.                     } else {
  759.                         ch = *inbufptr++;
  760.                         if (isdigit(ch)) {
  761.                             i = 0;
  762.                             while (isdigit(ch)) {
  763.                                 i = i*10 + ch - '0';
  764.                                 ch = *inbufptr++;
  765.                             }
  766.                             inbufptr--;
  767.                             *cp++ = i;
  768.                         } else {
  769.                             *cp++ = ch & 0x1f;
  770.                         }
  771.                     }
  772.                     while (*inbufptr == ' ' || *inbufptr == 't')
  773.                         inbufptr++;
  774.                 } while ((ch = *inbufptr++) == ch2 || ch == '#');
  775.                 inbufptr--;
  776.                 *cp = 0;
  777.                 curtokint = cp - curtokbuf;
  778.                 curtok = TOK_STRLIT;
  779.                 return;
  781.             case '(':
  782.                 if (*inbufptr == '*' && !C_lex) {
  783.                     inbufptr++;
  784.     switch (commenting_flag ? 0 : parsecomment(0, 1)) {
  785.         case 0:
  786.                             comment(1);
  787.     break;
  788.         case 2:
  789.     return;
  790.     }
  791.                     break;
  792.                 } else if (*inbufptr == '.') {
  793.                     curtok = TOK_LBR;
  794.                     inbufptr++;
  795.                 } else {
  796.                     curtok = TOK_LPAR;
  797.                 }
  798.                 return;
  800.             case '{':
  801.                 if (C_lex || modula2) {
  802.                     curtok = TOK_LBRACE;
  803.                     return;
  804.                 }
  805.                 switch (commenting_flag ? 0 : parsecomment(0, 0)) {
  806.                     case 0:
  807.                         comment(0);
  808.                         break;
  809.                     case 2:
  810.                         return;
  811.                 }
  812.                 break;
  814.             case '}':
  815.                 if (C_lex || modula2) {
  816.                     curtok = TOK_RBRACE;
  817.                     return;
  818.                 }
  819. if (skipflag > 0) {
  820.     skipflag = 0;
  821. } else
  822.     warning("Unmatched '}' in input file [244]");
  823.                 break;
  825.             case ')':
  826.                 curtok = TOK_RPAR;
  827.                 return;
  829.             case '*':
  830. if (*inbufptr == (C_lex ? '/' : ')')) {
  831.     inbufptr++;
  832.     if (skipflag > 0) {
  833. skipflag = 0;
  834.     } else
  835. warning("Unmatched '*)' in input file [245]");
  836.     break;
  837. } else if (*inbufptr == '*' && !C_lex) {
  838.     curtok = TOK_STARSTAR;
  839.     inbufptr++;
  840. } else
  841.     curtok = TOK_STAR;
  842.                 return;
  844.             case '+':
  845.                 if (C_lex && *inbufptr == '+') {
  846.                     curtok = TOK_PLPL;
  847.                     inbufptr++;
  848.                 } else
  849.                     curtok = TOK_PLUS;
  850.                 return;
  852.             case ',':
  853.                 curtok = TOK_COMMA;
  854.                 return;
  856.             case '-':
  857.                 if (C_lex && *inbufptr == '-') {
  858.                     curtok = TOK_MIMI;
  859.                     inbufptr++;
  860.                 } else if (*inbufptr == '>') {
  861.                     curtok = TOK_ARROW;
  862.                     inbufptr++;
  863.                 } else
  864.                     curtok = TOK_MINUS;
  865.                 return;
  867.             case '.':
  868.                 if (*inbufptr == '.') {
  869.                     curtok = TOK_DOTS;
  870.                     inbufptr++;
  871.                 } else if (*inbufptr == ')') {
  872.                     curtok = TOK_RBR;
  873.                     inbufptr++;
  874.                 } else
  875.                     curtok = TOK_DOT;
  876.                 return;
  878.             case '/':
  879. if (C_lex && *inbufptr == '*') {
  880.     inbufptr++;
  881.     comment(2);
  882.     break;
  883. }
  884.                 curtok = TOK_SLASH;
  885.                 return;
  887.             case ':':
  888.                 if (*inbufptr == '=') {
  889.                     curtok = TOK_ASSIGN;
  890.                     inbufptr++;
  891. } else if (*inbufptr == ':') {
  892.                     curtok = TOK_COLONCOLON;
  893.                     inbufptr++;
  894.                 } else
  895.                     curtok = TOK_COLON;
  896.                 return;
  898.             case ';':
  899.                 curtok = TOK_SEMI;
  900.                 return;
  902.             case '<':
  903.                 if (*inbufptr == '=') {
  904.                     curtok = TOK_LE;
  905.                     inbufptr++;
  906.                 } else if (*inbufptr == '>') {
  907.                     curtok = TOK_NE;
  908.                     inbufptr++;
  909.                 } else if (*inbufptr == '<') {
  910.                     curtok = TOK_LTLT;
  911.                     inbufptr++;
  912.                 } else
  913.                     curtok = TOK_LT;
  914.                 return;
  916.             case '>':
  917.                 if (*inbufptr == '=') {
  918.                     curtok = TOK_GE;
  919.                     inbufptr++;
  920.                 } else if (*inbufptr == '>') {
  921.                     curtok = TOK_GTGT;
  922.                     inbufptr++;
  923.                 } else
  924.                     curtok = TOK_GT;
  925.                 return;
  927.             case '=':
  928. if (*inbufptr == '=') {
  929.     curtok = TOK_EQEQ;
  930.     inbufptr++;
  931. } else
  932.     curtok = TOK_EQ;
  933.                 return;
  935.             case '[':
  936.                 curtok = TOK_LBR;
  937.                 return;
  939.             case ']':
  940.                 curtok = TOK_RBR;
  941.                 return;
  943.             case '^':
  944.                 curtok = TOK_HAT;
  945.                 return;
  947.             case '&':
  948.                 if (*inbufptr == '&') {
  949.                     curtok = TOK_ANDAND;
  950.                     inbufptr++;
  951.                 } else
  952.                     curtok = TOK_AMP;
  953.                 return;
  955.             case '|':
  956.                 if (*inbufptr == '|') {
  957.                     curtok = TOK_OROR;
  958.                     inbufptr++;
  959.                 } else
  960.                     curtok = TOK_VBAR;
  961.                 return;
  963.             case '~':
  964.                 curtok = TOK_TWIDDLE;
  965.                 return;
  967.             case '!':
  968.                 if (*inbufptr == '=') {
  969.                     curtok = TOK_BANGEQ;
  970.                     inbufptr++;
  971.                 } else
  972.                     curtok = TOK_BANG;
  973.                 return;
  975.             case '%':
  976. if (C_lex) {
  977.     curtok = TOK_PERC;
  978.     return;
  979. }
  980. goto ident;
  982.             case '?':
  983.                 curtok = TOK_QM;
  984.                 return;
  986.             case '@':
  987. curtok = TOK_ADDR;
  988.                 return;
  990.             case EOFMARK:
  991.                 if (curtok == TOK_EOF) {
  992.                     if (inputkind == INP_STRLIST)
  993.                         error("Unexpected end of macro");
  994.                     else
  995.                         error("Unexpected end of file");
  996.                 }
  997.                 curtok = TOK_EOF;
  998.                 return;
  1000.             default:
  1001.                 if (isdigit(ch)) {
  1002.     cp = inbufptr;
  1003.     while (isxdigit(*cp))
  1004. cp++;
  1005.     if (*cp == '#' && isxdigit(cp[1])) {
  1006. i = atoi(inbufptr-1);
  1007. inbufptr = cp+1;
  1008.     } else if (toupper(cp[-1]) == 'B' ||
  1009.        toupper(cp[-1]) == 'C') {
  1010.                         inbufptr--;
  1011. i = 8;
  1012.     } else if (toupper(*cp) == 'H') {
  1013.                         inbufptr--;
  1014. i = 16;
  1015.     } else if ((ch == '0' && toupper(*inbufptr) == 'X' &&
  1016. isxdigit(inbufptr[1]))) {
  1017. inbufptr++;
  1018. i = 16;
  1019.     } else {
  1020. i = 10;
  1021.     }
  1022.     if (i != 10) {
  1023.                         curtokint = 0;
  1024.                         while (isdigit(*inbufptr) ||
  1025.        (i > 10 && isxdigit(*inbufptr))) {
  1026.                             ch = toupper(*inbufptr++);
  1027.                             curtokint *= i;
  1028.                             if (ch <= '9')
  1029.                                 curtokint += ch - '0';
  1030.                             else
  1031.                                 curtokint += ch - 'A' + 10;
  1032.                         }
  1033.                         sprintf(curtokbuf, "%ld", curtokint);
  1034. if ((toupper(*inbufptr) == 'B' && i == 8) ||
  1035.     (toupper(*inbufptr) == 'H' && i == 16))
  1036.     inbufptr++;
  1037. if (toupper(*inbufptr) == 'C' && i == 8) {
  1038.     inbufptr++;
  1039.     curtok = TOK_STRLIT;
  1040.     curtokbuf[0] = curtokint;
  1041.     curtokbuf[1] = 0;
  1042.     curtokint = 1;
  1043.     return;
  1044. }
  1045.                         if (toupper(*inbufptr) == 'L') {
  1046.                             strcat(curtokbuf, "L");
  1047.                             inbufptr++;
  1048.                         }
  1049.                         curtok = (i == 8) ? TOK_OCTLIT : TOK_HEXLIT;
  1050.                         return;
  1051.                     }
  1052.                     cp = curtokbuf;
  1053.                     i = 0;
  1054.                     while (ch == '0')
  1055.                         ch = *inbufptr++;
  1056.                     if (isdigit(ch)) {
  1057.                         while (isdigit(ch)) {
  1058.                             *cp++ = ch;
  1059.                             ch = *inbufptr++;
  1060.                         }
  1061.                     } else
  1062.                         *cp++ = '0';
  1063.                     if (ch == '.') {
  1064.                         if (isdigit(*inbufptr)) {
  1065.                             *cp++ = ch;
  1066.                             ch = *inbufptr++;
  1067.                             i = 1;
  1068.                             while (isdigit(ch)) {
  1069.                                 *cp++ = ch;
  1070.                                 ch = *inbufptr++;
  1071.                             }
  1072.                         }
  1073.                     }
  1074.                     if (ch == 'e' || ch == 'E' ||
  1075. ch == 'd' || ch == 'D' ||
  1076. ch == 'q' || ch == 'Q') {
  1077.                         ch = *inbufptr;
  1078.                         if (isdigit(ch) || ch == '+' || ch == '-') {
  1079.                             *cp++ = 'e';
  1080.                             inbufptr++;
  1081.                             i = 1;
  1082.                             do {
  1083.                                 *cp++ = ch;
  1084.                                 ch = *inbufptr++;
  1085.                             } while (isdigit(ch));
  1086.                         }
  1087.                     }
  1088.                     inbufptr--;
  1089.                     *cp = 0;
  1090.                     if (i) {
  1091.                         curtok = TOK_REALLIT;
  1092.                         curtokint = cp - curtokbuf;
  1093.                     } else {
  1094.                         if (cp >= curtokbuf+10) {
  1095.                             i = strcmp(curtokbuf, "2147483648");
  1096.                             if (cp > curtokbuf+10 || i > 0) {
  1097. curtok = TOK_REALLIT;
  1098. curtokint = cp - curtokbuf + 2;
  1099. strcat(curtokbuf, ".0");
  1100. return;
  1101.     }
  1102.                             if (i == 0) {
  1103.                                 curtok = TOK_MININT;
  1104.                                 curtokint = -2147483648;
  1105.                                 return;
  1106.                             }
  1107.                         }
  1108.                         curtok = TOK_INTLIT;
  1109.                         curtokint = atol(curtokbuf);
  1110.                         if (toupper(*inbufptr) == 'L') {
  1111.                             strcat(curtokbuf, "L");
  1112.                             inbufptr++;
  1113.                         }
  1114.                     }
  1115.                     return;
  1116.                 } else if (isalpha(ch) || ch == '_') {
  1117. ident:
  1118.                     {
  1119.                         register char *cp2;
  1120.                         curtoksym = NULL;
  1121.                         cp = curtokbuf;
  1122.                         cp2 = curtokcase;
  1123. *cp2++ = symcase ? ch : tolower(ch);
  1124. *cp++ = pascalcasesens ? ch : toupper(ch);
  1125. while (isalnum((ch = *inbufptr++)) ||
  1126.        ch == '_' ||
  1127.        (ch == '%' && !C_lex) ||
  1128.        (ch == '$' && dollar_idents)) {
  1129.     *cp2++ = symcase ? ch : tolower(ch);
  1130.     if (!ignorenonalpha || isalnum(ch))
  1131. *cp++ = pascalcasesens ? ch : toupper(ch);
  1132. }
  1133.                         inbufptr--;
  1134.                         *cp2 = 0;
  1135.                         *cp = 0;
  1136. if (pascalsignif > 0)
  1137.     curtokbuf[pascalsignif] = 0;
  1138.                     }
  1139.     if (*curtokbuf == '%') {
  1140. if (!strcicmp(curtokbuf, "%INCLUDE")) {
  1141.     char *cp2 = inbufptr;
  1142.     while (isspace(*cp2)) cp2++;
  1143.     if (*cp2 == ''')
  1144. cp2++;
  1145.     cp = curtokbuf;
  1146.     while (*cp2 && *cp2 != ''' &&
  1147.    *cp2 != ';' && !isspace(*cp2)) {
  1148. *cp++ = *cp2++;
  1149.     }
  1150.     *cp = 0;
  1151.     cp = my_strrchr(curtokbuf, '/');
  1152.     if (cp && (!strcicmp(cp, "/LIST") ||
  1153.        !strcicmp(cp, "/NOLIST")))
  1154. *cp = 0;
  1155.     if (*cp2 == ''')
  1156. cp2++;
  1157.     while (isspace(*cp2)) cp2++;
  1158.     if (*cp2 == ';')
  1159. cp2++;
  1160.     while (isspace(*cp2)) cp2++;
  1161.     if (!*cp2) {
  1162. inbufptr = cp2;
  1163. (void) handle_include(stralloc(curtokbuf));
  1164. return;
  1165.     }
  1166. } else if (!strcicmp(curtokbuf, "%TITLE") ||
  1167.    !strcicmp(curtokbuf, "%SUBTITLE")) {
  1168.     gettok();   /* string literal */
  1169.     break;
  1170. } else if (!strcicmp(curtokbuf, "%PAGE")) {
  1171.     /* should store a special page-break comment? */
  1172.     break;   /* ignore token */
  1173. } else if ((i = 2, !strcicmp(curtokbuf, "%B")) ||
  1174.    (i = 8, !strcicmp(curtokbuf, "%O")) ||
  1175.    (i = 16, !strcicmp(curtokbuf, "%X"))) {
  1176.     while (isspace(*inbufptr)) inbufptr++;
  1177.     if (*inbufptr == ''') {
  1178. inbufptr++;
  1179. curtokint = 0;
  1180. while (*inbufptr && *inbufptr != ''') {
  1181.     ch = toupper(*inbufptr++);
  1182.     if (isxdigit(ch)) {
  1183. curtokint *= i;
  1184. if (ch <= '9')
  1185.     curtokint += ch - '0';
  1186. else
  1187.     curtokint += ch - 'A' + 10;
  1188.     } else if (!isspace(ch))
  1189. warning("Bad digit in literal [246]");
  1190. }
  1191. if (*inbufptr)
  1192.     inbufptr++;
  1193. sprintf(curtokbuf, "%ld", curtokint);
  1194. curtok = (i == 8) ? TOK_OCTLIT : TOK_HEXLIT;
  1195. return;
  1196.     }
  1197.                         }
  1198.     }
  1199.                     {
  1200.                         register unsigned int hash;
  1201.                         register Symbol *sp;
  1203.                         hash = 0;
  1204.                         for (cp = curtokbuf; *cp; cp++)
  1205.                             hash = hash*3 + *cp;
  1206.                         sp = symtab[hash % SYMHASHSIZE];
  1207.                         while (sp && (i = strcmp(sp->name, curtokbuf)) != 0) {
  1208.                             if (i < 0)
  1209.                                 sp = sp->left;
  1210.                             else
  1211.                                 sp = sp->right;
  1212.                         }
  1213.                         if (!sp)
  1214.                             sp = findsymbol(curtokbuf);
  1215. if (sp->flags & SSYNONYM) {
  1216.     i = 100;
  1217.     while (--i > 0 && sp && (sp->flags & SSYNONYM)) {
  1218. Strlist *sl;
  1219. sl = strlist_find(sp->symbolnames, "===");
  1220. if (sl)
  1221.     sp = (Symbol *)sl->value;
  1222. else
  1223.     sp = NULL;
  1224.     }
  1225.     if (!sp)
  1226. break;    /* ignore token */
  1227. }
  1228. if (sp->kwtok && !(sp->flags & KWPOSS) &&
  1229.     (pascalcasesens != 2 || !islower(*curtokbuf)) &&
  1230.     (pascalcasesens != 3 || !isupper(*curtokbuf))) {
  1231.     curtok = sp->kwtok;
  1232.     return;
  1233. }
  1234. curtok = TOK_IDENT;
  1235.                         curtoksym = sp;
  1236.                         if ((i = withlevel) != 0 && sp->fbase) {
  1237.                             while (--i >= 0) {
  1238.                                 curtokmeaning = sp->fbase;
  1239.                                 while (curtokmeaning) {
  1240.                                     if (curtokmeaning->rectype == withlist[i]) {
  1241.                                         curtokint = i;
  1242.                                         return;
  1243.                                     }
  1244.                                     curtokmeaning = curtokmeaning->snext;
  1245.                                 }
  1246.                             }
  1247.                         }
  1248.                         curtokmeaning = sp->mbase;
  1249.                         while (curtokmeaning && !curtokmeaning->isactive)
  1250.                             curtokmeaning = curtokmeaning->snext;
  1251. if (!curtokmeaning)
  1252.     return;
  1253. while (curtokmeaning->kind == MK_SYNONYM)
  1254.     curtokmeaning = curtokmeaning->xnext;
  1255. /* look for unit.ident notation */
  1256.                         if (curtokmeaning->kind == MK_MODULE ||
  1257.     curtokmeaning->kind == MK_FUNCTION) {
  1258.                             for (cp = inbufptr; isspace(*cp); cp++) ;
  1259.                             if (*cp == '.') {
  1260.                                 for (cp++; isspace(*cp); cp++) ;
  1261.                                 if (isalpha(*cp)) {
  1262.                                     Meaning *mp = curtokmeaning;
  1263.                                     Symbol *sym = curtoksym;
  1264.                                     char *saveinbufptr = inbufptr;
  1265.                                     gettok();
  1266.                                     if (curtok == TOK_DOT)
  1267. gettok();
  1268.     else
  1269. curtok = TOK_END;
  1270.                                     if (curtok == TOK_IDENT) {
  1271. curtokmeaning = curtoksym->mbase;
  1272. while (curtokmeaning &&
  1273.        curtokmeaning->ctx != mp)
  1274.     curtokmeaning = curtokmeaning->snext;
  1275. if (!curtokmeaning &&
  1276.     !strcmp(sym->name, "SYSTEM")) {
  1277.     curtokmeaning = curtoksym->mbase;
  1278.     while (curtokmeaning &&
  1279.    curtokmeaning->ctx != nullctx)
  1280. curtokmeaning = curtokmeaning->snext;
  1281. }
  1282.     } else
  1283. curtokmeaning = NULL;
  1284.                                     if (!curtokmeaning) {
  1285.                                         /* oops, was probably funcname.field */
  1286.                                         inbufptr = saveinbufptr;
  1287.                                         curtokmeaning = mp;
  1288.                                         curtoksym = sym;
  1289.                                     }
  1290.                                 }
  1291.                             }
  1292.                         }
  1293.                         return;
  1294.                     }
  1295.                 } else {
  1296.                     warning("Unrecognized character in file [247]");
  1297.                 }
  1298.         }
  1299.     }
  1300. }
  1304. void checkkeyword(tok)
  1305. Token tok;
  1306. {
  1307.     if (curtok == TOK_IDENT &&
  1308. curtoksym->kwtok == tok) {
  1309. curtoksym->flags &= ~KWPOSS;
  1310. curtok = tok;
  1311.     }
  1312. }
  1315. void checkmodulewords()
  1316. {
  1317.     if (modula2) {
  1318. checkkeyword(TOK_FROM);
  1319. checkkeyword(TOK_DEFINITION);
  1320. checkkeyword(TOK_IMPLEMENT);
  1321. checkkeyword(TOK_MODULE);
  1322. checkkeyword(TOK_IMPORT);
  1323. checkkeyword(TOK_EXPORT);
  1324.     } else if (curtok == TOK_IDENT &&
  1325.        (curtoksym->kwtok == TOK_MODULE ||
  1326. curtoksym->kwtok == TOK_IMPORT ||
  1327. curtoksym->kwtok == TOK_EXPORT ||
  1328. curtoksym->kwtok == TOK_IMPLEMENT)) {
  1329. if (!strcmp(curtokbuf, "UNIT") ||
  1330.     !strcmp(curtokbuf, "USES") ||
  1331.     !strcmp(curtokbuf, "INTERFACE") ||
  1332.     !strcmp(curtokbuf, "IMPLEMENTATION")) {
  1333.     modulenotation = 0;
  1334.     findsymbol("UNIT")->flags &= ~KWPOSS;
  1335.     findsymbol("USES")->flags &= ~KWPOSS;
  1336.     findsymbol("INTERFACE")->flags &= ~KWPOSS;
  1337.     findsymbol("IMPLEMENTATION")->flags &= ~KWPOSS;
  1338. } else {
  1339.     modulenotation = 1;
  1340.     findsymbol("MODULE")->flags &= ~KWPOSS;
  1341.     findsymbol("EXPORT")->flags &= ~KWPOSS;
  1342.     findsymbol("IMPORT")->flags &= ~KWPOSS;
  1343.     findsymbol("IMPLEMENT")->flags &= ~KWPOSS;
  1344. }
  1345. curtok = curtoksym->kwtok;
  1346.     }
  1347. }
  1360. /* End. */