home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / unix / volume21 / p2c / part31 < prev    next >
Encoding:
Internet Message Format  |  1990-04-05  |  52.1 KB
  1. Subject:  v21i076:  Pascal to C translator, Part31/32
  2. Newsgroups: comp.sources.unix
  3. Approved: rsalz@uunet.UU.NET
  4. X-Checksum-Snefru: e0f19771 289416a8 a180c7d2 77bbbdc5
  5.  
  6. Submitted-by: Dave Gillespie <daveg@csvax.caltech.edu>
  7. Posting-number: Volume 21, Issue 76
  8. Archive-name: p2c/part31
  9.  
  10. #! /bin/sh
  11. # This is a shell archive.  Remove anything before this line, then unpack
  12. # it by saving it into a file and typing "sh file".  To overwrite existing
  13. # files, type "sh file -c".  You can also feed this as standard input via
  14. # unshar, or by typing "sh <file", e.g..  If this archive is complete, you
  15. # will see the following message at the end:
  16. #        "End of archive 31 (of 32)."
  17. # Contents:  src/lex.c.1
  18. # Wrapped by rsalz@litchi.bbn.com on Mon Mar 26 14:29:54 1990
  19. PATH=/bin:/usr/bin:/usr/ucb ; export PATH
  20. if test -f 'src/lex.c.1' -a "${1}" != "-c" ; then 
  21.   echo shar: Will not clobber existing file \"'src/lex.c.1'\"
  22. else
  23. echo shar: Extracting \"'src/lex.c.1'\" \(49580 characters\)
  24. sed "s/^X//" >'src/lex.c.1' <<'END_OF_FILE'
  25. X/* "p2c", a Pascal to C translator.
  26. X   Copyright (C) 1989 David Gillespie.
  27. X   Author's address: daveg@csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
  28. X
  29. XThis program is free software; you can redistribute it and/or modify
  30. Xit under the terms of the GNU General Public License as published by
  31. Xthe Free Software Foundation (any version).
  32. X
  33. XThis program is distributed in the hope that it will be useful,
  34. Xbut WITHOUT ANY WARRANTY; without even the implied warranty of
  35. XMERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  36. XGNU General Public License for more details.
  37. X
  38. XYou should have received a copy of the GNU General Public License
  39. Xalong with this program; see the file COPYING.  If not, write to
  40. Xthe Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
  41. X
  42. X
  43. X
  44. X#define PROTO_LEX_C
  45. X#include "trans.h"
  46. X
  47. X
  48. X/* Define LEXDEBUG for a token trace */
  49. X#define LEXDEBUG
  50. X
  51. X
  52. X
  53. X
  54. X#define EOFMARK 1
  55. X
  56. X
  57. XStatic char dollar_flag, lex_initialized;
  58. XStatic int if_flag, if_skip;
  59. XStatic int commenting_flag;
  60. XStatic char *commenting_ptr;
  61. XStatic int skipflag;
  62. XStatic char modulenotation;
  63. XStatic short inputkind;
  64. XStatic Strlist *instrlist;
  65. XStatic char inbuf[300];
  66. XStatic char *oldinfname, *oldctxname;
  67. XStatic Strlist *endnotelist;
  68. X
  69. X
  70. X
  71. X#define INP_FILE     0
  72. X#define INP_INCFILE  1
  73. X#define INP_STRLIST  2
  74. X
  75. XStatic struct inprec {
  76. X    struct inprec *next;
  77. X    short kind;
  78. X    char *fname, *inbufptr;
  79. X    int lnum;
  80. X    FILE *filep;
  81. X    Strlist *strlistp, *tempopts;
  82. X    Token curtok, saveblockkind;
  83. X    Symbol *curtoksym;
  84. X    Meaning *curtokmeaning;
  85. X} *topinput;
  86. X
  87. X
  88. X
  89. X
  90. X
  91. X
  92. Xchar *fixpascalname(name)
  93. Xchar *name;
  94. X{
  95. X    char *cp, *cp2;
  96. X
  97. X    if (pascalsignif > 0) {
  98. X        name = format_ds("%.*s", pascalsignif, name);
  99. X        if (!pascalcasesens)
  100. X            upc(name);
  101. X    else if (pascalcasesens == 3)
  102. X        lwc(name);
  103. X    } else if (!pascalcasesens)
  104. X        name = strupper(name);
  105. X    else if (pascalcasesens == 3)
  106. X    name = strlower(name);
  107. X    if (ignorenonalpha) {
  108. X    for (cp = cp2 = name; *cp; cp++)
  109. X        if (isalnum(*cp))
  110. X        *cp2++ = *cp;
  111. X    }
  112. X    return name;
  113. X}
  114. X
  115. X
  116. X
  117. XStatic void makekeyword(name)
  118. Xchar *name;
  119. X{
  120. X    Symbol *sym;
  121. X
  122. X    if (*name) {
  123. X        sym = findsymbol(name);
  124. X        sym->flags |= AVOIDNAME;
  125. X    }
  126. X}
  127. X
  128. X
  129. XStatic void makeglobword(name)
  130. Xchar *name;
  131. X{
  132. X    Symbol *sym;
  133. X
  134. X    if (*name) {
  135. X        sym = findsymbol(name);
  136. X        sym->flags |= AVOIDGLOB;
  137. X    }
  138. X}
  139. X
  140. X
  141. X
  142. XStatic void makekeywords()
  143. X{
  144. X    makekeyword("auto");
  145. X    makekeyword("break");
  146. X    makekeyword("char");
  147. X    makekeyword("continue");
  148. X    makekeyword("default");
  149. X    makekeyword("defined");   /* is this one really necessary? */
  150. X    makekeyword("double");
  151. X    makekeyword("enum");
  152. X    makekeyword("extern");
  153. X    makekeyword("float");
  154. X    makekeyword("int");
  155. X    makekeyword("long");
  156. X    makekeyword("noalias");
  157. X    makekeyword("register");
  158. X    makekeyword("return");
  159. X    makekeyword("short");
  160. X    makekeyword("signed");
  161. X    makekeyword("sizeof");
  162. X    makekeyword("static");
  163. X    makekeyword("struct");
  164. X    makekeyword("switch");
  165. X    makekeyword("typedef");
  166. X    makekeyword("union");
  167. X    makekeyword("unsigned");
  168. X    makekeyword("void");
  169. X    makekeyword("volatile");
  170. X    makekeyword("asm");
  171. X    makekeyword("fortran");
  172. X    makekeyword("entry");
  173. X    makekeyword("pascal");
  174. X    if (cplus != 0) {
  175. X        makekeyword("class");
  176. X        makekeyword("delete");
  177. X        makekeyword("friend");
  178. X        makekeyword("inline");
  179. X        makekeyword("new");
  180. X        makekeyword("operator");
  181. X        makekeyword("overload");
  182. X        makekeyword("public");
  183. X        makekeyword("this");
  184. X        makekeyword("virtual");
  185. X    }
  186. X    makekeyword(name_UCHAR);
  187. X    makekeyword(name_SCHAR);    /* any others? */
  188. X    makekeyword(name_BOOLEAN);
  189. X    makekeyword(name_PROCEDURE);
  190. X    makekeyword(name_ESCAPE);
  191. X    makekeyword(name_ESCIO);
  192. X    makekeyword(name_CHKIO);
  193. X    makekeyword(name_SETIO);
  194. X    makeglobword("main");
  195. X    makeglobword("vextern");     /* used in generated .h files */
  196. X    makeglobword("argc");
  197. X    makeglobword("argv");
  198. X    makekeyword("TRY");
  199. X    makekeyword("RECOVER");
  200. X    makekeyword("RECOVER2");
  201. X    makekeyword("ENDTRY");
  202. X}
  203. X
  204. X
  205. X
  206. XStatic Symbol *Pkeyword(name, tok)
  207. Xchar *name;
  208. XToken tok;
  209. X{
  210. X    Symbol *sp = NULL;
  211. X
  212. X    if (pascalcasesens != 2) {
  213. X    sp = findsymbol(strlower(name));
  214. X    sp->kwtok = tok;
  215. X    }
  216. X    if (pascalcasesens != 3) {
  217. X    sp = findsymbol(strupper(name));
  218. X    sp->kwtok = tok;
  219. X    }
  220. X    return sp;
  221. X}
  222. X
  223. X
  224. XStatic Symbol *Pkeywordposs(name, tok)
  225. Xchar *name;
  226. XToken tok;
  227. X{
  228. X    Symbol *sp = NULL;
  229. X
  230. X    if (pascalcasesens != 2) {
  231. X    sp = findsymbol(strlower(name));
  232. X    sp->kwtok = tok;
  233. X    sp->flags |= KWPOSS;
  234. X    }
  235. X    if (pascalcasesens != 3) {
  236. X    sp = findsymbol(strupper(name));
  237. X    sp->kwtok = tok;
  238. X    sp->flags |= KWPOSS;
  239. X    }
  240. X    return sp;
  241. X}
  242. X
  243. X
  244. XStatic void makePascalwords()
  245. X{
  246. X    Pkeyword("AND", TOK_AND);
  247. X    Pkeyword("ARRAY", TOK_ARRAY);
  248. X    Pkeywordposs("ANYVAR", TOK_ANYVAR);
  249. X    Pkeywordposs("ABSOLUTE", TOK_ABSOLUTE);
  250. X    Pkeyword("BEGIN", TOK_BEGIN);
  251. X    Pkeywordposs("BY", TOK_BY);
  252. X    Pkeyword("CASE", TOK_CASE);
  253. X    Pkeyword("CONST", TOK_CONST);
  254. X    Pkeyword("DIV", TOK_DIV);
  255. X    Pkeywordposs("DEFINITION", TOK_DEFINITION);
  256. X    Pkeyword("DO", TOK_DO);
  257. X    Pkeyword("DOWNTO", TOK_DOWNTO);
  258. X    Pkeyword("ELSE", TOK_ELSE);
  259. X    Pkeywordposs("ELSIF", TOK_ELSIF);
  260. X    Pkeyword("END", TOK_END);
  261. X    Pkeywordposs("EXPORT", TOK_EXPORT);
  262. X    Pkeyword("FILE", TOK_FILE);
  263. X    Pkeyword("FOR", TOK_FOR);
  264. X    Pkeywordposs("FROM", TOK_FROM);
  265. X    Pkeyword("FUNCTION", TOK_FUNCTION);
  266. X    Pkeyword("GOTO", TOK_GOTO);
  267. X    Pkeyword("IF", TOK_IF);
  268. X    Pkeywordposs("IMPLEMENT", TOK_IMPLEMENT);
  269. X    Pkeywordposs("IMPLEMENTATION", TOK_IMPLEMENT);
  270. X    Pkeywordposs("IMPORT", TOK_IMPORT);
  271. X    Pkeyword("IN", TOK_IN);
  272. X    Pkeywordposs("INLINE", TOK_INLINE);
  273. X    Pkeywordposs("INTERFACE", TOK_EXPORT);
  274. X    Pkeywordposs("INTERRUPT", TOK_INTERRUPT);
  275. X    Pkeyword("LABEL", TOK_LABEL);
  276. X    Pkeywordposs("LOOP", TOK_LOOP);
  277. X    Pkeyword("MOD", TOK_MOD);
  278. X    Pkeywordposs("MODULE", TOK_MODULE);
  279. X    Pkeyword("NIL", TOK_NIL);
  280. X    Pkeyword("NOT", TOK_NOT);
  281. X    Pkeyword("OF", TOK_OF);
  282. X    Pkeyword("OR", TOK_OR);
  283. X    Pkeywordposs("ORIGIN", TOK_ORIGIN);
  284. X    Pkeywordposs("OTHERWISE", TOK_OTHERWISE);
  285. X    Pkeywordposs("OVERLAY", TOK_SEGMENT);
  286. X    Pkeyword("PACKED", TOK_PACKED);
  287. X    Pkeywordposs("POINTER", TOK_POINTER);
  288. X    Pkeyword("PROCEDURE", TOK_PROCEDURE);
  289. X    Pkeyword("PROGRAM", TOK_PROGRAM);
  290. X    Pkeywordposs("QUALIFIED", TOK_QUALIFIED);
  291. X    Pkeyword("RECORD", TOK_RECORD);
  292. X    Pkeywordposs("RECOVER", TOK_RECOVER);
  293. X    Pkeywordposs("REM", TOK_REM);
  294. X    Pkeyword("REPEAT", TOK_REPEAT);
  295. X    Pkeywordposs("RETURN", TOK_RETURN);
  296. X    if (which_lang == LANG_UCSD)
  297. X    Pkeyword("SEGMENT", TOK_SEGMENT);
  298. X    else
  299. X    Pkeywordposs("SEGMENT", TOK_SEGMENT);
  300. X    Pkeyword("SET", TOK_SET);
  301. X    Pkeywordposs("SHL", TOK_SHL);
  302. X    Pkeywordposs("SHR", TOK_SHR);
  303. X    Pkeyword("THEN", TOK_THEN);
  304. X    Pkeyword("TO", TOK_TO);
  305. X    Pkeywordposs("TRY", TOK_TRY);
  306. X    Pkeyword("TYPE", TOK_TYPE);
  307. X    Pkeyword("UNTIL", TOK_UNTIL);
  308. X    Pkeywordposs("USES", TOK_IMPORT);
  309. X    Pkeywordposs("UNIT", TOK_MODULE);
  310. X    if (which_lang == LANG_VAX)
  311. X    Pkeyword("VALUE", TOK_VALUE);
  312. X    else
  313. X    Pkeywordposs("VALUE", TOK_VALUE);
  314. X    Pkeyword("VAR", TOK_VAR);
  315. X    Pkeywordposs("VARYING", TOK_VARYING);
  316. X    Pkeyword("WHILE", TOK_WHILE);
  317. X    Pkeyword("WITH", TOK_WITH);
  318. X    Pkeywordposs("XOR", TOK_XOR);
  319. X    Pkeyword("__MODULE", TOK_MODULE);
  320. X    Pkeyword("__IMPORT", TOK_IMPORT);
  321. X    Pkeyword("__EXPORT", TOK_EXPORT);
  322. X    Pkeyword("__IMPLEMENT", TOK_IMPLEMENT);
  323. X}
  324. X
  325. X
  326. X
  327. XStatic void deterministic(name)
  328. Xchar *name;
  329. X{
  330. X    Symbol *sym;
  331. X
  332. X    if (*name) {
  333. X        sym = findsymbol(name);
  334. X        sym->flags |= DETERMF;
  335. X    }
  336. X}
  337. X
  338. X
  339. XStatic void nosideeff(name)
  340. Xchar *name;
  341. X{
  342. X    Symbol *sym;
  343. X
  344. X    if (*name) {
  345. X        sym = findsymbol(name);
  346. X        sym->flags |= NOSIDEEFF;
  347. X    }
  348. X}
  349. X
  350. X
  351. X
  352. XStatic void recordsideeffects()
  353. X{
  354. X    deterministic("abs");
  355. X    deterministic("acos");
  356. X    deterministic("asin");
  357. X    deterministic("atan");
  358. X    deterministic("atan2");
  359. X    deterministic("atof");
  360. X    deterministic("atoi");
  361. X    deterministic("atol");
  362. X    deterministic("ceil");
  363. X    deterministic("cos");
  364. X    deterministic("cosh");
  365. X    deterministic("exp");
  366. X    deterministic("fabs");
  367. X    deterministic("feof");
  368. X    deterministic("feoln");
  369. X    deterministic("ferror");
  370. X    deterministic("floor");
  371. X    deterministic("fmod");
  372. X    deterministic("ftell");
  373. X    deterministic("isalnum");
  374. X    deterministic("isalpha");
  375. X    deterministic("isdigit");
  376. X    deterministic("islower");
  377. X    deterministic("isspace");
  378. X    deterministic("isupper");
  379. X    deterministic("labs");
  380. X    deterministic("ldexp");
  381. X    deterministic("log");
  382. X    deterministic("log10");
  383. X    deterministic("memcmp");
  384. X    deterministic("memchr");
  385. X    deterministic("pow");
  386. X    deterministic("sin");
  387. X    deterministic("sinh");
  388. X    deterministic("sqrt");
  389. X    deterministic("strchr");
  390. X    deterministic("strcmp");
  391. X    deterministic("strcspn");
  392. X    deterministic("strlen");
  393. X    deterministic("strncmp");
  394. X    deterministic("strpbrk");
  395. X    deterministic("strrchr");
  396. X    deterministic("strspn");
  397. X    deterministic("strstr");
  398. X    deterministic("tan");
  399. X    deterministic("tanh");
  400. X    deterministic("tolower");
  401. X    deterministic("toupper");
  402. X    deterministic(setequalname);
  403. X    deterministic(subsetname);
  404. X    deterministic(signextname);
  405. X}
  406. X
  407. X
  408. X
  409. X
  410. X
  411. Xvoid init_lex()
  412. X{
  413. X    int i;
  414. X
  415. X    inputkind = INP_FILE;
  416. X    inf_lnum = 0;
  417. X    inf_ltotal = 0;
  418. X    *inbuf = 0;
  419. X    inbufptr = inbuf;
  420. X    keepingstrlist = NULL;
  421. X    tempoptionlist = NULL;
  422. X    switch_strpos = 0;
  423. X    dollar_flag = 0;
  424. X    if_flag = 0;
  425. X    if_skip = 0;
  426. X    commenting_flag = 0;
  427. X    skipflag = 0;
  428. X    inbufindent = 0;
  429. X    modulenotation = 1;
  430. X    notephase = 0;
  431. X    endnotelist = NULL;
  432. X    for (i = 0; i < SYMHASHSIZE; i++)
  433. X        symtab[i] = 0;
  434. X    C_lex = 0;
  435. X    lex_initialized = 0;
  436. X}
  437. X
  438. X
  439. Xvoid setup_lex()
  440. X{
  441. X    lex_initialized = 1;
  442. X    if (!strcmp(language, "MODCAL"))
  443. X        sysprog_flag = 2;
  444. X    else
  445. X        sysprog_flag = 0;
  446. X    if (shortcircuit < 0)
  447. X        partial_eval_flag = (which_lang == LANG_TURBO ||
  448. X                 which_lang == LANG_VAX ||
  449. X                 which_lang == LANG_OREGON ||
  450. X                 modula2 ||
  451. X                 hpux_lang);
  452. X    else
  453. X        partial_eval_flag = shortcircuit;
  454. X    iocheck_flag = 1;
  455. X    range_flag = 1;
  456. X    ovflcheck_flag = 1;
  457. X    stackcheck_flag = 1;
  458. X    fixedflag = 0;
  459. X    withlevel = 0;
  460. X    makekeywords();
  461. X    makePascalwords();
  462. X    recordsideeffects();
  463. X    topinput = 0;
  464. X    ignore_directives = 0;
  465. X    skipping_module = 0;
  466. X    blockkind = TOK_END;
  467. X    gettok();
  468. X}
  469. X
  470. X
  471. X
  472. X
  473. Xint checkeatnote(msg)
  474. Xchar *msg;
  475. X{
  476. X    Strlist *lp;
  477. X    char *cp;
  478. X    int len;
  479. X
  480. X    for (lp = eatnotes; lp; lp = lp->next) {
  481. X    if (!strcmp(lp->s, "1")) {
  482. X        echoword("[*]", 0);
  483. X        return 1;
  484. X    }
  485. X    if (!strcmp(lp->s, "0"))
  486. X        return 0;
  487. X    len = strlen(lp->s);
  488. X    cp = msg;
  489. X    while (*cp && (*cp != lp->s[0] || strncmp(cp, lp->s, len)))
  490. X        cp++;
  491. X    if (*cp) {
  492. X        cp = lp->s;
  493. X        if (*cp != '[')
  494. X        cp = format_s("[%s", cp);
  495. X        if (cp[strlen(cp)-1] != ']')
  496. X        cp = format_s("%s]", cp);
  497. X        echoword(cp, 0);
  498. X        return 1;
  499. X    }
  500. X    }
  501. X    return 0;
  502. X}
  503. X
  504. X
  505. X
  506. Xvoid beginerror()
  507. X{
  508. X    end_source();
  509. X    if (showprogress) {
  510. X        fprintf(stderr, "\r%60s\r", "");
  511. X        clearprogress();
  512. X    } else
  513. X    echobreak();
  514. X}
  515. X
  516. X
  517. Xvoid counterror()
  518. X{
  519. X    if (maxerrors > 0) {
  520. X    if (--maxerrors == 0) {
  521. X        fprintf(outf, "\n/* Translation aborted: Too many errors. */\n");
  522. X        fprintf(outf,   "-------------------------------------------\n");
  523. X        if (outf != stdout)
  524. X        printf("Translation aborted: Too many errors.\n");
  525. X        if (verbose)
  526. X        fprintf(logf, "Translation aborted: Too many errors.\n");
  527. X        closelogfile();
  528. X        exit(EXIT_FAILURE);
  529. X    }
  530. X    }
  531. X}
  532. X
  533. X
  534. Xvoid error(msg)     /* does not return */
  535. Xchar *msg;
  536. X{
  537. X    flushcomments(NULL, -1, -1);
  538. X    beginerror();
  539. X    fprintf(outf, "/* %s, line %d: %s */\n", infname, inf_lnum, msg);
  540. X    fprintf(outf, "/* Translation aborted. */\n");
  541. X    fprintf(outf, "--------------------------\n");
  542. X    if (outf != stdout) {
  543. X        printf("%s, line %d/%d: %s\n", infname, inf_lnum, outf_lnum, msg);
  544. X        printf("Translation aborted.\n");
  545. X    }
  546. X    if (verbose) {
  547. X    fprintf(logf, "%s, line %d/%d: %s\n",
  548. X        infname, inf_lnum, outf_lnum, msg);
  549. X    fprintf(logf, "Translation aborted.\n");
  550. X    }
  551. X    closelogfile();
  552. X    exit(EXIT_FAILURE);
  553. X}
  554. X
  555. X
  556. Xvoid interror(proc, msg)      /* does not return */
  557. Xchar *proc, *msg;
  558. X{
  559. X    error(format_ss("Internal error in %s: %s", proc, msg));
  560. X}
  561. X
  562. X
  563. Xvoid warning(msg)
  564. Xchar *msg;
  565. X{
  566. X    if (checkeatnote(msg)) {
  567. X    if (verbose)
  568. X        fprintf(logf, "%s, %d/%d: Omitted warning: %s\n",
  569. X            infname, inf_lnum, outf_lnum, msg);
  570. X    return;
  571. X    }
  572. X    beginerror();
  573. X    addnote(format_s("Warning: %s", msg), curserial);
  574. X    counterror();
  575. X}
  576. X
  577. X
  578. Xvoid intwarning(proc, msg)
  579. Xchar *proc, *msg;
  580. X{
  581. X    if (checkeatnote(msg)) {
  582. X    if (verbose)
  583. X        fprintf(logf, "%s, %d/%d: Omitted internal error in %s: %s\n",
  584. X            infname, inf_lnum, outf_lnum, proc, msg);
  585. X    return;
  586. X    }
  587. X    beginerror();
  588. X    addnote(format_ss("Internal error in %s: %s", proc, msg), curserial);
  589. X    if (error_crash)
  590. X        exit(EXIT_FAILURE);
  591. X    counterror();
  592. X}
  593. X
  594. X
  595. X
  596. X
  597. Xvoid note(msg)
  598. Xchar *msg;
  599. X{
  600. X    if (blockkind == TOK_IMPORT || checkeatnote(msg)) {
  601. X    if (verbose)
  602. X        fprintf(logf, "%s, %d/%d: Omitted note: %s\n",
  603. X            infname, inf_lnum, outf_lnum, msg);
  604. X    return;
  605. X    }
  606. X    beginerror();
  607. X    addnote(format_s("Note: %s", msg), curserial);
  608. X    counterror();
  609. X}
  610. X
  611. X
  612. X
  613. Xvoid endnote(msg)
  614. Xchar *msg;
  615. X{
  616. X    if (blockkind == TOK_IMPORT || checkeatnote(msg)) {
  617. X    if (verbose)
  618. X        fprintf(logf, "%s, %d/%d: Omitted end-note: %s\n",
  619. X            infname, inf_lnum, outf_lnum, msg);
  620. X    return;
  621. X    }
  622. X    if (verbose)
  623. X    fprintf(logf, "%s, %d/%d: Recorded end-note: %s\n",
  624. X        infname, inf_lnum, outf_lnum, msg);
  625. X    (void) strlist_add(&endnotelist, msg);
  626. X}
  627. X
  628. X
  629. Xvoid showendnotes()
  630. X{
  631. X    while (initialcalls) {
  632. X    if (initialcalls->value)
  633. X        endnote(format_s("Remember to call %s in main program [215]",
  634. X                 initialcalls->s));
  635. X    strlist_eat(&initialcalls);
  636. X    }
  637. X    if (endnotelist) {
  638. X    end_source();
  639. X    while (endnotelist) {
  640. X        if (outf != stdout) {
  641. X        beginerror();
  642. X        printf("Note: %s\n", endnotelist->s);
  643. X        }
  644. X        fprintf(outf, "/* p2c: Note: %s */\n", endnotelist->s);
  645. X        outf_lnum++;
  646. X        strlist_eat(&endnotelist);
  647. X    }
  648. X    }
  649. X}
  650. X
  651. X
  652. X
  653. X
  654. X
  655. X
  656. X
  657. Xchar *tok_name(tok)
  658. XToken tok;
  659. X{
  660. X    if (tok == TOK_END && inputkind == INP_STRLIST)
  661. X    return "end of macro";
  662. X    if (tok == curtok && tok == TOK_IDENT)
  663. X        return format_s("'%s'", curtokcase);
  664. X    if (!modulenotation) {
  665. X        switch (tok) {
  666. X            case TOK_MODULE:    return "UNIT";
  667. X            case TOK_IMPORT:    return "USES";
  668. X            case TOK_EXPORT:    return "INTERFACE";
  669. X            case TOK_IMPLEMENT: return "IMPLEMENTATION";
  670. X        default:        break;
  671. X        }
  672. X    }
  673. X    return toknames[(int) tok];
  674. X}
  675. X
  676. X
  677. X
  678. Xvoid expected(msg)
  679. Xchar *msg;
  680. X{
  681. X    error(format_ss("Expected %s, found %s", msg, tok_name(curtok)));
  682. X}
  683. X
  684. X
  685. Xvoid expecttok(tok)
  686. XToken tok;
  687. X{
  688. X    if (curtok != tok)
  689. X        expected(tok_name(tok));
  690. X}
  691. X
  692. X
  693. Xvoid needtok(tok)
  694. XToken tok;
  695. X{
  696. X    if (curtok != tok)
  697. X        expected(tok_name(tok));
  698. X    gettok();
  699. X}
  700. X
  701. X
  702. Xint wexpected(msg)
  703. Xchar *msg;
  704. X{
  705. X    warning(format_ss("Expected %s, found %s [227]", msg, tok_name(curtok)));
  706. X    return 0;
  707. X}
  708. X
  709. X
  710. Xint wexpecttok(tok)
  711. XToken tok;
  712. X{
  713. X    if (curtok != tok)
  714. X        return wexpected(tok_name(tok));
  715. X    else
  716. X    return 1;
  717. X}
  718. X
  719. X
  720. Xint wneedtok(tok)
  721. XToken tok;
  722. X{
  723. X    if (wexpecttok(tok)) {
  724. X    gettok();
  725. X    return 1;
  726. X    } else
  727. X    return 0;
  728. X}
  729. X
  730. X
  731. Xvoid alreadydef(sym)
  732. XSymbol *sym;
  733. X{
  734. X    warning(format_s("Symbol '%s' was already defined [220]", sym->name));
  735. X}
  736. X
  737. X
  738. Xvoid undefsym(sym)
  739. XSymbol *sym;
  740. X{
  741. X    warning(format_s("Symbol '%s' is not defined [221]", sym->name));
  742. X}
  743. X
  744. X
  745. Xvoid symclass(sym)
  746. XSymbol *sym;
  747. X{
  748. X    warning(format_s("Symbol '%s' is not of the appropriate class [222]", sym->name));
  749. X}
  750. X
  751. X
  752. Xvoid badtypes()
  753. X{
  754. X    warning("Type mismatch [223]");
  755. X}
  756. X
  757. X
  758. Xvoid valrange()
  759. X{
  760. X    warning("Value range error [224]");
  761. X}
  762. X
  763. X
  764. X
  765. Xvoid skipparens()
  766. X{
  767. X    Token begintok;
  768. X
  769. X    if (curtok == TOK_LPAR) {
  770. X        gettok();
  771. X        while (curtok != TOK_RPAR)
  772. X            skipparens();
  773. X    } else if (curtok == TOK_LBR) {
  774. X        gettok();
  775. X        while (curtok != TOK_RBR)
  776. X            skipparens();
  777. X    } else if (curtok == TOK_BEGIN || curtok == TOK_RECORD ||
  778. X           curtok == TOK_CASE) {
  779. X    begintok = curtok;
  780. X        gettok();
  781. X        while (curtok != TOK_END)
  782. X        if (curtok == TOK_CASE && begintok == TOK_RECORD)
  783. X        gettok();
  784. X        else
  785. X        skipparens();
  786. X    }
  787. X    gettok();
  788. X}
  789. X
  790. X
  791. Xvoid skiptotoken2(tok1, tok2)
  792. XToken tok1, tok2;
  793. X{
  794. X    while (curtok != tok1 && curtok != tok2 &&
  795. X       curtok != TOK_END && curtok != TOK_RPAR &&
  796. X       curtok != TOK_RBR && curtok != TOK_EOF)
  797. X    skipparens();
  798. X}
  799. X
  800. X
  801. Xvoid skippasttoken2(tok1, tok2)
  802. XToken tok1, tok2;
  803. X{
  804. X    skiptotoken2(tok1, tok2);
  805. X    if (curtok == tok1 || curtok == tok2)
  806. X    gettok();
  807. X}
  808. X
  809. X
  810. Xvoid skippasttotoken(tok1, tok2)
  811. XToken tok1, tok2;
  812. X{
  813. X    skiptotoken2(tok1, tok2);
  814. X    if (curtok == tok1)
  815. X    gettok();
  816. X}
  817. X
  818. X
  819. Xvoid skiptotoken(tok)
  820. XToken tok;
  821. X{
  822. X    skiptotoken2(tok, tok);
  823. X}
  824. X
  825. X
  826. Xvoid skippasttoken(tok)
  827. XToken tok;
  828. X{
  829. X    skippasttoken2(tok, tok);
  830. X}
  831. X
  832. X
  833. X
  834. Xint skipopenparen()
  835. X{
  836. X    if (wneedtok(TOK_LPAR))
  837. X    return 1;
  838. X    skiptotoken(TOK_SEMI);
  839. X    return 0;
  840. X}
  841. X
  842. X
  843. Xint skipcloseparen()
  844. X{
  845. X    if (curtok == TOK_COMMA)
  846. X    warning("Too many arguments for built-in routine [225]");
  847. X    else
  848. X    if (wneedtok(TOK_RPAR))
  849. X        return 1;
  850. X    skippasttotoken(TOK_RPAR, TOK_SEMI);
  851. X    return 0;
  852. X}
  853. X
  854. X
  855. Xint skipcomma()
  856. X{
  857. X    if (curtok == TOK_RPAR)
  858. X    warning("Too few arguments for built-in routine [226]");
  859. X    else
  860. X    if (wneedtok(TOK_COMMA))
  861. X        return 1;
  862. X    skippasttotoken(TOK_RPAR, TOK_SEMI);
  863. X    return 0;
  864. X}
  865. X
  866. X
  867. X
  868. X
  869. X
  870. Xchar *findaltname(name, num)
  871. Xchar *name;
  872. Xint num;
  873. X{
  874. X    char *cp;
  875. X
  876. X    if (num <= 0)
  877. X        return name;
  878. X    if (num == 1 && *alternatename1)
  879. X        return format_s(alternatename1, name);
  880. X    if (num == 2 && *alternatename2)
  881. X        return format_s(alternatename2, name);
  882. X    if (*alternatename)
  883. X        return format_sd(alternatename, name, num);
  884. X    cp = name;
  885. X    if (*alternatename1) {
  886. X        while (--num >= 0)
  887. X        cp = format_s(alternatename1, cp);
  888. X    } else {
  889. X    while (--num >= 0)
  890. X        cp = format_s("%s_", cp);
  891. X    }
  892. X    return cp;
  893. X}
  894. X
  895. X
  896. X
  897. X
  898. XSymbol *findsymbol_opt(name)
  899. Xchar *name;
  900. X{
  901. X    register int i;
  902. X    register unsigned int hash;
  903. X    register char *cp;
  904. X    register Symbol *sp;
  905. X
  906. X    hash = 0;
  907. X    for (cp = name; *cp; cp++)
  908. X        hash = hash*3 + *cp;
  909. X    sp = symtab[hash % SYMHASHSIZE];
  910. X    while (sp && (i = strcmp(sp->name, name)) != 0) {
  911. X        if (i < 0)
  912. X            sp = sp->left;
  913. X        else
  914. X            sp = sp->right;
  915. X    }
  916. X    return sp;
  917. X}
  918. X
  919. X
  920. X
  921. XSymbol *findsymbol(name)
  922. Xchar *name;
  923. X{
  924. X    register int i;
  925. X    register unsigned int hash;
  926. X    register char *cp;
  927. X    register Symbol **prev, *sp;
  928. X
  929. X    hash = 0;
  930. X    for (cp = name; *cp; cp++)
  931. X        hash = hash*3 + *cp;
  932. X    prev = symtab + (hash % SYMHASHSIZE);
  933. X    while ((sp = *prev) != 0 &&
  934. X           (i = strcmp(sp->name, name)) != 0) {
  935. X        if (i < 0)
  936. X            prev = &(sp->left);
  937. X        else
  938. X            prev = &(sp->right);
  939. X    }
  940. X    if (!sp) {
  941. X        sp = ALLOCV(sizeof(Symbol) + strlen(name), Symbol, symbols);
  942. X        sp->mbase = sp->fbase = NULL;
  943. X        sp->left = sp->right = NULL;
  944. X        strcpy(sp->name, name);
  945. X        sp->flags = 0;
  946. X    sp->kwtok = TOK_NONE;
  947. X        sp->symbolnames = NULL;
  948. X        *prev = sp;
  949. X    }
  950. X    return sp;
  951. X}
  952. X
  953. X
  954. X
  955. X
  956. Xvoid clearprogress()
  957. X{
  958. X    oldinfname = NULL;
  959. X}
  960. X
  961. X
  962. Xvoid progress()
  963. X{
  964. X    char *ctxname;
  965. X    int needrefr;
  966. X    static int prevlen;
  967. X
  968. X    if (showprogress) {
  969. X        if (!curctx || curctx == nullctx || curctx->kind == MK_MODULE ||
  970. X            !strncmp(curctx->name, "__PROCPTR", 9) || blockkind == TOK_IMPORT)
  971. X            ctxname = "";
  972. X        else
  973. X            ctxname = curctx->name;
  974. X        needrefr = (inf_lnum & 15) == 0;
  975. X        if (oldinfname != infname || oldctxname != ctxname) {
  976. X        if (oldinfname != infname)
  977. X        prevlen = 60;
  978. X            fprintf(stderr, "\r%*s", prevlen + 2, "");
  979. X            oldinfname = infname;
  980. X            oldctxname = ctxname;
  981. X            needrefr = 1;
  982. X        }
  983. X        if (needrefr) {
  984. X            fprintf(stderr, "\r%5d %s  %s", inf_lnum, infname, ctxname);
  985. X        prevlen = 8 + strlen(infname) + strlen(ctxname);
  986. X        } else {
  987. X            fprintf(stderr, "\r%5d", inf_lnum);
  988. X        prevlen = 5;
  989. X    }
  990. X    }
  991. X}
  992. X
  993. X
  994. X
  995. Xvoid getline()
  996. X{
  997. X    char *cp, *cp2;
  998. X
  999. X    switch (inputkind) {
  1000. X
  1001. X        case INP_FILE:
  1002. X        case INP_INCFILE:
  1003. X            inf_lnum++;
  1004. X        inf_ltotal++;
  1005. X            if (fgets(inbuf, 300, inf)) {
  1006. X                cp = inbuf + strlen(inbuf);
  1007. X                if (*inbuf && cp[-1] == '\n')
  1008. X                    cp[-1] = 0;
  1009. X        if (inbuf[0] == '#' && inbuf[1] == ' ' && isdigit(inbuf[2])) {
  1010. X            cp = inbuf + 2;    /* in case input text came */
  1011. X            inf_lnum = 0;      /*  from the C preprocessor */
  1012. X            while (isdigit(*cp))
  1013. X            inf_lnum = inf_lnum*10 + (*cp++) - '0';
  1014. X            inf_lnum--;
  1015. X            while (isspace(*cp)) cp++;
  1016. X            if (*cp == '"' && (cp2 = my_strchr(cp+1, '"')) != NULL) {
  1017. X            cp++;
  1018. X            infname = stralloc(cp);
  1019. X            infname[cp2 - cp] = 0;
  1020. X            }
  1021. X            getline();
  1022. X            return;
  1023. X        }
  1024. X        if (copysource && *inbuf) {
  1025. X            start_source();
  1026. X            fprintf(outf, "%s\n", inbuf);
  1027. X        }
  1028. X                if (keepingstrlist) {
  1029. X                    strlist_append(keepingstrlist, inbuf)->value = inf_lnum;
  1030. X                }
  1031. X                if (showprogress && inf_lnum % showprogress == 0)
  1032. X                    progress();
  1033. X            } else {
  1034. X                if (showprogress)
  1035. X                    fprintf(stderr, "\n");
  1036. X                if (inputkind == INP_INCFILE) {
  1037. X                    pop_input();
  1038. X                    getline();
  1039. X                } else
  1040. X                    strcpy(inbuf, "\001");
  1041. X            }
  1042. X            break;
  1043. X
  1044. X        case INP_STRLIST:
  1045. X            if (instrlist) {
  1046. X                strcpy(inbuf, instrlist->s);
  1047. X                if (instrlist->value)
  1048. X                    inf_lnum = instrlist->value;
  1049. X                else
  1050. X                    inf_lnum++;
  1051. X                instrlist = instrlist->next;
  1052. X            } else
  1053. X                strcpy(inbuf, "\001");
  1054. X            break;
  1055. X    }
  1056. X    inbufptr = inbuf;
  1057. X    inbufindent = 0;
  1058. X}
  1059. X
  1060. X
  1061. X
  1062. X
  1063. XStatic void push_input()
  1064. X{
  1065. X    struct inprec *inp;
  1066. X
  1067. X    inp = ALLOC(1, struct inprec, inprecs);
  1068. X    inp->kind = inputkind;
  1069. X    inp->fname = infname;
  1070. X    inp->lnum = inf_lnum;
  1071. X    inp->filep = inf;
  1072. X    inp->strlistp = instrlist;
  1073. X    inp->inbufptr = stralloc(inbufptr);
  1074. X    inp->curtok = curtok;
  1075. X    inp->curtoksym = curtoksym;
  1076. X    inp->curtokmeaning = curtokmeaning;
  1077. X    inp->saveblockkind = TOK_NIL;
  1078. X    inp->next = topinput;
  1079. X    topinput = inp;
  1080. X    inbufptr = inbuf + strlen(inbuf);
  1081. X}
  1082. X
  1083. X
  1084. X
  1085. Xvoid push_input_file(fp, fname, isinclude)
  1086. XFILE *fp;
  1087. Xchar *fname;
  1088. Xint isinclude;
  1089. X{
  1090. X    push_input();
  1091. X    inputkind = (isinclude == 1) ? INP_INCFILE : INP_FILE;
  1092. X    inf = fp;
  1093. X    inf_lnum = 0;
  1094. X    infname = fname;
  1095. X    *inbuf = 0;
  1096. X    inbufptr = inbuf;
  1097. X    topinput->tempopts = tempoptionlist;
  1098. X    tempoptionlist = NULL;
  1099. X    if (isinclude != 2)
  1100. X        gettok();
  1101. X}
  1102. X
  1103. X
  1104. Xvoid include_as_import()
  1105. X{
  1106. X    if (inputkind == INP_INCFILE) {
  1107. X    if (topinput->saveblockkind == TOK_NIL)
  1108. X        topinput->saveblockkind = blockkind;
  1109. X    blockkind = TOK_IMPORT;
  1110. X    } else
  1111. X    warning(format_s("%s ignored except in include files [228]",
  1112. X             interfacecomment));
  1113. X}
  1114. X
  1115. X
  1116. Xvoid push_input_strlist(sp, fname)
  1117. XStrlist *sp;
  1118. Xchar *fname;
  1119. X{
  1120. X    push_input();
  1121. X    inputkind = INP_STRLIST;
  1122. X    instrlist = sp;
  1123. X    if (fname) {
  1124. X        infname = fname;
  1125. X        inf_lnum = 0;
  1126. X    } else
  1127. X        inf_lnum--;     /* adjust for extra getline() */
  1128. X    *inbuf = 0;
  1129. X    inbufptr = inbuf;
  1130. X    gettok();
  1131. X}
  1132. X
  1133. X
  1134. X
  1135. Xvoid pop_input()
  1136. X{
  1137. X    struct inprec *inp;
  1138. X
  1139. X    if (inputkind == INP_FILE || inputkind == INP_INCFILE) {
  1140. X    while (tempoptionlist) {
  1141. X        undooption(tempoptionlist->value, tempoptionlist->s);
  1142. X        strlist_eat(&tempoptionlist);
  1143. X    }
  1144. X    tempoptionlist = topinput->tempopts;
  1145. X    if (inf)
  1146. X        fclose(inf);
  1147. X    }
  1148. X    inp = topinput;
  1149. X    topinput = inp->next;
  1150. X    if (inp->saveblockkind != TOK_NIL)
  1151. X    blockkind = inp->saveblockkind;
  1152. X    inputkind = inp->kind;
  1153. X    infname = inp->fname;
  1154. X    inf_lnum = inp->lnum;
  1155. X    inf = inp->filep;
  1156. X    curtok = inp->curtok;
  1157. X    curtoksym = inp->curtoksym;
  1158. X    curtokmeaning = inp->curtokmeaning;
  1159. X    strcpy(inbuf, inp->inbufptr);
  1160. X    FREE(inp->inbufptr);
  1161. X    inbufptr = inbuf;
  1162. X    instrlist = inp->strlistp;
  1163. X    FREE(inp);
  1164. X}
  1165. X
  1166. X
  1167. X
  1168. X
  1169. Xint undooption(i, name)
  1170. Xint i;
  1171. Xchar *name;
  1172. X{
  1173. X    char kind = rctable[i].kind;
  1174. X
  1175. X    switch (kind) {
  1176. X
  1177. X        case 'S':
  1178. X    case 'B':
  1179. X        if (rcprevvalues[i]) {
  1180. X                *((short *)rctable[i].ptr) = rcprevvalues[i]->value;
  1181. X                strlist_eat(&rcprevvalues[i]);
  1182. X                return 1;
  1183. X            }
  1184. X            break;
  1185. X
  1186. X        case 'I':
  1187. X        case 'D':
  1188. X            if (rcprevvalues[i]) {
  1189. X                *((int *)rctable[i].ptr) = rcprevvalues[i]->value;
  1190. X                strlist_eat(&rcprevvalues[i]);
  1191. X                return 1;
  1192. X            }
  1193. X            break;
  1194. X
  1195. X        case 'L':
  1196. X            if (rcprevvalues[i]) {
  1197. X                *((long *)rctable[i].ptr) = rcprevvalues[i]->value;
  1198. X                strlist_eat(&rcprevvalues[i]);
  1199. X                return 1;
  1200. X            }
  1201. X            break;
  1202. X
  1203. X    case 'R':
  1204. X        if (rcprevvalues[i]) {
  1205. X        *((double *)rctable[i].ptr) = atof(rcprevvalues[i]->s);
  1206. X        strlist_eat(&rcprevvalues[i]);
  1207. X        return 1;
  1208. X        }
  1209. X        break;
  1210. X
  1211. X        case 'C':
  1212. X        case 'U':
  1213. X            if (rcprevvalues[i]) {
  1214. X                strcpy((char *)rctable[i].ptr, rcprevvalues[i]->s);
  1215. X                strlist_eat(&rcprevvalues[i]);
  1216. X                return 1;
  1217. X            }
  1218. X            break;
  1219. X
  1220. X        case 'A':
  1221. X            strlist_remove((Strlist **)rctable[i].ptr, name);
  1222. X            return 1;
  1223. X
  1224. X        case 'X':
  1225. X            if (rctable[i].def == 1) {
  1226. X                strlist_remove((Strlist **)rctable[i].ptr, name);
  1227. X                return 1;
  1228. X            }
  1229. X            break;
  1230. X
  1231. X    }
  1232. X    return 0;
  1233. X}
  1234. X
  1235. X
  1236. X
  1237. X
  1238. Xvoid badinclude()
  1239. X{
  1240. X    warning("Can't handle an \"include\" directive here [229]");
  1241. X    inputkind = INP_INCFILE;     /* expand it in-line */
  1242. X    gettok();
  1243. X}
  1244. X
  1245. X
  1246. X
  1247. Xint handle_include(fn)
  1248. Xchar *fn;
  1249. X{
  1250. X    FILE *fp = NULL;
  1251. X    Strlist *sl;
  1252. X
  1253. X    for (sl = includedirs; sl; sl = sl->next) {
  1254. X    fp = fopen(format_s(sl->s, fn), "r");
  1255. X    if (fp) {
  1256. X        fn = stralloc(format_s(sl->s, fn));
  1257. X        break;
  1258. X    }
  1259. X    }
  1260. X    if (!fp) {
  1261. X        perror(fn);
  1262. X        warning(format_s("Could not open include file %s [230]", fn));
  1263. X        return 0;
  1264. X    } else {
  1265. X        if (!quietmode && !showprogress)
  1266. X        if (outf == stdout)
  1267. X        fprintf(stderr, "Reading include file \"%s\"\n", fn);
  1268. X        else
  1269. X        printf("Reading include file \"%s\"\n", fn);
  1270. X    if (verbose)
  1271. X        fprintf(logf, "Reading include file \"%s\"\n", fn);
  1272. X        if (expandincludes == 0) {
  1273. X            push_input_file(fp, fn, 2);
  1274. X            curtok = TOK_INCLUDE;
  1275. X            strcpy(curtokbuf, fn);
  1276. X        } else {
  1277. X            push_input_file(fp, fn, 1);
  1278. X        }
  1279. X        return 1;
  1280. X    }
  1281. X}
  1282. X
  1283. X
  1284. X
  1285. Xint turbo_directive(closing, after)
  1286. Xchar *closing, *after;
  1287. X{
  1288. X    char *cp, *cp2;
  1289. X    int i, result;
  1290. X
  1291. X    if (!strcincmp(inbufptr, "$double", 7)) {
  1292. X    cp = inbufptr + 7;
  1293. X    while (isspace(*cp)) cp++;
  1294. X    if (cp == closing) {
  1295. X        inbufptr = after;
  1296. X        doublereals = 1;
  1297. X        return 1;
  1298. X    }
  1299. X    } else if (!strcincmp(inbufptr, "$nodouble", 9)) {
  1300. X    cp = inbufptr + 9;
  1301. X    while (isspace(*cp)) cp++;
  1302. X    if (cp == closing) {
  1303. X        inbufptr = after;
  1304. X        doublereals = 0;
  1305. X        return 1;
  1306. X    }
  1307. X    }
  1308. X    switch (inbufptr[2]) {
  1309. X
  1310. X        case '+':
  1311. X        case '-':
  1312. X            result = 1;
  1313. X            cp = inbufptr + 1;
  1314. X            for (;;) {
  1315. X                if (!isalpha(*cp++))
  1316. X                    return 0;
  1317. X                if (*cp != '+' && *cp != '-')
  1318. X                    return 0;
  1319. X                if (++cp == closing)
  1320. X                    break;
  1321. X                if (*cp++ != ',')
  1322. X                    return 0;
  1323. X            }
  1324. X            cp = inbufptr + 1;
  1325. X            do {
  1326. X                switch (*cp++) {
  1327. X
  1328. X                    case 'b':
  1329. X                    case 'B':
  1330. X                        if (shortcircuit < 0 && which_lang != LANG_MPW)
  1331. X                            partial_eval_flag = (*cp == '-');
  1332. X                        break;
  1333. X
  1334. X                    case 'i':
  1335. X                    case 'I':
  1336. X                        iocheck_flag = (*cp == '+');
  1337. X                        break;
  1338. X
  1339. X                    case 'r':
  1340. X                    case 'R':
  1341. X                        if (*cp == '+') {
  1342. X                            if (!range_flag)
  1343. X                                note("Range checking is ON [216]");
  1344. X                            range_flag = 1;
  1345. X                        } else {
  1346. X                            if (range_flag)
  1347. X                                note("Range checking is OFF [216]");
  1348. X                            range_flag = 0;
  1349. X                        }
  1350. X                        break;
  1351. X
  1352. X                    case 's':
  1353. X                    case 'S':
  1354. X                        if (*cp == '+') {
  1355. X                            if (!stackcheck_flag)
  1356. X                                note("Stack checking is ON [217]");
  1357. X                            stackcheck_flag = 1;
  1358. X                        } else {
  1359. X                            if (stackcheck_flag)
  1360. X                                note("Stack checking is OFF [217]");
  1361. X                            stackcheck_flag = 0;
  1362. X                        }
  1363. X                        break;
  1364. X
  1365. X                    default:
  1366. X                        result = 0;
  1367. X                        break;
  1368. X                }
  1369. X                cp++;
  1370. X            } while (*cp++ == ',');
  1371. X            if (result)
  1372. X                inbufptr = after;
  1373. X            return result;
  1374. X
  1375. X    case 'c':
  1376. X    case 'C':
  1377. X        if (toupper(inbufptr[1]) == 'S' &&
  1378. X        (inbufptr[3] == '+' || inbufptr[3] == '-') &&
  1379. X        inbufptr + 4 == closing) {
  1380. X        if (shortcircuit < 0)
  1381. X            partial_eval_flag = (inbufptr[3] == '+');
  1382. X        inbufptr = after;
  1383. X        return 1;
  1384. X        }
  1385. X        return 0;
  1386. X
  1387. X        case ' ':
  1388. X            switch (inbufptr[1]) {
  1389. X
  1390. X                case 'i':
  1391. X                case 'I':
  1392. X                    if (skipping_module)
  1393. X                        break;
  1394. X                    cp = inbufptr + 3;
  1395. X                    while (isspace(*cp)) cp++;
  1396. X                    cp2 = cp;
  1397. X                    i = 0;
  1398. X                    while (*cp2 && cp2 != closing)
  1399. X                        i++, cp2++;
  1400. X                    if (cp2 != closing)
  1401. X                        return 0;
  1402. X                    while (isspace(cp[i-1]))
  1403. X                        if (--i <= 0)
  1404. X                            return 0;
  1405. X                    inbufptr = after;
  1406. X                    cp2 = ALLOC(i + 1, char, strings);
  1407. X                    strncpy(cp2, cp, i);
  1408. X                    cp2[i] = 0;
  1409. X                    if (handle_include(cp2))
  1410. X            return 2;
  1411. X            break;
  1412. X
  1413. X        case 's':
  1414. X        case 'S':
  1415. X            cp = inbufptr + 3;
  1416. X            outsection(minorspace);
  1417. X            if (cp == closing) {
  1418. X            output("#undef __SEG__\n");
  1419. X            } else {
  1420. X            output("#define __SEG__ ");
  1421. X            while (*cp && cp != closing)
  1422. X                cp++;
  1423. X            if (*cp) {
  1424. X                i = *cp;
  1425. X                *cp = 0;
  1426. X                output(inbufptr + 3);
  1427. X                *cp = i;
  1428. X            }
  1429. X            output("\n");
  1430. X            }
  1431. X            outsection(minorspace);
  1432. X            inbufptr = after;
  1433. X            return 1;
  1434. X
  1435. X            }
  1436. X            return 0;
  1437. X
  1438. X    case '}':
  1439. X    case '*':
  1440. X        if (inbufptr + 2 == closing) {
  1441. X        switch (inbufptr[1]) {
  1442. X            
  1443. X          case 's':
  1444. X          case 'S':
  1445. X            outsection(minorspace);
  1446. X            output("#undef __SEG__\n");
  1447. X            outsection(minorspace);
  1448. X            inbufptr = after;
  1449. X            return 1;
  1450. X
  1451. X        }
  1452. X        }
  1453. X        return 0;
  1454. X
  1455. X        case 'f':   /* $ifdef etc. */
  1456. X        case 'F':
  1457. X            if (toupper(inbufptr[1]) == 'I' &&
  1458. X                ((toupper(inbufptr[3]) == 'O' &&
  1459. X                  toupper(inbufptr[4]) == 'P' &&
  1460. X                  toupper(inbufptr[5]) == 'T') ||
  1461. X                 (toupper(inbufptr[3]) == 'D' &&
  1462. X                  toupper(inbufptr[4]) == 'E' &&
  1463. X                  toupper(inbufptr[5]) == 'F') ||
  1464. X                 (toupper(inbufptr[3]) == 'N' &&
  1465. X                  toupper(inbufptr[4]) == 'D' &&
  1466. X                  toupper(inbufptr[5]) == 'E' &&
  1467. X                  toupper(inbufptr[6]) == 'F'))) {
  1468. X                note("Turbo Pascal conditional compilation directive was ignored [218]");
  1469. X            }
  1470. X            return 0;
  1471. X
  1472. X    }
  1473. X    return 0;
  1474. X}
  1475. X
  1476. X
  1477. X
  1478. X
  1479. Xextern Strlist *addmacros;
  1480. X
  1481. Xvoid defmacro(name, kind, fname, lnum)
  1482. Xchar *name, *fname;
  1483. Xlong kind;
  1484. Xint lnum;
  1485. X{
  1486. X    Strlist *defsl, *sl, *sl2;
  1487. X    Symbol *sym, *sym2;
  1488. X    Meaning *mp;
  1489. X    Expr *ex;
  1490. X
  1491. X    defsl = NULL;
  1492. X    sl = strlist_append(&defsl, name);
  1493. X    C_lex++;
  1494. X    if (fname && !strcmp(fname, "<macro>") && curtok == TOK_IDENT)
  1495. X        fname = curtoksym->name;
  1496. X    push_input_strlist(defsl, fname);
  1497. X    if (fname)
  1498. X        inf_lnum = lnum;
  1499. X    switch (kind) {
  1500. X
  1501. X        case MAC_VAR:
  1502. X            if (!wexpecttok(TOK_IDENT))
  1503. X        break;
  1504. X        for (mp = curtoksym->mbase; mp; mp = mp->snext) {
  1505. X        if (mp->kind == MK_VAR)
  1506. X            warning(format_s("VarMacro must be defined before declaration of variable %s [231]", curtokcase));
  1507. X        }
  1508. X            sl = strlist_append(&varmacros, curtoksym->name);
  1509. X            gettok();
  1510. X            if (!wneedtok(TOK_EQ))
  1511. X        break;
  1512. X            sl->value = (long)pc_expr();
  1513. X            break;
  1514. X
  1515. X        case MAC_CONST:
  1516. X            if (!wexpecttok(TOK_IDENT))
  1517. X        break;
  1518. X        for (mp = curtoksym->mbase; mp; mp = mp->snext) {
  1519. X        if (mp->kind == MK_CONST)
  1520. X            warning(format_s("ConstMacro must be defined before declaration of variable %s [232]", curtokcase));
  1521. X        }
  1522. X            sl = strlist_append(&constmacros, curtoksym->name);
  1523. X            gettok();
  1524. X            if (!wneedtok(TOK_EQ))
  1525. X        break;
  1526. X            sl->value = (long)pc_expr();
  1527. X            break;
  1528. X
  1529. X        case MAC_FIELD:
  1530. X            if (!wexpecttok(TOK_IDENT))
  1531. X        break;
  1532. X            sym = curtoksym;
  1533. X            gettok();
  1534. X            if (!wneedtok(TOK_DOT))
  1535. X        break;
  1536. X            if (!wexpecttok(TOK_IDENT))
  1537. X        break;
  1538. X        sym2 = curtoksym;
  1539. X            gettok();
  1540. X        if (!wneedtok(TOK_EQ))
  1541. X        break;
  1542. X            funcmacroargs = NULL;
  1543. X            sym->flags |= FMACREC;
  1544. X            ex = pc_expr();
  1545. X            sym->flags &= ~FMACREC;
  1546. X        for (mp = sym2->fbase; mp; mp = mp->snext) {
  1547. X        if (mp->rectype && mp->rectype->meaning &&
  1548. X            mp->rectype->meaning->sym == sym)
  1549. X            break;
  1550. X        }
  1551. X        if (mp) {
  1552. X        mp->constdefn = ex;
  1553. X        } else {
  1554. X        sl = strlist_append(&fieldmacros, 
  1555. X                    format_ss("%s.%s", sym->name, sym2->name));
  1556. X        sl->value = (long)ex;
  1557. X        }
  1558. X            break;
  1559. X
  1560. X        case MAC_FUNC:
  1561. X            if (!wexpecttok(TOK_IDENT))
  1562. X        break;
  1563. X            sym = curtoksym;
  1564. X            if (sym->mbase &&
  1565. X        (sym->mbase->kind == MK_FUNCTION ||
  1566. X         sym->mbase->kind == MK_SPECIAL))
  1567. X                sl = NULL;
  1568. X            else
  1569. X                sl = strlist_append(&funcmacros, sym->name);
  1570. X            gettok();
  1571. X            funcmacroargs = NULL;
  1572. X            if (curtok == TOK_LPAR) {
  1573. X                do {
  1574. X                    gettok();
  1575. X            if (curtok == TOK_RPAR && !funcmacroargs)
  1576. X            break;
  1577. X                    if (!wexpecttok(TOK_IDENT)) {
  1578. X            skiptotoken2(TOK_COMMA, TOK_RPAR);
  1579. X            continue;
  1580. X            }
  1581. X                    sl2 = strlist_append(&funcmacroargs, curtoksym->name);
  1582. X                    sl2->value = (long)curtoksym;
  1583. X                    curtoksym->flags |= FMACREC;
  1584. X                    gettok();
  1585. X                } while (curtok == TOK_COMMA);
  1586. X                if (!wneedtok(TOK_RPAR))
  1587. X            skippasttotoken(TOK_RPAR, TOK_EQ);
  1588. X            }
  1589. X            if (!wneedtok(TOK_EQ))
  1590. X        break;
  1591. X            if (sl)
  1592. X                sl->value = (long)pc_expr();
  1593. X            else
  1594. X                sym->mbase->constdefn = pc_expr();
  1595. X            for (sl2 = funcmacroargs; sl2; sl2 = sl2->next) {
  1596. X                sym2 = (Symbol *)sl2->value;
  1597. X                sym2->flags &= ~FMACREC;
  1598. X            }
  1599. X            strlist_empty(&funcmacroargs);
  1600. X            break;
  1601. X
  1602. X    }
  1603. X    if (curtok != TOK_EOF)
  1604. X        warning(format_s("Junk (%s) at end of macro definition [233]", tok_name(curtok)));
  1605. X    pop_input();
  1606. X    C_lex--;
  1607. X    strlist_empty(&defsl);
  1608. X}
  1609. X
  1610. X
  1611. X
  1612. Xvoid check_unused_macros()
  1613. X{
  1614. X    Strlist *sl;
  1615. X
  1616. X    if (warnmacros) {
  1617. X        for (sl = varmacros; sl; sl = sl->next)
  1618. X            warning(format_s("VarMacro %s was never used [234]", sl->s));
  1619. X        for (sl = constmacros; sl; sl = sl->next)
  1620. X            warning(format_s("ConstMacro %s was never used [234]", sl->s));
  1621. X        for (sl = fieldmacros; sl; sl = sl->next)
  1622. X            warning(format_s("FieldMacro %s was never used [234]", sl->s));
  1623. X        for (sl = funcmacros; sl; sl = sl->next)
  1624. X            warning(format_s("FuncMacro %s was never used [234]", sl->s));
  1625. X    }
  1626. X}
  1627. X
  1628. X
  1629. X
  1630. X
  1631. X
  1632. X#define skipspc(cp)   while (isspace(*cp)) cp++
  1633. X
  1634. XStatic int parsecomment(p2c_only, starparen)
  1635. Xint p2c_only, starparen;
  1636. X{
  1637. X    char namebuf[302];
  1638. X    char *cp, *cp2 = namebuf, *closing, *after;
  1639. X    char kind, chgmode, upcflag;
  1640. X    long val, oldval, sign;
  1641. X    double dval;
  1642. X    int i, tempopt, hassign;
  1643. X    Strlist *sp;
  1644. X    Symbol *sym;
  1645. X
  1646. X    if (if_flag)
  1647. X        return 0;
  1648. X    if (!p2c_only) {
  1649. X        if (!strncmp(inbufptr, noskipcomment, strlen(noskipcomment)) &&
  1650. X         *noskipcomment) {
  1651. X            inbufptr += strlen(noskipcomment);
  1652. X        if (skipflag < 0) {
  1653. X        curtok = TOK_ENDIF;
  1654. X        skipflag = 1;
  1655. X        return 2;
  1656. X        }
  1657. X        skipflag = 1;
  1658. X            return 1;
  1659. X        }
  1660. X    }
  1661. X    closing = inbufptr;
  1662. X    while (*closing && (starparen
  1663. X            ? (closing[0] != '*' || closing[1] != ')')
  1664. X            : (closing[0] != '}')))
  1665. X    closing++;
  1666. X    if (!*closing)
  1667. X    return 0;
  1668. X    after = closing + (starparen ? 2 : 1);
  1669. X    cp = inbufptr;
  1670. X    while (cp < closing && (*cp != '#' || cp[1] != '#'))
  1671. X    cp++;    /* Ignore comments */
  1672. X    if (cp < closing) {
  1673. X    while (isspace(cp[-1]))
  1674. X        cp--;
  1675. X    *cp = '#';   /* avoid skipping spaces past closing! */
  1676. X    closing = cp;
  1677. X    }
  1678. X    if (!p2c_only) {
  1679. X        if (!strncmp(inbufptr, "DUMP-SYMBOLS", 12) &&
  1680. X         closing == inbufptr + 12) {
  1681. X            wrapup();
  1682. X            inbufptr = after;
  1683. X            return 1;
  1684. X        }
  1685. X        if (!strncmp(inbufptr, fixedcomment, strlen(fixedcomment)) &&
  1686. X         *fixedcomment &&
  1687. X         inbufptr + strlen(fixedcomment) == closing) {
  1688. X            fixedflag++;
  1689. X            inbufptr = after;
  1690. X            return 1;
  1691. X        }
  1692. X        if (!strncmp(inbufptr, permanentcomment, strlen(permanentcomment)) &&
  1693. X         *permanentcomment &&
  1694. X         inbufptr + strlen(permanentcomment) == closing) {
  1695. X            permflag = 1;
  1696. X            inbufptr = after;
  1697. X            return 1;
  1698. X        }
  1699. X        if (!strncmp(inbufptr, interfacecomment, strlen(interfacecomment)) &&
  1700. X         *interfacecomment &&
  1701. X         inbufptr + strlen(interfacecomment) == closing) {
  1702. X            inbufptr = after;
  1703. X        curtok = TOK_INTFONLY;
  1704. X            return 2;
  1705. X        }
  1706. X        if (!strncmp(inbufptr, skipcomment, strlen(skipcomment)) &&
  1707. X         *skipcomment &&
  1708. X         inbufptr + strlen(skipcomment) == closing) {
  1709. X            inbufptr = after;
  1710. X        skipflag = -1;
  1711. X        skipping_module++;    /* eat comments in skipped portion */
  1712. X        do {
  1713. X        gettok();
  1714. X        } while (curtok != TOK_ENDIF);
  1715. X        skipping_module--;
  1716. X            return 1;
  1717. X        }
  1718. X    if (!strncmp(inbufptr, signedcomment, strlen(signedcomment)) &&
  1719. X         *signedcomment && !p2c_only &&
  1720. X         inbufptr + strlen(signedcomment) == closing) {
  1721. X        inbufptr = after;
  1722. X        gettok();
  1723. X        if (curtok == TOK_IDENT && curtokmeaning &&
  1724. X        curtokmeaning->kind == MK_TYPE &&
  1725. X        curtokmeaning->type == tp_char) {
  1726. X        curtokmeaning = mp_schar;
  1727. X        } else
  1728. X        warning("{SIGNED} applied to type other than CHAR [314]");
  1729. X        return 2;
  1730. X    }
  1731. X    if (!strncmp(inbufptr, unsignedcomment, strlen(unsignedcomment)) &&
  1732. X         *unsignedcomment && !p2c_only &&
  1733. X         inbufptr + strlen(unsignedcomment) == closing) {
  1734. X        inbufptr = after;
  1735. X        gettok();
  1736. X        if (curtok == TOK_IDENT && curtokmeaning &&
  1737. X        curtokmeaning->kind == MK_TYPE &&
  1738. X        curtokmeaning->type == tp_char) {
  1739. X        curtokmeaning = mp_uchar;
  1740. X        } else if (curtok == TOK_IDENT && curtokmeaning &&
  1741. X               curtokmeaning->kind == MK_TYPE &&
  1742. X               curtokmeaning->type == tp_integer) {
  1743. X        curtokmeaning = mp_unsigned;
  1744. X        } else if (curtok == TOK_IDENT && curtokmeaning &&
  1745. X               curtokmeaning->kind == MK_TYPE &&
  1746. X               curtokmeaning->type == tp_int) {
  1747. X        curtokmeaning = mp_uint;
  1748. X        } else
  1749. X        warning("{UNSIGNED} applied to type other than CHAR or INTEGER [313]");
  1750. X        return 2;
  1751. X    }
  1752. X        if (*inbufptr == '$') {
  1753. X            i = turbo_directive(closing, after);
  1754. X            if (i)
  1755. X                return i;
  1756. X        }
  1757. X    }
  1758. X    tempopt = 0;
  1759. X    cp = inbufptr;
  1760. X    if (*cp == '*') {
  1761. X        cp++;
  1762. X        tempopt = 1;
  1763. X    }
  1764. X    if (!isalpha(*cp))
  1765. X        return 0;
  1766. X    while ((isalnum(*cp) || *cp == '_') && cp2 < namebuf+300)
  1767. X        *cp2++ = toupper(*cp++);
  1768. X    *cp2 = 0;
  1769. X    i = numparams;
  1770. X    while (--i >= 0 && strcmp(rctable[i].name, namebuf)) ;
  1771. X    if (i < 0)
  1772. X        return 0;
  1773. X    kind = rctable[i].kind;
  1774. X    chgmode = rctable[i].chgmode;
  1775. X    if (chgmode == ' ')    /* allowed in p2crc only */
  1776. X        return 0;
  1777. X    if (chgmode == 'T' && lex_initialized) {
  1778. X        if (cp == closing || *cp == '=' || *cp == '+' || *cp == '-')
  1779. X            warning(format_s("%s works only at top of program [235]",
  1780. X                             rctable[i].name));
  1781. X    }
  1782. X    if (cp == closing) {
  1783. X        if (kind == 'S' || kind == 'I' || kind == 'D' || kind == 'L' ||
  1784. X        kind == 'R' || kind == 'B' || kind == 'C' || kind == 'U') {
  1785. X            undooption(i, "");
  1786. X            inbufptr = after;
  1787. X            return 1;
  1788. X        }
  1789. X    }
  1790. X    switch (kind) {
  1791. X
  1792. X        case 'S':
  1793. X        case 'I':
  1794. X        case 'L':
  1795. X            val = oldval = (kind == 'L') ? *(( long *)rctable[i].ptr) :
  1796. X                           (kind == 'S') ? *((short *)rctable[i].ptr) :
  1797. X                                           *((  int *)rctable[i].ptr);
  1798. X            switch (*cp) {
  1799. X
  1800. X                case '=':
  1801. X                    skipspc(cp);
  1802. X            hassign = (*++cp == '-' || *cp == '+');
  1803. X                    sign = (*cp == '-') ? -1 : 1;
  1804. X            cp += hassign;
  1805. X                    if (isdigit(*cp)) {
  1806. X                        val = 0;
  1807. X                        while (isdigit(*cp))
  1808. X                            val = val * 10 + (*cp++) - '0';
  1809. X                        val *= sign;
  1810. X            if (kind == 'D' && !hassign)
  1811. X                val += 10000;
  1812. X                    } else if (toupper(cp[0]) == 'D' &&
  1813. X                               toupper(cp[1]) == 'E' &&
  1814. X                               toupper(cp[2]) == 'F') {
  1815. X                        val = rctable[i].def;
  1816. X                        cp += 3;
  1817. X                    }
  1818. X                    break;
  1819. X
  1820. X                case '+':
  1821. X                case '-':
  1822. X                    if (chgmode != 'R')
  1823. X                        return 0;
  1824. X                    for (;;) {
  1825. X                        if (*cp == '+')
  1826. X                            val++;
  1827. X                        else if (*cp == '-')
  1828. X                            val--;
  1829. X                        else
  1830. X                            break;
  1831. X                        cp++;
  1832. X                    }
  1833. X                    break;
  1834. X
  1835. X            }
  1836. X            skipspc(cp);
  1837. X            if (cp != closing)
  1838. X                return 0;
  1839. X            strlist_insert(&rcprevvalues[i], "")->value = oldval;
  1840. X            if (tempopt)
  1841. X                strlist_insert(&tempoptionlist, "")->value = i;
  1842. X            if (kind == 'L')
  1843. X                *((long *)rctable[i].ptr) = val;
  1844. X            else if (kind == 'S')
  1845. X                *((short *)rctable[i].ptr) = val;
  1846. X            else
  1847. X                *((int *)rctable[i].ptr) = val;
  1848. X            inbufptr = after;
  1849. X            return 1;
  1850. X
  1851. X    case 'D':
  1852. X            val = oldval = *((int *)rctable[i].ptr);
  1853. X        if (*cp++ != '=')
  1854. X        return 0;
  1855. X        skipspc(cp);
  1856. X        if (toupper(cp[0]) == 'D' &&
  1857. X        toupper(cp[1]) == 'E' &&
  1858. X        toupper(cp[2]) == 'F') {
  1859. X        val = rctable[i].def;
  1860. X        cp += 3;
  1861. X        } else {
  1862. X                cp2 = namebuf;
  1863. X                while (*cp && cp != closing && !isspace(*cp))
  1864. X                    *cp2++ = *cp++;
  1865. X        *cp2 = 0;
  1866. X        val = parsedelta(namebuf, -1);
  1867. X        if (!val)
  1868. X            return 0;
  1869. X        }
  1870. X        skipspc(cp);
  1871. X            if (cp != closing)
  1872. X                return 0;
  1873. X            strlist_insert(&rcprevvalues[i], "")->value = oldval;
  1874. X            if (tempopt)
  1875. X                strlist_insert(&tempoptionlist, "")->value = i;
  1876. X            *((int *)rctable[i].ptr) = val;
  1877. X            inbufptr = after;
  1878. X            return 1;
  1879. X
  1880. X        case 'R':
  1881. X        if (*cp++ != '=')
  1882. X        return 0;
  1883. X        skipspc(cp);
  1884. X        if (toupper(cp[0]) == 'D' &&
  1885. X        toupper(cp[1]) == 'E' &&
  1886. X        toupper(cp[2]) == 'F') {
  1887. X        dval = rctable[i].def / 100.0;
  1888. X        cp += 3;
  1889. X        } else {
  1890. X        cp2 = cp;
  1891. X        while (isdigit(*cp) || *cp == '-' || *cp == '+' ||
  1892. X               *cp == '.' || toupper(*cp) == 'E')
  1893. X            cp++;
  1894. X        if (cp == cp2)
  1895. X            return 0;
  1896. X        dval = atof(cp2);
  1897. X        }
  1898. X        skipspc(cp);
  1899. X        if (cp != closing)
  1900. X        return 0;
  1901. X        sprintf(namebuf, "%g", *((double *)rctable[i].ptr));
  1902. X            strlist_insert(&rcprevvalues[i], namebuf);
  1903. X            if (tempopt)
  1904. X                strlist_insert(&tempoptionlist, namebuf)->value = i;
  1905. X        *((double *)rctable[i].ptr) = dval;
  1906. X            inbufptr = after;
  1907. X            return 1;
  1908. X
  1909. X        case 'B':
  1910. X        if (*cp++ != '=')
  1911. X        return 0;
  1912. X        skipspc(cp);
  1913. X        if (toupper(cp[0]) == 'D' &&
  1914. X        toupper(cp[1]) == 'E' &&
  1915. X        toupper(cp[2]) == 'F') {
  1916. X        val = rctable[i].def;
  1917. X        cp += 3;
  1918. X        } else {
  1919. X        val = parse_breakstr(cp);
  1920. X        while (*cp && cp != closing && !isspace(*cp))
  1921. X            cp++;
  1922. X        }
  1923. X        skipspc(cp);
  1924. X        if (cp != closing || val == -1)
  1925. X        return 0;
  1926. X            strlist_insert(&rcprevvalues[i], "")->value =
  1927. X        *((short *)rctable[i].ptr);
  1928. X            if (tempopt)
  1929. X                strlist_insert(&tempoptionlist, "")->value = i;
  1930. X        *((short *)rctable[i].ptr) = val;
  1931. X            inbufptr = after;
  1932. X            return 1;
  1933. X
  1934. X        case 'C':
  1935. X        case 'U':
  1936. X            if (*cp == '=') {
  1937. X                cp++;
  1938. X                skipspc(cp);
  1939. X                for (cp2 = cp; cp2 != closing && !isspace(*cp2); cp2++)
  1940. X                    if (!*cp2 || cp2-cp >= rctable[i].def)
  1941. X                        return 0;
  1942. X                cp2 = (char *)rctable[i].ptr;
  1943. X                sp = strlist_insert(&rcprevvalues[i], cp2);
  1944. X                if (tempopt)
  1945. X                    strlist_insert(&tempoptionlist, "")->value = i;
  1946. X                while (cp != closing && !isspace(*cp2))
  1947. X                    *cp2++ = *cp++;
  1948. X                *cp2 = 0;
  1949. X                if (kind == 'U')
  1950. X                    upc((char *)rctable[i].ptr);
  1951. X                skipspc(cp);
  1952. X                if (cp != closing)
  1953. X                    return 0;
  1954. X                inbufptr = after;
  1955. X                if (!strcmp(rctable[i].name, "LANGUAGE") &&
  1956. X                    !strcmp((char *)rctable[i].ptr, "MODCAL"))
  1957. X                    sysprog_flag |= 2;
  1958. X                return 1;
  1959. X            }
  1960. X            return 0;
  1961. X
  1962. X        case 'F':
  1963. X        case 'G':
  1964. X            if (*cp == '=' || *cp == '+' || *cp == '-') {
  1965. X                upcflag = (kind == 'F' && !pascalcasesens);
  1966. X                chgmode = *cp++;
  1967. X                skipspc(cp);
  1968. X                cp2 = namebuf;
  1969. X                while (isalnum(*cp) || *cp == '_' || *cp == '$' || *cp == '%')
  1970. X                    *cp2++ = *cp++;
  1971. X                *cp2++ = 0;
  1972. X        if (!*namebuf)
  1973. X            return 0;
  1974. X                skipspc(cp);
  1975. X                if (cp != closing)
  1976. X                    return 0;
  1977. X                if (upcflag)
  1978. X                    upc(namebuf);
  1979. X                sym = findsymbol(namebuf);
  1980. X        if (rctable[i].def & FUNCBREAK)
  1981. X            sym->flags &= ~FUNCBREAK;
  1982. X                if (chgmode == '-')
  1983. X                    sym->flags &= ~rctable[i].def;
  1984. X                else
  1985. X                    sym->flags |= rctable[i].def;
  1986. X                inbufptr = after;
  1987. X                return 1;
  1988. X           }
  1989. X           return 0;
  1990. X
  1991. X        case 'A':
  1992. X            if (*cp == '=' || *cp == '+' || *cp == '-') {
  1993. X                chgmode = *cp++;
  1994. X                skipspc(cp);
  1995. X                cp2 = namebuf;
  1996. X                while (cp != closing && !isspace(*cp) && *cp)
  1997. X                    *cp2++ = *cp++;
  1998. X                *cp2++ = 0;
  1999. X                skipspc(cp);
  2000. X                if (cp != closing)
  2001. X                    return 0;
  2002. X                if (chgmode != '+')
  2003. X                    strlist_remove((Strlist **)rctable[i].ptr, namebuf);
  2004. X                if (chgmode != '-')
  2005. X                    sp = strlist_insert((Strlist **)rctable[i].ptr, namebuf);
  2006. X                if (tempopt)
  2007. X                    strlist_insert(&tempoptionlist, namebuf)->value = i;
  2008. X                inbufptr = after;
  2009. X                return 1;
  2010. X            }
  2011. X            return 0;
  2012. X
  2013. X        case 'M':
  2014. X            if (!isspace(*cp))
  2015. X                return 0;
  2016. X            skipspc(cp);
  2017. X            if (!isalpha(*cp))
  2018. X                return 0;
  2019. X            for (cp2 = cp; *cp2 && cp2 != closing; cp2++) ;
  2020. X            if (cp2 > cp && cp2 == closing) {
  2021. X                inbufptr = after;
  2022. X                cp2 = format_ds("%.*s", (int)(cp2-cp), cp);
  2023. X                if (tp_integer != NULL) {
  2024. X                    defmacro(cp2, rctable[i].def, NULL, 0);
  2025. X                } else {
  2026. X                    sp = strlist_append(&addmacros, cp2);
  2027. X                    sp->value = rctable[i].def;
  2028. X                }
  2029. X                return 1;
  2030. X            }
  2031. X            return 0;
  2032. X
  2033. X        case 'X':
  2034. X            switch (rctable[i].def) {
  2035. X
  2036. X                case 1:     /* strlist with string values */
  2037. X                    if (!isspace(*cp) && *cp != '=' && 
  2038. X                        *cp != '+' && *cp != '-')
  2039. X                        return 0;
  2040. X                    chgmode = *cp++;
  2041. X                    skipspc(cp);
  2042. X                    cp2 = namebuf;
  2043. X                    while (isalnum(*cp) || *cp == '_' ||
  2044. X               *cp == '$' || *cp == '%' ||
  2045. X               *cp == '.' || *cp == '-' ||
  2046. X               (*cp == '\'' && cp[1] && cp[2] == '\'' &&
  2047. X                cp+1 != closing && cp[1] != '=')) {
  2048. X            if (*cp == '\'') {
  2049. X                *cp2++ = *cp++;
  2050. X                *cp2++ = *cp++;
  2051. X            }                
  2052. X                        *cp2++ = *cp++;
  2053. X            }
  2054. X                    *cp2++ = 0;
  2055. X                    if (chgmode == '-') {
  2056. X                        skipspc(cp);
  2057. END_OF_FILE
  2058. if test 49580 -ne `wc -c <'src/lex.c.1'`; then
  2059.     echo shar: \"'src/lex.c.1'\" unpacked with wrong size!
  2060. fi
  2061. # end of 'src/lex.c.1'
  2062. fi
  2063. echo shar: End of archive 31 \(of 32\).
  2064. cp /dev/null ark31isdone
  2065. MISSING=""
  2066. for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 ; do
  2067.     if test ! -f ark${I}isdone ; then
  2068.     MISSING="${MISSING} ${I}"
  2069.     fi
  2070. done
  2071. if test "${MISSING}" = "" ; then
  2072.     echo You have unpacked all 32 archives.
  2073.     echo "Now see PACKNOTES and the README"
  2074.     rm -f ark[1-9]isdone ark[1-9][0-9]isdone
  2075. else
  2076.     echo You still need to unpack the following archives:
  2077.     echo "        " ${MISSING}
  2078. fi
  2079. ##  End of shell archive.
  2080. exit 0
  2081.