github.com/Interlisp.maiko
1
0
Fork 0
mirror of https://github.com/Interlisp/maiko.git synced 2026-01-29 21:21:08 +00:00
Code Issues Projects Releases Wiki Activity

Reformat all C source files with Clang-format in Google style w/ 100 col width.

Browse Source
This commit is contained in:
Nick Briggs
2017-05-28 18:08:18 -07:00
parent 691645d048
commit 156c3292f8
167 changed files with 40520 additions and 48069 deletions
Download Patch File Download Diff File Expand all files Collapse all files

436
src/loopsops.c Executable file → Normal file
View File

@@ -1,7 +1,7 @@
/* $Id: loopsops.c,v 1.3 1999/05/31 23:35:37 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */
/* $Id: loopsops.c,v 1.3 1999/05/31 23:35:37 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved
*/
static char *id = "$Id: loopsops.c,v 1.3 1999/05/31 23:35:37 sybalsky Exp $ Copyright (C) Venue";
/************************************************************************/
/* */
/* (C) Copyright 1989-95 Venue. All Rights Reserved. */
@@ -16,16 +16,13 @@ static char *id = "$Id: loopsops.c,v 1.3 1999/05/31 23:35:37 sybalsky Exp $ Copy
#include "version.h"
/*
LOOPS opcodes:
FetchMethodOrHelp(object, selector) -> MethodFn
LookupIV(object, iv) -> Index into iDescrs
GetValue(object, iv)
PutValue(object, iv, val)
FetchMethodOrHelp(object, selector) -> MethodFn
LookupIV(object, iv) -> Index into iDescrs
GetValue(object, iv)
PutValue(object, iv, val)
*/
#include "lispemul.h"
@@ -38,111 +35,100 @@ static char *id = "$Id: loopsops.c,v 1.3 1999/05/31 23:35:37 sybalsky Exp $ Copy
#include "gc.h"
LispPTR lcfuncall(register unsigned int atom_index, register int argnum, register int bytenum);
LispPTR get_package_atom(char *char_base, DLword charlen, char *packname, DLword packlen, int externalp);
static char il_string[]="INTERLISP";
#define GET_IL_ATOM(string) get_package_atom((string),(sizeof(string)-1), \
il_string,9,NIL)
LispPTR get_package_atom(char *char_base, DLword charlen, char *packname, DLword packlen,
int externalp);
static char il_string[] = "INTERLISP";
#define GET_IL_ATOM(string) get_package_atom((string), (sizeof(string) - 1), il_string, 9, NIL)
#define AtomValPtr(index) Addr68k_from_LADDR(*(GetVALCELL68k(index)))
#define AtomValPtr(index) Addr68k_from_LADDR(*(GetVALCELL68k(index)))
#ifdef BIGVM
#define DTD_FROM_LADDR(x) \
(((struct dtd *)GetDTD(GetTypeNumber((x))))->dtd_name)
#define DTD_FROM_LADDR(x) (((struct dtd *)GetDTD(GetTypeNumber((x))))->dtd_name)
#else
#define DTD_FROM_LADDR(x) \
(((struct dtd *)GetDTD(GetTypeNumber((x))))->dtd_namelo + \
(((struct dtd *)GetDTD(GetTypeNumber((x))))->dtd_namehi<<16))
#define DTD_FROM_LADDR(x) \
(((struct dtd *)GetDTD(GetTypeNumber((x))))->dtd_namelo + \
(((struct dtd *)GetDTD(GetTypeNumber((x))))->dtd_namehi << 16))
#endif /* BIGVM */
/* These assume 0 <= POSINT <= 65535 */
#define SMALLP_FROM_POSINT(x) ((x) | S_POSITIVE)
#define POSINT_FROM_SMALLP(x) ((x) & 0xffff)
#define RETCALL(fn,argnum) return lcfuncall(fn,argnum,3)
#define SMALLP_FROM_POSINT(x) ((x) | S_POSITIVE)
#define POSINT_FROM_SMALLP(x) ((x)&0xffff)
#define RETCALL(fn, argnum) return lcfuncall(fn, argnum, 3)
/* #define PUNT (-1)*/
#define METH_CACHE_INDEX(CLASS,SELECTOR) (1023 & ((CLASS) ^ (SELECTOR)))
#define IV_CACHE_INDEX(VARLIST,IV) (1023 & ((VARLIST) ^ (IV)))
#define METH_CACHE_INDEX(CLASS, SELECTOR) (1023 & ((CLASS) ^ (SELECTOR)))
#define IV_CACHE_INDEX(VARLIST, IV) (1023 & ((VARLIST) ^ (IV)))
#define LC_TYPEP(obj,typeATOM) (DTD_FROM_LADDR((obj)) == typeATOM)
#define LC_TYPEP(obj, typeATOM) (DTD_FROM_LADDR((obj)) == typeATOM)
#define INSTANCEP(obj) (LC_TYPEP((obj),atom_instance))
#define CLASSP(obj) (LC_TYPEP((obj),atom_class))
#define INSTANCEP(obj) (LC_TYPEP((obj), atom_instance))
#define CLASSP(obj) (LC_TYPEP((obj), atom_class))
#define INSTANCE_OR_PUNT(obj,fn,argnum) \
{ if (!LC_TYPEP((obj),atom_instance)) \
RETCALL(fn,argnum); \
}
#define INSTANCE_OR_PUNT(obj, fn, argnum) \
{ \
if (!LC_TYPEP((obj), atom_instance)) RETCALL(fn, argnum); \
}
#define INSTANCE_CLASS_OR_PUNT(obj,fn,argnum) \
{ register LispPTR tmp = DTD_FROM_LADDR(obj); \
if (tmp != atom_instance && tmp != atom_class) \
RETCALL(fn,argnum); \
}
#define INSTANCE_CLASS_OR_PUNT(obj, fn, argnum) \
{ \
register LispPTR tmp = DTD_FROM_LADDR(obj); \
if (tmp != atom_instance && tmp != atom_class) RETCALL(fn, argnum); \
}
#define LC_INIT if (atom_instance == 0) LCinit()
#define LC_INIT \
if (atom_instance == 0) LCinit()
#define GET_IV_INDEX(objptr,iv,dest,otherwise) \
{ \
register struct LCIVCacheEntry *ce; \
register LispPTR iNames=objptr->iNames; \
\
ce = &(LCIVCache[IV_CACHE_INDEX(iNames, iv)]); \
if (ce->iNames == iNames && ce->iv == iv){ \
(dest) = POSINT_FROM_SMALLP(ce->index); \
}else{ \
if (! Listp(iNames)) { \
otherwise; \
}else{ \
register int i=0; \
while (1) { \
if ( car(iNames) == iv) { \
ce->iNames = objptr->iNames; \
ce->iv = iv; \
ce->index = SMALLP_FROM_POSINT(i); \
(dest) = i; \
break; \
}else{ \
i++; \
if ((iNames = cdr(iNames)) == NIL_PTR) { \
otherwise; \
} \
} \
} \
} \
} \
}
#define GET_IV_INDEX(objptr, iv, dest, otherwise) \
{ \
register struct LCIVCacheEntry *ce; \
register LispPTR iNames = objptr->iNames; \
\
ce = &(LCIVCache[IV_CACHE_INDEX(iNames, iv)]); \
if (ce->iNames == iNames && ce->iv == iv) { \
(dest) = POSINT_FROM_SMALLP(ce->index); \
} else { \
if (!Listp(iNames)) { \
otherwise; \
} else { \
register int i = 0; \
while (1) { \
if (car(iNames) == iv) { \
ce->iNames = objptr->iNames; \
ce->iv = iv; \
ce->index = SMALLP_FROM_POSINT(i); \
(dest) = i; \
break; \
} else { \
i++; \
if ((iNames = cdr(iNames)) == NIL_PTR) { otherwise; } \
} \
} \
} \
} \
}
struct LCClass { /* class datatype */
LispPTR metaClass, ivNames, ivDescrs,
classUnitRec, localIVs, cvNames,
cvDescrs, className, supers, subClasses,
otherClassDescription, selectors, methods, localSupers;
struct LCClass { /* class datatype */
LispPTR metaClass, ivNames, ivDescrs, classUnitRec, localIVs, cvNames, cvDescrs, className,
supers, subClasses, otherClassDescription, selectors, methods, localSupers;
};
struct LCInstance { /* instance datatype */
struct LCInstance { /* instance datatype */
LispPTR class, iNames, iDescrs, instMiscField;
};
struct LCMethodCacheEntry {
LispPTR class, selector, method_fn, junk;
} *LCMethodCache;
} * LCMethodCache;
struct LCIVCacheEntry {
LispPTR iNames, iv, index, junk;
} *LCIVCache;
} * LCIVCache;
LispPTR atom_instance = 0, /* various atom indices */
atom_class,
atom_annotatedValue,
atom_FetchMethodOrHelp_LCUFN,
atom_FetchMethod_LCUFN,
atom_FindVarIndex_LCUFN,
atom_GetIVValue_LCUFN,
atom_PutIVValue_LCUFN;
LispPTR atom_instance = 0, /* various atom indices */
atom_class, atom_annotatedValue, atom_FetchMethodOrHelp_LCUFN, atom_FetchMethod_LCUFN,
atom_FindVarIndex_LCUFN, atom_GetIVValue_LCUFN, atom_PutIVValue_LCUFN;
/* Called once to initialize the "constants" above */
@@ -155,11 +141,9 @@ LispPTR LCinit(void) {
atom_FindVarIndex_LCUFN = GET_IL_ATOM("\\FindVarIndex-LCUFN");
atom_GetIVValue_LCUFN = GET_IL_ATOM("\\GetIVValue-LCUFN");
atom_PutIVValue_LCUFN = GET_IL_ATOM("\\PutIVValue-LCUFN");
LCMethodCache = (struct LCMethodCacheEntry *)
AtomValPtr(GET_IL_ATOM("*Global-Method-Cache*"));
LCIVCache = (struct LCIVCacheEntry *)
AtomValPtr(GET_IL_ATOM("*Global-IV-Cache-Block*"));
return NIL_PTR; /* in case called from lisp */
LCMethodCache = (struct LCMethodCacheEntry *)AtomValPtr(GET_IL_ATOM("*Global-Method-Cache*"));
LCIVCache = (struct LCIVCacheEntry *)AtomValPtr(GET_IL_ATOM("*Global-IV-Cache-Block*"));
return NIL_PTR; /* in case called from lisp */
}
/* Type check fn */
@@ -167,126 +151,116 @@ LispPTR LCinit(void) {
so the loop is unnecessary. */
/* * * NOT USED * * */
#ifdef NEVER
int LCTypeOf(thing, typename)
register LispPTR thing,typename;
int LCTypeOf(thing, typename) register LispPTR thing, typename;
{
register struct dtd *dtd68k;
#ifdef BIGVM
for(dtd68k=(struct dtd *) GetDTD(GetTypeNumber(thing));
typename != (dtd68k->dtd_name);
dtd68k=(struct dtd *) GetDTD(dtd68k->dtd_supertype) ) {
if( dtd68k->dtd_supertype == 0) return 0;
for (dtd68k = (struct dtd *)GetDTD(GetTypeNumber(thing)); typename != (dtd68k->dtd_name);
dtd68k = (struct dtd *)GetDTD(dtd68k->dtd_supertype)) {
if (dtd68k->dtd_supertype == 0) return 0;
}
#else
for(dtd68k=(struct dtd *) GetDTD(GetTypeNumber(thing));
typename != dtd68k->dtd_namelo+(dtgd68k->dtd_namehi<<16) ;
dtd68k=(struct dtd *) GetDTD(dtd68k->dtd_supertype) ) {
if( dtd68k->dtd_supertype == 0) return 0;
for (dtd68k = (struct dtd *)GetDTD(GetTypeNumber(thing));
typename != dtd68k->dtd_namelo + (dtgd68k->dtd_namehi << 16);
dtd68k = (struct dtd *)GetDTD(dtd68k->dtd_supertype)) {
if (dtd68k->dtd_supertype == 0) return 0;
}
#endif /* BIGVM */
return 1;
return 1;
}
#endif /* NEVER */
/* Method lookup using global cache */
LispPTR LCFetchMethodOrHelp(register LispPTR object, register LispPTR selector)
{
LispPTR LCFetchMethodOrHelp(register LispPTR object, register LispPTR selector) {
register struct LCInstance *objptr;
register struct LCMethodCacheEntry *ce;
register LispPTR cur_class;
LC_INIT;
INSTANCE_CLASS_OR_PUNT(object,atom_FetchMethodOrHelp_LCUFN,2);
INSTANCE_CLASS_OR_PUNT(object, atom_FetchMethodOrHelp_LCUFN, 2);
objptr = (struct LCInstance *) Addr68k_from_LADDR(object);
objptr = (struct LCInstance *)Addr68k_from_LADDR(object);
ce = &(LCMethodCache[METH_CACHE_INDEX((cur_class = objptr->class), selector)]);
if(ce->class == cur_class && ce->selector == selector)
return ce->method_fn;
if (ce->class == cur_class && ce->selector == selector) return ce->method_fn;
/* not in cache, search class then supers */
{
LispPTR supers = ((struct LCClass *)Addr68k_from_LADDR(cur_class))->supers;
for (;;) {
register i=0;
register i = 0;
register LispPTR val;
register LispPTR *selectorptr;
register struct LCClass *classptr;
classptr = (struct LCClass *)Addr68k_from_LADDR(cur_class);
if (classptr->selectors == NIL_PTR) {
goto next_class;
}else{
selectorptr = (LispPTR *)Addr68k_from_LADDR(classptr->selectors);
goto next_class;
} else {
selectorptr = (LispPTR *)Addr68k_from_LADDR(classptr->selectors);
}
while ((val = selectorptr[i++]) != NIL_PTR) {
if (val == selector) {
ce->class = objptr->class;
ce->selector = selector;
return (ce->method_fn =
((LispPTR *)Addr68k_from_LADDR(classptr->methods))[i-1]) ;
}
if (val == selector) {
ce->class = objptr->class;
ce->selector = selector;
return (ce->method_fn = ((LispPTR *)Addr68k_from_LADDR(classptr->methods))[i - 1]);
}
};
next_class:
if( (cur_class = car(supers) ) == NIL_PTR)
break;
next_class:
if ((cur_class = car(supers)) == NIL_PTR) break;
supers = cdr(supers);
}
}
/* we didn't find it at all; punt */
RETCALL(atom_FetchMethodOrHelp_LCUFN,2);
RETCALL(atom_FetchMethodOrHelp_LCUFN, 2);
/* return lcfuncall(atom_FetchMethodOrHelp_LCUFN,2,3); */
/* return PUNT;*/
/* return lcfuncall(atom_FetchMethodOrHelp_LCUFN,2,3); */
/* return PUNT;*/
}
LispPTR LCFetchMethod(register LispPTR class, register LispPTR selector)
{
LispPTR LCFetchMethod(register LispPTR class, register LispPTR selector) {
register struct LCMethodCacheEntry *ce;
LC_INIT;
/* Check cache before doing type check */
ce = &(LCMethodCache[METH_CACHE_INDEX(class, selector)]);
if(ce->class == class && ce->selector == selector)
return ce->method_fn;
if (ce->class == class && ce->selector == selector) return ce->method_fn;
/* it wasn't there, go search class then supers */
if (!LC_TYPEP(class, atom_class)) RETCALL(atom_FetchMethod_LCUFN,2);
if (!LC_TYPEP(class, atom_class)) RETCALL(atom_FetchMethod_LCUFN, 2);
{
register LispPTR cur_class = class;
LispPTR supers = ((struct LCClass *)Addr68k_from_LADDR(cur_class))->supers;
for (;;) {
register i=0;
register i = 0;
register LispPTR val;
register struct LCClass *classptr;
register LispPTR *selectorptr;
classptr = (struct LCClass *)Addr68k_from_LADDR(cur_class);
if (classptr->selectors == NIL_PTR) goto next_class;
else selectorptr = (LispPTR *)Addr68k_from_LADDR(classptr->selectors);
if (classptr->selectors == NIL_PTR)
goto next_class;
else
selectorptr = (LispPTR *)Addr68k_from_LADDR(classptr->selectors);
while ((val = selectorptr[i++]) != NIL_PTR) {
if (val == selector) {
ce->class = class;
ce->selector = selector;
return (ce->method_fn =
((LispPTR *)Addr68k_from_LADDR(classptr->methods))[i-1]);
}
if (val == selector) {
ce->class = class;
ce->selector = selector;
return (ce->method_fn = ((LispPTR *)Addr68k_from_LADDR(classptr->methods))[i - 1]);
}
};
next_class:
if( (cur_class = car(supers) ) == NIL_PTR)
break;
next_class:
if ((cur_class = car(supers)) == NIL_PTR) break;
supers = cdr(supers);
}
}
@@ -295,106 +269,97 @@ next_class:
return NIL_PTR;
}
LispPTR LCFindVarIndex(register LispPTR iv, register LispPTR object)
{
LispPTR LCFindVarIndex(register LispPTR iv, register LispPTR object) {
register struct LCInstance *objptr;
register struct LCIVCacheEntry *ce;
register LispPTR iNames;
LC_INIT;
INSTANCE_CLASS_OR_PUNT(object,atom_FindVarIndex_LCUFN,2);
INSTANCE_CLASS_OR_PUNT(object, atom_FindVarIndex_LCUFN, 2);
objptr = (struct LCInstance *) Addr68k_from_LADDR(object);
objptr = (struct LCInstance *)Addr68k_from_LADDR(object);
ce = &(LCIVCache[IV_CACHE_INDEX((iNames = objptr->iNames), iv)]);
if (ce->iNames == iNames && ce->iv == iv)
return ce->index;
if (ce->iNames == iNames && ce->iv == iv) return ce->index;
if (! Listp(iNames)) return NIL_PTR; /* FastFindIndex lisp macro (& others?) */
/* needs this check too ! */
if (!Listp(iNames)) return NIL_PTR; /* FastFindIndex lisp macro (& others?) */
/* needs this check too ! */
{
register int i;
for (i=0; i++; (iNames = cdr(iNames)) != NIL_PTR) {
if ( car(iNames) == iv) {
ce->iNames = objptr->iNames;
ce->iv = iv;
return (ce->index = SMALLP_FROM_POSINT(i));
for (i = 0; i++; (iNames = cdr(iNames)) != NIL_PTR) {
if (car(iNames) == iv) {
ce->iNames = objptr->iNames;
ce->iv = iv;
return (ce->index = SMALLP_FROM_POSINT(i));
}
}
return NIL_PTR;
}
}
#if 01
LispPTR
LCGetIVValue(register LispPTR object, register LispPTR iv)
{
LispPTR LCGetIVValue(register LispPTR object, register LispPTR iv) {
register struct LCInstance *objptr;
register LispPTR val;
register int index;
LC_INIT;
INSTANCE_OR_PUNT(object,atom_GetIVValue_LCUFN,2);
INSTANCE_OR_PUNT(object, atom_GetIVValue_LCUFN, 2);
objptr = (struct LCInstance *) Addr68k_from_LADDR(object);
GET_IV_INDEX(objptr,iv,index,goto pnut);
val = ((LispPTR *) Addr68k_from_LADDR(objptr->iDescrs))[index];
objptr = (struct LCInstance *)Addr68k_from_LADDR(object);
GET_IV_INDEX(objptr, iv, index, goto pnut);
val = ((LispPTR *)Addr68k_from_LADDR(objptr->iDescrs))[index];
if (!LC_TYPEP(val, atom_annotatedValue)) return val;
pnut:
RETCALL(atom_GetIVValue_LCUFN,2);
/*
return LCGetActiveValue(object,val);
*/
pnut:
RETCALL(atom_GetIVValue_LCUFN, 2);
/*
return LCGetActiveValue(object,val);
*/
}
LispPTR LCPutIVValue(register LispPTR object, register LispPTR iv, register LispPTR val)
{
LispPTR LCPutIVValue(register LispPTR object, register LispPTR iv, register LispPTR val) {
register struct LCInstance *objptr;
register LispPTR *valptr;
register int index;
LC_INIT;
INSTANCE_OR_PUNT(object,atom_PutIVValue_LCUFN,3);
INSTANCE_OR_PUNT(object, atom_PutIVValue_LCUFN, 3);
objptr = (struct LCInstance *) Addr68k_from_LADDR(object);
GET_IV_INDEX(objptr,iv,index,goto pnut);
valptr = &(((LispPTR *) Addr68k_from_LADDR(objptr->iDescrs))[index]);
objptr = (struct LCInstance *)Addr68k_from_LADDR(object);
GET_IV_INDEX(objptr, iv, index, goto pnut);
valptr = &(((LispPTR *)Addr68k_from_LADDR(objptr->iDescrs))[index]);
if (!LC_TYPEP(*valptr, atom_annotatedValue)) {
FRPLPTR((*valptr), val);
return val;
}
pnut:
RETCALL(atom_PutIVValue_LCUFN,3);
/*
return LCPutActiveValue(object,*valptr,val);
*/
pnut:
RETCALL(atom_PutIVValue_LCUFN, 3);
/*
return LCPutActiveValue(object,*valptr,val);
*/
}
#endif
LispPTR lcfuncall(register unsigned int atom_index, register int argnum, register int bytenum)
/* Atomindex for Function to invoke */
/* Number of ARGS on TOS and STK */
/* Number of bytes of Caller's
OPCODE(including multi-byte) */
/* Atomindex for Function to invoke */
/* Number of ARGS on TOS and STK */
/* Number of bytes of Caller's
OPCODE(including multi-byte) */
{
register struct definition_cell *defcell68k; /* Definition Cell PTR */
register short pv_num; /* scratch for pv */
register short pv_num; /* scratch for pv */
register struct fnhead *tmp_fn;
int rest; /* use for arignments */
int closurep=NIL;
int rest; /* use for arignments */
int closurep = NIL;
register CClosure *closure68k;
if (atom_index == 0xffffffff) error("Loops punt to nonexistant fn");
/* Get Next Block offset from argnum */
CURRENTFX->nextblock = (LADDR_from_68k(CurrentStackPTR) & 0x0ffff)
- (argnum<<1)+4 /* +3 */;
CURRENTFX->nextblock = (LADDR_from_68k(CurrentStackPTR) & 0x0ffff) - (argnum << 1) + 4 /* +3 */;
/* Setup IVar */
IVar = Addr68k_from_LADDR((((LispPTR)(CURRENTFX->nextblock)) | STK_OFFSET));
@@ -402,41 +367,38 @@ LispPTR lcfuncall(register unsigned int atom_index, register int argnum, registe
/* Set PC to the Next Instruction and save into FX */
CURRENTFX->pc = ((UNSIGNED)PC - (UNSIGNED)FuncObj) + bytenum;
PushCStack; /* save TOS */
PushCStack; /* save TOS */
/* Get DEFCELL 68k address */
defcell68k =(struct definition_cell *) GetDEFCELL68k(atom_index);
defcell68k = (struct definition_cell *)GetDEFCELL68k(atom_index);
tmp_fn = (struct fnhead *)Addr68k_from_LADDR( defcell68k->defpointer );
tmp_fn = (struct fnhead *)Addr68k_from_LADDR(defcell68k->defpointer);
if((UNSIGNED)(CurrentStackPTR + tmp_fn->stkmin +STK_SAFE)
>= (UNSIGNED)EndSTKP )
{
LispPTR test;
test= *((LispPTR*)CurrentStackPTR);
/* DOSTACKOVERFLOW(argnum,bytenum-1); XXX until we figure out what should be happening */
S_CHECK(test==*((LispPTR*)CurrentStackPTR), "overflow in ccfuncall");
}
if ((UNSIGNED)(CurrentStackPTR + tmp_fn->stkmin + STK_SAFE) >= (UNSIGNED)EndSTKP) {
LispPTR test;
test = *((LispPTR *)CurrentStackPTR);
/* DOSTACKOVERFLOW(argnum,bytenum-1); XXX until we figure out what should be happening */
S_CHECK(test == *((LispPTR *)CurrentStackPTR), "overflow in ccfuncall");
}
FuncObj = tmp_fn;
if( FuncObj->na >= 0 )
{
/* This Function is Spread Type */
/* Arguments on Stack Adjustment */
rest = argnum - FuncObj->na;
if (FuncObj->na >= 0) {
/* This Function is Spread Type */
/* Arguments on Stack Adjustment */
rest = argnum - FuncObj->na;
while(rest <0) {
PushStack(NIL_PTR);
rest++;
}
CurrentStackPTR -= (rest<<1);
} /* if end */
while (rest < 0) {
PushStack(NIL_PTR);
rest++;
}
CurrentStackPTR -= (rest << 1);
} /* if end */
/* Set up BF */
CurrentStackPTR+=2;
CurrentStackPTR += 2;
GETWORD(CurrentStackPTR) = BF_MARK;
GETWORD(CurrentStackPTR+1) = CURRENTFX->nextblock;
CurrentStackPTR+=2;
GETWORD(CurrentStackPTR + 1) = CURRENTFX->nextblock;
CurrentStackPTR += 2;
/* Set up FX */
GETWORD(CurrentStackPTR) = FX_MARK;
@@ -445,22 +407,19 @@ LispPTR lcfuncall(register unsigned int atom_index, register int argnum, registe
((struct frameex1 *)CurrentStackPTR)->alink = LADDR_from_68k(PVar);
PVar = (DLword *)CurrentStackPTR + FRAMESIZE;
#ifdef BIGVM
((struct frameex1 *)CurrentStackPTR)->fnheader =
(defcell68k->defpointer);
((struct frameex1 *)CurrentStackPTR)->fnheader = (defcell68k->defpointer);
#else
((struct frameex1 *)CurrentStackPTR)->lofnheader =
(defcell68k->defpointer) & 0x0ffff;
((struct frameex1 *)CurrentStackPTR)->hi2fnheader =
((defcell68k->defpointer) & SEGMASK) >> 16;
((struct frameex1 *)CurrentStackPTR)->lofnheader = (defcell68k->defpointer) & 0x0ffff;
((struct frameex1 *)CurrentStackPTR)->hi2fnheader = ((defcell68k->defpointer) & SEGMASK) >> 16;
((struct frameex1 *)CurrentStackPTR)->hi1fnheader = 0;
#endif /* BIGVM */
CurrentStackPTR = PVar;
/* Set up PVar area */
pv_num = FuncObj->pv+1; /* Changed Apr.27 */
pv_num = FuncObj->pv + 1; /* Changed Apr.27 */
while(pv_num > 0) {
while (pv_num > 0) {
*((LispPTR *)CurrentStackPTR) = 0x0ffff0000;
CurrentStackPTR += DLWORDSPER_CELL;
*((LispPTR *)CurrentStackPTR) = 0x0ffff0000;
@@ -471,6 +430,5 @@ LispPTR lcfuncall(register unsigned int atom_index, register int argnum, registe
/* Set PC points New Function's first OPCODE */
PC = (ByteCode *)FuncObj + FuncObj->startpc;
return -2; /* signal to OP_miscn to leave stack & pc alone */
return -2; /* signal to OP_miscn to leave stack & pc alone */
} /* end lcfuncall */