LLlex.c 13 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675
  1. /*
  2. * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
  3. * See the copyright notice in the ACK home directory, in the file "Copyright".
  4. *
  5. * Author: Ceriel J.H. Jacobs
  6. */
  7. /* L E X I C A L A N A L Y S E R F O R M O D U L A - 2 */
  8. /* $Id$ */
  9. #include <stdlib.h>
  10. #include <stdio.h>
  11. #include <string.h>
  12. #include "debug.h"
  13. #include "idfsize.h"
  14. #include "numsize.h"
  15. #include "strsize.h"
  16. #include "alloc.h"
  17. #include "em_arith.h"
  18. #include "em_label.h"
  19. #include "assert.h"
  20. #include "LLlex.h"
  21. #include "input.h"
  22. #include "f_info.h"
  23. #include "Lpars.h"
  24. #include "class.h"
  25. #include "idf.h"
  26. #include "def.h"
  27. #include "type.h"
  28. #include "warning.h"
  29. #include "errout.h"
  30. extern char *getwdir();
  31. t_token dot,
  32. aside;
  33. t_type *toktype;
  34. int idfsize = IDFSIZE;
  35. int ForeignFlag;
  36. #ifdef DEBUG
  37. extern int cntlines;
  38. #endif
  39. int token_nmb = 0;
  40. int tk_nmb_at_last_syn_err = -ERR_SHADOW;
  41. extern char options[];
  42. extern int flt_status;
  43. STATIC
  44. SkipComment()
  45. {
  46. /* Skip Modula-2 comments (* ... *).
  47. Note that comments may be nested (par. 3.5).
  48. */
  49. register int ch, c;
  50. register int CommentLevel = 0;
  51. LoadChar(ch);
  52. if (ch == '$') {
  53. LoadChar(ch);
  54. switch(ch) {
  55. case 'F':
  56. /* Foreign; This definition module has an
  57. implementation in another language.
  58. In this case, don't generate prefixes in front
  59. of the names. Also, don't generate call to
  60. initialization routine.
  61. */
  62. ForeignFlag = D_FOREIGN;
  63. break;
  64. case 'U':
  65. inidf['_'] = 1;
  66. break;
  67. case 'A': /* Extra array bound checks, on or off */
  68. case 'R': /* Range checks, on or off */
  69. {
  70. int on_on_minus = ch == 'R';
  71. LoadChar(c);
  72. if (c == '-') {
  73. options[ch] = on_on_minus;
  74. break;
  75. }
  76. if (c == '+') {
  77. options[ch] = !on_on_minus;
  78. break;
  79. }
  80. ch = c;
  81. }
  82. /* fall through */
  83. default:
  84. break;
  85. }
  86. }
  87. for (;;) {
  88. if (!(ch & 0200) && class(ch) == STNL) {
  89. LineNumber++;
  90. #ifdef DEBUG
  91. cntlines++;
  92. #endif
  93. }
  94. else if (ch == '(') {
  95. LoadChar(ch);
  96. if (ch == '*') CommentLevel++;
  97. else continue;
  98. }
  99. else if (ch == '*') {
  100. LoadChar(ch);
  101. if (ch == ')') {
  102. CommentLevel--;
  103. if (CommentLevel < 0) break;
  104. }
  105. else continue;
  106. }
  107. else if (ch == EOI) {
  108. lexerror("unterminated comment");
  109. PushBack();
  110. break;
  111. }
  112. LoadChar(ch);
  113. }
  114. }
  115. STATIC struct string *
  116. GetString(upto)
  117. {
  118. /* Read a Modula-2 string, delimited by the character "upto".
  119. */
  120. register int ch;
  121. register struct string *str = (struct string *)
  122. Malloc((unsigned) sizeof(struct string));
  123. register char *p;
  124. register int len;
  125. len = ISTRSIZE;
  126. str->s_str = p = Malloc((unsigned int) ISTRSIZE);
  127. while (LoadChar(ch), ch != upto) {
  128. if (!(ch & 0200) && class(ch) == STNL) {
  129. lexerror("newline in string");
  130. LineNumber++;
  131. #ifdef DEBUG
  132. cntlines++;
  133. #endif
  134. break;
  135. }
  136. if (ch == EOI) {
  137. lexerror("end-of-file in string");
  138. break;
  139. }
  140. *p++ = ch;
  141. if (p - str->s_str == len) {
  142. str->s_str = Realloc(str->s_str,
  143. (unsigned int) len + RSTRSIZE);
  144. p = str->s_str + len;
  145. len += RSTRSIZE;
  146. }
  147. }
  148. str->s_length = p - str->s_str;
  149. len = (str->s_length+(int)word_size) & ~((int)word_size-1);
  150. while (p - str->s_str < len) {
  151. *p++ = '\0';
  152. }
  153. str->s_str = Realloc(str->s_str, (unsigned) len);
  154. if (str->s_length == 0) str->s_length = 1;
  155. /* ??? string length at least 1 ??? */
  156. return str;
  157. }
  158. static char *s_error = "illegal line directive";
  159. STATIC int
  160. getch()
  161. {
  162. register int ch;
  163. while (LoadChar(ch), (ch & 0200) && ch != EOI) {
  164. error("non-ascii '\\%03o' read", ch & 0377);
  165. }
  166. return ch;
  167. }
  168. CheckForLineDirective()
  169. {
  170. register int ch = getch();
  171. register int i = 0;
  172. char buf[IDFSIZE];
  173. register char *c = buf;
  174. if (ch != '#') {
  175. PushBack();
  176. return;
  177. }
  178. do { /*
  179. * Skip to next digit
  180. * Do not skip newlines
  181. */
  182. ch = getch();
  183. if (class(ch) == STNL || class(ch) == STEOI) {
  184. LineNumber++;
  185. error(s_error);
  186. return;
  187. }
  188. } while (class(ch) != STNUM);
  189. while (class(ch) == STNUM) {
  190. i = i*10 + (ch - '0');
  191. ch = getch();
  192. }
  193. while (ch != '"' && class(ch) != STNL && class(ch) != STEOI)
  194. ch = getch();
  195. if (ch == '"') {
  196. c = buf;
  197. do {
  198. ch = getch();
  199. if (c < &buf[IDFSIZE]) *c++ = ch;
  200. if (class(ch) == STNL || class(ch) == STEOI) {
  201. LineNumber++;
  202. error(s_error);
  203. return;
  204. }
  205. } while (ch != '"');
  206. *--c = '\0';
  207. do {
  208. ch = getch();
  209. } while (class(ch) != STNL && class(ch) != STEOI);
  210. /*
  211. * Remember the file name
  212. */
  213. if (class(ch) == STNL && strcmp(FileName,buf)) {
  214. FileName = Salloc(buf,(unsigned) strlen(buf) + 1);
  215. WorkingDir = getwdir(FileName);
  216. }
  217. }
  218. if (class(ch) == STEOI) {
  219. error(s_error);
  220. return;
  221. }
  222. LineNumber = i;
  223. }
  224. STATIC
  225. CheckForLet()
  226. {
  227. register int ch;
  228. LoadChar(ch);
  229. if (ch != EOI) {
  230. if (class(ch) == STIDF) {
  231. lexerror("token separator required between identifier and number");
  232. }
  233. PushBack();
  234. }
  235. }
  236. int
  237. LLlex()
  238. {
  239. /* LLlex() is the Lexical Analyzer.
  240. The putting aside of tokens is taken into account.
  241. */
  242. register t_token *tk = &dot;
  243. char buf[(IDFSIZE > NUMSIZE ? IDFSIZE : NUMSIZE) + 2];
  244. register int ch, nch;
  245. toktype = error_type;
  246. if (ASIDE) { /* a token is put aside */
  247. *tk = aside;
  248. ASIDE = 0;
  249. return tk->tk_symb;
  250. }
  251. token_nmb++;
  252. again:
  253. ch = getch();
  254. tk->tk_lineno = LineNumber;
  255. switch (class(ch)) {
  256. case STNL:
  257. LineNumber++;
  258. #ifdef DEBUG
  259. cntlines++;
  260. #endif
  261. CheckForLineDirective();
  262. goto again;
  263. case STSKIP:
  264. goto again;
  265. case STGARB:
  266. if ((unsigned) ch - 040 < 0137) {
  267. lexerror("garbage char %c", ch);
  268. }
  269. else lexerror("garbage char \\%03o", ch);
  270. goto again;
  271. case STSIMP:
  272. if (ch == '(') {
  273. LoadChar(nch);
  274. if (nch == '*') {
  275. SkipComment();
  276. goto again;
  277. }
  278. PushBack();
  279. }
  280. if (ch == '&') return tk->tk_symb = AND;
  281. if (ch == '~') return tk->tk_symb = NOT;
  282. return tk->tk_symb = ch;
  283. case STCOMP:
  284. LoadChar(nch);
  285. switch (ch) {
  286. case '.':
  287. if (nch == '.') {
  288. return tk->tk_symb = UPTO;
  289. }
  290. break;
  291. case ':':
  292. if (nch == '=') {
  293. return tk->tk_symb = BECOMES;
  294. }
  295. break;
  296. case '<':
  297. if (nch == '=') {
  298. return tk->tk_symb = LESSEQUAL;
  299. }
  300. if (nch == '>') {
  301. return tk->tk_symb = '#';
  302. }
  303. break;
  304. case '>':
  305. if (nch == '=') {
  306. return tk->tk_symb = GREATEREQUAL;
  307. }
  308. break;
  309. default :
  310. crash("(LLlex, STCOMP)");
  311. }
  312. PushBack();
  313. return tk->tk_symb = ch;
  314. case STIDF:
  315. {
  316. register char *tag = &buf[0];
  317. register t_idf *id;
  318. do {
  319. if (tag - buf < idfsize) *tag++ = ch;
  320. LoadChar(ch);
  321. if (ch == '_' && *(tag-1) == '_') {
  322. lexerror("an identifier may not contain two consecutive underscores");
  323. }
  324. } while(in_idf(ch));
  325. PushBack();
  326. *tag = '\0';
  327. if (*(tag - 1) == '_') {
  328. lexerror("last character of an identifier may not be an underscore");
  329. }
  330. tk->TOK_IDF = id = str2idf(buf, 1);
  331. return tk->tk_symb = id->id_reserved ? id->id_reserved : IDENT;
  332. }
  333. case STSTR: {
  334. register struct string *str = GetString(ch);
  335. if (str->s_length == 1) {
  336. tk->TOK_INT = *(str->s_str) & 0377;
  337. toktype = char_type;
  338. free(str->s_str);
  339. free((char *) str);
  340. }
  341. else {
  342. tk->tk_data.tk_str = str;
  343. if (! fit((arith)(str->s_length), (int) word_size)) {
  344. lexerror("string too long");
  345. }
  346. toktype = standard_type(T_STRING, 1, (arith)(str->s_length));
  347. }
  348. return tk->tk_symb = STRING;
  349. }
  350. case STNUM:
  351. {
  352. /* The problem arising with the "parsing" of a number
  353. is that we don't know the base in advance so we
  354. have to read the number with the help of a rather
  355. complex finite automaton.
  356. */
  357. enum statetp {Oct,OptHex,Hex,Dec,OctEndOrHex,End,OptReal,Real};
  358. register enum statetp state;
  359. register int base = 8;
  360. register char *np = &buf[0];
  361. *np++ = ch;
  362. state = is_oct(ch) ? Oct : Dec;
  363. LoadChar(ch);
  364. for (;;) {
  365. switch(state) {
  366. case Oct:
  367. while (is_oct(ch)) {
  368. if (np < &buf[NUMSIZE]) *np++ = ch;
  369. LoadChar(ch);
  370. }
  371. if (ch == 'B' || ch == 'C') {
  372. state = OctEndOrHex;
  373. break;
  374. }
  375. /* Fall Through */
  376. case Dec:
  377. base = 10;
  378. while (is_dig(ch)) {
  379. if (np < &buf[NUMSIZE]) {
  380. *np++ = ch;
  381. }
  382. LoadChar(ch);
  383. }
  384. if (ch == 'D') state = OptHex;
  385. else if (is_hex(ch)) state = Hex;
  386. else if (ch == '.') state = OptReal;
  387. else {
  388. state = End;
  389. if (ch == 'H') base = 16;
  390. else PushBack();
  391. }
  392. break;
  393. case OptHex:
  394. LoadChar(ch);
  395. if (is_hex(ch)) {
  396. if (np < &buf[NUMSIZE]) *np++ = 'D';
  397. state = Hex;
  398. }
  399. else {
  400. state = End;
  401. ch = 'D';
  402. PushBack();
  403. }
  404. break;
  405. case Hex:
  406. while (is_hex(ch)) {
  407. if (np < &buf[NUMSIZE]) *np++ = ch;
  408. LoadChar(ch);
  409. }
  410. base = 16;
  411. state = End;
  412. if (ch != 'H') {
  413. lexerror("H expected after hex number");
  414. PushBack();
  415. }
  416. break;
  417. case OctEndOrHex:
  418. if (np < &buf[NUMSIZE]) *np++ = ch;
  419. LoadChar(ch);
  420. if (ch == 'H') {
  421. base = 16;
  422. state = End;
  423. break;
  424. }
  425. if (is_hex(ch)) {
  426. state = Hex;
  427. break;
  428. }
  429. PushBack();
  430. ch = *--np;
  431. *np++ = '\0';
  432. /* Fall through */
  433. case End: {
  434. int ovfl = 0;
  435. *np = '\0';
  436. if (np >= &buf[NUMSIZE]) {
  437. tk->TOK_INT = 1;
  438. lexerror("constant too long");
  439. }
  440. else {
  441. /* The upperbound will be the same as
  442. when computed with something like
  443. max(unsigned long) / base (when base
  444. is even). The problem is that
  445. unsigned long or unsigned arith is
  446. not accepted by all compilers
  447. */
  448. arith ubound = max_int[sizeof(arith)]
  449. / (base >> 1);
  450. np = &buf[0];
  451. while (*np == '0') np++;
  452. tk->TOK_INT = 0;
  453. while (*np) {
  454. int c;
  455. if (is_dig(*np)) {
  456. c = *np++ - '0';
  457. }
  458. else {
  459. assert(is_hex(*np));
  460. c = *np++ - 'A' + 10;
  461. }
  462. if (tk->TOK_INT < 0 ||
  463. tk->TOK_INT > ubound) {
  464. ovfl++;
  465. }
  466. tk->TOK_INT = tk->TOK_INT*base;
  467. if (tk->TOK_INT < 0 &&
  468. tk->TOK_INT + c >= 0) {
  469. ovfl++;
  470. }
  471. tk->TOK_INT += c;
  472. }
  473. }
  474. toktype = card_type;
  475. if (ch == 'C' && base == 8) {
  476. toktype = char_type;
  477. if (ovfl != 0 || tk->TOK_INT>255 ||
  478. tk->TOK_INT < 0) {
  479. lexwarning(W_ORDINARY, "character constant out of range");
  480. }
  481. CheckForLet();
  482. return tk->tk_symb = INTEGER;
  483. }
  484. if (options['l']) {
  485. if (base != 10) {
  486. LoadChar(ch);
  487. if (ch != 'D') {
  488. PushBack();
  489. }
  490. }
  491. }
  492. if (ch == 'D' && (options['l'] || base == 10)) {
  493. if (options['l']) {
  494. /* Local extension: LONGCARD exists,
  495. so internally also longintorcard_type
  496. exists.
  497. */
  498. toktype = longcard_type;
  499. if (ovfl == 0 && tk->TOK_INT >= 0 &&
  500. tk->TOK_INT<=max_int[(int)long_size]) {
  501. toktype = longintorcard_type;
  502. }
  503. else if (! chk_bounds(tk->TOK_INT,
  504. full_mask[(int)long_size],
  505. T_CARDINAL)) {
  506. ovfl = 1;
  507. }
  508. }
  509. else {
  510. if (ovfl != 0 ||
  511. tk->TOK_INT > max_int[(int)long_size] ||
  512. tk->TOK_INT < 0) {
  513. ovfl = 1;
  514. }
  515. toktype = longint_type;
  516. }
  517. }
  518. else if (ovfl == 0 && tk->TOK_INT >= 0 &&
  519. tk->TOK_INT<=max_int[(int)int_size]) {
  520. toktype = intorcard_type;
  521. }
  522. else if (! chk_bounds(tk->TOK_INT,
  523. full_mask[(int)int_size],
  524. T_CARDINAL)) {
  525. ovfl = 1;
  526. }
  527. if (ovfl)
  528. lexwarning(W_ORDINARY, "overflow in constant");
  529. CheckForLet();
  530. return tk->tk_symb = INTEGER;
  531. }
  532. case OptReal:
  533. /* The '.' could be the first of the '..'
  534. token. At this point, we need a
  535. look-ahead of two characters.
  536. */
  537. LoadChar(ch);
  538. if (ch == '.') {
  539. /* Indeed the '..' token
  540. */
  541. PushBack();
  542. PushBack();
  543. state = End;
  544. base = 10;
  545. break;
  546. }
  547. state = Real;
  548. break;
  549. }
  550. if (state == Real) break;
  551. }
  552. /* a real real constant */
  553. if (np < &buf[NUMSIZE]) *np++ = '.';
  554. toktype = real_type;
  555. while (is_dig(ch)) {
  556. /* Fractional part
  557. */
  558. if (np < &buf[NUMSIZE]) *np++ = ch;
  559. LoadChar(ch);
  560. }
  561. if (ch == 'D') {
  562. toktype = longreal_type;
  563. LoadChar(ch);
  564. if (ch == '+' || ch == '-' || is_dig(ch)) {
  565. ch = 'E';
  566. PushBack();
  567. }
  568. }
  569. if (ch == 'E') {
  570. /* Scale factor
  571. */
  572. if (np < &buf[NUMSIZE]) *np++ = ch;
  573. LoadChar(ch);
  574. if (ch == '+' || ch == '-') {
  575. /* Signed scalefactor
  576. */
  577. if (np < &buf[NUMSIZE]) *np++ = ch;
  578. LoadChar(ch);
  579. }
  580. if (is_dig(ch)) {
  581. do {
  582. if (np < &buf[NUMSIZE]) *np++ = ch;
  583. LoadChar(ch);
  584. } while (is_dig(ch));
  585. }
  586. else {
  587. lexerror("bad scale factor");
  588. }
  589. }
  590. *np++ = '\0';
  591. PushBack();
  592. tk->tk_data.tk_real = new_real();
  593. if (np >= &buf[NUMSIZE]) {
  594. tk->TOK_RSTR = Salloc("0.0", 4);
  595. lexerror("real constant too long");
  596. }
  597. else tk->TOK_RSTR = Salloc(buf, (unsigned) (np - buf));
  598. CheckForLet();
  599. flt_str2flt(tk->TOK_RSTR, &(tk->TOK_RVAL));
  600. if (flt_status == FLT_OVFL) {
  601. lexwarning(W_ORDINARY, "overflow in floating point constant");
  602. }
  603. return tk->tk_symb = REAL;
  604. /*NOTREACHED*/
  605. }
  606. case STEOI:
  607. return tk->tk_symb = -1;
  608. case STCHAR:
  609. default:
  610. crash("(LLlex) Impossible character class");
  611. /*NOTREACHED*/
  612. }
  613. /*NOTREACHED*/
  614. }