walk.c 25 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154
  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. /* P A R S E T R E E W A L K E R */
  8. /* $Id$ */
  9. /* Routines to walk through parts of the parse tree, and generate
  10. code for these parts.
  11. */
  12. #include <stdlib.h>
  13. #include <string.h>
  14. #include "debug.h"
  15. #include <em_arith.h>
  16. #include <em_label.h>
  17. #include <em_reg.h>
  18. #include <em_code.h>
  19. #include <m2_traps.h>
  20. #include <assert.h>
  21. #include <alloc.h>
  22. #include <stb.h>
  23. #include "strict3rd.h"
  24. #include "dbsymtab.h"
  25. #include "LLlex.h"
  26. #include "def.h"
  27. #include "type.h"
  28. #include "scope.h"
  29. #include "main.h"
  30. #include "node.h"
  31. #include "Lpars.h"
  32. #include "desig.h"
  33. #include "f_info.h"
  34. #include "idf.h"
  35. #include "chk_expr.h"
  36. #include "walk.h"
  37. #include "misc.h"
  38. #include "warning.h"
  39. #include "bigresult.h"
  40. #include "use_insert.h"
  41. extern arith NewPtr();
  42. extern arith NewInt();
  43. extern arith TmpSpace();
  44. extern int proclevel;
  45. extern int gdb_flag;
  46. label text_label;
  47. label data_label = 1;
  48. struct withdesig *WithDesigs;
  49. t_node *Modules;
  50. static t_type *func_type;
  51. static t_node *priority;
  52. static int oldlineno;
  53. static int RegisterMessage();
  54. static int WalkDef();
  55. #ifdef DBSYMTAB
  56. static int stabdef();
  57. #endif
  58. static int MkCalls();
  59. static int UseWarnings();
  60. #define NO_EXIT_LABEL ((label) 0)
  61. #define RETURN_LABEL ((label) 1)
  62. #define REACH_FLAG 1
  63. #define EXIT_FLAG 2
  64. int
  65. LblWalkNode(lbl, nd, exit, reach)
  66. label lbl, exit;
  67. t_node *nd;
  68. {
  69. /* Generate code for node "nd", after generating instruction
  70. label "lbl". "exit" is the exit label for the closest
  71. enclosing LOOP.
  72. */
  73. def_ilb(lbl);
  74. return WalkNode(nd, exit, reach);
  75. }
  76. static arith tmpprio;
  77. STATIC
  78. DoPriority()
  79. {
  80. /* For the time being (???), handle priorities by calls to
  81. the runtime system
  82. */
  83. if (priority) {
  84. tmpprio = NewInt();
  85. C_loc(priority->nd_INT);
  86. CAL("stackprio", (int) word_size);
  87. C_lfr(word_size);
  88. C_stl(tmpprio);
  89. }
  90. }
  91. STATIC
  92. EndPriority()
  93. {
  94. if (priority) {
  95. C_lol(tmpprio);
  96. CAL("unstackprio", (int) word_size);
  97. FreeInt(tmpprio);
  98. }
  99. }
  100. def_ilb(l)
  101. label l;
  102. {
  103. /* Instruction label definition. Forget about line number.
  104. */
  105. C_df_ilb(l);
  106. oldlineno = 0;
  107. }
  108. DoLineno(nd)
  109. register t_node *nd;
  110. {
  111. /* Generate line number information, if necessary.
  112. */
  113. if ((! options['L']
  114. #ifdef DBSYMTAB
  115. || options['g']
  116. #endif /* DBSYMTAB */
  117. ) &&
  118. nd->nd_lineno &&
  119. nd->nd_lineno != oldlineno) {
  120. oldlineno = nd->nd_lineno;
  121. if (! options['L']) C_lin((arith) nd->nd_lineno);
  122. #ifdef DBSYMTAB
  123. if ( options['g']) {
  124. static int ms_lineno;
  125. if (ms_lineno != nd->nd_lineno) {
  126. ms_lineno = nd->nd_lineno;
  127. C_ms_std((char *) 0, N_SLINE, ms_lineno);
  128. }
  129. }
  130. #endif /* DBSYMTAB */
  131. }
  132. }
  133. DoFilename(needed)
  134. {
  135. /* Generate filename information, when needed.
  136. This routine is called at the generation of a
  137. procedure entry, and after generating a call to
  138. another procedure.
  139. */
  140. static label filename_label = 0;
  141. oldlineno = 0; /* always invalidate remembered line number */
  142. if (needed && ! options['L']) {
  143. if (! filename_label) {
  144. filename_label = 1;
  145. C_df_dlb((label) 1);
  146. C_rom_scon(FileName, (arith) (strlen(FileName) + 1));
  147. }
  148. C_fil_dlb((label) 1, (arith) 0);
  149. }
  150. }
  151. WalkModule(module)
  152. register t_def *module;
  153. {
  154. /* Walk through a module, and all its local definitions.
  155. Also generate code for its body.
  156. This code is collected in an initialization routine.
  157. */
  158. register t_scope *sc;
  159. t_scopelist *savevis = CurrVis;
  160. CurrVis = module->mod_vis;
  161. priority = module->mod_priority;
  162. sc = CurrentScope;
  163. /* Walk through it's local definitions
  164. */
  165. WalkDefList(sc->sc_def, WalkDef);
  166. /* Now, generate initialization code for this module.
  167. First call initialization routines for modules defined within
  168. this module.
  169. */
  170. sc->sc_off = 0; /* no locals (yet) */
  171. text_label = 1; /* label at end of initialization routine */
  172. TmpOpen(sc); /* Initialize for temporaries */
  173. C_pro_narg(sc->sc_name);
  174. #ifdef DBSYMTAB
  175. if (options['g']) {
  176. stb_string(module, D_MODULE);
  177. WalkDefList(sc->sc_def, stabdef);
  178. if (state == PROGRAM && module == Defined) {
  179. C_ms_stb_cst(module->df_idf->id_text,
  180. N_MAIN,
  181. 0,
  182. (arith) 0);
  183. }
  184. stb_string(module, D_END);
  185. }
  186. #endif
  187. DoPriority();
  188. if (module == Defined) {
  189. /* Body of implementation or program module.
  190. Call initialization routines of imported modules.
  191. Also prevent recursive calls of this one.
  192. */
  193. register t_node *nd = Modules;
  194. if (state == IMPLEMENTATION) {
  195. /* We don't actually prevent recursive calls,
  196. but do nothing if called recursively
  197. */
  198. C_df_dlb(++data_label);
  199. C_con_cst((arith) 0);
  200. /* if this one is set to non-zero, the initialization
  201. was already done.
  202. */
  203. C_loe_dlb(data_label, (arith) 0);
  204. C_zne(RETURN_LABEL);
  205. C_ine_dlb(data_label, (arith) 0);
  206. }
  207. else if (! options['R']) {
  208. /* put funny value in BSS, in an attempt to detect
  209. uninitialized variables
  210. */
  211. C_cal("killbss");
  212. }
  213. for (; nd; nd = nd->nd_NEXT) {
  214. C_cal(nd->nd_def->mod_vis->sc_scope->sc_name);
  215. }
  216. DoFilename(1);
  217. }
  218. WalkDefList(sc->sc_def, MkCalls);
  219. proclevel++;
  220. #ifdef DBSYMTAB
  221. if (options['g']) {
  222. C_ms_std((char *) 0, N_LBRAC, gdb_flag ? 0 : proclevel);
  223. }
  224. #endif /* DBSYMTAB */
  225. WalkNode(module->mod_body, NO_EXIT_LABEL, REACH_FLAG);
  226. DO_DEBUG(options['X'], PrNode(module->mod_body, 0));
  227. def_ilb(RETURN_LABEL);
  228. EndPriority();
  229. C_ret((arith) 0);
  230. #ifdef DBSYMTAB
  231. if (options['g']) {
  232. C_ms_std((char *) 0, N_RBRAC, gdb_flag ? 0 : proclevel);
  233. }
  234. #endif /* DBSYMTAB */
  235. C_end(-sc->sc_off);
  236. proclevel--;
  237. TmpClose();
  238. CurrVis = savevis;
  239. WalkDefList(sc->sc_def, UseWarnings);
  240. }
  241. WalkProcedure(procedure)
  242. register t_def *procedure;
  243. {
  244. /* Walk through the definition of a procedure and all its
  245. local definitions, checking and generating code.
  246. */
  247. t_scopelist *savevis = CurrVis;
  248. register t_type *tp;
  249. register t_param *param;
  250. register t_scope *procscope = procedure->prc_vis->sc_scope;
  251. label too_big = 0; /* returnsize larger than returnarea */
  252. arith StackAdjustment = 0; /* space for conformant arrays */
  253. arith retsav = 0; /* temporary space for return value */
  254. arith func_res_size = 0;
  255. #ifdef USE_INSERT
  256. int partno = C_getid();
  257. int partno2 = C_getid();
  258. #else
  259. label cd_init;
  260. label cd_body;
  261. #endif
  262. proclevel++;
  263. CurrVis = procedure->prc_vis;
  264. /* Generate code for all local modules and procedures
  265. */
  266. WalkDefList(procscope->sc_def, WalkDef);
  267. func_type = tp = RemoveEqual(ResultType(procedure->df_type));
  268. if (tp) {
  269. func_res_size = WA(tp->tp_size);
  270. if (TooBigForReturnArea(tp)) {
  271. #ifdef BIG_RESULT_ON_STACK
  272. /* The result type of this procedure is too big.
  273. The caller will have reserved space on its stack,
  274. above the parameters, to store the result.
  275. */
  276. too_big = 1;
  277. #else
  278. /* The result type of this procedure is too big.
  279. The actual procedure will return a pointer to a
  280. global data area in which the function result is
  281. stored.
  282. Notice that this makes the code non-reentrant.
  283. Here, we create the data area for the function
  284. result.
  285. */
  286. too_big = ++data_label;
  287. C_df_dlb(too_big);
  288. C_bss_cst(func_res_size, (arith)0, 0);
  289. #endif /* BIG_RESULT_ON_STACK */
  290. }
  291. }
  292. /* Generate code for this procedure
  293. */
  294. TmpOpen(procscope);
  295. #ifdef USE_INSERT
  296. C_insertpart(partno2); /* procedure header */
  297. #else
  298. C_pro_narg(procedure->prc_name);
  299. #ifdef DBSYMTAB
  300. if (options['g']) {
  301. stb_string(procedure, D_PROCEDURE);
  302. WalkDefList(procscope->sc_def, stabdef);
  303. stb_string(procedure, D_PEND);
  304. C_ms_std((char *) 0, N_LBRAC, gdb_flag ? 0 : proclevel);
  305. }
  306. #endif /* DBSYMTAB */
  307. C_ms_par(procedure->df_type->prc_nbpar
  308. #ifdef BIG_RESULT_ON_STACK
  309. + (too_big ? func_res_size : 0)
  310. #endif
  311. );
  312. #endif
  313. /* generate code for filename only when the procedure can be
  314. exported, either directly or by taking the address.
  315. This cannot be done if the level is bigger than one (because in
  316. this case it is a nested procedure).
  317. */
  318. DoFilename(procscope->sc_level == 1);
  319. DoPriority();
  320. text_label = 1; /* label at end of procedure */
  321. /* Check if we must save the stack pointer */
  322. for (param = ParamList(procedure->df_type);
  323. param;
  324. param = param->par_next) {
  325. if (! IsVarParam(param)) {
  326. tp = TypeOfParam(param);
  327. if ( IsConformantArray(tp)) {
  328. /* First time we get here
  329. */
  330. if (func_type && !too_big) {
  331. /* Some local space, only
  332. needed if the value itself
  333. is returned
  334. */
  335. retsav= TmpSpace(func_res_size, 1);
  336. }
  337. StackAdjustment = NewPtr();
  338. C_lor((arith) 1);
  339. STL(StackAdjustment, pointer_size);
  340. }
  341. }
  342. }
  343. #ifdef USE_INSERT
  344. C_insertpart(partno);
  345. #else
  346. cd_init = ++text_label;
  347. cd_body = ++text_label;
  348. c_bra(cd_init);
  349. def_ilb(cd_body);
  350. #endif
  351. if ((WalkNode(procedure->prc_body, NO_EXIT_LABEL, REACH_FLAG) & REACH_FLAG)) {
  352. if (func_res_size) {
  353. node_warning(procscope->sc_end,
  354. W_ORDINARY,
  355. "function procedure \"%s\" does not always return a value",
  356. procedure->df_idf->id_text);
  357. c_loc(M2_NORESULT);
  358. C_trp();
  359. C_asp(-func_res_size);
  360. }
  361. #ifndef USE_INSERT
  362. c_bra(RETURN_LABEL);
  363. #endif
  364. }
  365. #ifdef USE_INSERT
  366. C_beginpart(partno);
  367. #else
  368. def_ilb(cd_init);
  369. #endif
  370. /* Generate calls to initialization routines of modules defined within
  371. this procedure
  372. */
  373. WalkDefList(procscope->sc_def, MkCalls);
  374. /* Make sure that arguments of size < word_size are on a
  375. fixed place.
  376. Also make copies of parameters when neccessary.
  377. */
  378. for (param = ParamList(procedure->df_type);
  379. param;
  380. param = param->par_next) {
  381. if (! IsVarParam(param)) {
  382. tp = TypeOfParam(param);
  383. if (! IsConformantArray(tp)) {
  384. if (tp->tp_size < word_size &&
  385. (int) word_size % (int) tp->tp_size == 0) {
  386. C_lol(param->par_def->var_off);
  387. STL(param->par_def->var_off,
  388. tp->tp_size);
  389. }
  390. continue;
  391. }
  392. /* Here, we have to make a copy of the
  393. array. We must also remember how much
  394. room is reserved for copies, because
  395. we have to adjust the stack pointer before
  396. a RET is done. This is even more complicated
  397. when the procedure returns a value.
  398. Then, the value must be saved,
  399. the stack adjusted, the return value pushed
  400. again, and then RET
  401. */
  402. /* First compute new stackpointer */
  403. C_lal(param->par_def->var_off);
  404. CAL("new_stackptr", (int)pointer_size);
  405. C_lfr(pointer_size);
  406. C_ass(pointer_size);
  407. /* adjusted stack pointer */
  408. LOL(param->par_def->var_off, pointer_size);
  409. /* push source address */
  410. CAL("copy_array", (int)pointer_size);
  411. /* copy */
  412. }
  413. }
  414. #ifdef USE_INSERT
  415. C_endpart(partno);
  416. #else
  417. c_bra(cd_body);
  418. #endif
  419. DO_DEBUG(options['X'], PrNode(procedure->prc_body, 0));
  420. def_ilb(RETURN_LABEL); /* label at end */
  421. if (too_big) {
  422. /* Fill the data area reserved for the function result
  423. with the result
  424. */
  425. #ifdef BIG_RESULT_ON_STACK
  426. C_lal(procedure->df_type->prc_nbpar);
  427. #else
  428. c_lae_dlb(too_big);
  429. #endif /* BIG_RESULT_ON_STACK */
  430. C_sti(func_res_size);
  431. if (StackAdjustment) {
  432. /* Remove copies of conformant arrays
  433. */
  434. LOL(StackAdjustment, pointer_size);
  435. C_str((arith) 1);
  436. }
  437. #ifdef BIG_RESULT_ON_STACK
  438. func_res_size = 0;
  439. #else
  440. c_lae_dlb(too_big);
  441. func_res_size = pointer_size;
  442. #endif /* BIG_RESULT_ON_STACK */
  443. }
  444. else if (StackAdjustment) {
  445. /* First save the function result in a safe place.
  446. Then remove copies of conformant arrays,
  447. and put function result back on the stack
  448. */
  449. if (func_type) {
  450. STL(retsav, func_res_size);
  451. }
  452. LOL(StackAdjustment, pointer_size);
  453. C_str((arith) 1);
  454. if (func_type) {
  455. LOL(retsav, func_res_size);
  456. }
  457. }
  458. EndPriority();
  459. C_ret(func_res_size);
  460. #ifdef USE_INSERT
  461. C_beginpart(partno2);
  462. C_pro(procedure->prc_name, -procscope->sc_off);
  463. #ifdef DBSYMTAB
  464. if (options['g']) {
  465. stb_string(procedure, D_PROCEDURE);
  466. WalkDefList(procscope->sc_def, stabdef);
  467. stb_string(procedure, D_PEND);
  468. C_ms_std((char *) 0, N_LBRAC, gdb_flag ? 0 : proclevel);
  469. }
  470. #endif /* DBSYMTAB */
  471. C_ms_par(procedure->df_type->prc_nbpar
  472. #ifdef BIG_RESULT_ON_STACK
  473. + (too_big ? func_res_size : 0)
  474. #endif
  475. );
  476. #endif
  477. if (! options['n']) WalkDefList(procscope->sc_def, RegisterMessage);
  478. #ifdef USE_INSERT
  479. C_endpart(partno2);
  480. #endif
  481. #ifdef DBSYMTAB
  482. if (options['g']) {
  483. C_ms_std((char *) 0, N_RBRAC, gdb_flag ? 0 : proclevel);
  484. }
  485. #endif /* DBSYMTAB */
  486. C_end(-procscope->sc_off);
  487. if (! fit(procscope->sc_off, (int) word_size)) {
  488. node_error(procedure->prc_body,
  489. "maximum local byte count exceeded");
  490. }
  491. TmpClose();
  492. CurrVis = savevis;
  493. proclevel--;
  494. WalkDefList(procscope->sc_def, UseWarnings);
  495. }
  496. static
  497. WalkDef(df)
  498. register t_def *df;
  499. {
  500. /* Walk through a list of definitions
  501. */
  502. switch(df->df_kind) {
  503. case D_MODULE:
  504. WalkModule(df);
  505. break;
  506. case D_PROCEDURE:
  507. WalkProcedure(df);
  508. break;
  509. case D_VARIABLE:
  510. if (!proclevel && !(df->df_flags & D_ADDRGIVEN)) {
  511. C_df_dnam(df->var_name);
  512. C_bss_cst(
  513. WA(df->df_type->tp_size),
  514. (arith) 0, 0);
  515. }
  516. break;
  517. default:
  518. /* nothing */
  519. ;
  520. }
  521. }
  522. static
  523. MkCalls(df)
  524. register t_def *df;
  525. {
  526. /* Generate calls to initialization routines of modules
  527. */
  528. if (df->df_kind == D_MODULE) {
  529. C_lxl((arith) 0);
  530. CAL(df->mod_vis->sc_scope->sc_name, (int)pointer_size);
  531. }
  532. }
  533. WalkLink(nd, exit_label, end_reached)
  534. register t_node *nd;
  535. label exit_label;
  536. {
  537. /* Walk node "nd", which is a link.
  538. "exit_label" is set to a label number when inside a LOOP.
  539. "end_reached" maintains info about reachability (REACH_FLAG),
  540. and whether an EXIT statement was seen (EXIT_FLAG).
  541. */
  542. while (nd && nd->nd_class == Link) { /* statement list */
  543. end_reached = WalkNode(nd->nd_LEFT, exit_label, end_reached);
  544. nd = nd->nd_RIGHT;
  545. }
  546. return WalkNode(nd, exit_label, end_reached);
  547. }
  548. STATIC
  549. ForLoopVarExpr(nd)
  550. register t_node *nd;
  551. {
  552. register t_type *tp = nd->nd_type;
  553. CodePExpr(nd);
  554. CodeCoercion(tp, BaseType(tp));
  555. }
  556. int
  557. WalkStat(nd, exit_label, end_reached)
  558. register t_node *nd;
  559. label exit_label;
  560. {
  561. /* Walk through a statement, generating code for it.
  562. */
  563. register t_node *left = nd->nd_LEFT;
  564. register t_node *right = nd->nd_RIGHT;
  565. assert(nd->nd_class == Stat);
  566. if (nd->nd_symb == ';') return 1;
  567. if (! end_reached & REACH_FLAG) {
  568. node_warning(nd, W_ORDINARY, "statement not reached");
  569. }
  570. if (nd->nd_symb != WHILE ||
  571. nd->nd_lineno != left->nd_lineno) {
  572. /* Avoid double linenumber generation in while statements */
  573. DoLineno(nd);
  574. }
  575. options['R'] = (nd->nd_flags & ROPTION);
  576. options['A'] = (nd->nd_flags & AOPTION);
  577. switch(nd->nd_symb) {
  578. case '(': {
  579. t_node *nd1 = nd;
  580. if (ChkCall(&nd1)) {
  581. assert(nd == nd1);
  582. if (nd->nd_type != 0) {
  583. node_error(nd, "procedure call expected instead of function call");
  584. break;
  585. }
  586. CodeCall(nd);
  587. }
  588. }
  589. break;
  590. case BECOMES:
  591. DoAssign(nd);
  592. break;
  593. case IF:
  594. { label l1 = ++text_label, l3 = ++text_label;
  595. int end_r;
  596. ExpectBool(&(nd->nd_LEFT), l3, l1);
  597. assert(right->nd_symb == THEN);
  598. end_r = LblWalkNode(l3, right->nd_LEFT, exit_label, end_reached);
  599. if (right->nd_RIGHT) { /* ELSE part */
  600. label l2 = ++text_label;
  601. c_bra(l2);
  602. end_reached = end_r | LblWalkNode(l1, right->nd_RIGHT, exit_label, end_reached);
  603. l1 = l2;
  604. }
  605. else end_reached |= end_r;
  606. def_ilb(l1);
  607. break;
  608. }
  609. case CASE:
  610. end_reached = CaseCode(nd, exit_label, end_reached);
  611. break;
  612. case WHILE:
  613. { label loop = ++text_label,
  614. exit = ++text_label,
  615. dummy = ++text_label;
  616. c_bra(dummy);
  617. end_reached |= LblWalkNode(loop, right, exit_label, end_reached);
  618. def_ilb(dummy);
  619. ExpectBool(&(nd->nd_LEFT), loop, exit);
  620. def_ilb(exit);
  621. break;
  622. }
  623. case REPEAT:
  624. { label loop = ++text_label, exit = ++text_label;
  625. end_reached = LblWalkNode(loop, left, exit_label, end_reached);
  626. ExpectBool(&(nd->nd_RIGHT), exit, loop);
  627. def_ilb(exit);
  628. break;
  629. }
  630. case LOOP:
  631. { label loop = ++text_label, exit = ++text_label;
  632. if (LblWalkNode(loop, right, exit, end_reached) & EXIT_FLAG) {
  633. end_reached &= REACH_FLAG;
  634. }
  635. else end_reached = 0;
  636. c_bra(loop);
  637. def_ilb(exit);
  638. break;
  639. }
  640. case FOR:
  641. {
  642. arith tmp = NewInt();
  643. arith tmp2 = NewInt();
  644. int good_forvar;
  645. label l1 = ++text_label;
  646. label l2 = ++text_label;
  647. int uns = 0;
  648. arith stepsize;
  649. t_type *bstp;
  650. t_node *loopid;
  651. good_forvar = DoForInit(left);
  652. loopid = left->nd_LEFT;
  653. if ((stepsize = right->nd_LEFT->nd_INT) == 0) {
  654. node_warning(right->nd_LEFT,
  655. W_ORDINARY,
  656. "zero stepsize in FOR loop");
  657. }
  658. if (good_forvar) {
  659. bstp = BaseType(loopid->nd_type);
  660. uns = bstp->tp_fund != T_INTEGER;
  661. CodePExpr(left->nd_RIGHT->nd_RIGHT);
  662. C_stl(tmp);
  663. CodePExpr(left->nd_RIGHT->nd_LEFT);
  664. C_dup(int_size);
  665. C_stl(tmp2);
  666. C_lol(tmp);
  667. if (uns) C_cmu(int_size);
  668. else C_cmi(int_size);
  669. if (stepsize >= 0) C_zgt(l2);
  670. else C_zlt(l2);
  671. C_lol(tmp2);
  672. RangeCheck(loopid->nd_type,
  673. left->nd_RIGHT->nd_LEFT->nd_type);
  674. CodeDStore(loopid);
  675. if (stepsize >= 0) {
  676. C_lol(tmp);
  677. ForLoopVarExpr(loopid);
  678. }
  679. else {
  680. stepsize = -stepsize;
  681. ForLoopVarExpr(loopid);
  682. C_lol(tmp);
  683. }
  684. C_sbu(int_size);
  685. if (stepsize) {
  686. C_loc(stepsize);
  687. C_dvu(int_size);
  688. }
  689. C_stl(tmp);
  690. loopid->nd_def->df_flags |= D_FORLOOP;
  691. def_ilb(l1);
  692. if (! options['R']) {
  693. ForLoopVarExpr(loopid);
  694. C_stl(tmp2);
  695. }
  696. end_reached |= WalkNode(right->nd_RIGHT, exit_label, end_reached);
  697. if (! options['R']) {
  698. label x = ++text_label;
  699. C_lol(tmp2);
  700. ForLoopVarExpr(loopid);
  701. C_beq(x);
  702. c_loc(M2_FORCH);
  703. C_trp();
  704. def_ilb(x);
  705. }
  706. loopid->nd_def->df_flags &= ~D_FORLOOP;
  707. FreeInt(tmp2);
  708. if (stepsize) {
  709. C_lol(tmp);
  710. C_zeq(l2);
  711. C_lol(tmp);
  712. c_loc(1);
  713. C_sbu(int_size);
  714. C_stl(tmp);
  715. C_loc(right->nd_LEFT->nd_INT);
  716. ForLoopVarExpr(loopid);
  717. C_adu(int_size);
  718. RangeCheck(loopid->nd_type, bstp);
  719. CodeDStore(loopid);
  720. }
  721. }
  722. else {
  723. end_reached |= WalkNode(right->nd_RIGHT, exit_label, end_reached);
  724. loopid->nd_def->df_flags &= ~D_FORLOOP;
  725. }
  726. c_bra(l1);
  727. def_ilb(l2);
  728. FreeInt(tmp);
  729. }
  730. break;
  731. case WITH:
  732. {
  733. t_scopelist link;
  734. struct withdesig wds;
  735. t_desig ds;
  736. if (! WalkDesignator(&(nd->nd_LEFT), &ds, D_USED)) break;
  737. left = nd->nd_LEFT;
  738. if (left->nd_type->tp_fund != T_RECORD) {
  739. node_error(left, "record variable expected");
  740. break;
  741. }
  742. wds.w_next = WithDesigs;
  743. wds.w_flags = D_USED;
  744. WithDesigs = &wds;
  745. wds.w_scope = left->nd_type->rec_scope;
  746. CodeAddress(&ds);
  747. ds.dsg_kind = DSG_FIXED;
  748. /* Create a designator structure for the temporary.
  749. */
  750. ds.dsg_offset = NewPtr();
  751. ds.dsg_name = 0;
  752. CodeStore(&ds, address_type);
  753. ds.dsg_kind = DSG_PFIXED;
  754. /* the record is indirectly available */
  755. wds.w_desig = ds;
  756. link.sc_scope = wds.w_scope;
  757. link.sc_next = CurrVis;
  758. CurrVis = &link;
  759. end_reached = WalkNode(right, exit_label, end_reached);
  760. CurrVis = link.sc_next;
  761. WithDesigs = wds.w_next;
  762. FreePtr(ds.dsg_offset);
  763. ChkDesig(&(nd->nd_LEFT), wds.w_flags & (D_USED|D_DEFINED));
  764. break;
  765. }
  766. case EXIT:
  767. assert(exit_label != 0);
  768. if (end_reached & REACH_FLAG) end_reached = EXIT_FLAG;
  769. c_bra(exit_label);
  770. break;
  771. case RETURN:
  772. end_reached &= ~REACH_FLAG;
  773. if (right) {
  774. if (! ChkExpression(&(nd->nd_RIGHT))) break;
  775. /* The type of the return-expression must be
  776. assignment compatible with the result type of the
  777. function procedure (See Rep. 9.11).
  778. */
  779. if (!ChkAssCompat(&(nd->nd_RIGHT), func_type, "RETURN")) {
  780. break;
  781. }
  782. right = nd->nd_RIGHT;
  783. if (right->nd_type->tp_fund == T_STRING) {
  784. CodePString(right, func_type);
  785. }
  786. else CodePExpr(right);
  787. }
  788. c_bra(RETURN_LABEL);
  789. break;
  790. default:
  791. crash("(WalkStat)");
  792. }
  793. return end_reached;
  794. }
  795. extern int NodeCrash();
  796. int (*WalkTable[])() = {
  797. NodeCrash,
  798. NodeCrash,
  799. NodeCrash,
  800. NodeCrash,
  801. NodeCrash,
  802. NodeCrash,
  803. NodeCrash,
  804. NodeCrash,
  805. NodeCrash,
  806. NodeCrash,
  807. WalkStat,
  808. NodeCrash,
  809. WalkLink,
  810. };
  811. extern t_desig null_desig;
  812. ExpectBool(pnd, true_label, false_label)
  813. register t_node **pnd;
  814. label true_label, false_label;
  815. {
  816. /* "pnd" must indicate a boolean expression. Check this and
  817. generate code to evaluate the expression.
  818. */
  819. t_desig ds;
  820. ds = null_desig;
  821. if (ChkExpression(pnd)) {
  822. if ((*pnd)->nd_type != bool_type &&
  823. (*pnd)->nd_type != error_type) {
  824. node_error(*pnd, "boolean expression expected");
  825. }
  826. CodeExpr(*pnd, &ds, true_label, false_label);
  827. }
  828. }
  829. int
  830. WalkDesignator(pnd, ds, flags)
  831. t_node **pnd;
  832. t_desig *ds;
  833. {
  834. /* Check designator and generate code for it
  835. */
  836. if (! ChkVariable(pnd, flags)) return 0;
  837. *ds = null_desig;
  838. CodeDesig(*pnd, ds);
  839. return 1;
  840. }
  841. DoForInit(nd)
  842. t_node *nd;
  843. {
  844. register t_node *right = nd->nd_RIGHT;
  845. register t_def *df;
  846. t_type *base_tp;
  847. t_type *tpl, *tpr;
  848. int r;
  849. r = ChkVariable(&(nd->nd_LEFT), D_USED|D_DEFINED);
  850. r &= ChkExpression(&(right->nd_LEFT));
  851. r &= ChkExpression(&(right->nd_RIGHT));
  852. if (!r) return 0;
  853. df = nd->nd_LEFT->nd_def;
  854. if (df->df_kind == D_FIELD) {
  855. node_error(nd,
  856. "FOR-loop variable may not be a field of a record");
  857. return 1;
  858. }
  859. if (!df->var_name && df->var_off >= 0) {
  860. node_error(nd, "FOR-loop variable may not be a parameter");
  861. return 1;
  862. }
  863. if (df->df_scope != CurrentScope) {
  864. register t_scopelist *sc = CurrVis;
  865. for (;;) {
  866. if (!sc) {
  867. node_error(nd,
  868. "FOR-loop variable may not be imported");
  869. return 1;
  870. }
  871. if (sc->sc_scope == df->df_scope) break;
  872. sc = nextvisible(sc);
  873. }
  874. }
  875. if (df->df_type->tp_size > word_size ||
  876. !(df->df_type->tp_fund & T_DISCRETE)) {
  877. node_error(nd, "illegal type of FOR loop variable");
  878. return 1;
  879. }
  880. base_tp = BaseType(df->df_type);
  881. tpl = right->nd_LEFT->nd_type;
  882. tpr = right->nd_RIGHT->nd_type;
  883. #ifndef STRICT_3RD_ED
  884. if (! options['3']) {
  885. if (!ChkAssCompat(&(right->nd_LEFT), base_tp, "FOR statement") ||
  886. !ChkAssCompat(&(right->nd_RIGHT), base_tp, "FOR statement")) {
  887. return 1;
  888. }
  889. if (!TstCompat(df->df_type, tpl) ||
  890. !TstCompat(df->df_type, tpr)) {
  891. node_warning(nd, W_OLDFASHIONED, "compatibility required in FOR statement");
  892. }
  893. } else
  894. #endif
  895. if (!ChkCompat(&(right->nd_LEFT), base_tp, "FOR statement") ||
  896. !ChkCompat(&(right->nd_RIGHT), base_tp, "FOR statement")) {
  897. return 1;
  898. }
  899. return 1;
  900. }
  901. DoAssign(nd)
  902. register t_node *nd;
  903. {
  904. /* May we do it in this order (expression first) ???
  905. The reference manual sais nothing about it, but the book does:
  906. it sais that the left hand side is evaluated first.
  907. DAMN THE BOOK!
  908. */
  909. t_desig dsr;
  910. register t_type *tp;
  911. if (! (ChkExpression(&(nd->nd_RIGHT)) &
  912. ChkVariable(&(nd->nd_LEFT), D_DEFINED))) return;
  913. tp = nd->nd_LEFT->nd_type;
  914. if (! ChkAssCompat(&(nd->nd_RIGHT), tp, "assignment")) {
  915. return;
  916. }
  917. dsr = null_desig;
  918. #define StackNeededFor(ds) ((ds).dsg_kind == DSG_PLOADED \
  919. || (ds).dsg_kind == DSG_INDEXED)
  920. CodeExpr(nd->nd_RIGHT, &dsr, NO_LABEL, NO_LABEL);
  921. tp = nd->nd_RIGHT->nd_type;
  922. if (complex(tp)) {
  923. if (StackNeededFor(dsr)) CodeAddress(&dsr);
  924. }
  925. else {
  926. CodeValue(&dsr, tp);
  927. }
  928. CodeMove(&dsr, nd->nd_LEFT, tp);
  929. }
  930. static
  931. RegisterMessage(df)
  932. register t_def *df;
  933. {
  934. register t_type *tp;
  935. if (df->df_kind == D_VARIABLE) {
  936. if ( !(df->df_flags & D_NOREG)) {
  937. /* Examine type and size
  938. */
  939. tp = BaseType(df->df_type);
  940. if ((df->df_flags & D_VARPAR) ||
  941. (tp->tp_fund&(T_POINTER|T_HIDDEN|T_EQUAL))) {
  942. C_ms_reg(df->var_off,
  943. pointer_size,
  944. reg_pointer,
  945. 0);
  946. }
  947. else if (tp->tp_fund & T_NUMERIC) {
  948. C_ms_reg(df->var_off,
  949. tp->tp_size,
  950. tp->tp_fund == T_REAL ?
  951. reg_float : reg_any,
  952. 0);
  953. }
  954. }
  955. }
  956. }
  957. static
  958. df_warning(nd, df, warning)
  959. t_node *nd;
  960. t_def *df;
  961. char *warning;
  962. {
  963. if (! (df->df_kind & (D_VARIABLE|D_PROCEDURE|D_TYPE|D_CONST|D_PROCHEAD))) {
  964. return;
  965. }
  966. if (warning) {
  967. node_warning(nd,
  968. W_ORDINARY,
  969. "%s \"%s\" %s",
  970. (df->df_flags & D_VALPAR) ? "value parameter" :
  971. (df->df_flags & D_VARPAR) ? "variable parameter" :
  972. (df->df_kind == D_VARIABLE) ? "variable" :
  973. (df->df_kind == D_TYPE) ? "type" :
  974. (df->df_kind == D_CONST) ? "constant" :
  975. "procedure",
  976. df->df_idf->id_text, warning);
  977. }
  978. }
  979. static
  980. UseWarnings(df)
  981. register t_def *df;
  982. {
  983. t_node *nd = df->df_scope->sc_end;
  984. if (is_anon_idf(df->df_idf) ||
  985. !(df->df_kind&(D_IMPORTED|D_VARIABLE|D_PROCEDURE|D_CONST|D_TYPE)) ||
  986. (df->df_flags&(D_EXPORTED|D_QEXPORTED))) {
  987. return;
  988. }
  989. if (df->df_kind & D_IMPORTED) {
  990. register t_def *df1 = df->imp_def;
  991. df1->df_flags |= df->df_flags & (D_USED|D_DEFINED);
  992. if (df->df_kind == D_INUSE) return;
  993. if ( !(df->df_flags & D_IMP_BY_EXP)) {
  994. if (df->df_flags & (D_USED | D_DEFINED)) {
  995. return;
  996. }
  997. df_warning(nd,
  998. df1,
  999. df1->df_kind == D_VARIABLE ?
  1000. "imported but not used/assigned" :
  1001. "imported but not used");
  1002. return;
  1003. }
  1004. df = df1;
  1005. nd = df->df_scope->sc_end;
  1006. }
  1007. switch(df->df_flags & (D_USED|D_DEFINED|D_VALPAR|D_VARPAR)) {
  1008. case 0:
  1009. case D_VARPAR:
  1010. df_warning(nd, df,"never used/assigned");
  1011. break;
  1012. case D_USED:
  1013. df_warning(nd, df,"never assigned");
  1014. break;
  1015. case D_VALPAR:
  1016. case D_DEFINED:
  1017. case D_DEFINED|D_VALPAR:
  1018. df_warning(nd, df,"never used");
  1019. break;
  1020. }
  1021. }
  1022. WalkDefList(df, proc)
  1023. register t_def *df;
  1024. int (*proc)();
  1025. {
  1026. for (; df; df = df->df_nextinscope) {
  1027. (*proc)(df);
  1028. }
  1029. }
  1030. #ifdef DBSYMTAB
  1031. static int
  1032. stabdef(df)
  1033. t_def *df;
  1034. {
  1035. switch(df->df_kind) {
  1036. case D_CONST:
  1037. case D_VARIABLE:
  1038. stb_string(df, df->df_kind);
  1039. break;
  1040. }
  1041. }
  1042. #endif