mirror of
https://github.com/Interlisp/maiko.git
synced 2026-01-15 15:57:13 +00:00
117 lines
3.6 KiB
C
117 lines
3.6 KiB
C
/* $Id: intcall.c,v 1.3 1999/05/31 23:35:34 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved
|
|
*/
|
|
|
|
/************************************************************************/
|
|
/* */
|
|
/* (C) Copyright 1989-95 Venue. All Rights Reserved. */
|
|
/* Manufactured in the United States of America. */
|
|
/* */
|
|
/************************************************************************/
|
|
|
|
#include "version.h"
|
|
|
|
#include "lispemul.h"
|
|
#include "address.h"
|
|
#include "adr68k.h"
|
|
#include "lsptypes.h"
|
|
#include "lispmap.h"
|
|
#include "stack.h"
|
|
#include "return.h"
|
|
#include "emlglob.h"
|
|
#include "lspglob.h"
|
|
#include "initatms.h"
|
|
#include "cell.h"
|
|
#include "tosfns.h"
|
|
|
|
#include "intcalldefs.h"
|
|
#include "commondefs.h"
|
|
#include "llstkdefs.h"
|
|
#include "returndefs.h"
|
|
|
|
void cause_interruptcall(register unsigned int atom_index)
|
|
/* Atomindex for Function you want to invoke */
|
|
{
|
|
register struct definition_cell *defcell68k; /* Definition Cell PTR */
|
|
register short pv_num; /* scratch for pv */
|
|
register struct fnhead *tmp_fn;
|
|
int rest; /* use for arignments */
|
|
|
|
CURRENTFX->nopush = T;
|
|
CURRENTFX->nextblock = StkOffset_from_68K(CurrentStackPTR) + 4;
|
|
PushCStack; /* save TOS */
|
|
|
|
/* Setup IVar */
|
|
IVar = Addr68k_from_StkOffset(CURRENTFX->nextblock);
|
|
|
|
/* Set PC to the Next Instruction and save into pre-FX */
|
|
CURRENTFX->pc = ((UNSIGNED)PC - (UNSIGNED)FuncObj);
|
|
|
|
/* Get DEFCELL 68k address */
|
|
defcell68k = (struct definition_cell *)GetDEFCELL68k(atom_index);
|
|
|
|
/* Interrupt FN should be compiled code */
|
|
tmp_fn = (struct fnhead *)Addr68k_from_LADDR(defcell68k->defpointer);
|
|
|
|
/* This used to be >=, but I think that was a change from earlier,
|
|
when it was originally >. I changed it back on 2/2/98 to see
|
|
if that fixes stack overflow trouble. --JDS */
|
|
if ((UNSIGNED)(CurrentStackPTR + tmp_fn->stkmin + STK_SAFE) > (UNSIGNED)EndSTKP) {
|
|
/*printf("Interrupt:$$ STKOVER when ");
|
|
print(atom_index);
|
|
printf(" was called *****\n");*/
|
|
DOSTACKOVERFLOW(0, -1);
|
|
}
|
|
FuncObj = tmp_fn;
|
|
SWAPPED_FN_CHECK; /* Check for need to re-swap code stream */
|
|
if (FuncObj->na >= 0) {
|
|
/* This Function is Spread Type */
|
|
/* Arguments on Stack Adjustment */
|
|
rest = 0 - (FuncObj->na);
|
|
|
|
while (rest < 0) {
|
|
PushStack(NIL_PTR);
|
|
rest++;
|
|
}
|
|
CurrentStackPTR -= (rest << 1);
|
|
} /* if end */
|
|
|
|
/* Set up BF */
|
|
CurrentStackPTR += 2;
|
|
GETWORD(CurrentStackPTR) = BF_MARK;
|
|
GETWORD(CurrentStackPTR + 1) = CURRENTFX->nextblock;
|
|
CurrentStackPTR += 2;
|
|
|
|
/* Set up FX */
|
|
GETWORD(CurrentStackPTR) = FX_MARK;
|
|
|
|
/* Now SET new FX */
|
|
/* Make it SLOWP */
|
|
((FX *)CurrentStackPTR)->alink = StkOffset_from_68K(PVar) + 1;
|
|
((FX *)CurrentStackPTR)->blink = StkOffset_from_68K(DUMMYBF(CurrentStackPTR));
|
|
((FX *)CurrentStackPTR)->clink = StkOffset_from_68K(PVar);
|
|
PVar = (DLword *)CurrentStackPTR + FRAMESIZE;
|
|
#ifdef BIGVM
|
|
((FX *)CurrentStackPTR)->fnheader = (defcell68k->defpointer);
|
|
#else
|
|
((FX *)CurrentStackPTR)->lofnheader = (defcell68k->defpointer) & 0x0ffff;
|
|
((FX *)CurrentStackPTR)->hi2fnheader = ((defcell68k->defpointer) & SEGMASK) >> 16;
|
|
#endif /* BIGVM */
|
|
|
|
CurrentStackPTR = PVar;
|
|
|
|
/* Set up PVar area */
|
|
pv_num = FuncObj->pv + 1;
|
|
while (pv_num > 0) {
|
|
*((LispPTR *)CurrentStackPTR) = 0x0ffffffff;
|
|
CurrentStackPTR += DLWORDSPER_CELL;
|
|
*((LispPTR *)CurrentStackPTR) = 0x0ffffffff;
|
|
CurrentStackPTR += DLWORDSPER_CELL;
|
|
pv_num--;
|
|
}
|
|
|
|
/* Set PC points New Function's first OPCODE */
|
|
PC = (ByteCode *)FuncObj + FuncObj->startpc;
|
|
CURRENTFX->nextblock = StkOffset_from_68K(CurrentStackPTR);
|
|
MAKEFREEBLOCK(CurrentStackPTR, ((UNSIGNED)EndSTKP - (UNSIGNED)CurrentStackPTR) >> 1);
|
|
} /* end */
|