LLlex.c 11 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587
  1. /* L E X I C A L A N A L Y S E R F O R I S O - P A S C A L */
  2. #include <stdlib.h>
  3. #include <stdio.h>
  4. #include <string.h>
  5. #include "debug.h"
  6. #include "idfsize.h"
  7. #include "numsize.h"
  8. #include "strsize.h"
  9. #include <alloc.h>
  10. #include <em_arith.h>
  11. #include <em_label.h>
  12. #include "LLlex.h"
  13. #include "Lpars.h"
  14. #include "class.h"
  15. #include "const.h"
  16. #include "f_info.h"
  17. #include "idf.h"
  18. #include "input.h"
  19. #include "main.h"
  20. #include "type.h"
  21. extern long str2long();
  22. extern char *Malloc();
  23. #define TO_LOWER(ch) (ch |= ( ch>='A' && ch<='Z' ) ? 0x0020 : 0)
  24. #ifdef DEBUG
  25. extern int cntlines;
  26. #endif
  27. int idfsize = IDFSIZE;
  28. struct token dot,
  29. aside;
  30. struct type *toktype,
  31. *asidetype;
  32. static int eofseen;
  33. int tokenseen = 0; /* Some comment-options must precede any program text */
  34. /* Warning: The options specified inside comments take precedence over
  35. * the ones on the command line.
  36. */
  37. CommentOptions()
  38. {
  39. register int ch, ci;
  40. int on_on_minus = 0;
  41. /* Parse options inside comments */
  42. do {
  43. LoadChar(ch);
  44. ci = ch;
  45. switch ( ci ) {
  46. case 'c': /* for strings */
  47. case 'd': /* for longs */
  48. case 's': /* check for standard */
  49. case 'u': /* for underscores */
  50. case 'C': /* for different cases */
  51. case 'U': /* for underscores */
  52. if( tokenseen ) {
  53. lexwarning("the '%c' option must precede any program text", ci);
  54. break;
  55. }
  56. LoadChar(ch);
  57. if( ci == 's' && options[ci] && ch == '-')
  58. lexwarning("option '%c-' overrides previous one", ci);
  59. if( ch == '-' ) options[ci] = 0;
  60. else if( ch == '+' ) options[ci] = 1;
  61. else PushBack();
  62. break;
  63. case 'l': ci = 'L' ; /* for indexing */
  64. /* fall through */
  65. case 'L': /* FIL & LIN instructions */
  66. case 'R': /* range checks */
  67. case 'a': /* assertions */
  68. on_on_minus = 1;
  69. /* fall through */
  70. case 't': /* tracing */
  71. case 'A': /* extra array range-checks */
  72. LoadChar(ch);
  73. if( ch == '-' ) options[ci] = on_on_minus;
  74. else if( ch == '+' ) options[ci] = !on_on_minus;
  75. else PushBack();
  76. on_on_minus = 0;
  77. break;
  78. case 'i':
  79. {
  80. register int i=0;
  81. LoadChar(ch);
  82. while( ch >= '0' && ch <= '9' ) {
  83. i = 10 * i + (ch - '0');
  84. LoadChar(ch);
  85. }
  86. PushBack();
  87. if( tokenseen ) {
  88. lexwarning("the '%c' option must precede any program text", ci);
  89. break;
  90. }
  91. if( i <= 0 ) {
  92. lexwarning("bad '%c' option", ci);
  93. break;
  94. }
  95. max_intset = i;
  96. break;
  97. }
  98. default:
  99. break;
  100. }
  101. LoadChar(ch);
  102. } while (ch == ',' );
  103. PushBack();
  104. }
  105. STATIC
  106. SkipComment()
  107. {
  108. /* Skip ISO-Pascal comments (* ... *) or { ... }.
  109. Note :
  110. comments may not be nested (ISO 6.1.8).
  111. (* and { are interchangeable, so are *) and }.
  112. */
  113. register int ch;
  114. LoadChar(ch);
  115. if (ch == '$') CommentOptions();
  116. for (;;) {
  117. if( class(ch) == STNL ) {
  118. LineNumber++;
  119. #ifdef DEBUG
  120. cntlines++;
  121. #endif
  122. }
  123. else if( ch == '*' ) {
  124. LoadChar(ch);
  125. if( ch == ')' ) return; /* *) */
  126. else continue;
  127. }
  128. else if( ch == '}' ) return;
  129. else if( ch == EOI ) {
  130. lexerror("unterminated comment");
  131. break;
  132. }
  133. LoadChar(ch);
  134. }
  135. }
  136. STATIC struct string *
  137. GetString( delim )
  138. register int delim;
  139. {
  140. /* Read a Pascal string, delimited by the character ' or ".
  141. */
  142. register int ch;
  143. register struct string *str = (struct string *)
  144. Malloc((unsigned) sizeof(struct string));
  145. register char *p;
  146. register int len = ISTRSIZE;
  147. str->s_str = p = Malloc((unsigned int) ISTRSIZE);
  148. for( ; ; ) {
  149. LoadChar(ch);
  150. if( ch & 0200 ) {
  151. fatal("non-ascii '\\%03o' read", ch & 0377);
  152. /*NOTREACHED*/
  153. }
  154. if( class(ch) == STNL ) {
  155. lexerror("newline in string");
  156. LineNumber++;
  157. #ifdef DEBUG
  158. cntlines++;
  159. #endif
  160. break;
  161. }
  162. if( ch == EOI ) {
  163. lexerror("end-of-file in string");
  164. break;
  165. }
  166. if( ch == delim ) {
  167. LoadChar(ch);
  168. if( ch != delim )
  169. break;
  170. }
  171. *p++ = ch;
  172. if( p - str->s_str == len ) {
  173. extern char *Srealloc();
  174. str->s_str = Srealloc(str->s_str,
  175. (unsigned int) len + RSTRSIZE);
  176. p = str->s_str + len;
  177. len += RSTRSIZE;
  178. }
  179. }
  180. if( ch == EOI ) eofseen = 1;
  181. else PushBack();
  182. str->s_length = p - str->s_str;
  183. *p++ = '\0';
  184. /* ISO 6.1.7: string length at least 1 */
  185. if( str->s_length == 0 ) {
  186. lexerror("character-string: at least one character expected");
  187. str->s_length = 1;
  188. }
  189. return str;
  190. }
  191. static char *s_error = "illegal line directive";
  192. CheckForLineDirective()
  193. {
  194. register int ch;
  195. register int i = 0;
  196. char buf[IDFSIZE + 2];
  197. register char *c = buf;
  198. LoadChar(ch);
  199. if( ch != '#' ) {
  200. PushBack();
  201. return;
  202. }
  203. do { /*
  204. * Skip to next digit. Do not skip newlines.
  205. */
  206. LoadChar(ch);
  207. if( class(ch) == STNL ) {
  208. LineNumber++;
  209. lexerror(s_error);
  210. return;
  211. }
  212. else if( ch == EOI ) {
  213. eofseen = 1;
  214. break;
  215. }
  216. } while( class(ch) != STNUM );
  217. while( class(ch) == STNUM ) {
  218. i = i * 10 + (ch - '0');
  219. LoadChar(ch);
  220. }
  221. if( ch == EOI ) {
  222. eofseen = 1;
  223. }
  224. while( ch != '"' && ch != EOI && class(ch) != STNL) LoadChar(ch);
  225. if( ch == '"' ) {
  226. do {
  227. LoadChar(ch);
  228. *c++ = ch;
  229. if( class(ch) == STNL ) {
  230. LineNumber++;
  231. error(s_error);
  232. return;
  233. }
  234. } while( ch != '"' );
  235. *--c = '\0';
  236. do {
  237. LoadChar(ch);
  238. } while( class(ch) != STNL );
  239. /*
  240. * Remember the filename
  241. */
  242. if( !eofseen && strcmp(FileName, buf) ) {
  243. FileName = Salloc(buf,(unsigned) strlen(buf) + 1);
  244. }
  245. }
  246. if( eofseen ) {
  247. error(s_error);
  248. return;
  249. }
  250. LineNumber = i;
  251. }
  252. int
  253. LLlex()
  254. {
  255. /* LLlex() is the Lexical Analyzer.
  256. The putting aside of tokens is taken into account.
  257. */
  258. register struct token *tk = &dot;
  259. register int ch, nch;
  260. toktype = error_type;
  261. if( ASIDE ) { /* a token is put aside */
  262. *tk = aside;
  263. toktype = asidetype;
  264. ASIDE = 0;
  265. return tk->tk_symb;
  266. }
  267. tk->tk_lineno = LineNumber;
  268. again1:
  269. if( eofseen ) {
  270. eofseen = 0;
  271. ch = EOI;
  272. }
  273. else {
  274. again:
  275. LoadChar(ch);
  276. if( !options['C'] ) /* -C : cases are different */
  277. TO_LOWER(ch);
  278. if( (ch & 0200) && ch != EOI ) {
  279. fatal("non-ascii '\\%03o' read", ch & 0377);
  280. /*NOTREACHED*/
  281. }
  282. }
  283. switch( class(ch) ) {
  284. case STNL:
  285. LineNumber++;
  286. tk->tk_lineno++;
  287. #ifdef DEBUG
  288. cntlines++;
  289. #endif
  290. CheckForLineDirective();
  291. goto again1;
  292. case STSKIP:
  293. goto again;
  294. case STGARB:
  295. if( !tokenseen && (ch == '"' || ch == '_') ) {
  296. return tk->tk_symb = ch;
  297. }
  298. if( (unsigned) ch < 0177 )
  299. lexerror("garbage char %c", ch);
  300. else
  301. crash("(LLlex) garbage char \\%03o", ch);
  302. goto again;
  303. case STSIMP:
  304. if( ch == '(' ) {
  305. LoadChar(nch);
  306. if( nch == '*' ) { /* (* */
  307. SkipComment();
  308. tk->tk_lineno = LineNumber;
  309. goto again1;
  310. }
  311. if( nch == '.' ) /* (. is [ */
  312. return tk->tk_symb = '[';
  313. if( nch == EOI ) eofseen = 1;
  314. else PushBack();
  315. }
  316. else if( ch == '{' ) {
  317. SkipComment();
  318. tk->tk_lineno = LineNumber;
  319. goto again1;
  320. }
  321. else if( ch == '@' ) ch = '^'; /* @ is ^ */
  322. return tk->tk_symb = ch;
  323. case STCOMP:
  324. LoadChar(nch);
  325. switch( ch ) {
  326. case '.':
  327. if( nch == '.' ) /* .. */
  328. return tk->tk_symb = UPTO;
  329. if( nch == ')' ) /* .) is ] */
  330. return tk->tk_symb = ']';
  331. break;
  332. case ':':
  333. if( nch == '=' ) /* := */
  334. return tk->tk_symb = BECOMES;
  335. break;
  336. case '<':
  337. if( nch == '=' ) /* <= */
  338. return tk->tk_symb = LESSEQUAL;
  339. if( nch == '>' ) /* <> */
  340. return tk->tk_symb = NOTEQUAL;
  341. break;
  342. case '>':
  343. if( nch == '=' ) /* >= */
  344. return tk->tk_symb = GREATEREQUAL;
  345. break;
  346. default :
  347. crash("(LLlex, STCOMP)");
  348. /*NOTREACHED*/
  349. }
  350. if( nch == EOI ) eofseen = 1;
  351. else PushBack();
  352. return tk->tk_symb = ch;
  353. case STIDF: {
  354. char buf[IDFSIZE + 1];
  355. register char *tag = &buf[0];
  356. register struct idf *id;
  357. extern struct idf *str2idf();
  358. do {
  359. if( !options['C'] ) /* -C : cases are different */
  360. TO_LOWER(ch);
  361. if( tag - buf < idfsize )
  362. *tag++ = ch;
  363. LoadChar(ch);
  364. } while( in_idf(ch) );
  365. *tag = '\0';
  366. if( ch == EOI ) eofseen = 1;
  367. else PushBack();
  368. /* dtrg: removed to allow Pascal programs to access system routines
  369. * (necessary to make them do anything useful). What's this for,
  370. * anyway? */
  371. #if 0
  372. if( buf[0] == '_' ) lexerror("underscore starts identifier");
  373. #endif
  374. tk->TOK_IDF = id = str2idf(buf, 1);
  375. return tk->tk_symb = id->id_reserved ? id->id_reserved : IDENT;
  376. }
  377. case STSTR: {
  378. register struct string *str = GetString(ch);
  379. if( str->s_length == 1 && ch == '\'') {
  380. #ifdef DEBUG
  381. if( options['l'] ) {
  382. /* to prevent LexScan from crashing */
  383. tk->tk_data.tk_str = str;
  384. return tk->tk_symb = STRING;
  385. }
  386. #endif
  387. tk->TOK_INT = *(str->s_str) & 0377;
  388. toktype = char_type;
  389. free(str->s_str);
  390. free((char *) str);
  391. }
  392. else {
  393. if( ch == '\'' ) {
  394. tk->tk_data.tk_str = str;
  395. toktype = standard_type(T_STRINGCONST, 1, str->s_length);
  396. }
  397. else {
  398. tk->tk_data.tk_str = str;
  399. toktype = string_type;
  400. }
  401. }
  402. return tk->tk_symb = STRING;
  403. }
  404. case STNUM: {
  405. #define INT_MODE 0
  406. #define REAL_MODE 1
  407. char buf[NUMSIZE+2];
  408. register char *np = &buf[1];
  409. register int state = INT_MODE;
  410. extern char *Salloc();
  411. buf[0] = '-';
  412. do {
  413. if( np <= &buf[NUMSIZE] )
  414. *np++ = ch;
  415. LoadChar(ch);
  416. } while( is_dig(ch) );
  417. if( ch == '.' ) {
  418. LoadChar(ch);
  419. if( is_dig(ch) ) {
  420. if( np <= &buf[NUMSIZE] )
  421. *np++ = '.';
  422. do {
  423. /* fractional part */
  424. if( np <= &buf[NUMSIZE] )
  425. *np++ = ch;
  426. LoadChar(ch);
  427. } while( is_dig(ch) );
  428. state = REAL_MODE;
  429. }
  430. else {
  431. PushBack();
  432. PushBack();
  433. goto end;
  434. }
  435. }
  436. if( ch == 'e' || ch == 'E' ) {
  437. char *tp = np; /* save position in string */
  438. /* scale factor */
  439. if( np <= &buf[NUMSIZE] )
  440. *np++ = ch;
  441. LoadChar(ch);
  442. if( ch == '+' || ch == '-' ) {
  443. /* signed scale factor */
  444. if( np <= &buf[NUMSIZE] )
  445. *np++ = ch;
  446. LoadChar(ch);
  447. }
  448. if( is_dig(ch) ) {
  449. do {
  450. if( np <= &buf[NUMSIZE] )
  451. *np++ = ch;
  452. LoadChar(ch);
  453. } while( is_dig(ch) );
  454. state = REAL_MODE;
  455. }
  456. else {
  457. PushBack();
  458. PushBack();
  459. if( np - tp == 2 ) /* sign */
  460. PushBack();
  461. np = tp; /* restore position */
  462. goto end;
  463. }
  464. }
  465. /* syntax of number is correct */
  466. if( ch == EOI ) eofseen = 1;
  467. else PushBack();
  468. end:
  469. *np++ = '\0';
  470. if( state == INT_MODE ) {
  471. if( np > &buf[NUMSIZE+1] ) {
  472. tk->TOK_INT = 1;
  473. lexerror("constant too long");
  474. }
  475. else {
  476. np = &buf[1];
  477. while (*np == '0') /* skip leading zeros */
  478. np++;
  479. tk->TOK_INT = str2long(np, 10);
  480. if( tk->TOK_INT < 0 ||
  481. strlen(np) > strlen(maxint_str) ||
  482. strlen(np) == strlen(maxint_str) &&
  483. strcmp(np, maxint_str) > 0 )
  484. lexwarning("overflow in constant");
  485. }
  486. toktype = int_type;
  487. return tk->tk_symb = INTEGER;
  488. }
  489. /* REAL_MODE */
  490. tk->tk_data.tk_real = (struct real *)
  491. Malloc(sizeof(struct real));
  492. /* allocate struct for inverse */
  493. tk->TOK_RIV = (struct real *) Malloc(sizeof(struct real));
  494. tk->TOK_RIV->r_inverse = tk->tk_data.tk_real;
  495. tk->TOK_RLA = 0;
  496. tk->TOK_RIV->r_lab = 0;
  497. if( np > &buf[NUMSIZE+1] ) {
  498. tk->TOK_REL = Salloc("0.0", 4);
  499. tk->TOK_RIV->r_real = tk->TOK_REL;
  500. lexerror("floating constant too long");
  501. }
  502. else {
  503. tk->TOK_RIV->r_real = Salloc(buf,(unsigned) (np - buf));
  504. tk->TOK_REL = tk->TOK_RIV->r_real + 1;
  505. }
  506. toktype = real_type;
  507. return tk->tk_symb = REAL;
  508. /*NOTREACHED*/
  509. }
  510. case STEOI:
  511. return tk->tk_symb = -1;
  512. case STCHAR:
  513. default:
  514. crash("(LLlex) Impossible character class");
  515. /*NOTREACHED*/
  516. }
  517. /*NOTREACHED*/
  518. }