LLlex.c 11 KB

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