imc.mod

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

procedure GetModule() : String;
begin
    if not (currChar in CharSet{'a'..'z','A'..'Z'}) then
	DataError('Identifier expected');
	return nil;
    end;
    while currChar in CharSet{'a'..'z','A'..'Z','0'..'9'} do
	AddChar(currChar);
	NextChar;
    end;
    return NewString();
end GetModule;

procedure GetValue() : String;
begin
    while currChar # ';' do
	AddChar(currChar);
	NextChar;
    end;
    return NewString();
end GetValue;

(* InitChar: Initialize NextChar routine *)
procedure InitChar(entry : CharPtr);
begin
    currEntry := entry;
    currCharIndex := 0;
    currChar := currEntry^[currCharIndex];
end InitChar;

(* ProcessLocalEntry: Process the next local entry *)
procedure ProcessLocalEntry();
var
    number : integer;
    tn : TypeNode;
    num : Number;
    entry : CharPtr;
begin
    entry := CharPtr(stringTab+symTab^[symTabIndex].name-4);
    inc(symTabIndex);
    InitChar(entry);
    if echoFlag then
	writef(output,"l %s\n",entry^);
    end;
    while currChar # ':' do
	if currChar = 0C then
	    return;
	end;
	NextChar;
    end;
    NextChar;
    if currChar # 't' then
	return;
    end;
    NextChar;
    number := GetNumber();
    if (number <= MAXBUILTINTYPES) or (currChar # '=') then
	return;
    end;
    NextChar;
    num := DefineTypeNumber(number);
end ProcessLocalEntry;

(* ProcessExportEntry: Process the next export entry *)
procedure ProcessExportEntry() : boolean;
var
    name, modname : String;
    unqual, imported, extern : boolean;
    pn : PortNode;
    tn : TypeNode;
    entryType : char;
    mn : ModuleNode;
    entry : CharPtr;
begin
    entry := CharPtr(stringTab+symTab^[symTabIndex].name-4);
    inc(symTabIndex);
    InitChar(entry);
    if echoFlag then
	writef(output,"X %s\n",entry^);
    end;
    modname := GetModule();
    if currChar = '_' then
	NextChar;
	name := GetString();
    else
	name := nil;
    end;
    SkipOver(':');
    SkipOver('X');
    unqual := currChar = '0';
    NextChar;
    imported := currChar = '0';
    NextChar;
    extern := currChar = '0';
    NextChar;
    entryType := currChar;
    NextChar;
    case entryType of
    | 'v','p','f','t','c':
	new(pn);
	case entryType of
	| 'v':
	    pn^.kind := SYMVAR;
	    pn^.symVar := GetType();
	| 'p':
	    pn^.kind := SYMPROC;
	    pn^.symProc := BuildProc(nil);
	| 'f':
	    pn^.kind := SYMPROC;
	    tn := GetType();
	    SkipOver(',');
	    pn^.symProc := BuildProc(tn);
	| 't':
	    pn^.kind := SYMTYPE;
	    pn^.symType := GetType();
	| 'c':
	    pn^.kind := SYMCONST;
	    SkipOver('=');
	    pn^.symConst := BuildConst();
	end;
	DefinePort(modname,name,pn,imported,unqual,extern,currModule);
    | 'm':
	(* new module *)
	if inArchive then
	    mn := DefineModule(modname,0);
	else
	    mn := DefineModule(modname,fileListIndex);
	end;
	if mn^.defined then
	    writef(output,"Duplicate module %s(",fileName);
	    WriteString(output,modname);
	    writef(output,") ignored\n");
	    return(false);
	end;
	mn^.defined := true;
	currScope := mn^.scope;
	if logErrorsFlag then
	    writef(output,"Module ");
	    WriteString(output,modname);
	    writef(output,'\n');
	end;
	if inArchive then
	    mn^.watchErrors := TRUE;
	end;
	mn^.named := not inArchive;
	currModule := mn;
    | 'z':
	currModule := nil;
	(* end of external information *)
	return(false);
    else
	swritef(errorMsg,'Unknown symbol type %c',currChar);
	DataError(errorMsg);
    end;
    return(true);
end ProcessExportEntry;

type
    NameListRec = record
	name : cardinal;
	flags : cardinal;
	value : cardinal;
    end;
var
    stringTab : address;
    symTab : pointer to array [1..MAXINT] of NameListRec;
    symTabIndex : integer;

(* ProcessFile:  Process the file at the current seek position *)
procedure ProcessFile(obj : integer; header : ObjectHeader);
var
    readLen : integer;
    stringTabSize, stringTabOffset : cardinal;
    numSymbols, symTabOffset : integer;
    ignore : integer;
begin
    if header.magic # OBJECTMAGICNUMBER then
	return;
    end;
    (* read in symbol table *)
    numSymbols := header.symSize div (tsize(NameListRec) div BYTESIZE);
    if numSymbols <= 0 then
	Panic(fileName,"bad object file");
    end;
    symTabOffset := header.textSize+header.dataSize +
		header.textRelocSize + header.dataRelocSize;
    ignore := unix.lseek(obj,symTabOffset,1);
    Allocate(symTab,header.symSize*BYTESIZE);
    readLen := unix.read(obj,symTab^,header.symSize);

    (* get size of string table *)
    readLen := unix.read(obj,stringTabSize,BYTESPERWORD);
    stringTabSize := stringTabSize - BYTESPERWORD;
    if stringTabSize <= 0 then
	Panic(fileName,"bad object file");
    end;

    (* read in string table *)
    Allocate(stringTab,stringTabSize*BYTESIZE);
    readLen := unix.read(obj,stringTab^,stringTabSize);

    symTabIndex := 1;
    loop
	if symTabIndex > numSymbols then
	    exit;
	end;
	if symTab^[symTabIndex].flags mod 256 = EXPORTSYMBOL then
	    if not ProcessExportEntry() then
		exit;
	    end;
	elsif (currModule # nil) and
		(symTab^[symTabIndex].flags mod 256 = LOCALSYMBOL)
	then
	    ProcessLocalEntry();
	else
	    inc(symTabIndex);
	end;
    end;

    Deallocate(stringTab,stringTabSize*BYTESIZE);
    Deallocate(symTab,header.symSize*BYTESIZE);
end ProcessFile;

procedure ProcessArchive(obj : integer);
var
    arOffset, moduleSize : cardinal;
    dir : array [1..ARCHIVEDIRECTORYSIZE] of char;
    readLen : integer;
    header : ObjectHeader;
begin
    inArchive := TRUE;
    (* start after magic string *)
    arOffset := ARCHIVEMAGICSTRINGSIZE;
    loop
	(* position to next module *)
	ignore := unix.lseek(obj,arOffset,0);

	(* get directory entry *)
	readLen := unix.read(obj,dir,ARCHIVEDIRECTORYSIZE);
	if readLen # ARCHIVEDIRECTORYSIZE then
	    exit;
	end;
	readLen := sreadf(dir,"%s %*d %*d %*d %*d %d",moduleName,moduleSize);

	(* read in object file header *)
	readLen := unix.read(obj,header,OBJECTHEADERSIZE);
	if readLen # OBJECTHEADERSIZE then
	    exit;
	end;

	ProcessFile(obj,header);

	arOffset := (arOffset + ARCHIVEDIRECTORYSIZE + moduleSize+1) div 2 * 2;
    end;
    inArchive := FALSE;
end ProcessArchive;

var
    fileName, arg : ArgString;
    i, j, readLen, fileNameLength, ignore : integer;
    objFile : integer;
    header : ObjectHeader;
    mn : ModuleNode;
begin
    currModule := nil;
    dataErrorCount := 0;
    fileListIndex := 0;
    echoFlag := FALSE;
    traceNumtab := FALSE;
    traceSymtab := FALSE;
    tracePorttab := FALSE;
    autoMakeFlag := FALSE;
    logErrorsFlag := FALSE;
    libraryCheckFlag := FALSE;
    makeFlags := "";
    inArchive := FALSE;
    if NumParameters <= 1 then
	Panic("usage","mod2.2 files.o");
    end;
    if NumParameters > MAXARGS div 2 then
	Panic("usage","Cannot handle that many files");
    end;
    for i := 1 to NumParameters do
	if cardinal(i) = NumParameters then
	    Assign(fileName,LIBFILENAME);
	else
	    GetParameter(i,fileName,fileNameLength);
	end;
	if fileName[0] = '-' then
	    case fileName[1] of
	    | 'e':
		echoFlag := TRUE;
	    | 'v':
		logErrorsFlag := TRUE;
	    | 'm':
		autoMakeFlag := TRUE;
		Assign(makeFlags,fileName);
	    | 'L':
		libraryCheckFlag := TRUE;
	    | 'W':
		WatchModule(fileName);
	    | 'N':
		IgnoreModule(fileName);
	    | 'T':
		if Compare(fileName,'=',"-Tnumtab") then
		    traceNumtab := TRUE;
		elsif Compare(fileName,'=',"-Tsymtab") then
		    traceSymtab := TRUE;
		elsif Compare(fileName,'=',"-Tporttab") then
		    tracePorttab := TRUE;
		end;
	    | 'l':
		SaveArg(fileName);
		(* get end of library name *)
		j := 2;
		while fileName[j] # 0C do
		    arg[j-2] := fileName[j];
		    inc(j);
		end;
		arg[j-2] := 0C;
		Assign(fileName,"/lib/lib");
		Append(fileName,arg);
		Append(fileName,".a");
		objFile := unix.open(fileName,0);
		if objFile >= 0 then
		    if echoFlag then
			writef(output,"File %s\n",fileName);
		    end;
		    ProcessArchive(objFile);
		    ignore := unix.close(objFile);
		else
		    Assign(fileName,"/usr/lib/lib");
		    Append(fileName,arg);
		    Append(fileName,".a");
		    objFile := unix.open(fileName,0);
		    if objFile >= 0 then
			ProcessArchive(objFile);
			ignore := unix.close(objFile);
		    else
			Assign(fileName,"/usr/local/lib/lib");
			Append(fileName,arg);
			Append(fileName,".a");
			objFile := unix.open(fileName,0);
			if objFile >= 0 then
			    ProcessArchive(objFile);
			    ignore := unix.close(objFile);
			else
			    Panic(arg,"Cannot open library file");
			end;
		    end;
		end;
	    else
		Panic("Unknown option",fileName);
	    end;
	else
	    if cardinal(i) # NumParameters then
		SaveArg(fileName);
	    end;
	    objFile := unix.open(fileName,0);
	    if objFile < 0 then
		Panic(fileName,"Cannot open file");
	    else
		if echoFlag then
		    writef(output,"File %s\n",fileName);
		end;
		readLen := unix.read(objFile,header,OBJECTHEADERSIZE);
		if readLen # OBJECTHEADERSIZE then
		    Panic(fileName,"Error reading file header");
		end;
		if Compare(header.armagic,'=',ARCHIVEMAGICSTRING) then
		    ProcessArchive(objFile);
		elsif header.magic = OBJECTMAGICNUMBER then
		    ProcessFile(objFile, header);
		else
		    Panic(fileName,"Not an object file or library");
		end;
		ignore := unix.close(objFile);
	    end;
	end;
    end;
    CheckExports();
    if (errorCount > 0) and autoMakeFlag and not fatalErrorFlag then
	AddArg("mod");
	AddArg("-c");
	AddArg(makeFlags);
	if libraryCheckFlag then
	    AddArg("-L");
	end;
	if logErrorsFlag then
	    AddArg("-v");
	end;
	i := 2;	(* skip -m *)
	while makeFlags[i] # 0C do
	    j := 0;
	    while (makeFlags[i] # ',') and (makeFlags[i] # ' ') and
		    (makeFlags[i] # 0C)
	    do
		fileName[j] := makeFlags[i];
		inc(i);
		inc(j);
	    end;
	    fileName[j] := 0C;
	    AddArg(fileName);
	    if makeFlags[i] # 0C then
		inc(i);
	    end;
	end;
	executeFlag := FALSE;
	mn := moduleList^.first;
	loop
	    if mn = nil then
		exit;
	    end;
	    if mn^.outOfDate then
		if mn^.named and (mn^.fileName # 0) then
		    CopyString(mn^.name,fileName);
		    Assign(arg,"-W");
		    Append(arg,fileName);
		    AddArg(arg);
		    CopyString(fileList[mn^.fileName],fileName);
		    i := 0;
		    while fileName[i] # 0C do
			inc(i);
		    end;
		    if (fileName[i-2] = '.') and (fileName[i-1] = 'o') then
			fileName[i-1] := 0C;
			Append(fileName,"mod");
			AddArg(fileName);
			fileList[mn^.fileName] := nil;
		    else
			fatalErrorFlag := TRUE;
			writef(output,"Cannot determine source file from %s\n",
				fileName);
		    end;
		    executeFlag := TRUE;
		else
		    fatalErrorFlag := TRUE;
		    writef(output,"Cannot find file for module %s\n",fileName);
		end;
	    elsif not mn^.builtin and mn^.ignoreErrors then
		CopyString(mn^.name,fileName);
		Assign(arg,"-N");
		Append(arg,fileName);
		AddArg(arg);
	    end;
	    mn := mn^.next;
	end;
	if executeFlag then
	    for i := 1 to fileListIndex do
		if fileList[i] # nil then
		    AddString(fileList[i]);
		end;
	    end;
	    Execute("mod");
	end;
    end;
    if errorCount > 100 then
	errorCount := 101;
    end;
    unix.uexit(errorCount);
end imc.