func.c 5.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269
  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. /* expression types for predefined functions are assembled */
  10. int typetable[10];
  11. int exprlimit;
  12. /* handle all predefined functions */
  13. #define cv(X) conversion(type,X); pop=X
  14. parm(cnt)
  15. int cnt;
  16. {
  17. if( cnt> exprlimit)
  18. error("Not enough arguments");
  19. if( cnt < exprlimit)
  20. error("Too many arguments");
  21. }
  22. callfcn(fcnnr,cnt,typetable)
  23. int fcnnr,cnt;
  24. int *typetable;
  25. {
  26. int pop=DOUBLETYPE;
  27. int res=DOUBLETYPE;
  28. int type;
  29. type= typetable[0];
  30. exprlimit=cnt;
  31. if(debug) print("fcn=%d\n",fcnnr);
  32. switch(fcnnr)
  33. {
  34. case ABSSYM: cv(DOUBLETYPE);
  35. C_cal("_abr");
  36. parm(1);
  37. break;
  38. case ASCSYM: cv(STRINGTYPE);
  39. C_cal("_asc");
  40. res=INTTYPE;
  41. parm(1);
  42. break;
  43. case ATNSYM: cv(DOUBLETYPE);
  44. C_cal("_atn");
  45. parm(1);
  46. break;
  47. case CDBLSYM: cv(DOUBLETYPE);
  48. return(DOUBLETYPE);;
  49. case CHRSYM: cv(INTTYPE);
  50. C_cal("_chr");
  51. res=STRINGTYPE;
  52. parm(1);
  53. break;
  54. case CSNGSYM: cv(DOUBLETYPE);
  55. return(DOUBLETYPE);
  56. case CINTSYM: cv(INTTYPE);
  57. return(INTTYPE);
  58. case COSSYM: cv(DOUBLETYPE);
  59. C_cal("_cos");
  60. parm(1);
  61. break;
  62. case CVISYM: cv(STRINGTYPE);
  63. C_cal("_cvi");
  64. res=INTTYPE;
  65. parm(1);
  66. break;
  67. case CVSSYM: cv(STRINGTYPE);
  68. C_cal("_cvd");
  69. res=DOUBLETYPE;
  70. parm(1);
  71. break;
  72. case CVDSYM: cv(STRINGTYPE);
  73. C_cal("_cvd");
  74. res=DOUBLETYPE;
  75. parm(1);
  76. break;
  77. case EOFSYM:
  78. if( cnt==0)
  79. {
  80. res= INTTYPE;
  81. pop= INTTYPE;
  82. C_loc((arith) -1);
  83. } else cv(INTTYPE);
  84. C_cal("_ioeof");
  85. res=INTTYPE;
  86. break;
  87. case EXPSYM: cv(DOUBLETYPE);
  88. C_cal("_exp");
  89. parm(1);
  90. break;
  91. case FIXSYM: cv(DOUBLETYPE);
  92. C_cal("_fix");
  93. res=INTTYPE;
  94. parm(1);
  95. break;
  96. case INPSYM:
  97. case LPOSSYM:
  98. case FRESYM: pop=0;
  99. warning("function not supported");
  100. parm(1);
  101. break;
  102. case HEXSYM: cv(INTTYPE);
  103. C_cal("_hex"); res=STRINGTYPE;
  104. parm(1);
  105. break;
  106. case OUTSYM:
  107. case INSTRSYM: cv(DOUBLETYPE);
  108. C_cal("_instr");
  109. res=STRINGTYPE;
  110. parm(1);
  111. break;
  112. case INTSYM: cv(DOUBLETYPE);
  113. C_cal("_fcint");
  114. parm(1);
  115. break;
  116. case LEFTSYM: parm(2);
  117. extraconvert(type, STRINGTYPE,typetable[1]);
  118. type= typetable[1];
  119. cv(INTTYPE);
  120. C_cal("_left");
  121. res=STRINGTYPE;
  122. C_asp((arith) BEMPTRSIZE);
  123. C_asp((arith) BEMINTSIZE);
  124. C_lfr((arith) BEMPTRSIZE);
  125. return(STRINGTYPE);
  126. case LENSYM: cv(STRINGTYPE);
  127. C_cal("_length");
  128. res=INTTYPE;
  129. parm(1);
  130. break;
  131. case LOCSYM: cv(INTTYPE);
  132. C_cal("_loc");
  133. res=INTTYPE;
  134. parm(1);
  135. break;
  136. case LOGSYM: cv(DOUBLETYPE);
  137. C_cal("_log");
  138. parm(1);
  139. break;
  140. case MKISYM: cv(INTTYPE);
  141. C_cal("_mki");
  142. res=STRINGTYPE;
  143. parm(1);
  144. break;
  145. case MKSSYM: cv(DOUBLETYPE);
  146. C_cal("_mkd");
  147. res=STRINGTYPE;
  148. parm(1);
  149. break;
  150. case MKDSYM: cv(DOUBLETYPE);
  151. C_cal("_mkd");
  152. res=STRINGTYPE;
  153. parm(1);
  154. break;
  155. case OCTSYM: cv(INTTYPE);
  156. C_cal("_oct");
  157. res=STRINGTYPE;
  158. parm(1);
  159. break;
  160. case PEEKSYM: cv(INTTYPE);
  161. C_cal("_peek");
  162. res=INTTYPE;
  163. parm(1);
  164. break;
  165. case POSSYM: C_asp((arith) typestring(type));
  166. C_exa_dnam("_pos");
  167. C_loe_dnam("_pos",(arith) 0);
  168. return(INTTYPE);
  169. case RIGHTSYM: parm(2);
  170. extraconvert(type, STRINGTYPE,typetable[1]);
  171. type= typetable[1];
  172. cv(INTTYPE);
  173. C_cal("_right");
  174. res=STRINGTYPE;
  175. C_asp((arith) BEMINTSIZE);
  176. C_asp((arith) BEMPTRSIZE);
  177. C_lfr((arith) BEMPTRSIZE);
  178. return(STRINGTYPE);
  179. case RNDSYM: if( cnt==1) pop=type;
  180. else pop=0;
  181. C_cal("_rnd");
  182. res= DOUBLETYPE;
  183. break;
  184. case SGNSYM: cv(DOUBLETYPE);
  185. C_cal("_sgn");
  186. res=INTTYPE;
  187. parm(1);
  188. break;
  189. case SINSYM: cv(DOUBLETYPE);
  190. C_cal("_sin");
  191. parm(1);
  192. break;
  193. case SPACESYM: cv(INTTYPE);
  194. C_cal("_space");
  195. res=STRINGTYPE;
  196. parm(1);
  197. break;
  198. case SPCSYM: cv(INTTYPE);
  199. C_cal("_spc");
  200. res=0;
  201. parm(1);
  202. break;
  203. case SQRSYM: cv(DOUBLETYPE);
  204. C_cal("_sqt");
  205. parm(1);
  206. break;
  207. case STRSYM: cv(DOUBLETYPE);
  208. C_cal("_nstr");
  209. res=STRINGTYPE; /* NEW */
  210. parm(1);
  211. break;
  212. case STRINGSYM:
  213. parm(2); /* 2 is NEW */
  214. if (typetable[1] == STRINGTYPE) {
  215. C_cal("_asc");
  216. C_asp((arith)BEMPTRSIZE);
  217. C_lfr((arith)BEMINTSIZE);
  218. typetable[1] = INTTYPE;
  219. }
  220. extraconvert(type,
  221. DOUBLETYPE,
  222. typetable[1]); /* NEW */
  223. type= typetable[1];
  224. cv(DOUBLETYPE); /* NEW */
  225. C_cal("_string");
  226. res=STRINGTYPE;
  227. C_asp((arith)typestring(DOUBLETYPE)); /*NEW*/
  228. break;
  229. case TABSYM: cv(INTTYPE);
  230. C_cal("_tab");
  231. res=0;
  232. parm(1);
  233. break;
  234. case TANSYM: cv(DOUBLETYPE);
  235. C_cal("_tan");
  236. parm(1);
  237. break;
  238. case VALSYM: cv(STRINGTYPE);
  239. C_loi((arith)BEMPTRSIZE);
  240. C_cal("atoi");
  241. res=INTTYPE;
  242. parm(1);
  243. break;
  244. case VARPTRSYM: cv(DOUBLETYPE);
  245. C_cal("_valptr");
  246. parm(1);
  247. break;
  248. default: error("unknown function");
  249. }
  250. if(pop) C_asp((arith) typestring(pop));
  251. if(res) C_lfr((arith) typestring(res));
  252. return(res);
  253. }