303 lines
8.5 KiB
C
303 lines
8.5 KiB
C
/* TIPC Scheme Runtime Support - Property List Support
|
||
(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: 27 March 1985
|
||
Last Modification: 25 February 1986
|
||
|
||
Note: The property list structure has the following representation:
|
||
|
||
+-----------+ +-----------+ +-----------+
|
||
| sym | o-|-->|prop | o-|-->| val | o-|--> etc.
|
||
+-----------+ +-----------+ +-----------+
|
||
+------------+ ^
|
||
| | | +--> next symbol's entry
|
||
| Property | | |
|
||
| List Hash | +-----------+ +-----------+
|
||
| Table |-->| | o-|-->| | o-|--> next entry in hash chain
|
||
| | +-----------+ +-----------+
|
||
+------------+
|
||
*/
|
||
#include "ctype.h"
|
||
#include "scheme.h"
|
||
|
||
#include "slist.h"
|
||
|
||
#define FOUND 1
|
||
#define NOT_FOUND 0
|
||
|
||
/************************************************************************/
|
||
/* Get Property Value */
|
||
/************************************************************************/
|
||
get_prop(sym,prop)
|
||
int sym[2];
|
||
int prop[2];
|
||
{
|
||
sym_search(sym);
|
||
if (prop_search(sym,prop) == FOUND)
|
||
{
|
||
take_cadr(sym);
|
||
}
|
||
else
|
||
{ /* property (or symbol) not found-- return nil */
|
||
sym[C_PAGE] = sym[C_DISP] = 0;
|
||
}
|
||
} /* end of function: get_prop(sym,prop) */
|
||
|
||
/************************************************************************/
|
||
/* Get Property List */
|
||
/************************************************************************/
|
||
prop_list(name)
|
||
int name[2];
|
||
{
|
||
int retstat = 0; /* the return status */
|
||
|
||
if (ptype[CORRPAGE(name[C_PAGE])] == SYMTYPE*2)
|
||
{
|
||
sym_search(name);
|
||
take_cdr(name);
|
||
}
|
||
else
|
||
{
|
||
set_src_err("PROPLIST", 1, name);
|
||
retstat = -1;
|
||
}
|
||
return(retstat);
|
||
} /* end of function: prop_list(name) */
|
||
|
||
/************************************************************************/
|
||
/* Put Property Value */
|
||
/************************************************************************/
|
||
put_prop(name, value, prop)
|
||
int name[2];
|
||
int value[2];
|
||
int prop[2];
|
||
{
|
||
int hash_value; /* hash key for the symbol */
|
||
ENTER(put_prop);
|
||
|
||
mov_reg(tmp_reg, name);
|
||
if (ptype[CORRPAGE(name[C_PAGE])] == SYMTYPE*2)
|
||
{
|
||
sym_search(tmp_reg);
|
||
if(tmp_reg[C_PAGE])
|
||
{ /* symbol found in property list table */
|
||
if (prop_search(tmp_reg, prop) == FOUND)
|
||
{
|
||
take_cdr(tmp_reg);
|
||
put_ptr(CORRPAGE(tmp_reg[C_PAGE]), tmp_reg[C_DISP] , value[C_PAGE],
|
||
value[C_DISP]);
|
||
}
|
||
else
|
||
{ /* property not present in symbol's property list */
|
||
mov_reg(name, tmp_reg);
|
||
take_cdr(name);
|
||
cons(name, value, name);
|
||
cons(name, prop, name);
|
||
put_ptr(CORRPAGE(tmp_reg[C_PAGE]), tmp_reg[C_DISP]+3, name[C_PAGE],
|
||
name[C_DISP]);
|
||
}
|
||
}
|
||
else
|
||
{ /* symbol wasn't found in property list table */
|
||
cons(tmp_reg, value, nil_reg);
|
||
cons(tmp_reg, prop, tmp_reg);
|
||
cons(tmp_reg, name, tmp_reg);
|
||
hash_value = sym_hash(name);
|
||
name[C_PAGE] = prop_page[hash_value];
|
||
name[C_DISP] = prop_disp[hash_value];
|
||
cons(tmp_reg, tmp_reg, name);
|
||
prop_page[hash_value] = tmp_reg[C_PAGE];
|
||
prop_disp[hash_value] = tmp_reg[C_DISP];
|
||
}
|
||
name[C_PAGE] = value[C_PAGE];
|
||
name[C_DISP] = value[C_DISP];
|
||
}
|
||
else /* name operand is not a symbol */
|
||
{
|
||
set_src_err("PUTPROP", 3, name, value, prop);
|
||
return(-1);
|
||
}
|
||
return(0);
|
||
} /* end of function: put_prop(name, value, prop) */
|
||
|
||
|
||
/************************************************************************/
|
||
/* Remove Property */
|
||
/************************************************************************/
|
||
rem_prop(sym, prop)
|
||
int sym[2];
|
||
int prop[2];
|
||
{
|
||
int search[2];
|
||
int temp[2];
|
||
ENTER(rem_prop);
|
||
|
||
sym_search(sym);
|
||
if(sym[C_PAGE])
|
||
{
|
||
mov_reg(search,sym);
|
||
while (search[C_PAGE])
|
||
{
|
||
mov_reg(temp,search);
|
||
take_cadr(temp);
|
||
if (eq(temp,prop))
|
||
{
|
||
mov_reg(temp,search);
|
||
take_cddr(temp);
|
||
take_cdr(temp);
|
||
put_ptr(CORRPAGE(search[C_PAGE]), search[C_DISP]+3, temp[C_PAGE],
|
||
temp[C_DISP]);
|
||
break;
|
||
}
|
||
else
|
||
{
|
||
take_cddr(search);
|
||
}
|
||
} /* end: while (search[C_PAGE]) */
|
||
} /* end: if(sym[C_PAGE]) */
|
||
} /* end of function: rem_prop(sym, prop) */
|
||
|
||
|
||
|
||
|
||
/************************************************************************/
|
||
/* Symbol List Search */
|
||
/************************************************************************/
|
||
|
||
/********* Code rewritten in assembly language on 5/22/86 by JCJ ******
|
||
|
||
sym_search(sym)
|
||
int sym[2];
|
||
{
|
||
int hash_value; /* symbol's hash value */
|
||
int sym_save[2]; /* initial value of symbol argument */
|
||
int temp[2]; /* temporary "register" */
|
||
ENTER(sym_search);
|
||
|
||
if (ptype[CORRPAGE(sym[C_PAGE])] == SYMTYPE*2)
|
||
{
|
||
/* save symbol's page and displacement for testing purposes */
|
||
mov_reg(sym_save, sym);
|
||
|
||
/* obtain hash chain to search */
|
||
hash_value = sym_hash(sym);
|
||
sym[C_PAGE] = prop_page[hash_value];
|
||
sym[C_DISP] = prop_disp[hash_value];
|
||
|
||
while(sym[C_PAGE])
|
||
{
|
||
mov_reg(temp, sym);
|
||
take_caar(temp);
|
||
if (eq(temp, sym_save))
|
||
{
|
||
/* symbol found-- return pointer to symbol's property list */
|
||
take_car(sym);
|
||
break;
|
||
}
|
||
else
|
||
{
|
||
take_cdr(sym);
|
||
}
|
||
} /* end: while(sym[C_PAGE]) */
|
||
}
|
||
} /* end of function: sym_search(sym) */
|
||
|
||
***** Code rewritten in assembly language on 5/22/86 by JCJ ******/
|
||
|
||
|
||
|
||
/************************************************************************/
|
||
/* Search For a Given Property */
|
||
/************************************************************************/
|
||
|
||
/********* Code rewritten in assembly language on 5/22/86 by JCJ ******
|
||
|
||
prop_search(list, prop)
|
||
int list[2],prop[2];
|
||
{
|
||
int search[2]; /* current search entry in list */
|
||
int temp[2]; /* temporary "register" */
|
||
ENTER(prop_search);
|
||
|
||
mov_reg(search, list);
|
||
take_cdr(search);
|
||
while(search[C_PAGE])
|
||
{
|
||
mov_reg(temp, search);
|
||
take_car(temp);
|
||
if (eq(temp,prop))
|
||
{
|
||
mov_reg(list, search);
|
||
return(FOUND);
|
||
}
|
||
take_cddr(search);
|
||
} /* end: while(search[C_PAGE]) */
|
||
return(NOT_FOUND);
|
||
} /* end of function: prop_search(list, prop) */
|
||
|
||
***** Code rewritten in assembly language on 5/22/86 by JCJ ******/
|
||
|
||
|
||
/************************************************************************/
|
||
/* Dump Contents of Property List */
|
||
/************************************************************************/
|
||
/***** Code turned off 22 OCT 85 (JCJ) *****
|
||
dump_prop()
|
||
{
|
||
int ent[2]; /* current property list entry */
|
||
int hash_value; /* current hash key value */
|
||
int prop[2]; /* a property pointer */
|
||
int temp[2]; /* temporary "register" */
|
||
int sym[2]; /* pointer to a symbol whose prop list we're dumping */
|
||
char *symbol; /* a symbol's print name */
|
||
int val[2]; /* a value pointer */
|
||
|
||
char *symbol_name(); /* retrieves a symbol's print name */
|
||
|
||
ENTER(dump_prop);
|
||
|
||
for (hash_value = 0; hash_value < HT_SIZE; hash_value++)
|
||
{
|
||
ent[C_PAGE] = prop_page[hash_value];
|
||
ent[C_DISP] = prop_disp[hash_value];
|
||
while (ent[C_PAGE])
|
||
{
|
||
ASSERT(ptype[CORRPAGE(ent[C_PAGE])] == LISTTYPE*2);
|
||
mov_reg(temp, ent);
|
||
take_car(temp);
|
||
ASSERT(ptype[CORRPAGE(temp[C_PAGE])] == LISTTYPE*2);
|
||
mov_reg(sym,temp);
|
||
take_car(sym);
|
||
ASSERT(ptype[CORRPAGE(sym[C_PAGE])] == SYMTYPE*2);
|
||
symbol = symbol_name(CORRPAGE(sym[C_PAGE]),sym[C_DISP]);
|
||
printf("\nProperty List for |%s|\n", symbol);
|
||
rlsstr(symbol);
|
||
|
||
take_cdr(temp);
|
||
while(temp[C_PAGE])
|
||
{
|
||
ASSERT(ptype[CORRPAGE(temp[C_PAGE])] == LISTTYPE*2);
|
||
mov_reg(prop,temp);
|
||
take_car(prop);
|
||
printf(" property: ");
|
||
annotate(CORRPAGE(prop[C_PAGE]), prop[C_DISP]);
|
||
take_cdr(temp);
|
||
ASSERT(ptype[CORRPAGE(temp[C_PAGE])] == LISTTYPE*2);
|
||
mov_reg(val,temp);
|
||
take_car(val);
|
||
printf(" value: ");
|
||
annotate(CORRPAGE(val[C_PAGE]), val[C_DISP]);
|
||
take_cdr(temp);
|
||
} /* end: while(temp[C_PAGE]) */
|
||
take_cdr(ent);
|
||
} /* end: while (ent[C_PAGE]) */
|
||
} /* end: for (hash_value = 0; hash_value < HT_SIZE; hash_value++) */
|
||
}
|
||
***** Code turned off 22 OCT 85 (JCJ) *****/
|
||
|