MODULE Loader;
IMPORT SYSTEM, KernelLog, Commands, Heaps, Modules, Machine, Streams, Files;
CONST
Ok = 0;
FileNotFound = 3401;
TagInvalid = 3402;
FileCorrupt = 3403;
IncompatibleImport = 3405;
IncompatibleModuleName = 3406;
AddressSize = SYSTEM.SIZEOF (SYSTEM.ADDRESS);
MaxStructs = 1024;
FileTag = 0BBX;
NoZeroCompress = 0ADX;
FileVersion* = 0B1X;
FileVersionOC=0B2X;
CurrentFileVersion=0B4X;
EUEnd = 0; EURecord = 1; EUobjScope = 0; EUrecScope = 1; EUerrScope = -1;
EUProcFlagBit = 31;
Sentinel = LONGINT(0FFFFFFFFH);
UsesDefinitions = 31;
DefinitionModule = "Interfaces";
TYPE
ObjHeader = RECORD
entries, commands, pointers, types, modules, links, dataLinks: LONGINT;
codeSize, dataSize, refSize, constSize, exTableLen, procs, maxPtrs, crc: LONGINT;
staticTdSize: LONGINT;
name: Modules.Name
END;
DataLinkRec = RECORD
mod: LONGINT;
entry: LONGINT;
fixups: LONGINT;
ofs: POINTER TO ARRAY OF SYSTEM.SIZE
END;
LinkRec = RECORD
mod: LONGINT;
entry: LONGINT;
link: SYSTEM.SIZE
END;
TypeRec = RECORD
init: BOOLEAN;
entry, methods, inhMethods, baseMod: LONGINT;
baseEntry: SYSTEM.ADDRESS;
END;
VAR
trace: BOOLEAN;
PROCEDURE ReadHeader(r: Streams.Reader; VAR h: ObjHeader; VAR res: LONGINT; VAR msg: ARRAY OF CHAR);
VAR symSize: LONGINT; flags: SET; ignore: Modules.Module; tag: CHAR;
BEGIN
r.Char(tag);
IF tag = FileTag THEN
r.Char(tag);
IF tag = NoZeroCompress THEN r.Char(tag) END;
IF (tag = FileVersion) OR (tag >= FileVersionOC) & (tag <= CurrentFileVersion) THEN
IF tag = FileVersion THEN
r.RawNum(symSize);
ELSIF tag >= FileVersionOC THEN
r.RawLInt(symSize)
END;
flags := {};
r.SkipBytes(symSize);
r.RawLInt(h.refSize);
r.RawLInt(h.entries);
r.RawLInt(h.commands);
r.RawLInt(h.pointers);
r.RawLInt(h.types);
r.RawLInt(h.modules);
r.RawLInt(h.dataLinks);
r.RawLInt(h.links);
r.RawLInt(h.dataSize);
r.RawLInt(h.constSize);
r.RawLInt(h.codeSize);
r.RawLInt(h.exTableLen);
r.RawLInt(h.procs);
r.RawLInt(h.maxPtrs);
r.RawLInt(h.staticTdSize);
IF ORD(tag) >= 0B4H THEN r.RawLInt(h.crc) END;
r.RawString(h.name);
IF trace THEN
KernelLog.String(" name: "); KernelLog.String(h.name);
KernelLog.String(" symSize: "); KernelLog.Int(symSize, 1);
KernelLog.String(" refSize: "); KernelLog.Int(h.refSize, 1); KernelLog.Ln;
KernelLog.String(" entries: "); KernelLog.Int(h.entries, 1);
KernelLog.String(" commands: "); KernelLog.Int(h.commands, 1);
KernelLog.String(" pointers: "); KernelLog.Int(h.pointers, 1);
KernelLog.String(" types: "); KernelLog.Int(h.types, 1);
KernelLog.String(" modules: "); KernelLog.Int(h.modules, 1); KernelLog.Ln;
KernelLog.String(" dataLinks: "); KernelLog.Int(h.dataLinks, 1);
KernelLog.String(" links: "); KernelLog.Int(h.links, 1);
KernelLog.String(" dataSize: "); KernelLog.Int(h.dataSize, 1);
KernelLog.String(" constSize: "); KernelLog.Int(h.constSize, 1);
KernelLog.String(" codeSize: "); KernelLog.Int(h.codeSize, 1); KernelLog.Ln;
KernelLog.String(" exTableLen: "); KernelLog.Int(h.exTableLen, 1);
KernelLog.String(" procs: "); KernelLog.Int(h.procs, 1);
KernelLog.String(" maxPtrs: "); KernelLog.Int(h.maxPtrs, 1);
KernelLog.String(" staticTdSize: "); KernelLog.Int(h.staticTdSize, 1); KernelLog.Ln
END;
IF r.res # Streams.Ok THEN res := r.res END
ELSE
res := TagInvalid
END
ELSE
res := TagInvalid
END
END ReadHeader;
PROCEDURE ReadString8(r: Streams.Reader; VAR str: ARRAY OF CHAR);
VAR i: LONGINT; ch: CHAR;
BEGIN
i := 0;
r.Char(ch);
WHILE ch # 0X DO
str[i] := ch; INC(i);
r.Char(ch);
END;
str[i] := 0X;
END ReadString8;
PROCEDURE AllocateModule(m: Modules.Module; h: ObjHeader);
VAR dataSize: SYSTEM.SIZE;
BEGIN
dataSize := SYSTEM.VAL(SYSTEM.SIZE, h.dataSize) + (-h.dataSize) MOD 8;
NEW(m.entry, h.entries);
NEW(m.command, h.commands);
NEW(m.ptrAdr, h.pointers);
NEW(m.typeInfo, h.types);
NEW(m.module, h.modules);
NEW(m.data, dataSize + h.constSize);
NEW(m.code, h.codeSize);
NEW(m.staticTypeDescs, h.staticTdSize);
NEW(m.refs, h.refSize);
NEW(m.exTable, h.exTableLen);
m.sb := SYSTEM.ADR(m.data[0]) + dataSize;
END AllocateModule;
PROCEDURE ReadEntryBlock(r: Streams.Reader; m: Modules.Module): BOOLEAN;
VAR tag: CHAR; i, num: LONGINT;
BEGIN
r.Char(tag);
IF tag = 82X THEN
FOR i := 0 TO LEN(m.entry)-1 DO
r.RawNum(num);
m.entry[i] := num + SYSTEM.ADR(m.code[0])
END;
RETURN TRUE
ELSE
RETURN FALSE
END
END ReadEntryBlock;
PROCEDURE ReadCommandBlock(r: Streams.Reader; m: Modules.Module): BOOLEAN;
VAR tag : CHAR; i, adr : LONGINT;
BEGIN
r.Char(tag);
IF tag = 83X THEN
FOR i := 0 TO LEN(m.command)-1 DO
r.RawNum(adr); m.command[i].argTdAdr := adr;
r.RawNum(adr); m.command[i].retTdAdr := adr;
r.RawString(m.command[i].name);
r.RawNum(adr); m.command[i].entryAdr := adr;
END;
RETURN TRUE
ELSE
RETURN FALSE
END;
END ReadCommandBlock;
PROCEDURE ReadPointerBlock(r: Streams.Reader; m: Modules.Module): BOOLEAN;
VAR tag: CHAR; i, num: LONGINT;
BEGIN
r.Char(tag);
IF tag = 84X THEN
FOR i := 0 TO LEN(m.ptrAdr)-1 DO
r.RawNum(num);
ASSERT(num MOD AddressSize = 0);
m.ptrAdr[i] := m.sb + num
END;
RETURN TRUE
ELSE
RETURN FALSE
END
END ReadPointerBlock;
PROCEDURE ReadImportBlock(r: Streams.Reader; m: Modules.Module; VAR res: LONGINT;
VAR msg: ARRAY OF CHAR): BOOLEAN;
VAR tag: CHAR; i: LONGINT; name: Modules.Name;
BEGIN
r.Char(tag);
IF tag = 85X THEN
i := 0;
WHILE (i # LEN(m.module)) & (res = Ok) DO
ReadString8(r, name);
m.module[i] := Modules.ThisModule(name, res, msg);
INC(i)
END
ELSE
res := FileCorrupt
END;
RETURN res = Ok
END ReadImportBlock;
PROCEDURE ReadDataLinkBlock(r: Streams.Reader; dataLinks: LONGINT; VAR d: ARRAY OF DataLinkRec): BOOLEAN;
VAR tag: CHAR; i, j, num: LONGINT;
BEGIN
r.Char(tag);
IF tag = 8DX THEN
FOR i := 0 TO dataLinks-1 DO
r.Char(tag); d[i].mod := ORD(tag);
r.RawNum(num); d[i].entry := num;
r.RawLInt(num); d[i].fixups := num;
IF d[i].fixups > 0 THEN
NEW(d[i].ofs, d[i].fixups);
FOR j := 0 TO d[i].fixups-1 DO
r.RawNum(num); d[i].ofs[j] := num
END
ELSE
d[i].ofs := NIL
END
END;
RETURN TRUE
ELSE
RETURN FALSE
END
END ReadDataLinkBlock;
PROCEDURE ReadLinkBlock(r: Streams.Reader; links, entries: LONGINT; VAR l: ARRAY OF LinkRec; VAR f: ARRAY OF LONGINT; VAR caseTableSize: LONGINT): BOOLEAN;
VAR tag: CHAR; i, num: LONGINT;
BEGIN
r.Char(tag);
IF tag = 86X THEN
FOR i := 0 TO links-1 DO
r.Char(tag); l[i].mod := ORD(tag);
r.Char(tag); l[i].entry := ORD(tag);
r.RawNum(num); l[i].link := num
END;
FOR i := 0 TO entries-1 DO
r.RawNum(num); f[i] := num;
END;
r.RawNum(caseTableSize);
RETURN TRUE
ELSE
RETURN FALSE
END
END ReadLinkBlock;
PROCEDURE ReadConstBlock(r: Streams.Reader; m: Modules.Module; h: ObjHeader): BOOLEAN;
VAR tag: CHAR; i: LONGINT; t: SYSTEM.ADDRESS;
BEGIN
r.Char(tag);
IF tag = 87X THEN
t := m.sb;
FOR i := 0 TO h.constSize-1 DO
r.Char(tag); SYSTEM.PUT(t, tag); INC(t)
END;
SYSTEM.GET(m.sb, t); ASSERT(t = 0);
SYSTEM.PUT(m.sb, m);
RETURN TRUE
ELSE
RETURN FALSE
END
END ReadConstBlock;
PROCEDURE ReadExportBlock(r: Streams.Reader; m: Modules.Module): BOOLEAN;
TYPE ExportPtr = POINTER TO Modules.ExportDesc;
VAR tag: CHAR; structs, i: LONGINT; struct: ARRAY MaxStructs OF SYSTEM.ADDRESS;
p {UNTRACED}: ExportPtr;
PROCEDURE LoadScope(VAR scope: Modules.ExportDesc; level, adr: LONGINT);
VAR no1, no2, fp, off, num: LONGINT;
BEGIN
r.RawLInt(num); scope.exports := num;
no1 := 0; no2 := 0;
IF scope.exports # 0 THEN
NEW(scope.dsc, scope.exports);
scope.dsc[0].adr := adr
END;
IF level = EUrecScope THEN
INC(structs); struct[structs] := SYSTEM.VAL(SYSTEM.ADDRESS, SYSTEM.ADR(scope))
END;
r.RawNum(fp);
WHILE fp # EUEnd DO
IF fp = EURecord THEN
r.RawNum(off);
IF off < 0 THEN
p := SYSTEM.VAL(ExportPtr, struct[-off]);
scope.dsc[no2].exports := p.exports;
scope.dsc[no2].dsc := p.dsc
ELSE
LoadScope(scope.dsc[no2], EUrecScope, off)
END
ELSE
IF level = EUobjScope THEN r.RawNum(adr); scope.dsc[no1].adr := adr END;
scope.dsc[no1].fp := fp; no2 := no1; INC(no1)
END;
r.RawNum(fp)
END
END LoadScope;
BEGIN
r.Char(tag);
IF tag = 88X THEN
structs := 0;
FOR i := 0 TO MaxStructs - 1 DO struct[i] := Heaps.NilVal END;
LoadScope(m.export, EUobjScope, 0);
RETURN TRUE
ELSE
RETURN FALSE
END
END ReadExportBlock;
PROCEDURE ReadCodeBlock(r: Streams.Reader; m: Modules.Module): BOOLEAN;
VAR tag: CHAR; ignore: LONGINT;
BEGIN
r.Char(tag);
IF tag = 89X THEN
r.Bytes(m.code^, 0, LEN(m.code), ignore);
RETURN TRUE
ELSE
RETURN FALSE
END
END ReadCodeBlock;
PROCEDURE ReadUseBlock(r: Streams.Reader; m: Modules.Module; VAR dataLink: ARRAY OF DataLinkRec;
VAR res: LONGINT; VAR msg: ARRAY OF CHAR): BOOLEAN;
VAR tag: CHAR; i: LONGINT; name, prevname: ARRAY 256 OF CHAR;
mod: Modules.Module;
PROCEDURE Err;
BEGIN
IF res = Ok THEN
res := IncompatibleImport;
COPY(m.name, msg); Modules.Append(" incompatible with ", msg); Modules.Append(mod.name, msg);
END
END Err;
PROCEDURE FixupCall(code: SYSTEM.ADDRESS; link: SYSTEM.SIZE; fixval: SYSTEM.ADDRESS);
VAR nextlink: SYSTEM.SIZE; opcode: CHAR;
BEGIN
REPEAT
ASSERT((link >= 0) & (link < LEN(m.code)));
SYSTEM.GET(code + link, nextlink);
SYSTEM.GET(code + link - 1, opcode);
IF opcode = 0E8X THEN
SYSTEM.PUT(code + link, fixval - (code + link + 4))
ELSE
SYSTEM.PUT(code + link, fixval)
END;
link := nextlink
UNTIL link = Sentinel
END FixupCall;
PROCEDURE FixupVar(code: SYSTEM.ADDRESS; link: SYSTEM.SIZE; fixval: SYSTEM.ADDRESS);
VAR i: LONGINT; val, adr: SYSTEM.ADDRESS;
BEGIN
ASSERT(dataLink[link].mod # 0);
FOR i := 0 TO dataLink[link].fixups-1 DO
adr := code + dataLink[link].ofs[i];
SYSTEM.GET(adr, val);
SYSTEM.PUT(adr, val + fixval)
END
END FixupVar;
PROCEDURE CheckScope(scope: Modules.ExportDesc; level: LONGINT);
VAR fp, i, link: LONGINT; adr: SYSTEM.SIZE; tdadr: SYSTEM.ADDRESS; tmpErr: BOOLEAN;
BEGIN
tmpErr := (level = EUerrScope);
i := 0; link := 0;
r.RawNum(fp);
WHILE fp # EUEnd DO
IF fp = EURecord THEN
r.RawNum(link);
IF tmpErr THEN
CheckScope(scope.dsc[i], EUerrScope)
ELSE
IF scope.dsc[i].dsc # NIL THEN
IF link # 0 THEN
adr := scope.dsc[i].dsc[0].adr;
SYSTEM.GET(mod.sb + adr, tdadr);
SYSTEM.PUT(m.sb-link, tdadr)
END
END;
CheckScope(scope.dsc[i], EUrecScope)
END
ELSE
prevname := name; ReadString8(r, name);
IF level >= EUobjScope THEN
tmpErr := FALSE;
IF level = EUobjScope THEN r.RawNum(link) END;
i := 0; WHILE (i < scope.exports) & (scope.dsc[i].fp # fp) DO INC(i) END;
IF i >= scope.exports THEN
Err; tmpErr := TRUE; Modules.Append("/", msg);
IF name = "@" THEN Modules.Append("@/",msg); Modules.Append(prevname, msg)
ELSE Modules.Append(name, msg)
END;
DEC(i)
ELSIF (level = EUobjScope) & (link # 0) THEN
IF ~(EUProcFlagBit IN SYSTEM.VAL(SET, link)) THEN
FixupVar(SYSTEM.ADR(m.code[0]), link, mod.sb + scope.dsc[i].adr)
ELSE
FixupCall(SYSTEM.ADR(m.code[0]), SYSTEM.VAL(SYSTEM.SIZE, SYSTEM.VAL(SET, link) - {EUProcFlagBit}),
scope.dsc[i].adr + SYSTEM.ADR(mod.code[0]))
END
END
END
END;
r.RawNum(fp)
END
END CheckScope;
BEGIN
r.Char(tag);
IF tag = 8AX THEN
i := 0;
ReadString8(r, name);
WHILE (name # "") & (res = Ok) DO
mod := Modules.ThisModule(name, res, msg);
IF res = Ok THEN
CheckScope(mod.export, EUobjScope)
END;
ReadString8(r, name)
END
ELSE
res := FileCorrupt
END;
RETURN res = Ok
END ReadUseBlock;
PROCEDURE ReadTypeBlock(r: Streams.Reader; m: Modules.Module; VAR type: ARRAY OF TypeRec): BOOLEAN;
VAR
tag: CHAR; i, j, newMethods, pointers, method, entry, num: LONGINT;
tdSize: LONGINT;
recSize, ofs, totTdSize : SYSTEM.SIZE; base: SYSTEM.ADDRESS;
name: Modules.Name; flags: SET;
startAddr, tdAdr: SYSTEM.ADDRESS;
staticTypeBlock {UNTRACED}: Heaps.StaticTypeBlock;
BEGIN
r.Char(tag);
IF tag = 8BX THEN
totTdSize := 0;
IF LEN(m.staticTypeDescs) > 0 THEN
startAddr := SYSTEM.ADR(m.staticTypeDescs[0]);
END;
FOR i := 0 TO LEN(type)-1 DO
type[i].init := FALSE;
r.RawNum(num); recSize := num;
r.RawNum(num); type[i].entry := num;
r.RawNum(num); type[i].baseMod := num;
r.RawNum(num); type[i].baseEntry := num;
r.RawNum(num); type[i].methods := ABS (num);
IF num >= 0 THEN flags := {}
ELSE flags := {Heaps.ProtTypeBit}
END;
r.RawNum(num); type[i].inhMethods := num;
r.RawNum(newMethods);
r.RawLInt(pointers);
r.RawString(name);
r.RawLInt(tdSize);
NEW(m.typeInfo[i]);
Heaps.FillStaticType(tdAdr, startAddr, SYSTEM.VAL(SYSTEM.ADDRESS, m.typeInfo[i]), tdSize, recSize, pointers,
Modules.MaxTags + type[i].methods);
m.typeInfo[i].tag := tdAdr;
m.typeInfo[i].flags := flags;
m.typeInfo[i].mod := m;
m.typeInfo[i].name := name;
base := m.typeInfo[i].tag + Modules.Mth0Ofs;
FOR j := 0 TO newMethods - 1 DO
r.RawNum(method);
r.RawNum(entry);
SYSTEM.PUT(base - AddressSize*method, m.entry[entry]);
END;
staticTypeBlock := SYSTEM.VAL(Heaps.StaticTypeBlock, tdAdr);
ASSERT(LEN(staticTypeBlock.pointerOffsets) = pointers);
FOR j := 0 TO pointers - 1 DO
r.RawNum(num); ofs := num;
ASSERT(ofs MOD AddressSize = 0);
staticTypeBlock.pointerOffsets[j] := ofs;
ASSERT(SYSTEM.ADR(staticTypeBlock.pointerOffsets[j]) < startAddr + tdSize)
END;
ASSERT(m.typeInfo[i].tag # 0);
ASSERT( (SYSTEM.ADR(m.data[0]) <= m.sb + type[i].entry) ,1001);
ASSERT( (m.sb + type[i].entry+4 <= SYSTEM.ADR(m.data[LEN(m.data)-1])+1) ,1002 );
SYSTEM.PUT(m.sb + type[i].entry, m.typeInfo[i].tag);
startAddr := startAddr + tdSize;
totTdSize := totTdSize + tdSize;
END;
ASSERT(totTdSize = LEN(m.staticTypeDescs));;
RETURN TRUE
ELSE
RETURN FALSE
END
END ReadTypeBlock;
PROCEDURE ReadRefBlock(r: Streams.Reader; m: Modules.Module): BOOLEAN;
VAR tag: CHAR; ignore: LONGINT;
BEGIN
r.Char(tag);
IF tag = 8CX THEN
r.Bytes(m.refs^, 0, LEN(m.refs), ignore);
RETURN TRUE
ELSE
RETURN FALSE
END
END ReadRefBlock;
PROCEDURE FixupGlobals(m: Modules.Module; VAR dataLink: ARRAY OF DataLinkRec);
VAR i: LONGINT; t: SYSTEM.SIZE; adr: SYSTEM.ADDRESS;
BEGIN
IF dataLink[0].mod = 0 THEN
FOR i := 0 TO dataLink[0].fixups-1 DO
adr := SYSTEM.ADR(m.code[0]) + dataLink[0].ofs[i];
SYSTEM.GET(adr, t); SYSTEM.PUT(adr, t + m.sb)
END
END
END FixupGlobals;
PROCEDURE FixupLinks(m: Modules.Module; VAR link: ARRAY OF LinkRec; VAR fixupCounts: ARRAY OF LONGINT; caseTableSize: LONGINT; VAR res: LONGINT);
VAR i: LONGINT;
PROCEDURE FixRelative(ofs: SYSTEM.SIZE; val: SYSTEM.ADDRESS);
VAR t: SYSTEM.SIZE; adr: SYSTEM.ADDRESS;
BEGIN
ASSERT(val # 0);
WHILE ofs # Sentinel DO
adr := SYSTEM.ADR(m.code[0])+ofs;
SYSTEM.GET(adr, t);
SYSTEM.PUT(adr, val - (adr+4));
ofs := t
END
END FixRelative;
PROCEDURE FixEntry(ofs: SYSTEM.SIZE; VAR fixupCounts: ARRAY OF LONGINT);
VAR t: SYSTEM.SIZE; adr: SYSTEM.ADDRESS; i: LONGINT;
BEGIN
i := 0;
WHILE ofs # Sentinel DO
adr := SYSTEM.ADR(m.code[0])+ofs;
SYSTEM.GET(adr, t);
WHILE fixupCounts[i] = 0 DO INC(i) END;
SYSTEM.PUT(adr, m.entry[i]);
DEC(fixupCounts[i]);
ofs := t
END
END FixEntry;
PROCEDURE FixCase(ofs: SYSTEM.SIZE; caseTableSize: LONGINT);
VAR i: LONGINT; t: SYSTEM.SIZE; adr: SYSTEM.ADDRESS;
BEGIN
i := caseTableSize;
WHILE i > 0 DO
adr := m.sb+ofs;
SYSTEM.GET(adr, t);
SYSTEM.PUT(adr, SYSTEM.ADR(m.code[0]) + t);
DEC(i); INC (ofs, AddressSize);
END
END FixCase;
BEGIN
FOR i := 0 TO LEN(link)-1 DO
ASSERT(link[i].mod = 0);
CASE link[i].entry OF
243..253: HALT(100);
|254: FixEntry(link[i].link, fixupCounts)
|255: FixCase(link[i].link, caseTableSize)
ELSE res := 3406; RETURN
END
END
END FixupLinks;
PROCEDURE FixupCommands(m : Modules.Module);
VAR i : LONGINT;
BEGIN
FOR i := 0 TO LEN(m.command)-1 DO
m.command[i].entryAdr := m.command[i].entryAdr + SYSTEM.ADR(m.code[0]);
IF (m.command[i].argTdAdr > 1) THEN
SYSTEM.GET(m.sb + m.command[i].argTdAdr, m.command[i].argTdAdr);
END;
IF (m.command[i].retTdAdr > 1) THEN
SYSTEM.GET(m.sb + m.command[i].retTdAdr, m.command[i].retTdAdr);
END;
END;
END FixupCommands;
PROCEDURE InitType(m: Modules.Module; VAR type: ARRAY OF TypeRec; i: LONGINT);
VAR j, baseMod, extLevel: LONGINT; t: SYSTEM.ADDRESS; root, baseTag, baseMth, baseRoot: SYSTEM.ADDRESS; baseM: Modules.Module;
BEGIN
IF ~type[i].init THEN
root := m.typeInfo[i].tag;
baseTag := root + Modules.Tag0Ofs;
baseMth := root + Modules.Mth0Ofs;
baseMod := type[i].baseMod; extLevel := 0;
ASSERT(baseMod >= -1);
IF baseMod # -1 THEN
IF baseMod = 0 THEN
j := 0; WHILE type[j].entry # type[i].baseEntry DO INC(j) END;
InitType(m, type, j);
baseM := m
ELSE
baseM := m.module[baseMod-1];
t := type[i].baseEntry;
j := 0; WHILE baseM.export.dsc[j].fp # t DO INC(j) END;
type[i].baseEntry := baseM.export.dsc[j].dsc[0].adr
END;
SYSTEM.GET(baseM.sb + type[i].baseEntry, baseRoot);
SYSTEM.GET(baseRoot + Modules.Tag0Ofs, t);
WHILE t # 0 DO
SYSTEM.PUT(baseTag - AddressSize * extLevel, t);
INC(extLevel);
SYSTEM.GET(baseRoot + Modules.Tag0Ofs - AddressSize * extLevel, t)
END;
FOR j := 0 TO type[i].inhMethods-1 DO
SYSTEM.GET(baseMth - AddressSize * j, t);
IF t = 0 THEN
SYSTEM.GET(baseRoot + Modules.Mth0Ofs - AddressSize*j, t);
SYSTEM.PUT(baseMth - AddressSize * j, t)
END;
END
END;
m.typeInfo[i].flags := m.typeInfo[i].flags + SYSTEM.VAL(SET, extLevel);
ASSERT(extLevel < Modules.MaxTags);
SYSTEM.PUT(baseTag - AddressSize * extLevel, m.typeInfo[i].tag);
type[i].init := TRUE
END
END InitType;
PROCEDURE ReadExTableBlock(r: Streams.Reader; m: Modules.Module): BOOLEAN;
VAR
tag: CHAR;
pcFrom, pcTo, pcHandler, i: LONGINT;
PROCEDURE SelectionSort(exTable: Modules.ExceptionTable);
VAR
p, q, min: LONGINT;
entry: Modules.ExceptionTableEntry;
BEGIN
FOR p := 0 TO LEN(exTable) - 2 DO
min := p;
FOR q := p + 1 TO LEN(exTable) - 1 DO
IF exTable[min].pcFrom > exTable[q].pcFrom THEN min := q END;
entry := exTable[min]; exTable[min] := exTable[p]; exTable[p] := entry;
END
END
END SelectionSort;
BEGIN
r.Char(tag);
IF tag = 8EX THEN
FOR i := 0 TO LEN(m.exTable) -1 DO
r.Char(tag);
IF tag = 0FEX THEN
r.RawNum(pcFrom);
r.RawNum(pcTo);
r.RawNum(pcHandler);
m.exTable[i].pcFrom := pcFrom + SYSTEM.ADR(m.code[0]);
m.exTable[i].pcTo := pcTo + SYSTEM.ADR(m.code[0]);
m.exTable[i].pcHandler := pcHandler + SYSTEM.ADR(m.code[0]);
ELSE
RETURN FALSE;
END;
END;
SelectionSort(m.exTable);
RETURN TRUE;
ELSE
RETURN FALSE;
END;
END ReadExTableBlock;
PROCEDURE ReadPtrsInProcBlock(r: Streams.Reader; m: Modules.Module): BOOLEAN;
VAR tag: CHAR; i, j, codeoffset, beginOffset, endOffset, nofptrs, p : LONGINT;
procTable: Modules.ProcTable; ptrTable: Modules.PtrTable;
PROCEDURE Max(i, j : LONGINT) : LONGINT;
BEGIN
IF i > j THEN
RETURN i
ELSE
RETURN j
END
END Max;
PROCEDURE SwapProcTableEntries(p, q : LONGINT);
VAR procentry : Modules.ProcTableEntry;
k, i, basep, baseq: LONGINT; ptr: SYSTEM.SIZE;
BEGIN
k := Max(procTable[p].noPtr, procTable[q].noPtr);
IF k > 0 THEN
basep := p * m.maxPtrs; baseq := q * m.maxPtrs;
FOR i := 0 TO k - 1 DO
ptr := ptrTable[basep + i];
ptrTable[basep + i] := ptrTable[baseq + i];
ptrTable[baseq + i] := ptr
END
END;
procentry := procTable[p];
procTable[p] := procTable[q];
procTable[q] := procentry
END SwapProcTableEntries;
PROCEDURE SortProcTable;
VAR i, j, min : LONGINT;
BEGIN
FOR i := 0 TO m.noProcs - 2 DO
min := i;
FOR j := i + 1 TO m.noProcs - 1 DO
IF procTable[j].pcFrom < procTable[min].pcFrom THEN min:= j END
END;
IF min # i THEN SwapProcTableEntries(i, min) END
END
END SortProcTable;
BEGIN
r.Char(tag);
IF tag = 8FX THEN
NEW(procTable, m.noProcs); NEW(ptrTable, m.noProcs * m.maxPtrs);
m.procTable := procTable; m.ptrTable := ptrTable;
FOR i := 0 TO m.noProcs - 1 DO
r.RawNum(codeoffset);
r.RawNum(beginOffset);
r.RawNum(endOffset);
r.RawLInt(nofptrs);
procTable[i].pcFrom := codeoffset + SYSTEM.ADR(m.code[0]);
procTable[i].pcStatementBegin := beginOffset + SYSTEM.ADR(m.code[0]);
procTable[i].pcStatementEnd := endOffset + SYSTEM.ADR(m.code[0]);
procTable[i].noPtr := nofptrs;
FOR j := 0 TO nofptrs - 1 DO
r.RawNum(p);
ptrTable[i * m.maxPtrs + j] := p
END
END;
SortProcTable();
m.firstProc := procTable[0].pcFrom;
FOR i := 0 TO m.noProcs - 2 DO
procTable[i].pcLimit := procTable[i + 1].pcFrom
END;
procTable[m.noProcs - 1].pcLimit := SYSTEM.ADR(m.code[0]) + LEN(m.code) + 1;
procTable := NIL; ptrTable := NIL;
RETURN TRUE
ELSE
RETURN FALSE
END
END ReadPtrsInProcBlock;
PROCEDURE LoadObj*(name, fileName: ARRAY OF CHAR; VAR res: LONGINT; VAR msg: ARRAY OF CHAR): Modules.Module;
VAR
f: Files.File; r: Files.Reader; h: ObjHeader; m: Modules.Module; i, caseTableSize: LONGINT;
dataLink: POINTER TO ARRAY OF DataLinkRec;
link: POINTER TO ARRAY OF LinkRec;
fixupCounts : POINTER TO ARRAY OF LONGINT;
type: POINTER TO ARRAY OF TypeRec;
BEGIN
f := Files.Old(fileName);
IF f # NIL THEN
IF trace THEN KernelLog.String("Loading "); KernelLog.String(fileName); KernelLog.Ln END;
res := Ok; msg[0] := 0X;
Files.OpenReader(r, f, 0);
ReadHeader(r, h, res, msg);
IF res = Ok THEN
IF h.name = name THEN
NEW(m);
i := 0; WHILE h.name[i] # 0X DO m.name[i] := h.name[i]; INC(i) END;
m.name[i] := 0X;
m.noProcs := h.procs;
m.maxPtrs := h.maxPtrs;
m.crc := h.crc;
AllocateModule(m,h);
IF trace THEN
KernelLog.Hex(SYSTEM.ADR(m.code[0]), 8); KernelLog.Char(" ");
KernelLog.String(m.name); KernelLog.Hex(m.sb, 9); KernelLog.Ln
END;
NEW(dataLink, h.dataLinks); NEW(link, h.links); NEW(fixupCounts, h.entries);
NEW(type, h.types);
IF ReadEntryBlock(r, m) & ReadCommandBlock(r, m) & ReadPointerBlock(r, m) &
ReadImportBlock(r, m, res, msg) & ReadDataLinkBlock(r, h.dataLinks, dataLink^) &
ReadLinkBlock(r, h.links, h.entries, link^, fixupCounts^, caseTableSize) & ReadConstBlock(r, m,h) & ReadExportBlock(r, m) &
ReadCodeBlock(r, m) & ReadUseBlock(r, m, dataLink^, res, msg) &
ReadTypeBlock(r, m, type^) & ReadExTableBlock(r, m) & ReadPtrsInProcBlock(r, m) &
ReadRefBlock(r, m) THEN
IF h.dataLinks # 0 THEN FixupGlobals(m, dataLink^) END;
IF h.links # 0 THEN FixupLinks(m, link^, fixupCounts^, caseTableSize, res) END;
IF h.commands # 0 THEN FixupCommands(m); END;
IF res = Ok THEN
FOR i := 0 TO LEN(type^)-1 DO InitType(m, type^, i) END
END
ELSE
IF res = Ok THEN res := FileCorrupt END
END;
dataLink := NIL; link := NIL; type := NIL
ELSE
res := IncompatibleModuleName; COPY(fileName, msg); Modules.Append(" incompatible module name", msg)
END;
END;
IF (res # Ok) & (msg[0] = 0X) THEN COPY(fileName, msg); Modules.Append(" corrupt", msg) END
ELSE
res := FileNotFound; COPY(fileName, msg); Modules.Append(" not found", msg)
END;
IF res # Ok THEN m := NIL END;
RETURN m
END LoadObj;
PROCEDURE Trace*(context : Commands.Context);
BEGIN
trace := ~trace;
context.out.String("Loader: trace ");
IF trace THEN context.out.String("on") ELSE context.out.String("off") END;
context.out.Ln;
END Trace;
BEGIN
trace := FALSE;
Modules.AddLoader (Machine.DefaultObjectFileExtension, LoadObj);
END Loader.
(*
11.05.98 pjm Started
*)
SystemTools.Free Loader ~