eval.c 9.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536
  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. #include "bem.h"
  6. #ifndef NORSCID
  7. static char rcs_id[] = "$Id$" ;
  8. #endif
  9. /* Here you find all routines to evaluate expressions and
  10. generate code for assignment statements
  11. */
  12. exprtype(ltype,rtype)
  13. int ltype,rtype;
  14. {
  15. /* determine the result type of an expression */
  16. if ( ltype==STRINGTYPE || rtype==STRINGTYPE)
  17. {
  18. if ( ltype!=rtype)
  19. error("type conflict, string expected");
  20. return( STRINGTYPE);
  21. }
  22. /* take maximum */
  23. if ( ltype<rtype) return(rtype);
  24. return(ltype);
  25. }
  26. conversion(oldtype,newtype)
  27. int oldtype,newtype;
  28. {
  29. /* the value on top of the stack should be converted */
  30. if ( oldtype==newtype) return;
  31. switch( oldtype)
  32. {
  33. case INTTYPE:
  34. if ( newtype==FLOATTYPE || newtype==DOUBLETYPE)
  35. {
  36. C_loc((arith)BEMINTSIZE);
  37. C_loc((arith)BEMFLTSIZE);
  38. C_cif ();
  39. } else {
  40. if (debug)
  41. print("type n=%d o=%d\n",newtype,oldtype);
  42. error("conversion error");
  43. }
  44. break;
  45. case FLOATTYPE:
  46. case DOUBLETYPE:
  47. if ( newtype==INTTYPE)
  48. {
  49. /* rounded ! */
  50. C_cal("_cint");
  51. C_asp((arith)BEMFLTSIZE);
  52. C_lfr((arith)BEMINTSIZE);
  53. break;
  54. } else if ( newtype==FLOATTYPE || newtype==DOUBLETYPE)
  55. break;
  56. default:
  57. if (debug)
  58. print("type n=%d o=%d\n",newtype,oldtype);
  59. error("conversion error");
  60. }
  61. }
  62. extraconvert(oldtype,newtype,topstack)
  63. int oldtype,newtype,topstack;
  64. {
  65. /* the value below the top of the stack should be converted */
  66. if ( oldtype==newtype ) return;
  67. if ( debug) print("extra convert %d %d %d\n",oldtype,newtype,topstack);
  68. /* save top in dummy */
  69. switch( topstack)
  70. {
  71. case INTTYPE:
  72. C_ste_dnam("dummy1",(arith)0);
  73. break;
  74. case FLOATTYPE:
  75. case DOUBLETYPE:
  76. /* rounded ! */
  77. C_lae_dnam("dummy1",(arith)0);
  78. C_sti((arith)BEMFLTSIZE);
  79. break;
  80. default:
  81. error("conversion error");
  82. return;
  83. }
  84. /* now its on top of the stack */
  85. conversion(oldtype,newtype);
  86. /* restore top */
  87. switch( topstack)
  88. {
  89. case INTTYPE:
  90. C_loe_dnam("dummy1",(arith)0);
  91. break;
  92. case FLOATTYPE:
  93. case DOUBLETYPE:
  94. /* rounded ! */
  95. C_lae_dnam("dummy1",(arith)0);
  96. C_loi((arith)BEMFLTSIZE);
  97. }
  98. }
  99. boolop(ltype,rtype,operator)
  100. int ltype,rtype,operator;
  101. {
  102. if ( operator != NOTSYM)
  103. {
  104. extraconvert(ltype,INTTYPE,rtype);
  105. conversion(rtype,INTTYPE);
  106. } else conversion(ltype,INTTYPE);
  107. switch( operator)
  108. {
  109. case NOTSYM:
  110. C_com((arith)BEMINTSIZE);
  111. break;
  112. case ANDSYM:
  113. C_and((arith)BEMINTSIZE);
  114. break;
  115. case ORSYM:
  116. C_ior((arith)BEMINTSIZE);
  117. break;
  118. case XORSYM:
  119. C_xor((arith)BEMINTSIZE);
  120. break;
  121. case EQVSYM:
  122. C_xor((arith)BEMINTSIZE);
  123. C_com((arith)BEMINTSIZE);
  124. break;
  125. case IMPSYM:
  126. /* implies */
  127. C_com((arith)BEMINTSIZE);
  128. C_and((arith)BEMINTSIZE);
  129. C_com((arith)BEMINTSIZE);
  130. break;
  131. default:
  132. error("boolop:unexpected");
  133. }
  134. return(INTTYPE);
  135. }
  136. genbool(operator)
  137. int operator;
  138. {
  139. int l1,l2;
  140. l1= genlabel();
  141. l2= genlabel();
  142. switch(operator)
  143. {
  144. case '<': C_zlt((label)l1); break;
  145. case '>': C_zgt((label)l1); break;
  146. case '=': C_zeq((label)l1); break;
  147. case NESYM: C_zne((label)l1); break;
  148. case LESYM: C_zle((label)l1); break;
  149. case GESYM: C_zge((label)l1); break;
  150. default: error("relop:unexpected operator");
  151. }
  152. C_loc((arith)0);
  153. C_bra((label)l2);
  154. C_df_ilb((label)l1);
  155. C_loc((arith)-1);
  156. C_df_ilb((label)l2);
  157. }
  158. relop( ltype,rtype,operator)
  159. int ltype,rtype,operator;
  160. {
  161. int result;
  162. if (debug) print("relop %d %d op=%d\n",ltype,rtype,operator);
  163. result= exprtype(ltype,rtype);
  164. extraconvert(ltype,result,rtype);
  165. conversion(rtype,result);
  166. /* compare the objects */
  167. if ( result==INTTYPE)
  168. C_cmi((arith)BEMINTSIZE);
  169. else if ( result==FLOATTYPE || result==DOUBLETYPE)
  170. C_cmf((arith)BEMFLTSIZE);
  171. else if ( result==STRINGTYPE)
  172. {
  173. C_cal("_strcomp");
  174. C_asp((arith)(2*BEMPTRSIZE));
  175. C_lfr((arith)BEMINTSIZE);
  176. } else error("relop:unexpected");
  177. /* handle the relational operators */
  178. genbool(operator);
  179. return(INTTYPE);
  180. }
  181. plusmin(ltype,rtype,operator)
  182. int ltype,rtype,operator;
  183. {
  184. int result;
  185. result= exprtype(ltype,rtype);
  186. if ( result== STRINGTYPE)
  187. {
  188. if ( operator== '+')
  189. {
  190. C_cal("_concat");
  191. C_asp((arith)(2*BEMPTRSIZE));
  192. C_lfr((arith)BEMPTRSIZE);
  193. } else error("illegal operator");
  194. } else {
  195. extraconvert(ltype,result,rtype);
  196. conversion(rtype,result);
  197. if ( result== INTTYPE)
  198. {
  199. if ( operator=='+')
  200. C_adi((arith)BEMINTSIZE);
  201. else C_sbi((arith)BEMINTSIZE);
  202. } else {
  203. if ( operator=='+')
  204. C_adf((arith)BEMFLTSIZE);
  205. else C_sbf((arith)BEMFLTSIZE);
  206. }
  207. }
  208. return(result);
  209. }
  210. muldiv(ltype,rtype,operator)
  211. int ltype,rtype,operator;
  212. {
  213. int result;
  214. result=exprtype(ltype,rtype);
  215. if (operator==MODSYM || operator== '\\') result=INTTYPE;
  216. extraconvert(ltype,result,rtype);
  217. conversion(rtype,result);
  218. if ( result== INTTYPE)
  219. {
  220. if ( operator=='/')
  221. {
  222. result=DOUBLETYPE;
  223. extraconvert(ltype,result,rtype);
  224. conversion(rtype,result);
  225. C_dvf((arith)BEMFLTSIZE);
  226. } else
  227. if ( operator=='\\')
  228. C_dvi((arith)BEMINTSIZE);
  229. else
  230. if ( operator=='*')
  231. C_mli((arith)BEMINTSIZE);
  232. else
  233. if ( operator==MODSYM)
  234. C_rmi((arith)BEMINTSIZE);
  235. else error("illegal operator");
  236. } else {
  237. if ( operator=='/')
  238. C_dvf((arith)BEMFLTSIZE);
  239. else
  240. if ( operator=='*')
  241. C_mlf((arith)BEMFLTSIZE);
  242. else error("illegal operator");
  243. }
  244. return(result);
  245. }
  246. negate(type)
  247. int type;
  248. {
  249. switch(type)
  250. {
  251. case INTTYPE:
  252. C_ngi((arith)BEMINTSIZE);
  253. break;
  254. case DOUBLETYPE:
  255. case FLOATTYPE:
  256. C_ngf((arith)BEMFLTSIZE);
  257. break;
  258. default:
  259. error("Illegal operator");
  260. }
  261. return(type);
  262. }
  263. #ifdef ___
  264. power(ltype,rtype)
  265. int ltype,rtype;
  266. {
  267. int resulttype = exprtype(ltype, rtype);
  268. extraconvert(ltype,resulttype,rtype);
  269. conversion(rtype,resulttype);
  270. switch(resulttype) {
  271. case INTTYPE:
  272. C_cal("_ipower");
  273. break;
  274. case DOUBLETYPE:
  275. case FLOATTYPE:
  276. C_cal("_power");
  277. break;
  278. default:
  279. error("Illegal operator");
  280. }
  281. C_asp((arith)(2*typestring(resulttype)));
  282. C_lfr((arith)typestring(resulttype));
  283. return(resulttype);
  284. }
  285. #else
  286. power(ltype,rtype)
  287. int ltype,rtype;
  288. {
  289. extraconvert(ltype,DOUBLETYPE,rtype);
  290. conversion(rtype,DOUBLETYPE);
  291. C_cal("_power");
  292. C_asp((arith)(2*BEMFLTSIZE));
  293. C_lfr((arith)BEMFLTSIZE);
  294. return(DOUBLETYPE);
  295. }
  296. #endif
  297. int typesize(ltype)
  298. int ltype;
  299. {
  300. switch( ltype)
  301. {
  302. case INTTYPE:
  303. return(BEMINTSIZE);
  304. case FLOATTYPE:
  305. case DOUBLETYPE:
  306. return(BEMFLTSIZE);
  307. case STRINGTYPE:
  308. return(BEMPTRSIZE);
  309. default:
  310. error("typesize:unexpected");
  311. if (debug) print("type received %d\n",ltype);
  312. }
  313. return(BEMINTSIZE);
  314. }
  315. int typestring(type)
  316. int type;
  317. {
  318. switch(type)
  319. {
  320. case INTTYPE:
  321. return(BEMINTSIZE);
  322. case FLOATTYPE:
  323. case DOUBLETYPE:
  324. return(BEMFLTSIZE);
  325. case STRINGTYPE:
  326. return(BEMPTRSIZE);
  327. default:
  328. error("typestring: unexpected type");
  329. }
  330. return(0);
  331. }
  332. loadvar(type)
  333. int type;
  334. {
  335. /* load a simple variable its address is on the stack*/
  336. C_loi((arith)typestring(type));
  337. }
  338. loadint(value)
  339. int value;
  340. {
  341. C_loc((arith)value);
  342. return(INTTYPE);
  343. }
  344. loaddbl(value)
  345. char *value;
  346. {
  347. int index;
  348. index=genlabel();
  349. C_df_dlb((label)index);
  350. C_bss_fcon((arith)BEMFLTSIZE,value,(arith)BEMFLTSIZE,1);
  351. C_lae_dlb((label)index,(arith)0);
  352. C_loi((arith)BEMFLTSIZE);
  353. return(DOUBLETYPE);
  354. }
  355. loadstr(value)
  356. int value;
  357. {
  358. C_lae_dlb((label)value,(arith)0);
  359. }
  360. loadaddr(s)
  361. Symbol *s;
  362. {
  363. extern Symbol *fcn;
  364. int i,j;
  365. arith sum;
  366. if (debug) print("load %s %d\n",s->symname,s->symtype);
  367. if ( s->symalias>0)
  368. C_lae_dlb((label)s->symalias,(arith)0);
  369. else {
  370. j= -s->symalias;
  371. if (debug) print("load parm %d\n",j);
  372. /* first count the sizes. */
  373. sum = 0;
  374. for(i=fcn->dimensions;i>j;i--)
  375. sum += typesize(fcn->dimlimit[i-1]);
  376. C_lal(sum);
  377. }
  378. return(s->symtype);
  379. }
  380. /* This is a new routine */
  381. save_address()
  382. {
  383. C_lae_dnam("dummy3",(arith)0);
  384. C_sti((arith)BEMPTRSIZE);
  385. }
  386. assign(type,lt)
  387. int type,lt;
  388. {
  389. extern int e1,e2;
  390. conversion(lt,type);
  391. C_lae_dnam("dummy3",(arith)0); /* Statement added by us */
  392. C_loi((arith)BEMPTRSIZE);
  393. /* address is on stack already */
  394. C_sti((arith)typestring(type));
  395. }
  396. storevar(lab,type)
  397. int lab,type;
  398. {
  399. /*store value back */
  400. C_lae_dlb((label)lab,(arith)0);
  401. C_sti((arith)typestring(type));
  402. }
  403. /* maintain a stack of array references */
  404. int dimstk[MAXDIMENSIONS], dimtop= -1;
  405. Symbol *arraystk[MAXDIMENSIONS];
  406. newarrayload(s)
  407. Symbol *s;
  408. {
  409. if ( dimtop<MAXDIMENSIONS) dimtop++;
  410. if ( s->dimensions==0)
  411. {
  412. s->dimensions=1;
  413. defarray(s);
  414. }
  415. dimstk[dimtop]= 0;
  416. arraystk[dimtop]= s;
  417. C_lae_dlb((label)s->symalias,(arith)0);
  418. }
  419. endarrayload()
  420. {
  421. return(arraystk[dimtop--]->symtype);
  422. }
  423. loadarray(type)
  424. int type;
  425. {
  426. int dim;
  427. Symbol *s;
  428. if ( dimtop<0 || dimtop>=MAXDIMENSIONS)
  429. fatal("too many nested array references");
  430. /* index expression is on top of stack */
  431. s=arraystk[dimtop];
  432. dim= dimstk[dimtop];
  433. if ( dim>=s->dimensions)
  434. {
  435. error("too many indices");
  436. dimstk[dimtop]=0;
  437. return;
  438. }
  439. conversion(type,INTTYPE);
  440. C_lae_dlb((label)s->dimalias[dim],(arith)0);
  441. C_aar((arith)BEMINTSIZE);
  442. dimstk[dimtop]++;
  443. }