do_proc.c 4.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224
  1. /*
  2. * Sources of the "PROCEDURE CALL" group instructions
  3. */
  4. /* $Header$ */
  5. #include <em_abs.h>
  6. #include "logging.h"
  7. #include "global.h"
  8. #include "log.h"
  9. #include "mem.h"
  10. #include "shadow.h"
  11. #include "memdirect.h"
  12. #include "trap.h"
  13. #include "warn.h"
  14. #include "text.h"
  15. #include "proctab.h"
  16. #include "fra.h"
  17. #include "rsb.h"
  18. #include "linfil.h"
  19. extern int running; /* from main.c */
  20. PRIVATE lfr(), ret();
  21. DoCAIz() /* proc identifier on top of stack */
  22. {
  23. /* CAI -: Call procedure (procedure identifier on stack) */
  24. register long pi = spop(psize);
  25. LOG(("@P6 DoCAIz(%lu)", pi));
  26. call(arg_p(pi), RSB_CAL);
  27. }
  28. DoCALl2(arg)
  29. long arg;
  30. {
  31. /* CAL p: Call procedure (with identifier p) */
  32. register long pi = (L_arg_2() * arg);
  33. LOG(("@P6 DoCALl2(%lu)", pi));
  34. call(arg_p(pi), RSB_CAL);
  35. }
  36. DoCALl4(arg)
  37. long arg;
  38. {
  39. /* CAL p: Call procedure (with identifier p) */
  40. register long pi = (L_arg_4() * arg);
  41. LOG(("@P6 DoCALl4(%lu)", pi));
  42. call(arg_p(pi), RSB_CAL);
  43. }
  44. DoCALm(arg)
  45. long arg;
  46. {
  47. /* CAL p: Call procedure (with identifier p) */
  48. register long pi = arg_p(arg);
  49. LOG(("@P6 DoCALm(%lu)", pi));
  50. call(pi, RSB_CAL);
  51. }
  52. DoCALs(hob, wfac)
  53. long hob;
  54. size wfac;
  55. {
  56. /* CAL p: Call procedure (with identifier p) */
  57. register long pi = (S_arg(hob) * wfac);
  58. LOG(("@P6 DoCALs(%lu)", pi));
  59. call(arg_p(pi), RSB_CAL);
  60. }
  61. DoLFRl2(arg)
  62. size arg;
  63. {
  64. /* LFR s: Load function result */
  65. register size l = (L_arg_2() * arg);
  66. LOG(("@P6 DoLFRl2(%ld)", l));
  67. lfr(arg_s(l));
  68. }
  69. DoLFRm(arg)
  70. size arg;
  71. {
  72. /* LFR s: Load function result */
  73. LOG(("@P6 DoLFRm(%ld)", arg));
  74. lfr(arg_s(arg));
  75. }
  76. DoLFRs(hob, wfac)
  77. long hob;
  78. size wfac;
  79. {
  80. /* LFR s: Load function result */
  81. register size l = (S_arg(hob) * wfac);
  82. LOG(("@P6 DoLFRs(%ld)", l));
  83. lfr(arg_s(l));
  84. }
  85. DoRETl2(arg)
  86. size arg;
  87. {
  88. /* RET z: Return (function result consists of top z bytes) */
  89. register size l = (L_arg_2() * arg);
  90. LOG(("@P6 DoRETl2(%ld)", l));
  91. ret(arg_z(l));
  92. }
  93. DoRETm(arg)
  94. size arg;
  95. {
  96. /* RET z: Return (function result consists of top z bytes) */
  97. LOG(("@P6 DoRETm(%ld)", arg));
  98. ret(arg_z(arg));
  99. }
  100. DoRETs(hob, wfac)
  101. long hob;
  102. size wfac;
  103. {
  104. /* RET z: Return (function result consists of top z bytes) */
  105. register size l = (S_arg(hob) * wfac);
  106. LOG(("@P6 DoRETs(%ld)", l));
  107. ret(arg_z(l));
  108. }
  109. /************************************************************************
  110. * Calling a new procedure. *
  111. ************************************************************************/
  112. call(new_PI, rsbcode)
  113. long new_PI;
  114. int rsbcode;
  115. {
  116. /* legality of new_PI has already been checked */
  117. register size nloc = proctab[new_PI].pr_nloc;
  118. register ptr ep = proctab[new_PI].pr_ep;
  119. push_frame(SP); /* remember AB */
  120. pushrsb(rsbcode);
  121. /* do the call */
  122. PI = new_PI;
  123. st_inc(nloc);
  124. newPC(ep);
  125. spoilFRA();
  126. LOG(("@p5 call: new_PI = %lu, nloc = %lu, ep = %lu",
  127. new_PI, nloc, ep));
  128. }
  129. /************************************************************************
  130. * Loading a function result. *
  131. ************************************************************************/
  132. PRIVATE lfr(sz)
  133. size sz;
  134. {
  135. if (sz > FRALimit) {
  136. wtrap(WILLLFR, EILLINS);
  137. }
  138. LOG(("@p5 lfr: size = %ld", sz));
  139. #ifdef LOGGING
  140. if (!FRA_def) {
  141. warning(WRFUNGAR);
  142. }
  143. if (sz != FRASize) {
  144. warning(FRASize < sz ? WRFUNSML : WRFUNLAR);
  145. }
  146. #endif LOGGING
  147. pushFRA(sz);
  148. spoilFRA();
  149. }
  150. /************************************************************************
  151. * Returning from a procedure. *
  152. ************************************************************************/
  153. PRIVATE ret(sz)
  154. size sz;
  155. {
  156. if (sz > FRALimit) {
  157. wtrap(WILLRET, EILLINS);
  158. }
  159. LOG(("@p5 ret: size = %ld", sz));
  160. /* retrieve return value from stack */
  161. FRA_def = DEFINED;
  162. FRASize = sz;
  163. popFRA(FRASize);
  164. switch (poprsb(0)) {
  165. case RSB_STP:
  166. if (sz == wsize) {
  167. ES_def = DEFINED;
  168. ES = btol(FRA[sz-1]);
  169. /* one byte only */
  170. }
  171. running = 0; /* stop the machine */
  172. return;
  173. case RSB_CAL:
  174. /* OK */
  175. break;
  176. case RSB_RTT:
  177. case RSB_NRT:
  178. warning(WRETTRAP);
  179. running = 0; /* stop the machine */
  180. return;
  181. default:
  182. warning(WRETBAD);
  183. return;
  184. }
  185. }