123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152 |
- /*
- * Sources of the "PROCEDURE CALL" group instructions
- */
- /* $Id$ */
- #include <em_abs.h>
- #include "logging.h"
- #include "global.h"
- #include "log.h"
- #include "mem.h"
- #include "shadow.h"
- #include "memdirect.h"
- #include "trap.h"
- #include "warn.h"
- #include "text.h"
- #include "proctab.h"
- #include "fra.h"
- #include "rsb.h"
- #include "linfil.h"
- extern int running; /* from main.c */
- PRIVATE lfr(), ret();
- DoCAI() /* proc identifier on top of stack */
- {
- /* CAI -: Call procedure (procedure identifier on stack) */
- register long pi = spop(psize);
- LOG(("@P6 DoCAI(%lu)", pi));
- call(arg_p(pi), RSB_CAL);
- }
- DoCAL(pi)
- register long pi;
- {
- /* CAL p: Call procedure (with identifier p) */
- LOG(("@P6 DoCAL(%lu)", pi));
- call(arg_p(pi), RSB_CAL);
- }
- DoLFR(l)
- register size l;
- {
- /* LFR s: Load function result */
- LOG(("@P6 DoLFR(%ld)", l));
- lfr(arg_s(l));
- }
- DoRET(l)
- register size l;
- {
- /* RET z: Return (function result consists of top z bytes) */
- LOG(("@P6 DoRET(%ld)", l));
- ret(arg_z(l));
- }
- /************************************************************************
- * Calling a new procedure. *
- ************************************************************************/
- call(new_PI, rsbcode)
- long new_PI;
- int rsbcode;
- {
- /* legality of new_PI has already been checked */
- register size nloc = proctab[new_PI].pr_nloc;
- register ptr ep = proctab[new_PI].pr_ep;
- push_frame(SP); /* remember AB */
- pushrsb(rsbcode);
- /* do the call */
- PI = new_PI;
- st_inc(nloc);
- newPC(ep);
- spoilFRA();
- LOG(("@p5 call: new_PI = %lu, nloc = %lu, ep = %lu",
- new_PI, nloc, ep));
- }
- /************************************************************************
- * Loading a function result. *
- ************************************************************************/
- PRIVATE lfr(sz)
- size sz;
- {
- if (sz > FRALimit) {
- wtrap(WILLLFR, EILLINS);
- }
- LOG(("@p5 lfr: size = %ld", sz));
- #ifdef LOGGING
- if (!FRA_def) {
- warning(WRFUNGAR);
- }
- if (sz != FRASize) {
- warning(FRASize < sz ? WRFUNSML : WRFUNLAR);
- }
- #endif /* LOGGING */
- pushFRA(sz);
- spoilFRA();
- }
- /************************************************************************
- * Returning from a procedure. *
- ************************************************************************/
- PRIVATE ret(sz)
- size sz;
- {
- if (sz > FRALimit) {
- wtrap(WILLRET, EILLINS);
- }
- LOG(("@p5 ret: size = %ld", sz));
- /* retrieve return value from stack */
- FRA_def = DEFINED;
- FRASize = sz;
- popFRA(FRASize);
- switch (poprsb(0)) {
- case RSB_STP:
- if (sz == wsize) {
- ES_def = DEFINED;
- ES = btol(FRA[sz-1]);
- /* one byte only */
- }
- running = 0; /* stop the machine */
- return;
- case RSB_CAL:
- /* OK */
- break;
- case RSB_RTT:
- case RSB_NRT:
- warning(WRETTRAP);
- running = 0; /* stop the machine */
- return;
- default:
- warning(WRETBAD);
- return;
- }
- }
|