do_proc.c 2.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152
  1. /*
  2. * Sources of the "PROCEDURE CALL" group instructions
  3. */
  4. /* $Id$ */
  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. DoCAI() /* proc identifier on top of stack */
  22. {
  23. /* CAI -: Call procedure (procedure identifier on stack) */
  24. register long pi = spop(psize);
  25. LOG(("@P6 DoCAI(%lu)", pi));
  26. call(arg_p(pi), RSB_CAL);
  27. }
  28. DoCAL(pi)
  29. register long pi;
  30. {
  31. /* CAL p: Call procedure (with identifier p) */
  32. LOG(("@P6 DoCAL(%lu)", pi));
  33. call(arg_p(pi), RSB_CAL);
  34. }
  35. DoLFR(l)
  36. register size l;
  37. {
  38. /* LFR s: Load function result */
  39. LOG(("@P6 DoLFR(%ld)", l));
  40. lfr(arg_s(l));
  41. }
  42. DoRET(l)
  43. register size l;
  44. {
  45. /* RET z: Return (function result consists of top z bytes) */
  46. LOG(("@P6 DoRET(%ld)", l));
  47. ret(arg_z(l));
  48. }
  49. /************************************************************************
  50. * Calling a new procedure. *
  51. ************************************************************************/
  52. call(new_PI, rsbcode)
  53. long new_PI;
  54. int rsbcode;
  55. {
  56. /* legality of new_PI has already been checked */
  57. register size nloc = proctab[new_PI].pr_nloc;
  58. register ptr ep = proctab[new_PI].pr_ep;
  59. push_frame(SP); /* remember AB */
  60. pushrsb(rsbcode);
  61. /* do the call */
  62. PI = new_PI;
  63. st_inc(nloc);
  64. newPC(ep);
  65. spoilFRA();
  66. LOG(("@p5 call: new_PI = %lu, nloc = %lu, ep = %lu",
  67. new_PI, nloc, ep));
  68. }
  69. /************************************************************************
  70. * Loading a function result. *
  71. ************************************************************************/
  72. PRIVATE lfr(sz)
  73. size sz;
  74. {
  75. if (sz > FRALimit) {
  76. wtrap(WILLLFR, EILLINS);
  77. }
  78. LOG(("@p5 lfr: size = %ld", sz));
  79. #ifdef LOGGING
  80. if (!FRA_def) {
  81. warning(WRFUNGAR);
  82. }
  83. if (sz != FRASize) {
  84. warning(FRASize < sz ? WRFUNSML : WRFUNLAR);
  85. }
  86. #endif /* LOGGING */
  87. pushFRA(sz);
  88. spoilFRA();
  89. }
  90. /************************************************************************
  91. * Returning from a procedure. *
  92. ************************************************************************/
  93. PRIVATE ret(sz)
  94. size sz;
  95. {
  96. if (sz > FRALimit) {
  97. wtrap(WILLRET, EILLINS);
  98. }
  99. LOG(("@p5 ret: size = %ld", sz));
  100. /* retrieve return value from stack */
  101. FRA_def = DEFINED;
  102. FRASize = sz;
  103. popFRA(FRASize);
  104. switch (poprsb(0)) {
  105. case RSB_STP:
  106. if (sz == wsize) {
  107. ES_def = DEFINED;
  108. ES = btol(FRA[sz-1]);
  109. /* one byte only */
  110. }
  111. running = 0; /* stop the machine */
  112. return;
  113. case RSB_CAL:
  114. /* OK */
  115. break;
  116. case RSB_RTT:
  117. case RSB_NRT:
  118. warning(WRETTRAP);
  119. running = 0; /* stop the machine */
  120. return;
  121. default:
  122. warning(WRETBAD);
  123. return;
  124. }
  125. }