porttab.mod

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

procedure SameConst(ecn : ConstNode; var icn : ConstNode) : boolean;
var
    result : boolean;
begin
    if ecn = icn then
	return TRUE;
    elsif ecn^.kind # icn^.kind then
	return FALSE;
    else
	result := TRUE;
	case ecn^.kind of
	| DTSTRING :
	    result := ecn^.strVal = icn^.strVal;
	| DTCHAR :
	    result := ecn^.charVal = icn^.charVal;
	| DTINTEGER, DTCARDINAL :
	    result := ecn^.cardVal = icn^.cardVal;
	| DTBOOLEAN :
	    result := ecn^.boolVal = icn^.boolVal;
	| DTREAL, DTLONGREAL :
	    result := ecn^.realVal = icn^.realVal;
	| DTSET :
	    result := SameType(ecn^.setVal^.setType,icn^.setVal^.setType)
			and (ecn^.setVal^.value = icn^.setVal^.value)
			and (ecn^.setVal^.size = icn^.setVal^.size);
	| DTENUMERATION :
	    result := SameType(ecn^.enumVal^.enumType,icn^.enumVal^.enumType)
			and (ecn^.enumVal^.enumOrd = icn^.enumVal^.enumOrd);
	else
	    writef(output,"SameConst: unexpected kind?");
	    result := false;
	end;
    end;
    if result then
	(*icn := ecn;*)
    end;
    return result;
end SameConst;

const
    TYPESTACKSIZE = 100;
var
    etnStack, itnStack : array [1..TYPESTACKSIZE] of TypeNode;
    typeStackPtr : cardinal;

procedure SameType(etn : TypeNode; var itn : TypeNode) : boolean;
var
    result : boolean;
    epn, ipn : ParamNode;
    efn, ifn : FieldNode;
    een, ien : EnumNode;
    i : cardinal;
begin
    if etn = itn then
	return TRUE;
    elsif (etn = nil) or (itn = nil) then
	return FALSE;
    elsif etn^.kind # itn^.kind then
	return (etn^.kind = DTOPAQUE) or (itn^.kind = DTOPAQUE);
    else
	result := TRUE;
	case etn^.kind of
	| DTNULL, DTINTEGER, DTBOOLEAN, DTCHAR, DTREAL, DTBYTE, DTCARDINAL,
		DTWORD, DTPROCESS, DTLONGREAL:
	    (* matching primitive types *)
	| DTPOINTER:
	    for i := typeStackPtr to 1 by -1 do
		if etnStack[i] = etn then
		    return itn = itnStack[i];
		end;
	    end;
	    inc(typeStackPtr);
	    etnStack[typeStackPtr] := etn;
	    itnStack[typeStackPtr] := itn;
	    result := SameType(etn^.toType,itn^.toType);
	    dec(typeStackPtr);
	| DTRECORD:
	    if etn^.fieldList # nil then
		efn := etn^.fieldList^.first;
	    else
		efn := nil;
	    end;
	    if itn^.fieldList # nil then
		ifn := itn^.fieldList^.first;
	    else
		ifn := nil;
	    end;
	    while result and (efn # nil) and (ifn # nil) do
		result := (efn^.name = ifn^.name)
			    and (efn^.size = ifn^.size)
			    and (efn^.offset = ifn^.offset)
			    and SameType(efn^.fieldType,ifn^.fieldType);
		efn := efn^.next;
		ifn := ifn^.next;
	    end;
	    result := result and (efn = nil) and (ifn = nil);
	| DTPROC:
	    result := SameType(etn^.retType,itn^.retType);
	    if etn^.paramList # nil then
		epn := etn^.paramList^.first;
	    else
		epn := nil;
	    end;
	    if itn^.paramList # nil then
		ipn := itn^.paramList^.first;
	    else
		ipn := nil;
	    end;
	    while result and (epn # nil) and (ipn # nil) do
		result := (epn^.name = ipn^.name)
			    and (epn^.kind = ipn^.kind)
			    and SameType(epn^.paramType,ipn^.paramType);
		epn := epn^.next;
		ipn := ipn^.next;
	    end;
	    result := result and (epn = nil) and (ipn = nil);
	| DTARRAY:
	    result := SameType(etn^.indexType,itn^.indexType)
			and SameType(etn^.elementType,itn^.elementType);
	| DTSET:
	    result := SameType(etn^.setRange,itn^.setRange);
	| DTOPAQUE:
	    result := true;
	| DTSUBRANGE:
	    result := (etn^.subMinOrd = itn^.subMinOrd) and
			(etn^.subMinOrd = itn^.subMinOrd) and
			SameType(etn^.baseType,itn^.baseType);
	| DTENUMERATION:
	    result := etn^.enumCount = itn^.enumCount;
	    if etn^.enumList # nil then
		een := etn^.enumList^.first;
	    else
		een := nil;
	    end;
	    if itn^.enumList # nil then
		ien := itn^.enumList^.first;
	    else
		ien := nil;
	    end;
	    while result and (een # nil) and (ien # nil) do
		result := (een^.name = ien^.name) and
			    (een^.enumOrd = ien^.enumOrd);
		een := een^.next;
		ien := ien^.next;
	    end;
	    result := result and (een = nil) and (ien = nil);
	else
	    writef(output,"SameType: unexpected type?");
	    result := false;
	end;
    end;
    if result then
	(*itn := etn;*)
    end;
    return result;
end SameType;

procedure CheckSame(exp, imp : PortNode);
begin
    if exp^.kind # imp^.kind then
	ModuleError("identifier is used a different kind of object in",
	    exp^.name,exp^.refModule,imp^.refModule);
    elsif exp^.extern <> imp^.extern then
	ModuleError("external attribute differs with that in",
	    exp^.name,exp^.refModule,imp^.refModule);
    else
	case exp^.kind of
	| SYMCONST:
	    if not SameConst(exp^.symConst,imp^.symConst) then
		ModuleError("constant differs with that in",
		    exp^.name,exp^.refModule,imp^.refModule);
	    end;
	| SYMPROC:
	    if not SameType(exp^.symProc,imp^.symProc) then
		ModuleError("procedure differs with that in",
		    exp^.name,exp^.refModule,imp^.refModule);
	    end;
	| SYMTYPE:
	    if not SameType(exp^.symType,imp^.symType) then
		ModuleError("type differs with that in",
		    exp^.name,exp^.refModule,imp^.refModule);
	    end;
	| SYMVAR:
	    if not SameType(exp^.symVar,imp^.symVar) then
		ModuleError("variable type differs with that in",
		    exp^.name,exp^.refModule,imp^.refModule);
	    end;
	end;
    end;
end CheckSame;

procedure CheckExports();
var
    mn : ModuleNode;
    pn, pnnext : PortNode;
    sym : Symbol;
begin
    if logErrorsFlag then
	writef(output,"CheckExports:\n");
    end;
    if moduleList = nil then
	return;
    end;
    mn := moduleList^.first;
    while mn # nil do
	if tracePorttab then
	    writef(output,"Module ");
	    WriteString(output,mn^.name);
	    writef(output," scope=%d\n",mn^.scope);
	end;
	if mn^.ignoreErrors then
	    (* don't worry about this module *)
	elsif mn^.exports # nil then
	    sym := mn^.exports^.first;
	    while sym # nil do
		if tracePorttab then
		    writef(output,'Symbol ');
		    WriteString(output,sym^.name);
		    writef(output,' %c\n',dumpSymLetter[sym^.kind]);
		end;
		if sym^.exported = nil then
		    if sym^.imported # nil then
			pn := sym^.imported^.first;
			while pn # nil do
			    pnnext := pn^.next;
			    ModuleError("not exported but imported by",
				sym^.name,sym^.homeModule,pn^.refModule);
			    pn := pnnext;
			end;
		    end;
		else
		    if sym^.imported # nil then
			pn := sym^.imported^.first;
			while pn # nil do
			    pnnext := pn^.next;
			    if tracePorttab then
				writef(output,"Imported ");
				DumpPort(pn);
			    end;
			    CheckSame(sym^.exported,pn);
			    pn := pnnext;
			end;
		    end;
		end;
		sym := sym^.next;
	    end;
	end;
	mn := mn^.next;
    end;
end CheckExports;

procedure WatchModule(arg : array of char);
var
    i : cardinal;
    mn : ModuleNode;
begin
    i := 2;	(* skip -M *)
    while (i < number(arg)) and (arg[i] # 0C) do
	while (i < number(arg)) and (arg[i] # 0C) and (arg[i] # ',') do
	    AddChar(arg[i]);
	    inc(i);
	end;
	mn := DefineModule(NewString(),0);
	mn^.watchErrors := TRUE;
	inc(i);
    end;
end WatchModule;

procedure IgnoreModule(arg : array of char);
var
    i : cardinal;
    mn : ModuleNode;
begin
    i := 2;	(* skip -N *)
    while (i < number(arg)) and (arg[i] # 0C) do
	while (i < number(arg)) and (arg[i] # 0C) and (arg[i] # ',') do
	    AddChar(arg[i]);
	    inc(i);
	end;
	mn := DefineModule(NewString(),0);
	mn^.ignoreErrors := TRUE;
	inc(i);
    end;
end IgnoreModule;

begin
    moduleList := nil;
    typeStackPtr := 0;
    errorCount := 0;
    dumpSymLetter[SYMNULL] := '?';
    dumpSymLetter[SYMMODULE] := 'M';
    dumpSymLetter[SYMVAR] := 'V';
    dumpSymLetter[SYMPROC] := 'P';
    dumpSymLetter[SYMCONST] := 'C';
    dumpSymLetter[SYMTYPE] := 'T';
    printSymKind[SYMNULL] := 'unknown';
    printSymKind[SYMMODULE] := 'module';
    printSymKind[SYMVAR] := 'variable';
    printSymKind[SYMPROC] := 'procedure';
    printSymKind[SYMCONST] := 'constant';
    printSymKind[SYMTYPE] := 'type';
    AddText("$GLOBAL$");
    globalModule := DefineModule(NewString(),0);
    globalModule^.scope := globalScope;
    AddText("IO");
    ioModule := DefineModule(NewString(),0);
    ioModule^.ignoreErrors := TRUE;
    ioModule^.builtin := TRUE;
    AddText("SYSTEM");
    systemModule := DefineModule(NewString(),0);
    systemModule^.ignoreErrors := TRUE;
    systemModule^.builtin := TRUE;
    AddText("MEMORY");
    memoryModule := DefineModule(NewString(),0);
    memoryModule^.ignoreErrors := TRUE;
    memoryModule^.builtin := TRUE;
    AddText("Storage");
    storageModule := DefineModule(NewString(),0);
    storageModule^.ignoreErrors := TRUE;
    storageModule^.builtin := TRUE;
    AddText("BITOPERATIONS");
    bitoperationsModule := DefineModule(NewString(),0);
    bitoperationsModule^.ignoreErrors := TRUE;
    bitoperationsModule^.builtin := TRUE;
end porttab.