110 lines
3.9 KiB
C
110 lines
3.9 KiB
C
/* =====> SHASH.C */
|
||
/* TIPC Scheme '84 Runtime Support - Symbol Support
|
||
(C) Copyright 1984,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 June 1984
|
||
Last Modification: 10 Feb 1987
|
||
|
||
Modification History:
|
||
10 Feb 87 - Modified the intern routine to recognize the special
|
||
(JCJ/TC) constants #T and #F as ``true'' and ``false,''
|
||
respectively. Also caused #!TRUE to be interned.
|
||
In a previous "fix", I caused #!EOF to be interned,
|
||
and this change reverses that decision. When #!EOF is
|
||
interned, the READ procedure aborts every time it is
|
||
read.
|
||
*/
|
||
#include "ctype.h"
|
||
#include "scheme.h"
|
||
|
||
intern(reg, string, length)
|
||
int reg[2]; /* "register" to return symbol's pointer */
|
||
char *string; /* characters comprizing symbol */
|
||
int length; /* number of characters in the symbol */
|
||
{
|
||
int disp; /* displacement of the symbol's entry */
|
||
int equal; /* equality indicator */
|
||
int hash_value; /* value returned from hashing function */
|
||
int i,j; /* our old favorite index variables */
|
||
int page; /* page number of the symbol's entry */
|
||
char *ptr; /* pointer to special constant name */
|
||
|
||
#define NUM_SPEC 6
|
||
static char *special_constants[NUM_SPEC] =
|
||
{"#T", "#F", "#!FALSE", "#!NULL", "#!TRUE", "#!UNASSIGNED"};
|
||
static int spec_len[NUM_SPEC] =
|
||
{2, 2, 7, 6, 6, 12};
|
||
static int spec_page[NUM_SPEC] =
|
||
{T_PAGE*2, NIL_PAGE*2, NIL_PAGE*2, NIL_PAGE*2, T_PAGE*2, UN_PAGE*2};
|
||
static int spec_disp[NUM_SPEC] =
|
||
{T_DISP, NIL_DISP, NIL_DISP, NIL_DISP, T_DISP, UN_DISP};
|
||
|
||
if (string[0] == '#')
|
||
{
|
||
for (i=0; i<NUM_SPEC; i++)
|
||
{
|
||
if (length == spec_len[i])
|
||
{
|
||
for (j=0, ptr=special_constant[i]; j<length; j++)
|
||
if (string[j] != *ptr++) goto no_match;
|
||
reg[C_PAGE] = spec_page[i];
|
||
reg[C_DISP] = spec_disp[i];
|
||
goto routine_exit;
|
||
} /* end: if (length == spec_len[i]) */
|
||
no_match:
|
||
} /* end: for (i=0; i<NUM_SPEC; i++) */
|
||
} /* end: if (string[0] == '#') */
|
||
hash_value = hash(string, length);
|
||
if (hash_page[hash_value] != 0)
|
||
{
|
||
page = CORRPAGE(hash_page[hash_value]);
|
||
disp = hash_disp[hash_value];
|
||
while (page != 0)
|
||
{
|
||
if (sym_eq(page, disp, string, length))
|
||
{
|
||
reg[C_PAGE] = ADJPAGE(page);
|
||
reg[C_DISP] = disp;
|
||
goto routine_exit;
|
||
}
|
||
/* Follow hash chain link pointer to next symbol */
|
||
i = CORRPAGE(get_byte(page,disp+3));
|
||
disp = get_word(page,disp+4);
|
||
page = i;
|
||
} /* end: while (page != 0) */
|
||
/* if loop exits, symbol not found-- add to oblist */
|
||
}
|
||
|
||
/* add symbol to oblist */
|
||
alloc_sym(reg, length);
|
||
page = CORRPAGE(reg[C_PAGE]);
|
||
disp = reg[C_DISP];
|
||
put_sym(string, page, disp, hash_page[hash_value], hash_disp[hash_value],
|
||
hash_value);
|
||
hash_page[hash_value] = ADJPAGE(page);
|
||
hash_disp[hash_value] = disp;
|
||
|
||
routine_exit:
|
||
} /* end of function: intern(reg, string, length) */
|
||
|
||
/************************************************************************/
|
||
/* Hashing Function */
|
||
/************************************************************************/
|
||
/*****
|
||
hash(sym, len)
|
||
char *sym; /* symbol to be "hashed" */
|
||
int len; /* number of characters in "sym" */
|
||
{
|
||
unsigned acc = 0;
|
||
int i;
|
||
for (i = 0; i < len; i++) acc += sym[i];
|
||
return (acc % HT_SIZE);
|
||
} /* end of function: hash(sym, len) */
|
||
*****/
|
||
|