mirror of
https://github.com/Interlisp/maiko.git
synced 2026-03-01 17:35:54 +00:00
133 lines
3.8 KiB
C
Executable File
133 lines
3.8 KiB
C
Executable File
/* $Id: intcall.c,v 1.3 1999/05/31 23:35:34 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */
|
|
static char *id = "$Id: intcall.c,v 1.3 1999/05/31 23:35:34 sybalsky Exp $ Copyright (C) Venue";
|
|
|
|
|
|
|
|
|
|
|
|
/************************************************************************/
|
|
/* */
|
|
/* (C) Copyright 1989-95 Venue. All Rights Reserved. */
|
|
/* Manufactured in the United States of America. */
|
|
/* */
|
|
/* The contents of this file are proprietary information */
|
|
/* belonging to Venue, and are provided to you under license. */
|
|
/* They may not be further distributed or disclosed to third */
|
|
/* parties without the specific permission of Venue. */
|
|
/* */
|
|
/************************************************************************/
|
|
|
|
#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"
|
|
|
|
|
|
|
|
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 toruble. --JDS */
|
|
if((UNSIGNED)(CurrentStackPTR + tmp_fn->stkmin +STK_SAFE) > (UNSIGNED)EndSTKP )
|
|
{
|
|
|
|
/*printf("Intrrupt:$$ 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 */
|