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) */
|
|||
|
*****/
|
|||
|
|