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         register size nloc = proctab[new_PI].pr_nloc;
  72         register ptr ep = proctab[new_PI].pr_ep;
  73
  74         push_frame(SP);                 /* remember AB */
  75         pushrsb(rsbcode);
  76
  77         /* do the call */
  78         PI = new_PI;
  79         st_inc(nloc);
  80         newPC(ep);
  81         spoilFRA();
  82         LOG(("@p5 call: new_PI = %lu, nloc = %lu, ep = %lu",
  83                                 new_PI, nloc, ep));
  84 }
  85
  86 /************************************************************************
  87  *              Loading a function result.                              *
  88  ************************************************************************/
  89
  90 PRIVATE lfr(sz)
  91         size sz;
  92 {
  93         if (sz > FRALimit) {
  94                 wtrap(WILLLFR, EILLINS);
  95         }
  96
  97         LOG(("@p5 lfr: size = %ld", sz));
  98
  99 #ifdef  LOGGING
 100         if (!FRA_def) {
 101                 warning(WRFUNGAR);
 102         }
 103         if (sz != FRASize) {
 104                 warning(FRASize < sz ? WRFUNSML : WRFUNLAR);
 105         }
 106 #endif  /* LOGGING */
 107
 108         pushFRA(sz);
 109         spoilFRA();
 110 }
 111
 112 /************************************************************************
 113  *              Returning from a procedure.                             *
 114  ************************************************************************/
 115
 116 PRIVATE ret(sz)
 117         size sz;
 118 {
 119         if (sz > FRALimit) {
 120                 wtrap(WILLRET, EILLINS);
 121         }
 122
 123         LOG(("@p5 ret: size = %ld", sz));
 124
 125         /* retrieve return value from stack */
 126         FRA_def = DEFINED;
 127         FRASize = sz;
 128         popFRA(FRASize);
 129
 130         switch (poprsb(0)) {
 131         case RSB_STP:
 132                 if (sz == wsize) {
 133                         ES_def = DEFINED;
 134                         ES = btol(FRA[sz-1]);
 135                                         /* one byte only */
 136                 }
 137                 running = 0;            /* stop the machine */
 138                 return;
 139         case RSB_CAL:
 140                 /* OK */
 141                 break;
 142         case RSB_RTT:
 143         case RSB_NRT:
 144                 warning(WRETTRAP);
 145                 running = 0;            /* stop the machine */
 146                 return;
 147         default:
 148                 warning(WRETBAD);
 149                 return;
 150         }
 151 }
 152