decls.p

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

(*#@(#)decls.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: decls.p,v 1.6 84/06/06 12:55:51 powell Exp $
 ****************************************************************************)
#include "globals.h"
#include "const.h"
#include "alloc.h"
#include "decls.h"
#include "bstmt.h"
#include "cstmt.h"
#include "scanner.h"
#include "optim.h"

function NewTypeNode {(kind : DataType) : TypeNode};
var
    tn : TypeNode;
begin
    new(tn);
    tn^.kind := kind;
    tn^.next := nil;
    tn^.number := 0;
    tn^.size := -1;
    tn^.alignment := -1;
    tn^.name := nil;
    tn^.opaqueName := nil;
    tn^.module := nil;
    NewTypeNode := tn;
end;

procedure InitGlobalModule;
begin
    new(globalModule);
    globalModule^.kind := MODGLOBAL;
    globalModule^.scope := currScope;
    globalModule^.exportScope := currScope;
    globalModule^.body := nil;
    globalModule^.qualExports := nil;
    globalModule^.unqualExports := nil;
    globalModule^.imports := nil;
    globalModule^.enclosing := nil;
    globalModule^.enclosingProc := nil;
    globalModule^.modules := AddToModuleList(nil,nil);
    currModule := globalModule;
    new(globalProc);
    globalProc^.name := nil;
    globalProc^.globalName := nil;
    globalProc^.procType := procTypeNode;
    globalProc^.body := nil;
    globalProc^.code := AddToCodeList(nil,nil);
    globalProc^.enclosing := nil;
    globalProc^.enclosingModule := globalModule;
    globalProc^.tempMap := nil;
    globalProc^.scope := currScope;
    globalProc^.block := currScope^.block;
    globalProc^.displayLevel := 1;
    globalProc^.mem := InitAllocationNode;
    globalProc^.initFlagVar := nil;
    globalProc^.containsProcs := false;
    globalProc^.containsUpLevel := [];
    globalProc^.doesUpLevel := [];
    globalModule^.procs := AddToProcList(nil,globalProc);
    currProc := globalProc;
    globalPortList := AddToPortList(nil,nil);
end;

procedure AddModuleName(module : ModuleNode; proc : ProcNode);
begin
    if (module = nil) or
	    ((module = globalModule) and ((proc = globalProc) or (proc = nil)))
    then begin
	{ do nothing }
    end else if proc = nil then begin
	{ global thing, just modules }
	AddModuleName(module^.enclosing,proc);
	AddString(module^.name);
	AddChar('_');
    end else if module^.enclosingProc = proc then begin
	{ next level is a module }
	AddModuleName(module^.enclosing,proc);
	AddString(module^.name);
	AddChar('_');
    end else if proc^.enclosingModule = module then begin
	{ next level is a proc }
	AddModuleName(module,proc^.enclosing);
	AddString(proc^.name);
	AddChar('_');
    end else begin
	ErrorName(module^.name,'Module/proc list confused');
	ErrorName(proc^.name,'Module/proc list confused');
    end;
end;

function GlobalName(name:String; module : ModuleNode; proc : ProcNode) : String;
var
    globalName : String;
begin
    if TraceDecls then begin
	write(output,'GlobalName(');
	WriteString(output,name);
	write(output,',');
	if module <> nil then begin
	    WriteString(output,module^.name);
	end;
	write(output,',');
	if proc <> nil then begin
	    WriteString(output,proc^.name);
	end;
	writeln(output,')');
    end;
    if name = nil then begin
	globalName := nil;
    end else begin
	AddModuleName(module,proc);
	AddString(name);
	globalName := NewString;
    end;
    GlobalName := globalName;
end;

procedure DefineConst{(name : String; value : ConstNode)};
var
    sym : Symbol;
begin
    if TraceDecls then begin
	write(output,'DefineConst(');
	WriteString(output,name);
	write(output,'=');
	WriteConstant(output,value);
	writeln(output,')');
    end;
    if DefineSymbol(sym,name,nil,SCOPECASE) then begin;
	sym^.kind := SYMCONST;
	sym^.symConst := value;
    end else begin
	CheckEqualConst(sym,value);
    end;
end;

procedure DefineType{(name : String; value : TypeNode)};
var
    sym : Symbol;
    tn, otn : TypeNode;
begin
    if TraceDecls then begin
	write(output,'DefineType(');
	WriteString(output,name);
	writeln(output,')');
    end;
    if value <> nil then begin
	if value^.name = nil then begin
	    value^.name := name;
	    if currModule^.kind = MODDEFINITION then begin
		value^.module := currModule;
	    end;
	end;
    end;
    if DefineSymbol(sym,name,nil,SCOPECASE) then begin
	sym^.kind := SYMTYPE;
	if value = nil then begin
	    { opaque type }
	    otn := NewTypeNode(DTOPAQUE);
	    otn^.size := WORDSIZE;
	    otn^.opaqueName := GlobalName(name,currModule,currProc);
	    otn^.name := name;
	    if currModule^.kind = MODDEFINITION then begin
		otn^.module := currModule;
	    end;
	    sym^.symType := otn;
	end else begin
	    sym^.symType := value;
	end;
    end else if (sym^.kind = SYMTYPE) and (value <> nil) then begin
	CheckEqualType(sym,value);
    end else begin
	ErrorName(name,'Type redefined');
    end;
    if TraceDecls then begin
	if value <> nil then begin
	    writeln(output,'size=',value^.size:1:0,', align=',
			value^.alignment:1:0);
	end else begin
	    writeln(output,'value=nil');
	end;
    end;
end;

function DefineVar{(name : String; varType : TypeNode; mt : MemoryType;
	global : boolean) : VarNode};
var
    sym : Symbol;
    vn : VarNode;
    globalName : String;
    createVar : boolean;
    atn : TypeNode;
begin
    if TraceDecls then begin
	write(output,'DefineVar(');
	WriteString(output,name);
	writeln(output,')');
    end;
    createVar := true;
    if name <> nil then begin
	if DefineSymbol(sym,name,nil,SCOPECASE) then begin
	    sym^.kind := SYMVAR;
	end else begin
	    { createVar := false; create it anyhow }
	    CheckEqualVar(sym,varType);
	end;
    end;
    if createVar then begin
	atn := ActualType(varType);
	if atn <> nil then begin
	    if atn^.kind = DTARRAY then begin
		if (atn^.arrayKind = ARRAYOPEN) and (mt <> MEMPARAM) then begin
		    ErrorName(name,'Open array type is valid only for parameters');
		end;
	    end;
	end;
	new(vn);
	vn^.varType := varType;
	vn^.readonly := false;
	vn^.indirect := false;
	vn^.changed := false;
	vn^.name := name;
	currProc^.varList := AddToVarList(currProc^.varList,vn);
	if mt = MEMNONE then begin
	    { don't allocate memory yet }
	    vn^.address.kind := MEMNONE;
	end else if (name <> nil) and (currProc = globalProc) and
		(mt in [MEMNORMAL,MEMFAST])
	then begin
	    if global then begin
		globalName := name;
	    end else begin
		globalName := GlobalName(name, currModule, currProc);
	    end;
	    AllocateGlobal(globalName,varType^.size,vn^.address);
	    vn^.address.gvn^.extern := global;
	end else if (name <> nil) and (mt = MEMNORMAL) and
	    (varType^.kind in [DTPOINTER,DTINTEGER,DTBOOLEAN,DTCHAR,DTREAL,
		    DTSET,DTCARDINAL,DTBYTE,DTWORD,DTSUBRANGE,DTENUMERATION])
	    and (varType^.size <= WORDSIZE)
	then begin
	    { try fast memory }
	    AllocateMemory(currProc^.mem,MEMFAST,SizeOf(varType),
		    AlignmentOf(varType),currProc,vn^.address);
	end else begin
	    AllocateMemory(currProc^.mem,mt,SizeOf(varType),
		    AlignmentOf(varType),currProc,vn^.address);
	end;
	if name <> nil then begin
	    sym^.symVar := vn;
	end;
    end;
    DefineVar := vn;
end;

procedure DefineVarList{(idList : IdentList; varType : TypeNode;
	global : Token)};
var
    id : IdentNode;
    sym : Symbol;
    vn : VarNode;
begin
    id := idList^.first;
    while id <> nil do begin
	vn := DefineVar(id^.name,varType,MEMNORMAL,global=TKEXTERNAL);
	id := id^.next;
    end;
end;

function DefineModule{(name : String; kind : Token) : ModuleNode};
var
    mn : ModuleNode;
    sym : Symbol;
    symCase : SymbolCase;
begin
    if 'i' in debugSet then begin
	write(output,'DefineModule ');
	WriteString(output,name);
	write(output,' : ');
	WriteString(output,currFile);
	writeln(output);
    end;
    new(mn);
    mn^.enclosing := currModule;
    mn^.enclosingProc := currProc;
    mn^.name := name;
    mn^.procs := AddToProcList(nil,nil);
    mn^.modules := AddToModuleList(nil,nil);
    mn^.unqualExports := nil;
    mn^.qualExports := nil;
    mn^.imports := nil;
    mn^.doingImport := false;
    currModule^.modules := AddToModuleList(currModule^.modules,mn);
    if kind = TKBEGIN then begin	{ kind = TKBEGIN for builtin modules }
	symCase := ANYCASE;
    end else begin
	symCase := ONECASE;
    end;
    if not DefineSymbol(sym,name,nil,symCase) then begin
	ErrorName(name,'Module name redefined');
    end;
    sym^.kind := SYMMODULE;
    sym^.symModule := mn;
    currModule := mn;
    case kind of
	TKMODULE : begin
	    mn^.kind := MODPROGRAM;
	    mn^.scope := StartScope(false);
	    if mn^.enclosing = globalModule then begin
		{ program module, use scope for global proc }
		globalProc^.scope := mn^.scope;
		globalProc^.block := mn^.scope^.block;
		globalProc^.enclosingModule := mn;
		compileModuleName := name;
	    end;
	end;
	TKBEGIN, TKDEFINITION : begin
	    mn^.kind := MODDEFINITION;
	    mn^.scope := StartScope(false);
	    mn^.doingImport := true;
	end;
	TKIMPLEMENTATION : begin
	    mn^.kind := MODIMPLEMENTATION;
	    mn^.scope := StartScope(false);
	    globalProc^.scope := mn^.scope;
	    globalProc^.block := mn^.scope^.block;
	    if mn^.enclosing <> globalModule then begin
		ErrorName(mn^.name,'Implementation modules must not be nested');
	    end else begin
		AddText(MODULEINITNAME);
		globalProc^.name := NewString;
		globalProc^.globalName := GlobalName(globalProc^.name,mn,nil);
		globalProc^.enclosingModule := mn;
		AddText(MODULEINITFLAG);
		globalProc^.initFlagVar := DefineVar(NewString,booleanTypeNode,
						MEMNORMAL,false);
		compileModuleName := name;
	    end;
	end;
    end;
    DefineModule := mn;
end;

procedure GlobalPort(sym : Symbol; mn, tomn : ModuleNode; qualified : boolean);
var
    pn : PortNode;
begin
    if (sym <> nil) and ((mn^.kind = MODIMPLEMENTATION) or
	    (tomn^.kind in [MODIMPLEMENTATION,MODPROGRAM]))
    then begin
	new(pn);
	pn^.sym := sym;
	pn^.module := mn;
	pn^.qualified := qualified;
	pn^.export := mn^.kind = MODIMPLEMENTATION;
	pn^.extern := false;
	if sym^.kind = SYMPROC then begin
	    pn^.extern := sym^.symProc^.extern;
	end else if sym^.kind = SYMVAR then begin
	    if sym^.symVar^.address.kind = MEMGLOBAL then begin
		pn^.extern := sym^.symVar^.address.gvn^.extern;
	    end;
	end;
	globalPortList := AddToPortList(globalPortList,pn);
	if 'g' in debugSet then begin
	    write(output,'GlobalPort: ');
	    WriteString(output,mn^.name);
	    write(output,'.');
	    WriteString(output,sym^.name);
	    write(output,' ',sym^.kind,' to ');
	    WriteString(output,tomn^.name);
	    writeln(output);
	end;
    end;
end;

procedure ExportExternalProcs(mn : ModuleNode);
var
    sym : Symbol;
    id : IdentNode;
begin
    { check qualified exports for procedures or modules }
    if mn^.qualExports <> nil then begin
	id := mn^.qualExports^.first;
	while id <> nil do begin
	    sym := LookUpSymbol(id^.name,nil,ONECASE);
	    if sym = nil then begin
		{ error, but already found }
	    end else if sym^.kind = SYMPROC then begin
		sym^.symProc^.internalProc := false;
	    end else if sym^.kind = SYMMODULE then begin
		ExportExternalProcs(sym^.symModule);
	    end;
	    GlobalPort(sym,mn,globalModule,false);
	    id := id^.next;
	end;
    end;

    { check unqualified exports for procedures or modules }
    if mn^.unqualExports <> nil then begin
	id := mn^.unqualExports^.first;
	while id <> nil do begin
	    sym := LookUpSymbol(id^.name,nil,ONECASE);
	    if sym = nil then begin
		{ error, but already found }
	    end else if sym^.kind = SYMPROC then begin
		sym^.symProc^.internalProc := false;
	    end else if sym^.kind = SYMMODULE then begin
		ExportExternalProcs(sym^.symModule);
	    end;
	    GlobalPort(sym,mn,globalModule,false);
	    id := id^.next;
	end;
    end;
end;

procedure ProcessExports(mn : ModuleNode);
var
    sym, nsym : Symbol;
    id : IdentNode;
    exportScope, enclScope : Scope;
begin
    if 'i' in debugSet then begin
	write(output,'ProcessExports ');
	WriteString(output,mn^.name);
	write(output,' : ');
	WriteString(output,currFile);
	writeln(output);
    end;
    { create scope for qualified exports }
    exportScope := StartScope(false);
    EndScope;
    mn^.exportScope := exportScope;

    { export qualified exports to module export scope }
    if mn^.qualExports <> nil then begin
	id := mn^.qualExports^.first;
	while id <> nil do begin
	    sym := LookUpSymbol(id^.name,nil,ONECASE);
	    if sym = nil then begin
		ErrorName(id^.name,'Exported identifier not found in module');
	    end else if sym^.kind in [SYMFIELD,SYMENUM] then begin
		ErrorName(id^.name,'Cannot export a field or enumeration constant');
	    end else begin
		if mn^.enclosing = globalModule then begin
		    if sym^.kind = SYMPROC then begin
			sym^.symProc^.internalProc := false;
		    end else if sym^.kind = SYMMODULE then begin
			ExportExternalProcs(sym^.symModule);
		    end;
		    GlobalPort(sym,mn,globalModule,true);
		end;
		nsym := Port(sym,exportScope);
	    end;
	    id := id^.next;
	end;
    end;

    { export unqualified exports to enclosing scope and module export scope }
    if mn^.unqualExports <> nil then begin
	enclScope := currScope^.enclosing;

	id := mn^.unqualExports^.first;
	while id <> nil do begin
	    sym := LookUpSymbol(id^.name,nil,ONECASE);
	    if sym = nil then begin
		ErrorName(id^.name,'Exported identifier not found in module');
	    end else if sym^.kind in [SYMFIELD,SYMENUM] then begin
		ErrorName(id^.name,'Cannot export a field or enumeration constant');
	    end else begin
		nsym := Port(sym,exportScope);
		nsym := Port(sym,enclScope);

		if mn^.enclosing = globalModule then begin
		    if sym^.kind = SYMPROC then begin
			sym^.symProc^.internalProc := false;
		    end else if sym^.kind = SYMMODULE then begin
			ExportExternalProcs(sym^.symModule);
		    end;
		    GlobalPort(sym,mn,globalModule,false);
		end;
	    end;
	    id := id^.next;
	end;
    end;
end;

procedure EndModule{(mn : ModuleNode; body : StmtList; name : String)};
var
    code : CodeNode;
begin

    if 'i' in debugSet then begin
	write(output,'EndModule ');
	WriteString(output,mn^.name);
	write(output,' : ');
	WriteString(output,currFile);
	writeln(output);
    end;
    if mn^.kind <> MODIMPLEMENTATION then begin
	ProcessExports(mn);
    end;
    mn^.body := body;
    mn^.doingImport := false;

    { put code for this module on enclosing procedures code list }
    new(code);
    code^.kind := CODEMODULE;
    code^.module := mn;
    code^.stmts := body;
    currProc^.code := AddToCodeList(currProc^.code,code);
    EndScope;
    currModule := mn^.enclosing;
    if (name <> nil) and (name <> mn^.name) then begin
	ErrorName(mn^.name,'Name of module does not appear on end');
    end;
end;

procedure GetDefinitionModule(mn : ModuleNode);
var
    fileString : String;
    i : integer;
begin
    if mn <> nil then begin
	{ read in the definition module }
	i := 0;
	while (i < mn^.name^.length)
	    and (i < FILENAMESIZE-4)
	do begin
	    AddChar(GetChar(mn^.name,i));
	    i := i + 1;
	end;
	AddText('.def');
	fileString := NewString;

	{ continue parsing with file }
	if not InitFile(fileString) then begin