98 lines
2.7 KiB
C
98 lines
2.7 KiB
C
/* =====> SREIFY.C */
|
||
/* TIPC Scheme '84 Runtime Support - Reification
|
||
(C) Copyright 1985,1986 by Texas Instruments Incorporated.
|
||
All rights reserved.
|
||
|
||
Author: John C. Jensen
|
||
Installation: Texas Instruments Incorporated, Dallas, Texas
|
||
Division: Central Research Laboratories
|
||
Cost Center: Computer Science Laboratory
|
||
Project: Computer Architecture Branch
|
||
Date Written: 5 March 1985
|
||
Last Modification: 25 February 1986
|
||
*/
|
||
#include "scheme.h"
|
||
|
||
/************************************************************************/
|
||
/* Reification Support */
|
||
/************************************************************************/
|
||
reify (direction, obj, index, val)
|
||
int direction; /* 0=fetch; 1=store */
|
||
int obj[2]; /* pointer to object to "reify" */
|
||
int index[2]; /* index into said object */
|
||
int val[2]; /* for stores, the value to store */
|
||
{
|
||
int disp,page; /* page and displacement components of a pointer */
|
||
int i; /* index value */
|
||
|
||
ENTER(reify);
|
||
|
||
if (index[C_PAGE] == SPECFIX*2)
|
||
{
|
||
if ((i = ((get_fix(CORRPAGE(index[C_PAGE]), index[C_DISP]) + 1) * 3)) < 0)
|
||
goto bad_opnd;
|
||
page = CORRPAGE(obj[C_PAGE]);
|
||
disp = obj[C_DISP];
|
||
switch (ptype[page]>>1)
|
||
{
|
||
case LISTTYPE: if (i) goto bad_opnd;
|
||
obj[C_DISP] = PTRSIZE*2;
|
||
return_fixnum:
|
||
obj[C_PAGE] = SPECFIX*2;
|
||
break;
|
||
|
||
case REFTYPE:
|
||
case FIXTYPE:
|
||
case CHARTYPE: if (i) goto bad_opnd;
|
||
obj[C_DISP] = PTRSIZE;
|
||
goto return_fixnum;
|
||
|
||
case FLOTYPE: if (i) goto bad_opnd;
|
||
obj[C_DISP] = FLOSIZE;
|
||
goto return_fixnum;
|
||
|
||
case PORTTYPE:
|
||
case SYMTYPE: if (i > 3) goto bad_opnd;
|
||
goto reify_anyway;
|
||
|
||
case CODETYPE: if (i >= get_word(page, disp+4)) goto bad_opnd;
|
||
goto reify_anyway;
|
||
|
||
case BIGTYPE:
|
||
case STRTYPE: if (i) goto bad_opnd;
|
||
|
||
case VECTTYPE:
|
||
case CONTTYPE:
|
||
case CLOSTYPE:
|
||
case ENVTYPE:
|
||
if (i >= get_word(page, disp+1)) goto bad_opnd;
|
||
reify_anyway:
|
||
if (direction)
|
||
{
|
||
if (i)
|
||
{
|
||
put_ptr(page, disp+i, val[C_PAGE], val[C_DISP]);
|
||
}
|
||
else goto bad_opnd;
|
||
}
|
||
else
|
||
{
|
||
obj[C_PAGE] = (i ? get_byte(page, disp+i) : SPECFIX*2);
|
||
obj[C_DISP] = get_word(page, disp+i+1);
|
||
}
|
||
break;
|
||
|
||
default: goto bad_opnd;
|
||
|
||
} /* end: switch (ptype[page]>>1) */
|
||
}
|
||
else
|
||
{
|
||
bad_opnd:
|
||
if (direction) set_src_er("%REIFY!", 3, obj, index, val);
|
||
else set_src_er("%REIFY", 2, obj, index);
|
||
return(-1);
|
||
}
|
||
return(0);
|
||
} /* end of function: reify (direction, obj, index, val) */
|
||
|