type.c 14 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707
  1. /* T Y P E D E F I N I T I O N M E C H A N I S M */
  2. #include "debug.h"
  3. #include <alloc.h>
  4. #include <assert.h>
  5. #include <em.h>
  6. #include <pc_file.h>
  7. #include "LLlex.h"
  8. #include "const.h"
  9. #include "def.h"
  10. #include "idf.h"
  11. #include "main.h"
  12. #include "node.h"
  13. #include "scope.h"
  14. #include "type.h"
  15. #ifndef NOCROSS
  16. #include "target_sizes.h"
  17. int
  18. word_align = AL_WORD,
  19. int_align = AL_INT,
  20. long_align = AL_LONG,
  21. pointer_align = AL_POINTER,
  22. real_align = AL_REAL,
  23. struct_align = AL_STRUCT;
  24. arith
  25. word_size = SZ_WORD,
  26. int_size = SZ_INT,
  27. long_size = SZ_LONG,
  28. pointer_size = SZ_POINTER,
  29. real_size = SZ_REAL;
  30. #endif /* NOCROSS */
  31. extern arith max_int;
  32. struct type
  33. *bool_type,
  34. *char_type,
  35. *int_type,
  36. *long_type,
  37. *real_type,
  38. *string_type,
  39. *std_type,
  40. *text_type,
  41. *nil_type,
  42. *emptyset_type,
  43. *void_type,
  44. *error_type;
  45. CheckTypeSizes()
  46. {
  47. /* first, do some checking
  48. */
  49. if( int_size != word_size )
  50. fatal("integer size not equal to word size");
  51. if( word_size != 2 && word_size != 4 )
  52. fatal("illegal wordsize");
  53. if( pointer_size != 2 && pointer_size != 4 )
  54. fatal("illegal pointersize");
  55. if( options['d'] ) {
  56. if( long_size < int_size )
  57. fatal("longsize should be at least the integersize");
  58. if( long_size > 2 * int_size)
  59. fatal("longsize should be at most twice the integersize");
  60. }
  61. if( pointer_size < word_size )
  62. fatal("pointersize should be at least the wordsize");
  63. if( real_size != 4 && real_size != 8 )
  64. fatal("illegal realsize");
  65. }
  66. InitTypes()
  67. {
  68. /* First check the sizes of some basic EM-types
  69. */
  70. CheckTypeSizes();
  71. if( options['s'] ) {
  72. options['c'] = 0;
  73. options['d'] = 0;
  74. options['u'] = 0;
  75. options['C'] = 0;
  76. options['U'] = 0;
  77. }
  78. /* Initialize the predefined types
  79. */
  80. /* character type
  81. */
  82. char_type = standard_type(T_CHAR, 1, (arith) 1);
  83. char_type->enm_ncst = 128; /* only 7 bits ASCII characters */
  84. /* boolean type
  85. */
  86. bool_type = standard_type(T_ENUMERATION, 1, (arith) 1);
  87. bool_type->enm_ncst = 2;
  88. /* integer type
  89. */
  90. int_type = standard_type(T_INTEGER, int_align, int_size);
  91. /* real type
  92. */
  93. real_type = standard_type(T_REAL, real_align, real_size);
  94. /* long type
  95. */
  96. if( options['d'] )
  97. long_type = standard_type(T_LONG, long_align, long_size);
  98. /* string type
  99. */
  100. if( options['c'] )
  101. string_type = standard_type(T_STRING, pointer_align, pointer_size);
  102. /* an unique type for standard procedures and functions
  103. */
  104. std_type = construct_type(T_PROCEDURE, NULLTYPE);
  105. /* text (file of char) type
  106. */
  107. text_type = construct_type(T_FILE, char_type);
  108. text_type->tp_flags |= T_HASFILE;
  109. /* an unique type indicating an error
  110. */
  111. error_type = standard_type(T_ERROR, 1, (arith) 1);
  112. void_type = error_type;
  113. /* the nilvalue has an unique type
  114. */
  115. nil_type = construct_type(T_POINTER, error_type);
  116. /* the type of an empty set is generic
  117. */
  118. emptyset_type = construct_type(T_SET, error_type);
  119. emptyset_type->tp_size = word_size;
  120. emptyset_type->tp_align = word_align;
  121. }
  122. int
  123. fit(sz, nbytes)
  124. arith sz;
  125. {
  126. return ((sz) + ((arith)0x80<<(((nbytes)-1)*8)) & ~full_mask[(nbytes)]) == 0;
  127. }
  128. struct type *
  129. standard_type(fund, algn, size)
  130. arith size;
  131. {
  132. register struct type *tp = new_type();
  133. tp->tp_fund = fund;
  134. tp->tp_palign = algn ? algn : 1;
  135. tp->tp_psize = size;
  136. tp->tp_align = word_align;
  137. tp->tp_size = WA(size);
  138. return tp;
  139. }
  140. struct type *
  141. construct_type(fund, tp)
  142. register struct type *tp;
  143. {
  144. /* fund must be a type constructor.
  145. * The pointer to the constructed type is returned.
  146. */
  147. register struct type *dtp = new_type();
  148. switch( dtp->tp_fund = fund ) {
  149. case T_PROCEDURE:
  150. case T_FUNCTION:
  151. dtp->tp_align = pointer_align;
  152. dtp->tp_size = 2 * pointer_size;
  153. break;
  154. case T_POINTER:
  155. dtp->tp_align = dtp->tp_palign = pointer_align;
  156. dtp->tp_size = dtp->tp_psize = pointer_size;
  157. break;
  158. case T_SET:
  159. case T_ARRAY:
  160. break;
  161. case T_FILE:
  162. dtp->tp_align = dtp->tp_palign = word_align;
  163. dtp->tp_size = dtp->tp_psize = sizeof(struct file);
  164. break;
  165. case T_SUBRANGE:
  166. assert(tp != 0);
  167. dtp->tp_align = tp->tp_align;
  168. dtp->tp_size = tp->tp_size;
  169. dtp->tp_palign = tp->tp_palign;
  170. dtp->tp_psize = tp->tp_psize;
  171. break;
  172. default:
  173. crash("funny type constructor");
  174. }
  175. dtp->next = tp;
  176. return dtp;
  177. }
  178. struct type *
  179. proc_type(parameters, n_bytes_params)
  180. struct paramlist *parameters;
  181. arith n_bytes_params;
  182. {
  183. register struct type *tp = construct_type(T_PROCEDURE, NULLTYPE);
  184. tp->prc_params = parameters;
  185. tp->prc_nbpar = n_bytes_params;
  186. return tp;
  187. }
  188. struct type *
  189. func_type(parameters, n_bytes_params, resulttype)
  190. struct paramlist *parameters;
  191. arith n_bytes_params;
  192. struct type *resulttype;
  193. {
  194. register struct type *tp = construct_type(T_FUNCTION, resulttype);
  195. tp->prc_params = parameters;
  196. tp->prc_nbpar = n_bytes_params;
  197. return tp;
  198. }
  199. chk_type_id(ptp, nd)
  200. register struct type **ptp;
  201. register struct node *nd;
  202. {
  203. register struct def *df;
  204. *ptp = error_type;
  205. if( ChkLinkOrName(nd) ) {
  206. if( nd->nd_class != Def )
  207. node_error(nd, "type expected");
  208. else {
  209. /* register struct def *df = nd->nd_def; */
  210. df = nd->nd_def;
  211. df->df_flags |= D_USED;
  212. if( df->df_kind & (D_TYPE | D_FTYPE | D_ERROR) ) {
  213. if( !df->df_type )
  214. node_error(nd, "type \"%s\" not declared",
  215. df->df_idf->id_text);
  216. else
  217. *ptp = df->df_type;
  218. }
  219. else
  220. node_error(nd,"identifier \"%s\" is not a type",
  221. df->df_idf->id_text);
  222. }
  223. }
  224. }
  225. struct type *
  226. subr_type(lb, ub)
  227. register struct node *lb, *ub;
  228. {
  229. /* Construct a subrange type from the constant expressions
  230. indicated by "lb" and "ub", but first perform some checks
  231. */
  232. register struct type *tp = lb->nd_type, *res;
  233. if( !TstTypeEquiv(lb->nd_type, ub->nd_type) ) {
  234. node_error(ub, "types of subrange bounds not equal");
  235. return error_type;
  236. }
  237. /* Check base type
  238. */
  239. if( !(tp->tp_fund & T_ORDINAL) ) {
  240. node_error(ub, "illegal base type for subrange");
  241. return error_type;
  242. }
  243. /* Check bounds
  244. */
  245. if( lb->nd_INT > ub->nd_INT )
  246. node_error(ub, "lower bound exceeds upper bound");
  247. /* Now construct resulting type
  248. */
  249. res = construct_type(T_SUBRANGE, tp);
  250. res->sub_lb = lb->nd_INT;
  251. res->sub_ub = ub->nd_INT;
  252. if (res->sub_lb >= 0) {
  253. if (ufit(res->sub_ub, 1)) {
  254. res->tp_psize = 1;
  255. res->tp_palign = 1;
  256. }
  257. else if (ufit(res->sub_ub, 2)) {
  258. res->tp_psize = 2;
  259. res->tp_palign = 2 < word_align ? 2 : word_align;
  260. }
  261. }
  262. else {
  263. if (fit(res->sub_lb, 1) && fit(res->sub_ub, 1)) {
  264. res->tp_psize = 1;
  265. res->tp_palign = 1;
  266. }
  267. else if (fit(res->sub_lb, 2) && fit(res->sub_ub, 2)) {
  268. res->tp_psize = 2;
  269. res->tp_palign = 2 < word_align ? 2 : word_align;
  270. }
  271. }
  272. return res;
  273. }
  274. getbounds(tp, plo, phi)
  275. register struct type *tp;
  276. arith *plo, *phi;
  277. {
  278. /* Get the bounds of a bounded type
  279. */
  280. assert(bounded(tp));
  281. if( tp->tp_fund & T_SUBRANGE ) {
  282. *plo = tp->sub_lb;
  283. *phi = tp->sub_ub;
  284. }
  285. else if( tp->tp_fund & T_INTEGER ) {
  286. *plo = -max_int;
  287. *phi = max_int;
  288. }
  289. else {
  290. *plo = 0;
  291. *phi = tp->enm_ncst - 1;
  292. }
  293. }
  294. struct type *
  295. set_type(tp, packed)
  296. register struct type *tp;
  297. unsigned short packed;
  298. {
  299. /* Construct a set type with base type "tp", but first
  300. perform some checks
  301. */
  302. struct type *basetype;
  303. static struct type *int_set = 0;
  304. arith lb, ub;
  305. if( tp == int_type ) {
  306. /* SET OF INTEGER */
  307. if( !int_set ) {
  308. struct node *lbn = new_node();
  309. struct node *ubn = new_node();
  310. lbn->nd_type = ubn->nd_type = int_type;
  311. /* the bounds are implicit */
  312. lbn->nd_INT = 0;
  313. ubn->nd_INT = max_intset;
  314. int_set = subr_type(lbn, ubn);
  315. }
  316. lb = 0;
  317. ub = max_intset;
  318. tp = int_set;
  319. }
  320. else {
  321. /* SET OF subrange/enumeration/char */
  322. if( !bounded(tp) ) {
  323. error("illegal base type of set");
  324. return error_type;
  325. }
  326. basetype = BaseType(tp);
  327. if( basetype == int_type ) {
  328. /* subrange of integers */
  329. getbounds(tp, &lb, &ub);
  330. if( lb < 0 || ub > max_intset ) {
  331. error("illegal integer base type of set");
  332. return error_type;
  333. }
  334. lb = 0;
  335. ub = max_intset;
  336. }
  337. else getbounds(basetype, &lb, &ub);
  338. }
  339. assert(lb == 0);
  340. /* at this point lb and ub denote the bounds of the host-type of the
  341. * base-type of the set
  342. */
  343. tp = construct_type(T_SET, tp);
  344. tp->tp_flags |= packed;
  345. tp->tp_psize = (ub - lb + 8) >> 3;
  346. tp->tp_size = WA(tp->tp_psize);
  347. tp->tp_align = word_align;
  348. if( !packed || word_size % tp->tp_psize != 0 ) {
  349. tp->tp_psize = tp->tp_size;
  350. tp->tp_palign = word_align;
  351. }
  352. else tp->tp_palign = tp->tp_psize;
  353. return tp;
  354. }
  355. arith
  356. ArrayElSize(tp, packed)
  357. register struct type *tp;
  358. {
  359. /* Align element size to alignment requirement of element type.
  360. Also make sure that its size is either a dividor of the word_size,
  361. or a multiple of it.
  362. */
  363. register arith algn;
  364. if( tp->tp_fund & T_ARRAY && !(tp->tp_flags & T_CHECKED) )
  365. ArraySizes(tp);
  366. if( !packed )
  367. return tp->tp_size;
  368. algn = align(tp->tp_psize, tp->tp_palign);
  369. if( word_size % algn != 0 ) {
  370. /* algn is not a dividor of the word size, so make sure it
  371. is a multiple
  372. */
  373. algn = WA(algn);
  374. }
  375. if( !fit(algn, (int) word_size) ) {
  376. error("element of array too large");
  377. }
  378. return algn;
  379. }
  380. ArraySizes(tp)
  381. register struct type *tp;
  382. {
  383. /* Assign sizes to an array type, and check index type
  384. */
  385. register struct type *index_type = IndexType(tp);
  386. register struct type *elem_type = tp->arr_elem;
  387. arith lo, hi, diff;
  388. tp->tp_flags |= T_CHECKED;
  389. tp->arr_elsize = ArrayElSize(elem_type,(int) IsPacked(tp));
  390. /* check index type
  391. */
  392. if( !bounded(index_type) ) {
  393. error("illegal index type");
  394. tp->tp_psize = tp->tp_size = tp->arr_elsize;
  395. tp->tp_palign = tp->tp_align = elem_type->tp_align;
  396. tp->next = error_type;
  397. return;
  398. }
  399. getbounds(index_type, &lo, &hi);
  400. diff = hi - lo;
  401. if( diff < 0 || !fit(diff, (int) word_size) ) {
  402. error("too many elements in array");
  403. }
  404. if( (unsigned long)full_mask[(int) pointer_size]/(diff + 1) <
  405. tp->arr_elsize ) {
  406. error("array too large");
  407. }
  408. tp->tp_psize = (diff + 1) * tp->arr_elsize;
  409. tp->tp_palign = (word_size % tp->tp_psize) ? word_align : tp->tp_psize;
  410. tp->tp_size = WA(tp->tp_psize);
  411. tp->tp_align = word_align;
  412. /* generate descriptor and remember label.
  413. */
  414. tp->arr_ardescr = ++data_label;
  415. C_df_dlb(data_label);
  416. C_rom_cst(lo);
  417. C_rom_cst(diff);
  418. C_rom_cst(tp->arr_elsize);
  419. }
  420. FreeForward(for_type)
  421. register struct forwtype *for_type;
  422. {
  423. if( !for_type ) return;
  424. FreeForward(for_type->f_next);
  425. free_node(for_type->f_node);
  426. free_forwtype(for_type);
  427. }
  428. chk_forw_types()
  429. {
  430. /* check all forward references (in pointer types) */
  431. register struct def *df = CurrentScope->sc_def;
  432. register struct def *ldf = NULLDEF;
  433. struct type *tp;
  434. while( df ) {
  435. if( df->df_kind & (D_FORWTYPE | D_FTYPE) ) {
  436. register struct forwtype *fw_type = df->df_fortype;
  437. if( df->df_kind == D_FORWTYPE ) {
  438. /* forward type not in this scope declared */
  439. register struct scopelist *scl = nextvisible(CurrVis);
  440. struct def *df1 = 0;
  441. while( scl ) {
  442. /* look in enclosing scopes */
  443. df1 = lookup(df->df_fortype->f_node->nd_IDF,
  444. scl->sc_scope, D_INUSE);
  445. if( df1 ) break;
  446. scl = nextvisible( scl );
  447. }
  448. if( !df1 || df1->df_kind != D_TYPE ) {
  449. /* bad forward type */
  450. tp = error_type;
  451. }
  452. else { /* ok */
  453. tp = df1->df_type;
  454. /* remove the def struct in the current scope */
  455. if( !ldf )
  456. CurrentScope->sc_def = df->df_nextinscope;
  457. else
  458. ldf->df_nextinscope = df->df_nextinscope;
  459. /* remove the def struct from symbol-table */
  460. remove_def(df);
  461. }
  462. }
  463. else /* forward type was resolved */
  464. tp = df->df_type;
  465. while( fw_type ) {
  466. if( tp == error_type )
  467. node_error(fw_type->f_node,
  468. "identifier \"%s\" is not a type",
  469. df->df_idf->id_text);
  470. fw_type->f_type->next = tp;
  471. #ifdef DBSYMTAB
  472. if (options['g']) {
  473. stb_addtp("(forward_type)", fw_type->f_type);
  474. }
  475. #endif
  476. fw_type = fw_type->f_next;
  477. }
  478. FreeForward( df->df_fortype );
  479. df->df_flags |= D_USED;
  480. if( tp == error_type )
  481. df->df_kind = D_ERROR;
  482. else
  483. df->df_kind = D_TYPE;
  484. }
  485. ldf = df;
  486. df = df->df_nextinscope;
  487. }
  488. }
  489. TstCaseConstants(nd, sel, sel1)
  490. register struct node *nd;
  491. register struct selector *sel, *sel1;
  492. {
  493. /* Insert selector of nested variant (sel1) in tagvalue-table of
  494. current selector (sel).
  495. */
  496. while( nd ) {
  497. if( !TstCompat(nd->nd_type, sel->sel_type) )
  498. node_error(nd, "type incompatibility in caselabel");
  499. else if( sel->sel_ptrs ) {
  500. arith i = nd->nd_INT - sel->sel_lb;
  501. if( i < 0 || i >= sel->sel_ncst )
  502. node_error(nd, "case constant: out of bounds");
  503. else if( sel->sel_ptrs[i] != sel )
  504. node_error(nd,
  505. "record variant: multiple defined caselabel");
  506. else
  507. sel->sel_ptrs[i] = sel1;
  508. }
  509. nd = nd->nd_next;
  510. }
  511. }
  512. arith
  513. align(pos, al)
  514. arith pos;
  515. int al;
  516. {
  517. arith i;
  518. return pos + ((i = pos % al) ? al - i : 0);
  519. }
  520. int
  521. gcd(m, n)
  522. register int m, n;
  523. {
  524. /* Greatest Common Divisor
  525. */
  526. register int r;
  527. while( n ) {
  528. r = m % n;
  529. m = n;
  530. n = r;
  531. }
  532. return m;
  533. }
  534. int
  535. lcm(m, n)
  536. int m, n;
  537. {
  538. /* Least Common Multiple
  539. */
  540. return m * (n / gcd(m, n));
  541. }
  542. #ifdef DEBUG
  543. DumpType(tp)
  544. register struct type *tp;
  545. {
  546. if( !tp ) return;
  547. print("align:%d; size:%ld;", tp->tp_align, (long) tp->tp_size);
  548. print(" fund:");
  549. switch( tp->tp_fund ) {
  550. case T_ENUMERATION:
  551. print("ENUMERATION; ncst:%d", tp->enm_ncst); break;
  552. case T_INTEGER:
  553. print("INTEGER"); break;
  554. case T_LONG:
  555. print("LONG"); break;
  556. case T_REAL:
  557. print("REAL"); break;
  558. case T_CHAR:
  559. print("CHAR"); break;
  560. case T_STRING:
  561. print("STRING"); break;
  562. case T_PROCEDURE:
  563. case T_FUNCTION:
  564. {
  565. register struct paramlist *par = ParamList(tp);
  566. if( tp->tp_fund == T_PROCEDURE )
  567. print("PROCEDURE");
  568. else
  569. print("FUNCTION");
  570. if( par ) {
  571. print("(");
  572. while( par ) {
  573. if( IsVarParam(par) ) print("VAR ");
  574. DumpType(TypeOfParam(par));
  575. par = par->next;
  576. }
  577. }
  578. break;
  579. }
  580. case T_FILE:
  581. print("FILE"); break;
  582. case T_STRINGCONST:
  583. print("STRINGCONST"); break;
  584. case T_SUBRANGE:
  585. print("SUBRANGE %ld-%ld", (long) tp->sub_lb, (long) tp->sub_ub);
  586. break;
  587. case T_SET:
  588. print("SET"); break;
  589. case T_ARRAY:
  590. print("ARRAY");
  591. print("; element:");
  592. DumpType(tp->arr_elem);
  593. print("; index:");
  594. DumpType(tp->next);
  595. print(";");
  596. return;
  597. case T_RECORD:
  598. print("RECORD"); break;
  599. case T_POINTER:
  600. print("POINTER"); break;
  601. default:
  602. crash("DumpType");
  603. }
  604. if( tp->next && tp->tp_fund != T_POINTER ) {
  605. /* Avoid printing recursive types!
  606. */
  607. print(" next:(");
  608. DumpType(tp->next);
  609. print(")");
  610. }
  611. print(";");
  612. }
  613. #endif