util/int/do_proc.c

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