symtab.p

<B>Digital的Unix操作系统VAX 4.2源码</B>

(*#@(#)symtab.p	4.1	Ultrix	7/17/90 *)
(****************************************************************************
 *									    *
 *  Copyright (c) 1984 by						    *
 *  DIGITAL EQUIPMENT CORPORATION, Maynard, Massachusetts.		    *
 *  All rights reserved.						    *
 * 									    *
 *  This software is furnished under a license and may be used and copied   *
 *  only in  accordance with  the  terms  of  such  license  and with the   *
 *  inclusion of the above copyright notice. This software or  any  other   *
 *  copies thereof may not be provided or otherwise made available to any   *
 *  other person.  No title to and ownership of  the  software is  hereby   *
 *  transferred.							    *
 * 									    *
 *  The information in this software is  subject to change without notice   *
 *  and  should  not  be  construed as  a commitment by DIGITAL EQUIPMENT   *
 *  CORPORATION.							    *
 * 									    *
 *  DIGITAL assumes no responsibility for the use  or  reliability of its   *
 *  software on equipment which is not supplied by DIGITAL.		    *
 * 									    *
$Header: symtab.p,v 1.6 84/06/06 13:03:11 powell Exp $
 ****************************************************************************)
#include "globals.h"
#include "alloc.h"
#include "decls.h"

{ symbol table }
const
    SYMTABSIZE = 1000;
var
    symTab : array [0..SYMTABSIZE] of Symbol;


procedure InitSymTab;
var
    i : integer;
begin
    for i := 0 to SYMTABSIZE do begin
	symTab[i] := nil;
    end;
    withQualList := nil;
    loopActive := false;
    generateBlockNumber := 1;
    currScope := nil;
    { builtinScope is scope with builtin identifiers }
    builtinScope := StartScope(false);
    EndScope;
    { globalScope is scope with globally exported identifiers }
    globalScope := StartScope(false);
    { leave globalScope active }
end;

function StartScope {(open : boolean) : Scope};
var
    scope : Scope;
begin
    if TraceSymtab then begin
	writeln(output,'StartScope ',generateBlockNumber:1);
    end;
    new(scope);
    scope^.block := generateBlockNumber;
    scope^.open := open;
    scope^.enclosing := currScope;
    scope^.symbols := AddToSymbolList(nil,nil);
    currScope := scope;
    StartScope := scope;
    generateBlockNumber := generateBlockNumber + 1;
end;

procedure OpenScope {(scope : Scope; open : boolean)};
var
    newScope : Scope;
begin
    if TraceSymtab then begin
	writeln(output,'OpenScope ',scope^.block:1);
    end;
    new(newScope);
    newScope^.block := scope^.block;
    newScope^.open := open;
    newScope^.enclosing := currScope;
    currScope := newScope;
end;

procedure EndScope;
begin
    if TraceSymtab then begin
	writeln(output,'EndScope ',currScope^.block:1);
    end;
    currScope := currScope^.enclosing;
end;

function LookUpSymbol {(name : String; scope : Scope; symCase : SymbolCase)
	: Symbol};
var
    sym : Symbol;
    symName : String;
    found : boolean;
    hash : integer;
    originalScope : Scope;
begin
    originalScope := scope;
    if scope = nil then begin
	scope := currScope;
    end;
    found := false;
    repeat
	if TraceSymtab then begin
	    writeln(output,'LookUpSymbol block ',scope^.block:1);
	end;
	hash := (name^.hash + scope^.block) mod (SYMTABSIZE+1);
	sym := symTab[hash];
	while not found and (sym <> nil) do begin
	    if TraceSymtab then begin
		write(output,'LookUpSymbol ');
		WriteString(output,sym^.name);
		write(output,' ',sym^.block:1,' ');
		WriteString(output,name);
		writeln(output,' ',scope^.block:1,' ',hash:1);
	    end;
	    if sym^.block <> scope^.block then begin
	    end else if sym^.name = name then begin
		found := true;
	    end else if not standardKeywordFlag and
		    ((sym^.symCase = ANYCASE) or (symCase = ANYCASE))
	    then begin
		found := EqualAnyCase(sym^.name,name);
	    end;
	    if not found then begin
		sym := sym^.nextInTable;
	    end;
	end;
	if not found then begin
	    if scope^.open then begin
		scope := scope^.enclosing;
	    end else begin
		scope := nil;
	    end;
	end;
    until found or (scope = nil);
    if sym <> nil then begin
	{ found it }
    end else if originalScope = nil then begin
	scope := builtinScope;
	{ check for a standard identifier in a builtin scope ignoring case }
	hash := (name^.hash + scope^.block) mod (SYMTABSIZE+1);
	sym := symTab[hash];
	while (sym <> nil) and not found do begin
	    if TraceSymtab then begin
		write(output,'LookUpSymbol ');
		WriteString(output,sym^.name);
		write(output,' ',sym^.block:1,' ');
		WriteString(output,name);
		writeln(output,' ',scope^.block:1,' ',hash:1);
	    end;
	    symName := sym^.name;
	    if sym^.block <> scope^.block then begin
		{ wrong block }
	    end else if name = symName then begin
		found := true;
	    end else begin
		found := EqualAnyCase(name,symName);
	    end;
	    if not found then begin
		sym := sym^.nextInTable;
	    end;
	end;
    end;
    if (sym = nil) and TraceSymtab then begin
	write(output,'LookUpSymbol did not find ');
	WriteString(output,name);
	if originalScope = nil then begin
	    originalScope := currScope;
	end;
	writeln(output,' ',originalScope^.block:1,' ',hash:1);
    end;
    LookUpSymbol := sym;
end;

function DefineSymbol {(var sym : Symbol; name : String; scope : Scope;
	symCase : SymbolCase) : boolean};
var
    hash : integer;
    found : boolean;
begin
    if scope = nil then begin
	scope := currScope;
    end;
    if symCase = SCOPECASE then begin
	if (scope^.block <= MAXBUILTINSCOPES) and (scope^.block <> 0) then begin
	    symCase := ANYCASE;
	end else begin
	    symCase := ONECASE;
	end;
    end;
    hash := (name^.hash + scope^.block) mod (SYMTABSIZE+1);
    sym := symTab[hash];
    found := false;
    while (sym <> nil) and not found do begin
	if sym^.block <> scope^.block then begin
	    { not right block }
	end else if sym^.name = name then begin
	    found := true;
	end else if not standardKeywordFlag and
		((sym^.symCase = ANYCASE) or (symCase = ANYCASE))
	then begin
	    found := EqualAnyCase(sym^.name,name);
	end;
	if not found then begin
	    sym := sym^.nextInTable;
	end;
    end;
    if found then begin
	{ do nothing }
    end else begin
	new(sym);
	sym^.name := name;
	sym^.block := scope^.block;
	sym^.nextInTable := symTab[hash];
	symTab[hash] := sym;
	sym^.kind := SYMNULL;
	sym^.symCase := symCase;
	if TraceSymtab then begin
	    write(output,'DefineSymbol ');
	    WriteString(output,sym^.name);
	    writeln(output,' ',sym^.block:1,' ',hash:1);
	end;
	scope^.symbols := AddToSymbolList(scope^.symbols,sym);
    end;
    DefineSymbol := not found;
end;

procedure DumpSymTab;
var
    i : integer;
    sym : Symbol;
begin
    for i := 0 to SYMTABSIZE do begin
	sym := symTab[i];
	while sym <> nil do begin
	    write(output,'hv=',i:0,' b=',sym^.block:0,' ',sym^.kind:0,' ');
	    WriteString(output,sym^.name);
	    if sym^.kind = SYMMODULE then begin
		write(output,'s=',sym^.symModule^.scope^.block:1,
		' es=',sym^.symModule^.exportScope^.block:1);
	    end;
	    writeln(output);
	    sym := sym^.nextInTable;
	end;
    end;
end;

{ QualifiedName:  Looks up a possible qualified name }
{ Removes idents from names as it searches.  Leaves extras, if any, in names }
function QualifiedName{(names : IdentList) : Symbol};
var
    sym : Symbol;
    id, idnext : IdentNode;
    scope : Scope;
    continue : boolean;
begin
    assert (names <> nil);
    assert (names^.first <> nil);
    sym := nil;
    scope := nil;		{ default scope }
    id := names^.first;
    repeat
	sym := LookUpSymbol(id^.name,scope,ONECASE);
	if sym = nil then begin
	    continue := false;
	    ErrorName(id^.name,'Symbol not found');
	end else begin
	    if sym^.kind <> SYMMODULE then begin
		continue := false;
	    end else begin
		continue := true;
		scope := sym^.symModule^.scope;
	    end;
	    { remove module name from front of list }
	    idnext := id^.next;
	    names^.first := idnext;
	    dispose(id);
	    id := idnext;
	end;
    until not continue or (id = nil);
    QualifiedName := sym;
end;

function TypeOf {(names : IdentList) : TypeNode};
var
    tn : TypeNode;
    sym : Symbol;
begin
    sym := QualifiedName(names);
    if sym = nil then begin
	tn := anyTypeNode;
    end else if names^.first <> nil then begin
	ErrorName(sym^.name,'Qualification error on type');
	tn := anyTypeNode;
    end else if (sym^.kind <> SYMTYPE) then begin
	ErrorName(sym^.name,'Must be a type');
	tn := anyTypeNode;
    end else begin
	dispose(names);
	tn := ActualType(sym^.symType);
    end;
    TypeOf := tn;
end;

function Compatible {(var dtn : TypeNode; den : ExprNode; var stn : TypeNode;
	sen : ExprNode) : TypeNode};
var
    src, dst, tn, etn : TypeNode;
begin
    tn := nil;
    src := BaseType(stn);
    dst := BaseType(dtn);
    if (src = nil) or (dst = nil) then begin
	{ not much we can do }
{ compatible if same }
    end else if dst = src then begin
	tn := dst;
{  or any type allowed }
    end else if (dst = anyTypeNode) or (src = anyTypeNode) then begin
	tn := dst;
{  or constant with integer or cardinal }
    end else if (dst = cardIntTypeNode) and
	    (src^.kind in [DTINTEGER,DTCARDINAL])
    then begin
	tn := src;
    end else if (src = cardIntTypeNode) and
	    (dst^.kind in [DTINTEGER,DTCARDINAL])
    then begin
	tn := dst;
{  or constant with char }
    end else if (dst = charConstTypeNode) and (src = charTypeNode) then begin
	tn := src;
	dtn := src;
	if den <> nil then begin
	    if den^.kind = EXPRCONST then begin
		den^.constType := src;
		den^.exprType := src;
	    end;
	end;
    end else if (src = charConstTypeNode) and (dst = charTypeNode) then begin
	tn := dst;
	stn := dst;
	if sen <> nil then begin
	    if sen^.kind = EXPRCONST then begin
		sen^.constType := dst;
		sen^.exprType := dst;
	    end;
	end;
{  or constant with real or longreal }