code.c 21 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142
  1. /* C O D E G E N E R A T I O N R O U T I N E S */
  2. #include "debug.h"
  3. #include <assert.h>
  4. #include <em.h>
  5. #include <em_reg.h>
  6. #include "LLlex.h"
  7. #include "Lpars.h"
  8. #include "def.h"
  9. #include "desig.h"
  10. #include "main.h"
  11. #include "node.h"
  12. #include "required.h"
  13. #include "scope.h"
  14. #include "type.h"
  15. int fp_used;
  16. CodeFil()
  17. {
  18. if ( !options['L'] )
  19. C_fil_dlb((label) 1, (arith) 0);
  20. }
  21. RomString(nd)
  22. register struct node *nd;
  23. {
  24. C_df_dlb(++data_label);
  25. C_rom_scon(nd->nd_STR, nd->nd_SLE); /* no trailing '\0' */
  26. nd->nd_SLA = data_label;
  27. }
  28. RomReal(nd)
  29. register struct node *nd;
  30. {
  31. C_df_dlb(++data_label);
  32. C_rom_fcon(nd->nd_REL, nd->nd_type->tp_size);
  33. nd->nd_RLA = nd->nd_RIV->r_lab = data_label;
  34. }
  35. BssVar()
  36. {
  37. /* generate bss segments for global variables */
  38. register struct def *df = GlobalScope->sc_def;
  39. while( df ) {
  40. if( df->df_kind == D_VARIABLE ) {
  41. C_df_dnam(df->var_name);
  42. /* ??? undefined value ??? */
  43. C_bss_cst(df->df_type->tp_size, (arith) 0, 0);
  44. }
  45. df = df->df_nextinscope;
  46. }
  47. }
  48. arith
  49. CodeGtoDescr(sc)
  50. register struct scope *sc;
  51. {
  52. /* Create code for goto descriptors
  53. */
  54. register struct node *lb = sc->sc_lablist;
  55. int first = 1;
  56. while( lb ) {
  57. if( lb->nd_def->lab_descr ) {
  58. if( first ) {
  59. /* create local for target SP */
  60. sc->sc_off = -WA(pointer_size - sc->sc_off);
  61. C_ms_gto();
  62. first = 0;
  63. }
  64. C_df_dlb(lb->nd_def->lab_descr);
  65. C_rom_ilb(lb->nd_def->lab_no);
  66. C_rom_cst(sc->sc_off);
  67. }
  68. lb = lb->nd_next;
  69. }
  70. if( !first )
  71. return sc->sc_off;
  72. else
  73. return (arith) 0;
  74. }
  75. arith
  76. CodeBeginBlock(df)
  77. register struct def *df;
  78. {
  79. /* Generate code at the beginning of the main program,
  80. procedure or function.
  81. */
  82. arith StackAdjustment = 0;
  83. arith offset; /* offset to save StackPointer */
  84. TmpOpen(df->prc_vis->sc_scope);
  85. switch( df->df_kind ) {
  86. case D_PROGRAM :
  87. C_exp("m_a_i_n");
  88. C_pro_narg("m_a_i_n");
  89. C_ms_par((arith) 0);
  90. offset = CodeGtoDescr(df->prc_vis->sc_scope);
  91. CodeFil();
  92. /* initialize external files */
  93. make_extfl();
  94. call_ini();
  95. break;
  96. case D_PROCEDURE :
  97. case D_FUNCTION : {
  98. struct type *tp;
  99. register struct paramlist *param;
  100. C_pro_narg(df->prc_name);
  101. C_ms_par(df->df_type->prc_nbpar);
  102. offset = CodeGtoDescr(df->prc_vis->sc_scope);
  103. CodeFil();
  104. for( param = ParamList(df->df_type); param; param = param->next)
  105. if( !IsVarParam(param) ) {
  106. tp = TypeOfParam(param);
  107. if( IsConformantArray(tp) ) {
  108. /* Here, we have to make a copy of the
  109. array. We must also remember how much
  110. room is reserved for copies, because
  111. we have to adjust the stack pointer
  112. before we return.
  113. */
  114. if( !StackAdjustment ) {
  115. /* First time we get here
  116. */
  117. StackAdjustment = NewInt(0);
  118. C_loc((arith) 0);
  119. C_stl(StackAdjustment);
  120. }
  121. /* Address of array */
  122. C_lol(param->par_def->var_off);
  123. /* First compute size of the array */
  124. C_lol(tp->arr_cfdescr + word_size);
  125. C_inc();
  126. /* gives number of elements */
  127. C_lol(tp->arr_cfdescr + 2 * word_size);
  128. /* size of elements */
  129. C_mli(word_size);
  130. C_loc(word_size - 1);
  131. C_adi(word_size);
  132. C_loc(word_size);
  133. C_dvi(word_size);
  134. /* size in words */
  135. C_loc(word_size);
  136. C_mli(word_size);
  137. /* size in bytes */
  138. C_dup(word_size);
  139. C_lol(StackAdjustment);
  140. C_adi(word_size);
  141. C_stl(StackAdjustment);
  142. /* remember stack adjustments */
  143. C_los(word_size); /* copy */
  144. C_lor((arith) 1);
  145. /* push new address of array
  146. ... downwards ... ???
  147. */
  148. C_stl(param->par_def->var_off);
  149. }
  150. }
  151. break;
  152. }
  153. default :
  154. crash("(CodeBeginBlock)");
  155. /*NOTREACHED*/
  156. }
  157. if( offset ) {
  158. /* save SP for non-local jump */
  159. C_lor((arith) 1);
  160. C_stl(offset);
  161. }
  162. return StackAdjustment;
  163. }
  164. CodeEndBlock(df, StackAdjustment)
  165. register struct def *df;
  166. arith StackAdjustment;
  167. {
  168. switch( df->df_kind ) {
  169. case D_PROGRAM :
  170. C_loc((arith) 0);
  171. C_cal("_hlt");
  172. break;
  173. case D_PROCEDURE :
  174. case D_FUNCTION : {
  175. struct type *tp;
  176. if( StackAdjustment ) {
  177. /* remove copies of conformant arrays */
  178. C_lol(StackAdjustment);
  179. C_ass(word_size);
  180. FreeInt(StackAdjustment);
  181. }
  182. if( !options['n'] )
  183. RegisterMessages(df->prc_vis->sc_scope->sc_def);
  184. if( tp = ResultType(df->df_type) ) {
  185. if( tp->tp_size == real_size )
  186. C_ldl(-tp->tp_size);
  187. else
  188. C_lol(-tp->tp_size);
  189. C_ret(tp->tp_size);
  190. }
  191. else
  192. C_ret((arith) 0);
  193. break;
  194. }
  195. default :
  196. crash("(CodeEndBlock)");
  197. /*NOTREACHED*/
  198. }
  199. C_end(- df->prc_vis->sc_scope->sc_off);
  200. TmpClose();
  201. }
  202. CodeExpr(nd, ds, true_label)
  203. register struct node *nd;
  204. register struct desig *ds;
  205. label true_label;
  206. {
  207. register struct type *tp = nd->nd_type;
  208. if( tp->tp_fund == T_REAL ) fp_used = 1;
  209. switch( nd->nd_class ) {
  210. case Value:
  211. switch( nd->nd_symb ) {
  212. case INTEGER:
  213. C_loc(nd->nd_INT);
  214. break;
  215. case REAL:
  216. C_lae_dlb(nd->nd_RLA, (arith) 0);
  217. C_loi(tp->tp_size);
  218. if( nd->nd_RSI )
  219. C_ngf(tp->tp_size);
  220. break;
  221. case STRING:
  222. if( tp->tp_fund == T_CHAR )
  223. C_loc(nd->nd_INT);
  224. else
  225. C_lae_dlb(nd->nd_SLA, (arith) 0);
  226. break;
  227. case NIL:
  228. C_zer(pointer_size);
  229. break;
  230. default:
  231. crash("(CodeExpr Value)");
  232. /*NOTREACHED*/
  233. }
  234. ds->dsg_kind = DSG_LOADED;
  235. break;
  236. case Uoper:
  237. CodeUoper(nd);
  238. ds->dsg_kind = DSG_LOADED;
  239. break;
  240. case Boper:
  241. CodeBoper(nd, true_label);
  242. ds->dsg_kind = DSG_LOADED;
  243. true_label = NO_LABEL;
  244. break;
  245. case Set: {
  246. register arith *st = nd->nd_set;
  247. register int i;
  248. ds->dsg_kind = DSG_LOADED;
  249. if( !st ) {
  250. C_zer(tp->tp_size);
  251. break;
  252. }
  253. for( i = tp->tp_size / word_size, st += i; i > 0; i--)
  254. C_loc(*--st);
  255. }
  256. break;
  257. case Xset:
  258. CodeSet(nd);
  259. ds->dsg_kind = DSG_LOADED;
  260. break;
  261. case Call:
  262. CodeCall(nd);
  263. ds->dsg_kind = DSG_LOADED;
  264. break;
  265. case NameOrCall: {
  266. /* actual procedure/function parameter */
  267. struct node *left = nd->nd_left;
  268. struct def *df = left->nd_def;
  269. if( df->df_kind & D_ROUTINE ) {
  270. int level = df->df_scope->sc_level;
  271. if( level <= 0 || (df->df_flags & D_EXTERNAL) )
  272. C_zer(pointer_size);
  273. else
  274. C_lxl((arith) (proclevel - level));
  275. C_lpi(df->prc_name);
  276. ds->dsg_kind = DSG_LOADED;
  277. break;
  278. }
  279. assert(df->df_kind == D_VARIABLE);
  280. assert(df->df_type->tp_fund & T_ROUTINE);
  281. CodeDesig(left, ds);
  282. break;
  283. }
  284. case Arrow:
  285. case Arrsel:
  286. case Def:
  287. case LinkDef:
  288. CodeDesig(nd, ds);
  289. break;
  290. case Cast: {
  291. /* convert integer to real */
  292. struct node *right = nd->nd_right;
  293. CodePExpr(right);
  294. Int2Real();
  295. ds->dsg_kind = DSG_LOADED;
  296. break;
  297. }
  298. default:
  299. crash("(CodeExpr : bad node type)");
  300. /*NOTREACHED*/
  301. } /* switch class */
  302. if( true_label ) {
  303. /* Only for boolean expressions
  304. */
  305. CodeValue(ds, tp);
  306. C_zeq(true_label);
  307. }
  308. }
  309. CodeUoper(nd)
  310. register struct node *nd;
  311. {
  312. register struct type *tp = nd->nd_type;
  313. CodePExpr(nd->nd_right);
  314. switch( nd->nd_symb ) {
  315. case '-':
  316. assert(tp->tp_fund & T_NUMERIC);
  317. if( tp->tp_fund == T_INTEGER )
  318. C_ngi(tp->tp_size);
  319. else
  320. C_ngf(tp->tp_size);
  321. break;
  322. case NOT:
  323. C_teq();
  324. break;
  325. case '(':
  326. break;
  327. default:
  328. crash("(CodeUoper)");
  329. /*NOTREACHED*/
  330. }
  331. }
  332. Operands(leftop, rightop)
  333. register struct node *leftop, *rightop;
  334. {
  335. CodePExpr(leftop);
  336. CodePExpr(rightop);
  337. }
  338. CodeBoper(expr, true_label)
  339. register struct node *expr; /* the expression tree itself */
  340. label true_label; /* label to jump to in logical exprs */
  341. {
  342. register struct node *leftop = expr->nd_left;
  343. register struct node *rightop = expr->nd_right;
  344. register struct type *tp = expr->nd_type;
  345. switch( expr->nd_symb ) {
  346. case '+':
  347. Operands(leftop, rightop);
  348. switch( tp->tp_fund ) {
  349. case T_INTEGER:
  350. C_adi(tp->tp_size);
  351. break;
  352. case T_REAL:
  353. C_adf(tp->tp_size);
  354. break;
  355. case T_SET:
  356. C_ior(tp->tp_size);
  357. break;
  358. default:
  359. crash("(CodeBoper: bad type +)");
  360. }
  361. break;
  362. case '-':
  363. Operands(leftop, rightop);
  364. switch( tp->tp_fund ) {
  365. case T_INTEGER:
  366. C_sbi(tp->tp_size);
  367. break;
  368. case T_REAL:
  369. C_sbf(tp->tp_size);
  370. break;
  371. case T_SET:
  372. C_com(tp->tp_size);
  373. C_and(tp->tp_size);
  374. break;
  375. default:
  376. crash("(CodeBoper: bad type -)");
  377. }
  378. break;
  379. case '*':
  380. Operands(leftop, rightop);
  381. switch( tp->tp_fund ) {
  382. case T_INTEGER:
  383. C_mli(tp->tp_size);
  384. break;
  385. case T_REAL:
  386. C_mlf(tp->tp_size);
  387. break;
  388. case T_SET:
  389. C_and(tp->tp_size);
  390. break;
  391. default:
  392. crash("(CodeBoper: bad type *)");
  393. }
  394. break;
  395. case '/':
  396. Operands(leftop, rightop);
  397. if( tp->tp_fund == T_REAL )
  398. C_dvf(tp->tp_size);
  399. else
  400. crash("(CodeBoper: bad type /)");
  401. break;
  402. case DIV:
  403. Operands(leftop, rightop);
  404. if( tp->tp_fund == T_INTEGER )
  405. C_dvi(tp->tp_size);
  406. else
  407. crash("(CodeBoper: bad type DIV)");
  408. break;
  409. case MOD:
  410. Operands(leftop, rightop);
  411. if( tp->tp_fund == T_INTEGER ) {
  412. C_cal("_mdi");
  413. C_asp(2 * tp->tp_size);
  414. C_lfr(tp->tp_size);
  415. }
  416. else
  417. crash("(CodeBoper: bad type MOD)");
  418. break;
  419. case '<':
  420. case LESSEQUAL:
  421. case '>':
  422. case GREATEREQUAL:
  423. case '=':
  424. case NOTEQUAL:
  425. CodePExpr(leftop);
  426. CodePExpr(rightop);
  427. tp = BaseType(rightop->nd_type);
  428. switch( tp->tp_fund ) {
  429. case T_INTEGER:
  430. C_cmi(tp->tp_size);
  431. break;
  432. case T_REAL:
  433. C_cmf(tp->tp_size);
  434. break;
  435. case T_ENUMERATION:
  436. case T_CHAR:
  437. C_cmu(word_size);
  438. break;
  439. case T_POINTER:
  440. C_cmp();
  441. break;
  442. case T_SET:
  443. if( expr->nd_symb == GREATEREQUAL ) {
  444. /* A >= B is the same as A equals A + B
  445. */
  446. C_dup(2 * tp->tp_size);
  447. C_asp(tp->tp_size);
  448. C_ior(tp->tp_size);
  449. expr->nd_symb = '=';
  450. }
  451. else if( expr->nd_symb == LESSEQUAL ) {
  452. /* A <= B is the same as A - B = []
  453. */
  454. C_com(tp->tp_size);
  455. C_and(tp->tp_size);
  456. C_zer(tp->tp_size);
  457. expr->nd_symb = '=';
  458. }
  459. C_cms(tp->tp_size);
  460. break;
  461. case T_STRING:
  462. case T_ARRAY:
  463. C_loc(IsString(tp));
  464. C_cal("_bcp");
  465. C_asp(2 * pointer_size + word_size);
  466. C_lfr(word_size);
  467. break;
  468. default:
  469. crash("(CodeBoper : bad type COMPARE)");
  470. }
  471. truthvalue(expr->nd_symb);
  472. if( true_label != NO_LABEL )
  473. C_zeq(true_label);
  474. break;
  475. case IN:
  476. /* In this case, evaluate right hand side first! The INN
  477. instruction expects the bit number on top of the stack
  478. */
  479. CodePExpr(rightop);
  480. CodePExpr(leftop);
  481. if( rightop->nd_type == emptyset_type )
  482. C_and(rightop->nd_type->tp_size);
  483. else
  484. C_inn(rightop->nd_type->tp_size);
  485. if( true_label != NO_LABEL )
  486. C_zeq(true_label);
  487. break;
  488. case AND:
  489. case OR:
  490. Operands(leftop, rightop);
  491. if( expr->nd_symb == AND )
  492. C_and(tp->tp_size);
  493. else
  494. C_ior(tp->tp_size);
  495. if( true_label != NO_LABEL )
  496. C_zeq(true_label);
  497. break;
  498. default:
  499. crash("(CodeBoper Bad operator %s\n)",
  500. symbol2str(expr->nd_symb));
  501. }
  502. }
  503. /* truthvalue() serves as an auxiliary function of CodeBoper */
  504. truthvalue(relop)
  505. {
  506. switch( relop ) {
  507. case '<':
  508. C_tlt();
  509. break;
  510. case LESSEQUAL:
  511. C_tle();
  512. break;
  513. case '>':
  514. C_tgt();
  515. break;
  516. case GREATEREQUAL:
  517. C_tge();
  518. break;
  519. case '=':
  520. C_teq();
  521. break;
  522. case NOTEQUAL:
  523. C_tne();
  524. break;
  525. default:
  526. crash("(truthvalue)");
  527. /*NOTREACHED*/
  528. }
  529. }
  530. CodeSet(nd)
  531. register struct node *nd;
  532. {
  533. register struct type *tp = nd->nd_type;
  534. C_zer(tp->tp_size);
  535. nd = nd->nd_right;
  536. while( nd ) {
  537. assert(nd->nd_class == Link && nd->nd_symb == ',');
  538. CodeEl(nd->nd_left, tp);
  539. nd = nd->nd_right;
  540. }
  541. }
  542. CodeEl(nd, tp)
  543. register struct node *nd;
  544. register struct type *tp;
  545. {
  546. if( nd->nd_class == Link && nd->nd_symb == UPTO ) {
  547. Operands(nd->nd_left, nd->nd_right);
  548. C_loc(tp->tp_size); /* push size */
  549. C_cal("_bts"); /* library routine to fill set */
  550. C_asp(3 * word_size);
  551. }
  552. else {
  553. CodePExpr(nd);
  554. C_set(tp->tp_size);
  555. C_ior(tp->tp_size);
  556. }
  557. }
  558. struct type *
  559. CodeParameters(param, arg)
  560. struct paramlist *param;
  561. struct node *arg;
  562. {
  563. register struct type *tp, *left_tp, *last_tp;
  564. struct node *left;
  565. struct desig ds;
  566. assert(param && arg);
  567. if( param->next )
  568. last_tp = CodeParameters(param->next, arg->nd_right);
  569. tp = TypeOfParam(param);
  570. left = arg->nd_left;
  571. left_tp = left->nd_type;
  572. if( IsConformantArray(tp) ) {
  573. if( last_tp != tp )
  574. /* push descriptors only once */
  575. CodeConfDescr(tp, left_tp);
  576. CodeDAddress(left);
  577. return tp;
  578. }
  579. if( IsVarParam(param) ) {
  580. CodeDAddress(left);
  581. return tp;
  582. }
  583. if( left_tp->tp_fund == T_STRING ) {
  584. CodePString(left, tp);
  585. return tp;
  586. }
  587. ds = InitDesig;
  588. CodeExpr(left, &ds, NO_LABEL);
  589. CodeValue(&ds, left_tp);
  590. RangeCheck(tp, left_tp);
  591. if( tp == real_type && BaseType(left_tp) == int_type )
  592. Int2Real();
  593. return tp;
  594. }
  595. CodeConfDescr(ftp, atp)
  596. register struct type *ftp, *atp;
  597. {
  598. struct type *elemtp = ftp->arr_elem;
  599. if( IsConformantArray(elemtp) )
  600. CodeConfDescr(elemtp, atp->arr_elem);
  601. if( atp->tp_fund == T_STRING ) {
  602. C_loc((arith) 1);
  603. C_loc(atp->tp_psize - 1);
  604. C_loc((arith) 1);
  605. }
  606. else if( IsConformantArray(atp) ) {
  607. if( atp->arr_sclevel < proclevel ) {
  608. C_lxa((arith) proclevel - atp->arr_sclevel);
  609. C_adp(atp->arr_cfdescr);
  610. }
  611. else
  612. C_lal(atp->arr_cfdescr);
  613. C_loi(3 * word_size);
  614. }
  615. else { /* normal array */
  616. assert(atp->tp_fund == T_ARRAY);
  617. assert(!IsConformantArray(atp));
  618. C_lae_dlb(atp->arr_ardescr, (arith) 0);
  619. C_loi( 3 * word_size);
  620. }
  621. }
  622. CodePString(nd, tp)
  623. struct node *nd;
  624. struct type *tp;
  625. {
  626. /* no null padding */
  627. C_lae_dlb(nd->nd_SLA, (arith) 0);
  628. C_loi(tp->tp_size);
  629. }
  630. CodeCall(nd)
  631. register struct node *nd;
  632. {
  633. /* Generate code for a procedure call. Checking of parameters
  634. and result is already done.
  635. */
  636. register struct node *left = nd->nd_left;
  637. register struct node *right = nd->nd_right;
  638. register struct def *df = left->nd_def;
  639. register struct type *result_tp;
  640. assert(IsProcCall(left));
  641. if( left->nd_type == std_type ) {
  642. CodeStd(nd);
  643. return;
  644. }
  645. if( right )
  646. (void) CodeParameters(ParamList(left->nd_type), right);
  647. assert(left->nd_class == Def);
  648. if( df->df_kind & D_ROUTINE ) {
  649. int level = df->df_scope->sc_level;
  650. if( level > 0 && !(df->df_flags & D_EXTERNAL) )
  651. C_lxl((arith) (proclevel - level));
  652. C_cal(df->prc_name);
  653. C_asp(left->nd_type->prc_nbpar);
  654. }
  655. else {
  656. label l1 = ++text_label;
  657. label l2 = ++text_label;
  658. assert(df->df_kind == D_VARIABLE);
  659. /* Push value of procedure/function parameter */
  660. CodePExpr(left);
  661. /* Test if value is a global or local procedure/function */
  662. C_exg(pointer_size);
  663. C_dup(pointer_size);
  664. C_zer(pointer_size);
  665. C_cmp();
  666. C_zeq(l1);
  667. /* At this point, on top of the stack the LB */
  668. C_exg(pointer_size);
  669. /* Now, the name of the procedure/function */
  670. C_cai();
  671. C_asp(pointer_size + left->nd_type->prc_nbpar);
  672. C_bra(l2);
  673. /* value is a global procedure/function */
  674. C_df_ilb(l1);
  675. C_asp(pointer_size); /* no LB needed */
  676. C_cai();
  677. C_asp(left->nd_type->prc_nbpar);
  678. C_df_ilb(l2);
  679. }
  680. if( result_tp = ResultType(left->nd_type) )
  681. C_lfr(result_tp->tp_size);
  682. }
  683. CodeStd(nd)
  684. struct node *nd;
  685. {
  686. register struct node *arg = nd->nd_right;
  687. register struct node *left = arg->nd_left;
  688. register struct type *tp = BaseType(left->nd_type);
  689. int req = nd->nd_left->nd_def->df_value.df_reqname;
  690. assert(arg->nd_class == Link && arg->nd_symb == ',');
  691. switch( req ) {
  692. case R_ABS:
  693. CodePExpr(left);
  694. if( tp == int_type )
  695. C_cal("_abi");
  696. else
  697. C_cal("_abr");
  698. C_asp(tp->tp_size);
  699. C_lfr(tp->tp_size);
  700. break;
  701. case R_SQR:
  702. CodePExpr(left);
  703. C_dup(tp->tp_size);
  704. if( tp == int_type )
  705. C_mli(int_size);
  706. else
  707. C_mlf(real_size);
  708. break;
  709. case R_SIN:
  710. case R_COS:
  711. case R_EXP:
  712. case R_LN:
  713. case R_SQRT:
  714. case R_ARCTAN:
  715. assert(tp == real_type);
  716. CodePExpr(left);
  717. switch( req ) {
  718. case R_SIN:
  719. C_cal("_sin");
  720. break;
  721. case R_COS:
  722. C_cal("_cos");
  723. break;
  724. case R_EXP:
  725. C_cal("_exp");
  726. break;
  727. case R_LN:
  728. C_cal("_log");
  729. break;
  730. case R_SQRT:
  731. C_cal("_sqt");
  732. break;
  733. case R_ARCTAN:
  734. C_cal("_atn");
  735. break;
  736. default:
  737. crash("(CodeStd)");
  738. /*NOTREACHED*/
  739. }
  740. C_asp(real_size);
  741. C_lfr(real_size);
  742. break;
  743. case R_TRUNC:
  744. assert(tp == real_type);
  745. CodePExpr(left);
  746. Real2Int();
  747. break;
  748. case R_ROUND:
  749. assert(tp == real_type);
  750. CodePExpr(left);
  751. C_cal("_rnd");
  752. C_asp(real_size);
  753. C_lfr(real_size);
  754. Real2Int();
  755. break;
  756. case R_ORD:
  757. CodePExpr(left);
  758. break;
  759. case R_CHR:
  760. CodePExpr(left);
  761. genrck(char_type);
  762. break;
  763. case R_SUCC:
  764. case R_PRED:
  765. CodePExpr(left);
  766. if( req == R_SUCC )
  767. C_inc();
  768. else
  769. C_dec();
  770. if( bounded(left->nd_type) )
  771. genrck(left->nd_type);
  772. break;
  773. case R_ODD:
  774. CodePExpr(left);
  775. C_loc((arith) 1);
  776. C_and(word_size);
  777. break;
  778. case R_EOF:
  779. case R_EOLN:
  780. CodeDAddress(left);
  781. if( req == R_EOF )
  782. C_cal("_efl");
  783. else
  784. C_cal("_eln");
  785. C_asp(pointer_size);
  786. C_lfr(word_size);
  787. break;
  788. case R_REWRITE:
  789. case R_RESET:
  790. CodeDAddress(left);
  791. if( tp == text_type )
  792. C_loc((arith) 0);
  793. else
  794. C_loc(tp->next->tp_psize);
  795. /* ??? elements of packed size ??? */
  796. if( req == R_REWRITE )
  797. C_cal("_cre");
  798. else
  799. C_cal("_opn");
  800. C_asp(pointer_size + word_size);
  801. break;
  802. case R_PUT:
  803. case R_GET:
  804. CodeDAddress(left);
  805. if( req == R_PUT )
  806. C_cal("_put");
  807. else
  808. C_cal("_get");
  809. C_asp(pointer_size);
  810. break;
  811. case R_PAGE:
  812. CodeDAddress(left);
  813. C_cal("_pag");
  814. C_asp(pointer_size);
  815. break;
  816. case R_PACK: {
  817. label lba = tp->arr_ardescr;
  818. CodeDAddress(left);
  819. arg = arg->nd_right;
  820. left = arg->nd_left;
  821. CodePExpr(left);
  822. arg = arg->nd_right;
  823. left = arg->nd_left;
  824. CodeDAddress(left);
  825. C_lae_dlb(left->nd_type->arr_ardescr, (arith) 0);
  826. C_lae_dlb(lba, (arith) 0);
  827. C_cal("_pac");
  828. C_asp(4 * pointer_size + word_size);
  829. break;
  830. }
  831. case R_UNPACK: {
  832. /* change sequence of arguments of the library routine
  833. _unp to merge code of R_PACK and R_UNPACK.
  834. */
  835. label lba, lbz = tp->arr_ardescr;
  836. CodeDAddress(left);
  837. arg = arg->nd_right;
  838. left = arg->nd_left;
  839. CodeDAddress(left);
  840. lba = left->nd_type->arr_ardescr;
  841. arg = arg->nd_right;
  842. left = arg->nd_left;
  843. CodePExpr(left);
  844. C_lae_dlb(lbz, (arith) 0);
  845. C_lae_dlb(lba, (arith) 0);
  846. C_cal("_unp");
  847. C_asp(4 * pointer_size + word_size);
  848. break;
  849. }
  850. case R_NEW:
  851. case R_DISPOSE:
  852. CodeDAddress(left);
  853. C_loc(PointedtoType(tp)->tp_size);
  854. if( req == R_NEW )
  855. C_cal("_new");
  856. else
  857. C_cal("_dis");
  858. C_asp(pointer_size + word_size);
  859. break;
  860. default:
  861. crash("(CodeStd)");
  862. /*NOTREACHED*/
  863. }
  864. }
  865. Int2Real()
  866. {
  867. /* convert integer to real */
  868. C_loc(int_size);
  869. C_loc(real_size);
  870. C_cif();
  871. }
  872. Real2Int()
  873. {
  874. /* convert real to integer */
  875. C_loc(real_size);
  876. C_loc(int_size);
  877. C_cfi();
  878. }
  879. RangeCheck(tpl, tpr)
  880. register struct type *tpl, *tpr;
  881. {
  882. /* Generate a range check if neccessary
  883. */
  884. arith llo, lhi, rlo, rhi;
  885. if( bounded(tpl) ) {
  886. /* in this case we might need a range check */
  887. if( !bounded(tpr) )
  888. /* yes, we need one */
  889. genrck(tpl);
  890. else {
  891. /* both types are restricted. check the bounds to see
  892. whether we need a range check. We don't need one
  893. if the range of values of the right hand side is a
  894. subset of the range of values of the left hand side.
  895. */
  896. getbounds(tpl, &llo, &lhi);
  897. getbounds(tpr, &rlo, &rhi);
  898. if( llo > rlo || lhi < rhi )
  899. genrck(tpl);
  900. }
  901. }
  902. }
  903. genrck(tp)
  904. register struct type *tp;
  905. {
  906. /* Generate a range check descriptor for type "tp" when
  907. necessary. Return its label.
  908. */
  909. arith lb, ub;
  910. register label o1;
  911. int newlabel = 0;
  912. if( !options['r'] ) return;
  913. getbounds(tp, &lb, &ub);
  914. if( tp->tp_fund == T_SUBRANGE ) {
  915. if( !(o1 = tp->sub_rck) ) {
  916. tp->sub_rck = o1 = ++data_label;
  917. newlabel = 1;
  918. }
  919. }
  920. else if( !(o1 = tp->enm_rck) ) {
  921. tp->enm_rck = o1 = ++data_label;
  922. newlabel = 1;
  923. }
  924. if( newlabel ) {
  925. C_df_dlb(o1);
  926. C_rom_cst(lb);
  927. C_rom_cst(ub);
  928. }
  929. C_lae_dlb(o1, (arith) 0);
  930. C_rck(word_size);
  931. }
  932. CodePExpr(nd)
  933. register struct node *nd;
  934. {
  935. /* Generate code to push the value of the expression "nd"
  936. on the stack.
  937. */
  938. struct desig designator;
  939. struct type *tp = BaseType(nd->nd_type);
  940. designator = InitDesig;
  941. CodeExpr(nd, &designator, NO_LABEL);
  942. if( tp->tp_fund & (T_ARRAY | T_RECORD) )
  943. CodeAddress(&designator);
  944. else
  945. CodeValue(&designator, nd->nd_type);
  946. }
  947. CodeDAddress(nd)
  948. struct node *nd;
  949. {
  950. /* Generate code to push the address of the designator "nd"
  951. on the stack.
  952. */
  953. struct desig designator;
  954. designator = InitDesig;
  955. CodeDesig(nd, &designator);
  956. CodeAddress(&designator);
  957. }
  958. CodeDStore(nd)
  959. register struct node *nd;
  960. {
  961. /* Generate code to store the expression on the stack
  962. into the designator "nd".
  963. */
  964. struct desig designator;
  965. designator = InitDesig;
  966. CodeDesig(nd, &designator);
  967. CodeStore(&designator, nd->nd_type);
  968. }
  969. RegisterMessages(df)
  970. register struct def *df;
  971. {
  972. register struct type *tp;
  973. for( ; df; df = df->df_nextinscope ) {
  974. if( df->df_kind == D_VARIABLE && !(df->df_flags & D_NOREG) ) {
  975. /* Examine type and size
  976. */
  977. tp = BaseType(df->df_type);
  978. if( df->df_flags & D_VARPAR || tp->tp_fund & T_POINTER )
  979. C_ms_reg(df->var_off, pointer_size,
  980. reg_pointer, 0);
  981. else if( df->df_flags & D_LOOPVAR )
  982. C_ms_reg(df->var_off, tp->tp_size, reg_loop,2);
  983. else if( tp->tp_fund & T_NUMERIC )
  984. C_ms_reg(df->var_off, tp->tp_size,
  985. tp->tp_fund == T_REAL ? reg_float : reg_any, 0);
  986. }
  987. }
  988. }