
<<MBLoader.mesa  >>
<<Edited by Sandman on 6-Aug-81 15:40:23>>
<<Edited by Lewis on 25-Sep-81 13:33:58>>
<<Edited by Levin on September 30, 1983 11:59 am>>

DIRECTORY
BcdDefs USING [
Base, BcdBase, FTIndex, FTNull, FTSelf, IMPHandle, IMPIndex, LinkFrag, MTHandle, NameRecord, NameString, ProcLimit, SGHandle, 
SGIndex, SPHandle, SPIndex],
BcdOps USING [ProcessImports, ProcessSegs, ProcessSpaces],
ConvertUnsafe USING [ToRope],
File USING [Capability],
IO USING [card, PutChar, PutF, PutRope, rope, STREAM],
MB USING [Abort, BHandle, FileItem, FileObject, Handle, MT, VirtualGlobalFrame],
MBLoaderOps USING [
AcquireBcd, EnumerateModules, FinishLoaderCore, FinishLoaderExtra, FinishLoadState, GetVirtualLinks, InitLoaderCore, 
InitLoaderExtra, InitLoadState, ModuleInfo, RealLinks, VirtualLinks],
MBVM USING [
AllocCode, Base, Code, CodeSeg, CopyRead, CopyWrite, LongCopyWrite,  LongPointerFromSeg, LongRead, LongWrite],
PrincOps USING [
ControlLink, EPIndex, GFTIndex, GFTNull, GlobalFrame, GlobalFrameHandle, NullLink, UnboundLink, wordsPerPage],
Basics USING [DIVMOD],
Rope USING [Concat, Equal, Fetch, Find, FromProc, Length, ROPE, Substr],
Segments USING [
BaseFromSegment, DeleteSegment, EnumerateDirectory, FileFromSegment, FHandle, FPFromFile, FPHandle, GetFileTimes, InsertFile, 
LockFile, NewSegment, Read, SegmentAddress, SHandle, SwapIn, Unlock, UnlockFile],
Space USING [
Create, Delete, Handle, LongPointer, Map, nullHandle, Unmap, virtualMemory],
Time USING [Packed];

MBLoader: PROGRAM
IMPORTS
Basics, BcdOps, ConvertUnsafe, IO, MB, MBLoaderOps, MBVM, Rope, Segments, Space
EXPORTS MB, MBLoaderOps =
BEGIN

data: MB.Handle _ NIL;

InitLoader: PUBLIC PROC [h: MB.Handle] = {
data _ h;
MBLoaderOps.InitLoaderCore[h];
MBLoaderOps.InitLoaderExtra[h];
MBLoaderOps.InitLoadState[h];
};

FinishLoader: PUBLIC PROC = {
MBLoaderOps.FinishLoadState[];
MBLoaderOps.FinishLoaderExtra[];
MBLoaderOps.FinishLoaderCore[];
data _ NIL;
};

<<Locate code files for bcd>>

FileNotFound: PUBLIC SIGNAL [name: Rope.ROPE] = CODE;

FindFiles: PUBLIC PROC [loadee: MB.BHandle] = {  
bcd: BcdDefs.BcdBase _ loadee.bcd;
ftb: BcdDefs.Base _ LOOPHOLE[bcd + bcd.ftOffset];
ssb: BcdDefs.NameString _ LOOPHOLE[bcd + bcd.ssOffset];
nFilesToFind: CARDINAL _ 0;
invalidFile: BOOL _ FALSE;
CheckAndAddCodeSeg: PROC [sgh: BcdDefs.SGHandle, sgi: BcdDefs.SGIndex]
RETURNS [BOOL] = {
IF sgh.class = code THEN {
f: MB.FileItem;
FOR f _ loadee.files, f.link UNTIL f = NIL DO
IF sgh.file = f.fti THEN RETURN[FALSE];
ENDLOOP;
f _ NEW[MB.FileObject _ [
link: loadee.files,
fti: sgh.file,
handle: NIL,
create: Time.Packed[0],
ext: FALSE]
];
loadee.files _ f;
SELECT sgh.file FROM
BcdDefs.FTSelf =>  f.handle _ Segments.FileFromSegment[loadee.bcdSegment];
BcdDefs.FTNull => NULL;
ENDCASE => {  -- a file name that we must look up
offset: CARDINAL = ftb[sgh.file].name;
length : CARDINAL = ssb.size[ftb[sgh.file].name];
FOR i: CARDINAL IN [offset..offset+length) DO
IF ssb.string.text[i] = '. THEN {f.ext _ TRUE;  EXIT};
ENDLOOP;    
nFilesToFind _ nFilesToFind + 1;
};
};
RETURN[FALSE]
};
LookupCodeFiles: PROC = {
Segments.EnumerateDirectory[CheckIfInList];
<<complain about code files that were not found>>
FOR f: MB.FileItem _ loadee.files, f.link UNTIL f = NIL DO
IF f.handle = NIL AND f.fti ~= BcdDefs.FTNull THEN {
i: CARDINAL _ ftb[f.fti].name;
GetFileChar: SAFE PROC RETURNS [char: CHAR] = TRUSTED {
char _ ssb.string[i]; i _ i + 1};
name: Rope.ROPE _ Rope.FromProc[len: ssb.size[ftb[f.fti].name], p: GetFileChar];
IF f.ext THEN name _ name.Concat[".bcd"];
SIGNAL FileNotFound[name];
};
ENDLOOP;
};
CheckIfInList: PROC [fp: Segments.FPHandle, name: STRING] RETURNS [stop: BOOL] = {
dirName: Rope.ROPE _ ConvertUnsafe.ToRope[name];
bcdExt: Rope.ROPE = ".bcd";
FillInFileHandle: PROC [ext: BOOL] RETURNS [found: BOOL _ FALSE] = {
FOR f: MB.FileItem _ loadee.files, f.link UNTIL f = NIL DO
SELECT f.fti FROM
BcdDefs.FTSelf => f.create _ Segments.GetFileTimes[f.handle].create;
BcdDefs.FTNull => NULL;
ENDCASE => {
i: CARDINAL _ ftb[f.fti].name;
GetFileChar: SAFE PROC RETURNS [char: CHAR] = TRUSTED {
char _ ssb.string[i]; i _ i + 1};
file: Rope.ROPE = Rope.FromProc[len: ssb.size[ftb[f.fti].name], p: GetFileChar];
nameFromDirectory: Rope.ROPE _ dirName;
IF file.Fetch[file.Length[]-1] = '. THEN
nameFromDirectory _ nameFromDirectory.Concat["."];
IF ext = f.ext AND Rope.Equal[file, nameFromDirectory, FALSE] THEN {
CheckFileVersion: PROC = {
referentBcd: BcdDefs.BcdBase;
seg: Segments.SHandle = Segments.NewSegment[f.handle, 1, 1, Segments.Read];
Segments.SwapIn[seg];
referentBcd _ Segments.SegmentAddress[seg];
IF referentBcd.version ~= ftb[f.fti].version THEN {
data.typescript.PutF[
"\N! %g has incorrect version",
IO.rope[NameToRope[ftb[f.fti].name, bcd]]];
invalidFile _ TRUE;
};
Segments.Unlock[seg];
Segments.LockFile[f.handle];
Segments.DeleteSegment[seg];
Segments.UnlockFile[f.handle];
};
f.handle _ Segments.InsertFile[fp, Segments.Read];
f.create _ Segments.GetFileTimes[f.handle].create;
CheckFileVersion[];
nFilesToFind _ nFilesToFind - 1;
RETURN[TRUE]
};
};
ENDLOOP;
};
extIndex: INT;
IF dirName.Fetch[dirName.Length[]-1] = '. THEN  -- ignore dot on end
dirName _ dirName.Substr[len: dirName.Length[] - 1];
extIndex _ dirName.Find[bcdExt, 0, FALSE];
IF extIndex ~= -1 AND extIndex = dirName.Length[] - bcdExt.Length[] THEN {
dirName _ dirName.Substr[len: extIndex];
IF FillInFileHandle[ext: FALSE] THEN RETURN[nFilesToFind = 0];
};
<<try using entire name>>
[] _ FillInFileHandle[ext: TRUE];
RETURN[nFilesToFind = 0]
};

[] _ BcdOps.ProcessSegs[bcd, CheckAndAddCodeSeg];
LookupCodeFiles[];
IF invalidFile THEN ERROR MB.Abort;
};


<<Load bcd's code segments into MBVM>>

FindCode: PUBLIC PROC [loadee: MB.BHandle] = { 
bcd: BcdDefs.BcdBase = loadee.bcd;
mt: MB.MT = loadee.mt;
invalidCode: BOOLEAN _ FALSE;
FindCodeSegment: PROC [mth: BcdDefs.MTHandle]
RETURNS [cseg: MBVM.CodeSeg] = { 
sgh: BcdDefs.SGHandle = @LOOPHOLE[bcd+bcd.sgOffset, BcdDefs.Base][mth.code.sgi];
file: Segments.FHandle;
pages: CARDINAL;
FindSpace: PROC [sph: BcdDefs.SPHandle, spi: BcdDefs.SPIndex] RETURNS [BOOLEAN] = {
RETURN[sph.seg = mth.code.sgi]};
FOR i: CARDINAL IN [1..mt.length) DO
IF mt[i].mth.code.sgi = mth.code.sgi AND (cseg _ mt[i].code) ~= NIL THEN {
cseg.shared _ TRUE;  -- code is shared and was already loaded  
RETURN[cseg]
};
ENDLOOP;
file _ HandleForFile[sgh.file];
pages _ sgh.pages + sgh.extraPages;
cseg _ MBVM.AllocCode[
file: file, base: MBVM.Code, fileBase: sgh.base, pages: pages,
sph: BcdOps.ProcessSpaces[bcd, FindSpace].sph];
cseg.segment _ Segments.NewSegment[file, sgh.base, pages, Segments.Read];
};
HandleForFile: PROC [fti: BcdDefs.FTIndex] RETURNS [file: Segments.FHandle] = {
FOR f: MB.FileItem _ loadee.files, f.link UNTIL f = NIL DO
IF f.fti = fti THEN RETURN[f.handle];
ENDLOOP;
RETURN[NIL]
};
FOR gfi: PrincOps.GFTIndex IN [1..mt.length) DO
mth: BcdDefs.MTHandle = mt[gfi].mth;
cseg: MBVM.CodeSeg;
IF mth.gfi ~= gfi THEN LOOP;
IF mth.altoCode THEN {
data.typescript.PutF[
"\N! %g is compiled for the Alto!",
IO.rope[NameToRope[mth.name, bcd]]];
invalidCode _ TRUE;
LOOP
};
cseg _ FindCodeSegment[mth];
FOR i: CARDINAL IN [gfi..gfi+mth.ngfi) DO mt[i].code _ cseg; ENDLOOP;
ENDLOOP;
IF invalidCode THEN ERROR MB.Abort;
FOR gfi: PrincOps.GFTIndex IN [1..mt.length) DO
mth: BcdDefs.MTHandle;
frame: PrincOps.GlobalFrameHandle;
gf: PrincOps.GlobalFrame;
cseg: MBVM.CodeSeg;
[mth: mth, frame: frame, code: cseg] _ mt[gfi];
IF mth.gfi ~= gfi THEN LOOP;
MBVM.CopyRead[to: @gf, from: frame, nwords: SIZE[PrincOps.GlobalFrame]];
gf.code.longbase _ MBVM.LongPointerFromSeg[cseg] + mth.code.offset;
gf.code.out _ TRUE;
gf.shared _ cseg.shared;
MBVM.CopyWrite[from: @gf, to: frame, nwords: SIZE[PrincOps.GlobalFrame]];
ENDLOOP;
};


<<Unbound import processing>>

ProcessUnboundImports: PUBLIC PROC = {
typescript: IO.STREAM = data.typescript;
loadmap: IO.STREAM = data.loadmap;
anyUnbound, anyUnboundCodeLinks: BOOL _ FALSE;
CheckIfUnresolved: PROC [rgfi: PrincOps.GFTIndex, module: MBLoaderOps.ModuleInfo]
RETURNS [BOOL] = {
IF ~module.resolved THEN {
bh: MB.BHandle = MBLoaderOps.AcquireBcd[module.config];
vgf: PrincOps.GlobalFrameHandle = MB.VirtualGlobalFrame[bh.mt[module.module].frame];
IF vgf.gfi = rgfi THEN {
codeLinks: BOOL = vgf.codelinks;
bcd: BcdDefs.BcdBase = bh.bcd;
mth: BcdDefs.MTHandle = bh.mt[module.module].mth;
vLinks: MBLoaderOps.VirtualLinks = MBLoaderOps.GetVirtualLinks[bh, mth];
first: BOOL _ TRUE;
MapDummy: PROC [gfi: PrincOps.GFTIndex, ep: PrincOps.EPIndex]
RETURNS [imp: BcdDefs.IMPHandle, offset: CARDINAL] = {
CheckImport: PROC [imph: BcdDefs.IMPHandle, impi: BcdDefs.IMPIndex]
RETURNS [BOOL] = {
IF gfi IN [imph.gfi..imph.gfi+imph.ngfi) THEN {
imp _ imph;
offset _ (gfi-imph.gfi)*BcdDefs.ProcLimit + ep;
RETURN[TRUE]
};
RETURN[FALSE]
};
[] _ BcdOps.ProcessImports[bcd, CheckImport];
};
OpenLinkSpace[bh, mth];
FOR i: CARDINAL IN [0..LENGTH[vLinks]) DO
SELECT ReadLink[i] FROM
PrincOps.NullLink, PrincOps.UnboundLink => {
<<Things are quite confusing here.  An unbound imported procedure or>>
<<variable will show up as a virtual link of type 'proc0' or 'proc1'.>>
<<An unbound imported program module will show up as a virtual link>>
<<of type 'var'.  An unbound imported type will show up as a virtual>>
<<link of type 'proc0' or 'proc1', while a bound, imported type will>>
<<have type 'type'.>>
imp: BcdDefs.IMPHandle;
offset: CARDINAL;
SELECT vLinks[i].vtag FROM
type => LOOP;
var => {
IF vLinks[i].vgfi = PrincOps.GFTNull THEN LOOP;  -- link was unbindable
[imp, offset] _ MapDummy[vLinks[i].vgfi, vLinks[i].var --should be 0--];
};
ENDCASE --proc-- => {
IF vLinks[i].gfi = PrincOps.GFTNull THEN LOOP;  -- link was unbindable
[imp, offset] _ MapDummy[vLinks[i].gfi, vLinks[i].ep];
};
IF ~anyUnbound THEN {
loadmap.PutRope["\NUnbound Imports:\N"];
typescript.PutRope["! Warning: the following modules have unbound imports:\N"];
anyUnbound _ TRUE;
};
IF first THEN {
loadmap.PutF["  %g:  ", IO.rope[NameToRope[mth.name, bcd]]];
typescript.PutF["  %g:  ", IO.rope[NameToRope[mth.name, bcd]]];
first _ FALSE;
}
ELSE {loadmap.PutChar[',]; typescript.PutChar[',]};
loadmap.PutF[
" %g[%d]",
IO.rope[NameToRope[imp.name, bcd]], IO.card[offset]
];
typescript.PutF[
" %g[%d]",
IO.rope[NameToRope[imp.name, bcd]], IO.card[offset]
];
};
ENDCASE;
ENDLOOP;
IF ~first THEN {
loadmap.PutChar['\N];
typescript.PutChar['\N];
};
CloseLinkSpace[];
};
};
RETURN[FALSE]
};
[] _ MBLoaderOps.EnumerateModules[CheckIfUnresolved];
};


<<Link management>>

linkBase: PCL;
PCL: TYPE = LONG POINTER TO PrincOps.ControlLink;

linkFile: File.Capability;
linkSpace: Space.Handle;
linkSpaceBasePage, currentPage, offsetToLinks: CARDINAL;

OpenLinkSpace: PUBLIC PROC [loadee: MB.BHandle, mth: BcdDefs.MTHandle] = {
frame: PrincOps.GlobalFrameHandle = loadee.mt[mth.gfi].frame;
nLinks: CARDINAL = LinkFragLength[loadee, mth];
IF MB.VirtualGlobalFrame[frame].codelinks THEN {
cseg: Segments.SHandle = loadee.mt[mth.gfi].code.segment;
Segments.FPFromFile[Segments.FileFromSegment[cseg], @linkFile];
offsetToLinks _ mth.code.offset - nLinks;
linkSpaceBasePage _ Segments.BaseFromSegment[cseg];
<<IF File.GetAttributes[linkFile].type ~= DCSFileTypes.tLeaderPage THEN>>
<<linkSpaceBasePage _ linkSpaceBasePage - 1;>>
linkSpace _ Space.Create[size: 1, parent: Space.virtualMemory];
linkBase _ Space.LongPointer[linkSpace];
currentPage _ LAST[CARDINAL];
}
ELSE {  -- frame links
linkSpace _ Space.nullHandle;  
linkBase _ LOOPHOLE[LONG[frame - nLinks], PCL];
};
};

CloseLinkSpace: PUBLIC PROC = {
IF linkSpace ~= Space.nullHandle THEN {
Space.Delete[linkSpace]; linkSpace _ Space.nullHandle};
};

MoveToPage: PROC [page: CARDINAL] = {
IF currentPage ~= LAST[CARDINAL] THEN Space.Unmap[linkSpace];
Space.Map[linkSpace, [linkFile, linkSpaceBasePage+page]];
currentPage _ page;
};

WriteLinks: PUBLIC PROC [
loadee: MB.BHandle, mth: BcdDefs.MTHandle, links: MBLoaderOps.RealLinks] = {
nLinks: CARDINAL = LinkFragLength[loadee, mth];
OpenLinkSpace[loadee, mth];
IF linkSpace = Space.nullHandle THEN  -- frame links at ls 
MBVM.LongCopyWrite[from: LOOPHOLE[links], to: linkBase, nwords: nLinks]
ELSE {
FOR i: CARDINAL IN [0..nLinks) DO 
WriteLink[offset: i, link: links[i]];
ENDLOOP;
CloseLinkSpace[];
};
};

WriteLink: PUBLIC PROC [offset: CARDINAL, link: PrincOps.ControlLink] = {
page: CARDINAL;
IF linkSpace = Space.nullHandle THEN {MBVM.LongWrite[linkBase+offset, link];  RETURN};
[page, offset] _ Basics.DIVMOD[offsetToLinks+offset, PrincOps.wordsPerPage];
IF page ~= currentPage THEN MoveToPage[page];
(linkBase+offset)^ _ link;
};

ReadLink: PUBLIC PROC [offset: CARDINAL] RETURNS [link: PrincOps.ControlLink] = {
page: CARDINAL;
IF linkSpace = Space.nullHandle THEN RETURN[MBVM.LongRead[linkBase+offset]];
[page, offset] _ Basics.DIVMOD[offsetToLinks+offset, PrincOps.wordsPerPage];
IF page ~= currentPage THEN MoveToPage[page];
RETURN[(linkBase+offset)^]
};

LinkFragLength: PUBLIC PROC [loadee: MB.BHandle, mth: BcdDefs.MTHandle]
RETURNS [nLinks: CARDINAL] = {
bcd: BcdDefs.BcdBase = loadee.bcd;
lfTable: BcdDefs.Base = LOOPHOLE[bcd + bcd.lfOffset];
WITH mth: mth SELECT FROM
direct => RETURN[mth.length];
indirect => RETURN[lfTable[mth.links].length];
multiple => RETURN[lfTable[mth.links].length];
ENDCASE;
};

GetVirtualLinks: PUBLIC PROC [loadee: MB.BHandle, mth: BcdDefs.MTHandle]
RETURNS [virtualLinks: MBLoaderOps.VirtualLinks] = {
bcd: BcdDefs.BcdBase = loadee.bcd;
linkFrag: LONG POINTER TO BcdDefs.LinkFrag;
lfTable: BcdDefs.Base = LOOPHOLE[bcd + bcd.lfOffset];
WITH mth: mth SELECT FROM
direct => RETURN[DESCRIPTOR[@mth.frag, mth.length]];
indirect => linkFrag _ @lfTable[mth.links];
multiple => linkFrag _ @lfTable[mth.links];
ENDCASE;
RETURN[DESCRIPTOR[linkFrag.frag]]
};

<<Utilities>>

NameToRope: PROC [name: BcdDefs.NameRecord, bcd: BcdDefs.BcdBase]
RETURNS [Rope.ROPE] = {
ssb: BcdDefs.NameString = LOOPHOLE[bcd + bcd.ssOffset];
i: CARDINAL _ name;
Proc: SAFE PROC RETURNS [char: CHAR] = TRUSTED {char _ ssb.string[i]; i _ i + 1};
RETURN[Rope.FromProc[len: ssb.size[name], p: Proc]]
};

END.