mirror of
https://github.com/Interlisp/maiko.git
synced 2026-01-25 19:46:21 +00:00
Maiko sources matching state as of 020102 prior to initial patching for Mac OSX
This commit is contained in:
Nick Briggs
610
src/fvar.c
Executable file
610
src/fvar.c
Executable file
@@ -0,0 +1,610 @@
|
||||
/* $Id: fvar.c,v 1.3 1999/05/31 23:35:29 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */
|
||||
static char *id = "$Id: fvar.c,v 1.3 1999/05/31 23:35:29 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 <stdio.h>
|
||||
#include "lispemul.h"
|
||||
#include "lspglob.h"
|
||||
#include "adr68k.h"
|
||||
#include "stack.h"
|
||||
#include "emlglob.h"
|
||||
#include "lispmap.h"
|
||||
#include "lsptypes.h"
|
||||
#include "gc.h"
|
||||
|
||||
#ifdef GCC386
|
||||
#include "inlnPS2.h"
|
||||
#endif
|
||||
|
||||
#define MaskShift(x) (((x) << 16) & SEGMASK)
|
||||
|
||||
|
||||
#ifdef BIGATOMS
|
||||
#define NT_OFFSET_MASK 0xFFFFFFF
|
||||
#define NT_TYPE_MASK 0xFF000000
|
||||
#define GetNTEntry(X) GetLongWord(X)
|
||||
#define NAMETABLE LispPTR
|
||||
#else
|
||||
#define NT_OFFSET_MASK 0xFF
|
||||
#define NT_TYPE_MASK 0xFF00
|
||||
#define GetNTEntry(X) GETWORD(X)
|
||||
#define NAMETABLE DLword
|
||||
#endif
|
||||
|
||||
/*************************************************************************
|
||||
N_OP_fvarn
|
||||
entry of OPCODE[120b-127b]: FVAR, FVARX
|
||||
|
||||
1. save TopOfStack to evaluation stack.
|
||||
2. set address of searching FVAR slot to chain.
|
||||
3. call lookfor. (It sets some content to FVAR slot)
|
||||
4. get some address by caluculation of content of FVAR slot.
|
||||
5. set the address to TopOfStack.
|
||||
**************************************************************************/
|
||||
LispPTR N_OP_fvarn(register int n)
|
||||
/* n is word offset */
|
||||
|
||||
{
|
||||
register DLword *chain; /* keep FVAR slot2 in CurrentFrameExtension */
|
||||
|
||||
chain = PVar + n;
|
||||
|
||||
if(WBITSPTR(chain)->LSB)
|
||||
{
|
||||
/* check 15bit of FVAR slot1 in CurrentFrameExtension.
|
||||
0: bound
|
||||
1: unbound */
|
||||
nfvlookup(CURRENTFX, chain, FuncObj);
|
||||
}
|
||||
|
||||
return(GetLongWord(Addr68k_from_LADDR(POINTERMASK &
|
||||
(((GETBASEWORD(chain,1))<<16) |
|
||||
GETBASEWORD(chain,0)))));
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
/**************************************************************************
|
||||
nfvlookup:
|
||||
|
||||
This routine is used by only OP_fvarn.
|
||||
( in addition to N_OP_fvar_() )
|
||||
1. get Atom index number of target fvar slot.
|
||||
2. call fvlookfor.
|
||||
|
||||
****************************************************************************/
|
||||
nfvlookup(struct frameex1 *apframe1, register DLword *achain, register struct fnhead *apfnhead1)
|
||||
/* pointer to current frame extension */
|
||||
/* pointer to 1st word of the searching
|
||||
FVAR slot in CurrentFrameExtension */
|
||||
/* pointer to current function heaer */
|
||||
{
|
||||
register DLword *pfh; /* pointer to current function header */
|
||||
register int paoffset; /* 2word offset in PVAR AREA */
|
||||
|
||||
pfh = (DLword *)apfnhead1;
|
||||
paoffset = ((UNSIGNED)achain - (UNSIGNED)PVar)>>2;
|
||||
/* slot to looked for, 2word offset from PVar */
|
||||
#ifdef BIGATOMS
|
||||
nnewframe(apframe1, achain,
|
||||
(*((LispPTR *)
|
||||
((DLword *)pfh + apfnhead1->fvaroffset) + paoffset
|
||||
- apfnhead1->nlocals)));
|
||||
#else
|
||||
nnewframe(apframe1, achain,
|
||||
(GETWORD(pfh + (apfnhead1->fvaroffset + paoffset -
|
||||
apfnhead1->nlocals))));
|
||||
#endif
|
||||
}
|
||||
|
||||
|
||||
/******************************************************************************
|
||||
|
||||
N_OP_stkscan
|
||||
entry STKSCAN OPCODE[057]
|
||||
|
||||
<<Enter>>
|
||||
TopOfStack: Low word - Atom index number of variable to be saned.
|
||||
<<Exit>>
|
||||
TopOfStack: Address of found value.
|
||||
|
||||
1. call fvlookup.
|
||||
2. Set *chain to TopOfStack.
|
||||
3. Increment Pc by 1.
|
||||
|
||||
******************************************************************************/
|
||||
|
||||
LispPTR N_OP_stkscan(LispPTR tos)
|
||||
{
|
||||
#ifdef I386
|
||||
int scratchx[3];
|
||||
int *scratch = (int *)(0xFFFFFFFC & (3+(UNSIGNED)scratchx));
|
||||
*scratch = tos;
|
||||
nnewframe(CURRENTFX, (DLword *)scratch, POINTERMASK & *scratch );
|
||||
return(swapx(*scratch));
|
||||
#else
|
||||
int scratch;
|
||||
scratch = tos;
|
||||
nnewframe(CURRENTFX, (DLword *)&scratch, POINTERMASK & scratch );
|
||||
return(swapx(scratch));
|
||||
#endif /* I386 */
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
/**************************************************
|
||||
N_OP_fvar_
|
||||
|
||||
Entry: FVAR_ opcode[0143]
|
||||
|
||||
|
||||
***************************************************/
|
||||
|
||||
LispPTR N_OP_fvar_(register LispPTR tos, register int n)
|
||||
{
|
||||
register DLword *ppvar; /* pointer to argued Fvar slot in pvar area */
|
||||
register DLword *pfreeval; /* pointer to argued free value */
|
||||
register int l1; /* return value of fvlookup() */
|
||||
|
||||
ppvar = PVar + n;
|
||||
|
||||
if(WBITSPTR(ppvar)->LSB) /* check unbound ? */
|
||||
{ /* unbound */
|
||||
nfvlookup(CURRENTFX, ppvar, FuncObj);
|
||||
}
|
||||
|
||||
pfreeval =Addr68k_from_LADDR( MaskShift((GETWORD(ppvar+1))) |
|
||||
GETWORD(ppvar) );
|
||||
|
||||
if( ((0xFF & GETWORD(ppvar+1)) != STK_HI))
|
||||
{
|
||||
GCLOOKUP(*((LispPTR *)pfreeval), DELREF);
|
||||
GCLOOKUP(tos, ADDREF);
|
||||
}
|
||||
|
||||
*((LispPTR *)pfreeval) = tos;
|
||||
return(tos);
|
||||
}
|
||||
|
||||
#define FVSTACK 2
|
||||
#define FVGLOBAL 6
|
||||
|
||||
#ifdef BIGATOMS
|
||||
#define FVIVARHI 0x0
|
||||
#define FVPVARHI (0x80000000)
|
||||
#define FVFVARHI (0xC0000000)
|
||||
#else
|
||||
#define FVIVARHI 0x0
|
||||
#define FVPVARHI 0x8000
|
||||
#define FVFVARHI 0xC000
|
||||
#endif
|
||||
|
||||
#define ENDSTACKMARK 0xb
|
||||
|
||||
|
||||
|
||||
|
||||
/******************************************************************************
|
||||
nnewframe
|
||||
|
||||
This routine is used by fvlookup and OP_stkscan.
|
||||
|
||||
1. scan Name table in new function header.
|
||||
2. if found, set address of searching variable to chain address.
|
||||
3. return the type of var, on stack, or global. (fs: unused, removed)
|
||||
|
||||
******************************************************************************/
|
||||
|
||||
nnewframe(register struct frameex1 *newpfra2, register DLword *achain, register int name)
|
||||
/* pointer to new frame extension */
|
||||
/* pointer to 1st word of the searching
|
||||
FVAR slot in CurrentFrameExtension */
|
||||
/* Atom index num. of target FVAR slot. */
|
||||
{
|
||||
|
||||
register NAMETABLE *pindex; /* '90/06/06 osamu changed from DLword *
|
||||
* index to indexs of new name table */
|
||||
register UNSIGNED i; /* temp for control */
|
||||
register int nametablesize; /* NameTable size of current function header. */
|
||||
register int ph; /* alink temp, also phase */
|
||||
struct frameex1 *onewpfra2, *oonewpfra2, *ooonewpfra2;
|
||||
|
||||
newframe:
|
||||
#ifdef SUN3_OS3_OR_OS4_IL
|
||||
newframe_setup_label();
|
||||
#endif
|
||||
/* assume that apframe1 points to the next frame to be scanned */
|
||||
ph = newpfra2->alink;
|
||||
if (ph==0) error("alink = 0 in nnewframe");
|
||||
if(ph == ENDSTACKMARK)
|
||||
{
|
||||
/* endStack */
|
||||
#ifdef BIGATOMS
|
||||
if ((name&SEGMASK) != 0) /* New symbol */
|
||||
{
|
||||
register int result = name+NEWATOM_VALUE_OFFSET;
|
||||
/* printf("NEW-SYMBOL in nnewframe, 0x%x, result = 0x%x\n", name, result); */
|
||||
GETBASEWORD(achain,1) = result>>16;
|
||||
GETBASEWORD(achain,0) = result & 0xFFFF;
|
||||
}
|
||||
else
|
||||
#endif /* BIGATOMS */
|
||||
|
||||
#ifdef BIGVM
|
||||
if (name & SEGMASK)
|
||||
{ /* It's a big-atom, so just offset from the base to get value */
|
||||
register int result = name + NEWATOM_VALUE_OFFSET;
|
||||
GETBASEWORD(achain,1) = result>>16;
|
||||
GETBASEWORD(achain,0) = result & 0xFFFF;
|
||||
}
|
||||
else
|
||||
{ /* It's an "old" atom, so offset into the table of atoms */
|
||||
register int result = (ATOMS_HI << 16) + (10*name) + NEWATOM_VALUE_OFFSET;
|
||||
GETBASEWORD(achain,1) = result>>16;
|
||||
GETBASEWORD(achain,0) = result & 0xFFFF;
|
||||
}
|
||||
#else
|
||||
if(name >= 0x8000)
|
||||
{
|
||||
GETBASEWORD(achain,1) = VALS_HI + 1;
|
||||
GETBASEWORD(achain,0) = name*2;
|
||||
}
|
||||
else
|
||||
{
|
||||
GETBASEWORD(achain,1) = VALS_HI;
|
||||
GETBASEWORD(achain,0) = name*2;
|
||||
}
|
||||
#endif /* BIGVM */
|
||||
return;
|
||||
}
|
||||
|
||||
ph &= 0xFFFE; /* to mask off SLOW bit */
|
||||
ooonewpfra2 = oonewpfra2;
|
||||
oonewpfra2 = onewpfra2;
|
||||
onewpfra2 = newpfra2;
|
||||
newpfra2 = (struct frameex1 *)(-FRAMESIZE + Stackspace + ph);
|
||||
|
||||
{ /* open new block to try and conserve address register */
|
||||
register struct fnhead *newpfn2; /* ptr to new fn header */
|
||||
|
||||
if(newpfra2->validnametable) /* check VALIDNAMETABLE */
|
||||
#ifdef BIGVM
|
||||
newpfn2 = (struct fnhead *)
|
||||
(Addr68k_from_LADDR(newpfra2->nametable));
|
||||
else
|
||||
newpfn2 = (struct fnhead *)
|
||||
(Addr68k_from_LADDR(newpfra2->fnheader));
|
||||
#else
|
||||
newpfn2 = (struct fnhead *)
|
||||
(Addr68k_from_LADDR(((newpfra2->hi2nametable)<<16 |
|
||||
newpfra2->lonametable )));
|
||||
else
|
||||
newpfn2 = (struct fnhead *)
|
||||
(Addr68k_from_LADDR(((newpfra2->hi2fnheader)<<16 |
|
||||
newpfra2->lofnheader )));
|
||||
#endif /* BIGVM */
|
||||
pindex = (NAMETABLE *)((DLword *)newpfn2 + FNHEADSIZE);
|
||||
/* now pindex points 1st word of Nametable. */
|
||||
#ifdef BIGATOMS
|
||||
nametablesize = (newpfn2->ntsize >> 1); /* ntsize is # of words in NT
|
||||
not # of element */
|
||||
#else
|
||||
nametablesize = newpfn2->ntsize;
|
||||
#endif
|
||||
}
|
||||
#ifdef SUN3_OS3_OR_OS4_IL
|
||||
newframe_loop_label();
|
||||
#endif
|
||||
|
||||
i = (UNSIGNED) (pindex + nametablesize);
|
||||
for(; (UNSIGNED)i > (UNSIGNED) pindex;)
|
||||
{ /* searching in NewFuncHeader */
|
||||
#ifdef BIGATOMS
|
||||
/* These used to be GETWORDs, but NAMETABLE is a CELL in 3-byte */
|
||||
#if 1
|
||||
if((int)*((NAMETABLE *)pindex++) == (int)name) {ph=1; goto foundit;}
|
||||
cont2: if((int)*((NAMETABLE *)pindex++) == (int)name) {ph=0; goto foundit;}
|
||||
#else
|
||||
if((int)*((NAMETABLE *)pindex++) == (int)name) {ph=1; goto foundit;}
|
||||
cont2: if((int)*((NAMETABLE *)pindex++) == (int)name) {ph=2; goto foundit;}
|
||||
cont3: if((int)*((NAMETABLE *)pindex++) == (int)name) {ph=3; goto foundit;}
|
||||
cont4: if((int)*((NAMETABLE *)pindex++) == (int)name) {ph=0; goto foundit;}
|
||||
#endif /* ISC */
|
||||
|
||||
#else
|
||||
if(GETWORD((NAMETABLE *)pindex++) == (DLword)name) {ph=1; goto foundit;}
|
||||
cont2: if(GETWORD((NAMETABLE *)pindex++) == (DLword)name) {ph=2; goto foundit;}
|
||||
cont3: if(GETWORD((NAMETABLE *)pindex++) == (DLword)name) {ph=3; goto foundit;}
|
||||
cont4: if(GETWORD((NAMETABLE *)pindex++) == (DLword)name) {ph=0; goto foundit;}
|
||||
#endif
|
||||
continue;
|
||||
foundit:
|
||||
{
|
||||
register int fvartype; /* probing fvar vartype */
|
||||
register int fvaroffset; /* probing fvar varoffset */
|
||||
register DLword *ppvar; /* ptr to probing var candidate */
|
||||
#ifdef BIGATOMS
|
||||
fvartype = (int) *(pindex + nametablesize - 1);
|
||||
#else
|
||||
fvartype = GETWORD(pindex + nametablesize - 1);
|
||||
#endif /* BIGATOMS */
|
||||
|
||||
fvaroffset = NT_OFFSET_MASK & fvartype;
|
||||
fvaroffset <<= 1;
|
||||
fvartype &= NT_TYPE_MASK;
|
||||
switch( fvartype )
|
||||
{
|
||||
case FVPVARHI: /* 0x8000 or 0x80000000(BIGATOMS) */
|
||||
ppvar = FRAMESIZE+(DLword *)newpfra2+fvaroffset;
|
||||
/* ppvar points to argued Pvar */
|
||||
if(WBITSPTR(ppvar)->xMSB)
|
||||
/* check UNBOUND (if *ppvar is negative , unbound) */
|
||||
switch ( ph )
|
||||
{
|
||||
case 0 : continue;
|
||||
case 1 : goto cont2;
|
||||
/* case 2 : goto cont3;
|
||||
case 3 : goto cont4; */
|
||||
}
|
||||
GETBASEWORD(achain,1) = STK_HI;
|
||||
GETBASEWORD(achain,0) = 0xFFFF & LADDR_from_68k(ppvar);
|
||||
/* save High word of PVAR slot address to FVAR slot */
|
||||
/* achain points to target FVAR slot */
|
||||
return;
|
||||
case FVFVARHI: /* 0xC000 or 0xC0000000(BIGATOMS) */
|
||||
ppvar = FRAMESIZE + (DLword *)newpfra2 + fvaroffset;
|
||||
if( WBITSPTR(ppvar)->LSB ) goto endlookfor;
|
||||
/* Not Found in new FnHeader, scan next one. */
|
||||
*((int *)achain) = *((int *)ppvar);
|
||||
/* save address of FX to FVAR slot */
|
||||
/* achain points to target FVAR slot */
|
||||
return;
|
||||
case FVIVARHI: /* 0x000: */
|
||||
ppvar = -1 + (DLword *)newpfra2;
|
||||
/* ppvar points to IVAR field in Basic frame */
|
||||
GETBASEWORD(achain,1) = STK_HI;
|
||||
GETBASEWORD(achain,0) = GETWORD(ppvar) + fvaroffset;
|
||||
return;
|
||||
default:error("Stack corrupted: bad value in name table");
|
||||
}/* end switch */
|
||||
}/* end if */
|
||||
}/* end for */
|
||||
|
||||
endlookfor:
|
||||
goto newframe; /* scan the next one */
|
||||
|
||||
}
|
||||
#ifndef BIGATOMS
|
||||
#ifdef SUN3_OS3_OR_OS4_IL
|
||||
|
||||
#define VALS_HI_RET(x) newframe_vals_hi_ret(x)
|
||||
#define STK_HI_RET(x) newframe_stk_hi_ret(x)
|
||||
|
||||
#else
|
||||
|
||||
#define VALS_HI_RET(x) \
|
||||
((int) x << 17) + VALS_HI + ((unsigned short) x >> 15)
|
||||
|
||||
#define STK_HI_RET(x) \
|
||||
((int) x << 16) | 1 | ((unsigned int) x >> 16)
|
||||
|
||||
#endif /* SUN3_IL */
|
||||
|
||||
#else
|
||||
|
||||
#ifdef BIGVM
|
||||
#define VALS_HI_RET(x) ((((int) x & SEGMASK) == 0) ? \
|
||||
(swapx((ATOMS_HI<<16) + (10 * (int) (x)) + NEWATOM_VALUE_OFFSET)) : \
|
||||
(swapx((int)x + NEWATOM_VALUE_OFFSET)))
|
||||
#else
|
||||
#define VALS_HI_RET(x) ((((int) x & SEGMASK) == 0) ? \
|
||||
(((int) x << 17) + VALS_HI + ((unsigned short) x >> 15)) : \
|
||||
(swapx((int)x + NEWATOM_VALUE_OFFSET)))
|
||||
#endif /* BIGVM */
|
||||
|
||||
#define STK_HI_RET(x) ((int) x << 16) | 1 | ((unsigned int) x >> 16)
|
||||
|
||||
#endif /* BIGATOMS */
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
/******************************************************************************
|
||||
native_newframe
|
||||
|
||||
1. scan Name table in new function header.
|
||||
2. if found, set address of searching variable to chain address.
|
||||
3. return the pointer
|
||||
|
||||
******************************************************************************/
|
||||
native_newframe(int slot)
|
||||
/* index of FVAR slot. */
|
||||
{
|
||||
register struct frameex2 *newpfra2; /* pointer to new frame extension */
|
||||
register DLword *achain; /* pointer to 1st word of the searching
|
||||
FVAR slot in CurrentFrameExtension */
|
||||
register int name; /* Atom# of target FVAR slot. */
|
||||
struct frameex2 *onewpfra2, *oonewpfra2, *ooonewpfra2;
|
||||
|
||||
{ /* LOCAL temp regs */
|
||||
register int rslot = slot;
|
||||
register struct fnhead *fnobj = FuncObj;
|
||||
register LispPTR *pvar = (LispPTR *) PVar;
|
||||
|
||||
#ifdef BIGATOMS
|
||||
name = (int) *((LispPTR *)
|
||||
((DLword *)fnobj + fnobj->fvaroffset)
|
||||
+ rslot - fnobj->nlocals);
|
||||
#else
|
||||
name = GETWORD((DLword *)fnobj +
|
||||
(fnobj->fvaroffset + rslot - fnobj->nlocals));
|
||||
#endif
|
||||
|
||||
newpfra2 = (struct frameex2 *) ((DLword *) pvar - FRAMESIZE);
|
||||
achain = (DLword *) (pvar + rslot);
|
||||
|
||||
}
|
||||
|
||||
{
|
||||
register NAMETABLE *pindex; /* index to indexs of new name table */
|
||||
register int i; /* temp for control */
|
||||
register int nametablesize; /* NameTable size of current fnhdr */
|
||||
register int alink;
|
||||
|
||||
natnewframe:
|
||||
#ifdef SUN3_OS3_OR_OS4_IL
|
||||
natnewframe_label();
|
||||
#endif
|
||||
/* assume that apframe1 points to the next frame to be scanned */
|
||||
|
||||
alink = newpfra2->alink;
|
||||
if (alink == 0) error("alink is 0 in native_newframe");
|
||||
if(alink == ENDSTACKMARK)
|
||||
{ /* End of stack, so return top-level-value */
|
||||
/* if (name & SEGMASK) printf("native_newframe returning name 0x%x, result 0x%x.\n",
|
||||
name, VALS_HI_RET(name)); */
|
||||
return(*((LispPTR *)achain) = VALS_HI_RET(name));
|
||||
}
|
||||
ooonewpfra2 = oonewpfra2;
|
||||
oonewpfra2 = onewpfra2;
|
||||
onewpfra2 = newpfra2;
|
||||
newpfra2 = (struct frameex2 *)(-FRAMESIZE + Stackspace + (alink & 0xFFFE));
|
||||
|
||||
|
||||
{ /* open new block to try and conserve address register */
|
||||
register struct fnhead *newpfn2; /* ptr to new fn header */
|
||||
|
||||
newpfn2 = GETNAMETABLE(newpfra2);
|
||||
|
||||
pindex = (NAMETABLE *)(((DLword *)newpfn2) + FNHEADSIZE);
|
||||
/* now pindex points 1st word of Nametable. */
|
||||
#ifdef BIGATOMS
|
||||
nametablesize = (newpfn2->ntsize >> 1); /* ntsize is # of words in NT
|
||||
nametablesize is # of items in NT */
|
||||
#else
|
||||
nametablesize = newpfn2->ntsize;
|
||||
#endif /* */
|
||||
|
||||
}
|
||||
#ifdef SUN4_OS4_IL
|
||||
|
||||
i = (UNSIGNED) (pindex + nametablesize);
|
||||
lookup:
|
||||
#ifdef BIGATOMS
|
||||
pindex = (LispPTR *) name_scan2((UNSIGNED)pindex, i, name);
|
||||
#else
|
||||
pindex = (DLword *) name_scan((UNSIGNED)pindex, i, name | (name<<16));
|
||||
#endif
|
||||
if (!pindex) goto natnewframe;
|
||||
{
|
||||
{
|
||||
#else
|
||||
#ifdef SUN3_OS3_OR_OS4_IL
|
||||
|
||||
i = nametablesize;
|
||||
if (--i < 0) goto natnewframe;
|
||||
|
||||
|
||||
/* **** assumes:
|
||||
d7 = name
|
||||
d6 = i
|
||||
a3 = pindex
|
||||
*** */
|
||||
#ifdef BIGATOMS
|
||||
lookup: fvar_lookup_loop2();
|
||||
#else
|
||||
lookup: fvar_lookup_loop();
|
||||
#endif
|
||||
{
|
||||
{
|
||||
#else
|
||||
|
||||
for(i=nametablesize; --i >= 0;){
|
||||
/* searching in NewFuncHeader */
|
||||
#ifdef BIGATOMS
|
||||
if((LispPTR) *((NAMETABLE *)pindex++) == (LispPTR)name){
|
||||
#else
|
||||
if(GETWORD((NAMETABLE *)pindex++) == (DLword)name){
|
||||
#endif /* BIGATOMS */
|
||||
|
||||
#endif
|
||||
#endif
|
||||
|
||||
register int fvartype; /* probing fvar vartype */
|
||||
register int fvaroffset; /* probing fvar varoffset */
|
||||
register DLword *ppvar; /* ptr to probing var candidate */
|
||||
#ifdef BIGATOMS
|
||||
fvartype = (int) *(pindex + nametablesize - 1);
|
||||
#else
|
||||
fvartype = GETWORD(pindex + nametablesize - 1);
|
||||
#endif /* BIGATOMS */
|
||||
|
||||
fvaroffset = (NT_OFFSET_MASK & fvartype) << 1;
|
||||
fvartype &= NT_TYPE_MASK;
|
||||
switch( fvartype ){
|
||||
case FVPVARHI: /* 0x8000 or 0x80000000(NEWATOM): */
|
||||
ppvar = FRAMESIZE + (DLword *)newpfra2 + fvaroffset;
|
||||
/* ppvar points to argued Pvar */
|
||||
if(WBITSPTR(ppvar)->xMSB)
|
||||
/* check UNBOUND (if *ppvar is negative , unbound) */
|
||||
#ifdef SUN4_OS4_IL
|
||||
goto lookup;
|
||||
#else
|
||||
#ifdef SUN3_OS3_OR_OS4_IL
|
||||
goto lookup;
|
||||
#else
|
||||
{
|
||||
continue;
|
||||
}
|
||||
#endif
|
||||
#endif
|
||||
/* save High word of PVAR slot address to FVAR slot */
|
||||
/* achain points to target FVAR slot */
|
||||
return(*((LispPTR *)achain) =
|
||||
STK_HI_RET( LADDR_from_68k( ppvar )));
|
||||
case FVFVARHI: /* 0xC000 or 0xC0000000(NEWATOM S) */
|
||||
ppvar = FRAMESIZE + (DLword *)newpfra2 + fvaroffset;
|
||||
if( WBITSPTR(ppvar)->LSB )
|
||||
{
|
||||
goto endlookfor;
|
||||
}
|
||||
/* Not Found in new FuncHeader, scan next one. */
|
||||
/* save address of frame extension to FVAR slot */
|
||||
/* achain points to target FVAR slot */
|
||||
return(*((int *)achain) = *((int *)ppvar));
|
||||
case FVIVARHI: /* 0x0000000: */
|
||||
ppvar = (DLword *)newpfra2 - 1;
|
||||
/* ppvar points to IVAR field in Basic frame */
|
||||
return(*((LispPTR *)achain) =
|
||||
STK_HI_RET(GETWORD(ppvar)+fvaroffset));;
|
||||
default:error("Stack corrupted: bad value in name table");
|
||||
}/* end switch */
|
||||
}/* end if */
|
||||
}/* end for */
|
||||
|
||||
endlookfor:
|
||||
goto natnewframe; /* scan the next one */
|
||||
}
|
||||
}
|
||||
Reference in New Issue
Block a user