-- AltoLoader.mesa Modified by Sandman, August 1, 1980 10:21 AM
-- Copyright Xerox Corporation 1979, 1980
DIRECTORY
AltoFileDefs USING [FP],
BcdDefs USING [FTIndex, FTNull, FTSelf, MTIndex, SGIndex, VersionID],
BcdOps USING [
BcdBase, MTHandle, NameString, ProcessModules, ProcessSegs, SGHandle],
ControlDefs USING [
ControlModule, ControlLink, FrameCodeBase, GFT, GFTIndex, GFTItem,
GlobalFrameHandle, LastAVSlot, MaxNGfi, NullControl, NullGlobalFrame],
DirectoryDefs USING [EnumerateDirectory],
FrameDefs USING [EnterGlobalFrame, EnumerateGlobalFrames],
FrameOps USING [Alloc, CodeHandle, FrameSize, Free, Start],
InlineDefs USING [BITAND],
LoaderOps USING [Binding, BindLink, Load, New],
LoadStateOps USING [Map],
Mopcodes USING [zRBL, zWBL],
SegmentDefs USING [
DataSegmentAddress, DataSegmentHandle, DefaultMDSBase, DeleteFileSegment,
EnumerateFileSegments, FileHandle, FileSegmentAddress, FileSegmentHandle,
FrameDS, HardDown, InsertFile, MakeDataSegment, MoveFileSegment, NewFile,
NewFileSegment, OldFileOnly, OpenFile, Read, ReleaseFile, SwapIn, SwapUp,
Unlock, VMtoFileSegment],
StringDefs USING [
AppendString, AppendSubString, EquivalentSubStrings, SubString,
SubStringDescriptor],
Storage USING [Node, Free, FreePages, PagesForWords],
Table USING [Base];
AltoLoader: PROGRAM
IMPORTS
DirectoryDefs, FrameDefs, FrameOps, BcdOps, InlineDefs, LoaderOps,
SegmentDefs, StringDefs, Storage
EXPORTS LoaderOps, FrameDefs =PUBLIC
BEGIN OPEN BcdOps, BcdDefs, ControlDefs;
Binding: PRIVATE TYPE = LoaderOps.Binding;
Map: PRIVATE TYPE = LoadStateOps.Map;
SubStringDescriptor: PRIVATE TYPE = StringDefs.SubStringDescriptor;
SubString: PRIVATE TYPE = StringDefs.SubString;
InvalidFile: PUBLIC SIGNAL [name: STRING] = CODE;
Load: PUBLIC PROCEDURE [name: STRING] RETURNS [bcd: BcdBase] =
BEGIN OPEN SegmentDefs;
file: FileHandle ← NewFile[name, Read, OldFileOnly];
pages: CARDINAL;
bcdseg: FileSegmentHandle ← NewFileSegment[file, 1, 1, Read];
SwapIn[bcdseg];
bcd ← FileSegmentAddress[bcdseg];
pages ← bcd.nPages;
IF bcd.versionIdent # BcdDefs.VersionID OR bcd.definitions THEN
ERROR InvalidFile[
name ! UNWIND => BEGIN Unlock[bcdseg]; DeleteFileSegment[bcdseg] END];
IF pages > 1 THEN
BEGIN
Unlock[bcdseg];
MoveFileSegment[bcdseg, 1, pages];
SwapIn[bcdseg];
bcd ← FileSegmentAddress[bcdseg];
END;
RETURN
END;
LoadConfig: PUBLIC PROCEDURE [name: STRING] RETURNS [PROGRAM] =
BEGIN
cm: ControlModule ← LoaderOps.New[LoaderOps.Load[name], TRUE, FALSE];
RETURN[LOOPHOLE[cm]]
END;
NewConfig: PUBLIC PROCEDURE [name: STRING] =
BEGIN [] ← LoaderOps.New[LoaderOps.Load[name], TRUE, FALSE]; RETURN END;
RunConfig: PUBLIC PROCEDURE [name: STRING] =
BEGIN
cm: ControlDefs.ControlModule ← LoaderOps.New[
LoaderOps.Load[name], TRUE, FALSE];
IF cm # NullControl THEN FrameOps.Start[cm];
RETURN
END;
FileItem: TYPE = POINTER TO FileObject;
FileObject: TYPE = RECORD [
fti: FTIndex, ext: BOOLEAN, handle: SegmentDefs.FileHandle, link: FileItem];
files: FileItem ← NIL;
loadee: BcdBase;
ssb: NameString;
ftb: Table.Base;
nfilestofind: CARDINAL ← 0;
tableopen: BOOLEAN ← FALSE;
FindFiles: PUBLIC PROCEDURE [bcd: BcdBase] =
BEGIN EnterCodeFileNames[loadee]; LookupFileTable[]; END;
EnterCodeFileNames: PROCEDURE [bcd: BcdBase] =
BEGIN
SegSearch: PROCEDURE [sgh: SGHandle, sgi: SGIndex] RETURNS [BOOLEAN] =
BEGIN IF sgh.class = code THEN AddFileName[sgh.file]; RETURN[FALSE]; END;
[] ← BcdOps.ProcessSegs[bcd, SegSearch];
RETURN;
END;
AddFileName: PROCEDURE [file: FTIndex] =
BEGIN
p: FileItem;
i, offset, length: CARDINAL;
FOR p ← files, p.link UNTIL p = NIL DO IF file = p.fti THEN RETURN; ENDLOOP;
p ← Storage.Node[SIZE[FileObject]];
p↑ ← [fti: file, handle: NIL, ext: FALSE, link: files];
files ← p;
IF file = FTSelf THEN
BEGIN p.handle ← SegmentDefs.VMtoFileSegment[loadee].file; RETURN END;
IF file = FTNull THEN BEGIN p.handle ← NIL; RETURN END;
offset ← ftb[file].name;
length ← ssb.size[ftb[file].name];
FOR i IN [offset..offset + length) DO
IF ssb.string.text[i] = '. THEN BEGIN p.ext ← TRUE; EXIT END; ENDLOOP;
nfilestofind ← nfilestofind + 1;
RETURN;
END;
FindFileName: PROCEDURE [name: SubString, ext: BOOLEAN]
RETURNS [found: BOOLEAN, item: FileItem] =
BEGIN
file: SubStringDescriptor ← [base: @ssb.string, offset:, length:];
FOR item ← files, item.link UNTIL item = NIL DO
file.offset ← ftb[item.fti].name;
file.length ← ssb.size[ftb[item.fti].name];
IF LastCharIsDot[@file] THEN name.length ← name.length + 1;
IF ext = item.ext AND StringDefs.EquivalentSubStrings[@file, name] THEN
RETURN[TRUE, item];
ENDLOOP;
RETURN[FALSE, NIL];
END;
LastCharIsDot: PROCEDURE [name: SubString] RETURNS [BOOLEAN] =
BEGIN RETURN[name.base[name.offset + name.length - 1] = '.]; END;
FileNotFound: PUBLIC SIGNAL [name: STRING] = CODE;
LookupFileTable: PROCEDURE =
BEGIN
p: FileItem;
ssd: StringDefs.SubStringDescriptor;
name: STRING ← [40];
IF nfilestofind # 0 THEN DirectoryDefs.EnumerateDirectory[CheckOne];
FOR p ← files, p.link UNTIL p = NIL DO
IF p.handle = NIL AND p.fti # FTNull THEN
BEGIN
ssd ←
[base: @ssb.string, offset: ftb[p.fti].name,
length: ssb.size[ftb[p.fti].name]];
name.length ← 0;
StringDefs.AppendSubString[name, @ssd];
IF p.ext THEN StringDefs.AppendString[name, ".bcd"L];
SIGNAL FileNotFound[name];
END;
ENDLOOP;
END;
CheckOne: PROCEDURE [fp: POINTER TO AltoFileDefs.FP, name: STRING]
RETURNS [found: BOOLEAN] =
BEGIN
i: CARDINAL;
dirName: SubStringDescriptor;
bcd: SubStringDescriptor ← [base: "bcd"L, offset: 0, length: 3];
item: FileItem;
FOR i IN [0..name.length) DO
IF name[i] = '. THEN
BEGIN
IF name.length - i # 5 THEN GOTO UseWholeName;
dirName ← [base: name, offset: i + 1, length: 3];
IF ~StringDefs.EquivalentSubStrings[@dirName, @bcd] THEN
GOTO UseWholeName;
dirName.offset ← 0;
dirName.length ← i;
GOTO HasBCDExtension;
END;
REPEAT
UseWholeName => NULL;
HasBCDExtension =>
BEGIN
[found, item] ← FindFileName[@dirName, FALSE];
IF found THEN RETURN[ThisIsTheOne[fp, item]];
END;
ENDLOOP;
dirName ← [base: name, offset: 0, length: name.length - 1];
-- ignore dot on end
[found, item] ← FindFileName[@dirName, TRUE];
RETURN[IF found THEN ThisIsTheOne[fp, item] ELSE FALSE];
END;
ThisIsTheOne: PROCEDURE [fp: POINTER TO AltoFileDefs.FP, item: FileItem]
RETURNS [BOOLEAN] =
BEGIN
item.handle ← SegmentDefs.InsertFile[fp, SegmentDefs.Read];
nfilestofind ← nfilestofind - 1;
RETURN[nfilestofind = 0];
END;
FileHandleFromTable: PROCEDURE [fti: FTIndex]
RETURNS [file: SegmentDefs.FileHandle] =
BEGIN
p: FileItem;
FOR p ← files, p.link UNTIL p = NIL DO
IF p.fti = fti THEN RETURN[p.handle]; ENDLOOP;
RETURN[NIL];
END;
-- Frame allocation/deallocation
AllocateFrames: PUBLIC PROCEDURE [bcd: BcdBase, alloc, framelinks: BOOLEAN]
RETURNS [POINTER] =
BEGIN OPEN SegmentDefs;
seg: DataSegmentHandle;
IF bcd.nModules = 1 THEN RETURN[AllocateSingleModule[bcd, framelinks]];
seg ← MakeDataSegment[
base: DefaultMDSBase, pages: RequiredFrameSpace[bcd, alloc, framelinks],
info: HardDown];
seg.type ← FrameDS;
RETURN[DataSegmentAddress[seg]];
END;
AllocateSingleModule: PROCEDURE [bcd: BcdBase, framelinks: BOOLEAN]
RETURNS [frame: POINTER] =
BEGIN
size: CARDINAL ← 0;
i: CARDINAL;
mth: MTHandle ← @LOOPHOLE[loadee + loadee.mtOffset, Table.Base][
FIRST[MTIndex]];
framelinks ← framelinks OR mth.links = frame OR ~mth.code.linkspace;
IF framelinks THEN size ← mth.frame.length;
size ← NextMultipleOfFour[size] + mth.framesize;
FOR i IN [0..ControlDefs.LastAVSlot] DO
IF FrameOps.FrameSize[i] >= size THEN BEGIN size ← i; EXIT END; ENDLOOP;
frame ← FrameOps.Alloc[size];
IF framelinks THEN frame ← NextMultipleOfFour[frame + mth.frame.length];
RETURN[frame];
END;
NextMultipleOfFour: PROCEDURE [x: UNSPECIFIED] RETURNS [UNSPECIFIED] =
BEGIN RETURN[x + InlineDefs.BITAND[-x, 3B]]; END;
RequiredFrameSpace: PROCEDURE [bcd: BcdBase, alloc, framelinks: BOOLEAN]
RETURNS [space: CARDINAL] =
BEGIN
FrameSize: PROCEDURE [mth: MTHandle, mti: MTIndex] RETURNS [BOOLEAN] =
BEGIN
IF alloc THEN space ← NextMultipleOfFour[space + 1];
IF framelinks OR mth.links = frame OR ~mth.code.linkspace THEN
space ← space + mth.frame.length;
space ← NextMultipleOfFour[space] + mth.framesize;
IF alloc AND ~framelinks AND mth.links = code AND mth.code.linkspace AND
mth.framesize <= 4 THEN space ← space + 3; -- this tries
-- to catch the case where a frame is alloced and framesize <= 4 so
-- it makes it so that enough space is counted so that a small frame
-- will fit.
RETURN[FALSE];
END;
space ← 0;
[] ← BcdOps.ProcessModules[bcd, FrameSize];
RETURN[Storage.PagesForWords[space]];
END;
FindFrameIndex: PUBLIC PROCEDURE [mth: MTHandle, framelinks: BOOLEAN]
RETURNS [fsi: CARDINAL] =
BEGIN
space: CARDINAL ← 0;
IF framelinks THEN space ← mth.frame.length;
space ← NextMultipleOfFour[space] + mth.framesize;
FOR fsi DECREASING IN [0..ControlDefs.LastAVSlot] DO
IF space >= FrameOps.FrameSize[fsi] THEN RETURN[fsi]; ENDLOOP;
RETURN[0]; -- see RequiredFrameSpace for alloced modules w/ framesize<7
END;
GetGfi: PUBLIC PROCEDURE [frame: GlobalFrameHandle, ngfi: [1..MaxNGfi]]
RETURNS [gfi: GFTIndex] =
BEGIN RETURN[FrameDefs.EnterGlobalFrame[frame, ngfi]]; END;
ReleaseFrames: PUBLIC PROCEDURE [
bcd: BcdBase, frames: POINTER, map: LoadStateOps.Map] =
BEGIN
i: CARDINAL;
mtb: Table.Base = LOOPHOLE[bcd + bcd.mtOffset];
IF frames = NIL THEN RETURN;
IF bcd.nModules = 1 THEN
BEGIN
Align: PROCEDURE [POINTER, WORD] RETURNS [POINTER] =
LOOPHOLE[InlineDefs.BITAND];
FrameOps.Free[Align[frames - mtb[FIRST[MTIndex]].frame.length, 177774B]]
END
ELSE Storage.FreePages[frames];
FOR i IN [0..LENGTH[map]) DO
OPEN ControlDefs;
GFT[map[i]] ← GFTItem[frame: NullGlobalFrame, epbase: 0];
ENDLOOP;
END;
-- Code management
FindCode: PUBLIC PROCEDURE [bcd: BcdBase, map: Map] =
BEGIN
GetCode: PROCEDURE [mth: MTHandle, mti: MTIndex] RETURNS [BOOLEAN] =
BEGIN
FindShared: PROCEDURE [f: GlobalFrameHandle] RETURNS [BOOLEAN] =
BEGIN
IF f # frame AND f.code.handle = frame.code.handle THEN
f.shared ← frame.shared ← TRUE;
RETURN[FALSE];
END;
frame: GlobalFrameHandle = ControlDefs.GFT[map[mth.gfi]].frame;
IF ~mth.altoCode THEN InvalidModule[bcd, mth];
frame.code.handle ← FindCodeSegment[bcd, mth, frame];
frame.code.offset ← mth.code.offset;
frame.code.out ← TRUE;
[] ← FrameDefs.EnumerateGlobalFrames[FindShared];
RETURN[FALSE];
END;
[] ← BcdOps.ProcessModules[bcd, GetCode];
RETURN
END;
FindCodeSegment: PUBLIC PROCEDURE [
bcd: BcdBase, mth: MTHandle, frame: GlobalFrameHandle]
RETURNS [seg: SegmentDefs.FileSegmentHandle] =
BEGIN OPEN SegmentDefs;
sgh: SGHandle ← @LOOPHOLE[bcd + bcd.sgOffset, Table.Base][mth.code.sgi];
file: FileHandle;
pages: CARDINAL;
FindSegment: PROCEDURE [s: FileSegmentHandle] RETURNS [BOOLEAN] =
BEGIN RETURN[s.file = file AND s.base = sgh.base AND s.pages = pages]; END;
file ← FileHandleFromTable[sgh.file];
OpenFile[file];
pages ← sgh.pages + sgh.extraPages;
seg ← EnumerateFileSegments[FindSegment];
IF seg = NIL THEN seg ← NewFileSegment[file, sgh.base, pages, Read];
seg.class ← code;
RETURN
END;
BadCode: PUBLIC SIGNAL [name: STRING] = CODE;
InvalidModule: PROCEDURE [bcd: BcdBase, mth: MTHandle] =
BEGIN OPEN SegmentDefs;
name: STRING ← [40];
ssd: StringDefs.SubStringDescriptor ←
[base: @ssb.string, offset: mth.name, length: ssb.size[mth.name]];
StringDefs.AppendSubString[name, @ssd];
SIGNAL BadCode[name];
END;
-- Binding and Map management
InitBinding: PUBLIC PROCEDURE [bcd: BcdBase] RETURNS [binding: Binding] =
BEGIN
i: CARDINAL;
p: POINTER ← Storage.Node[bcd.nDummies*SIZE[LoaderOps.BindLink]];
binding ← DESCRIPTOR[
p - CARDINAL[bcd.firstdummy*SIZE[LoaderOps.BindLink]], bcd.nDummies];
FOR i IN [bcd.firstdummy..bcd.firstdummy + bcd.nDummies) DO
binding[i] ← [whichgfi: 0, body: notbound[]]; ENDLOOP;
END;
ReleaseBinding: PUBLIC PROCEDURE [bcd: BcdBase, binding: Binding]
RETURNS [Binding] =
BEGIN
IF BASE[binding] # NIL THEN
Storage.Free[BASE[binding] + bcd.firstdummy*SIZE[LoaderOps.BindLink]];
RETURN[DESCRIPTOR[NIL, 0]];
END;
InitializeMap: PUBLIC PROCEDURE [bcd: BcdBase] RETURNS [map: LoadStateOps.Map] =
BEGIN
i: CARDINAL;
map ← DESCRIPTOR[Storage.Node[bcd.firstdummy], bcd.firstdummy];
FOR i IN [0..bcd.firstdummy) DO map[i] ← 0; ENDLOOP;
END;
DestroyMap: PUBLIC PROCEDURE [map: LoadStateOps.Map] =
BEGIN IF BASE[map] # NIL THEN Storage.Free[BASE[map]]; END;
-- Link management
ls: POINTER TO ControlDefs.ControlLink;
lls: LONG POINTER TO ControlDefs.ControlLink;
dirty, long: BOOLEAN;
OpenLinkSpace: PROCEDURE [frame: GlobalFrameHandle, mth: MTHandle] =
BEGIN OPEN SegmentDefs;
IF frame.codelinks THEN
BEGIN
fcb: ControlDefs.FrameCodeBase ← frame.code;
seg: FileSegmentHandle ← FrameOps.CodeHandle[frame];
fcb.out ← FALSE;
IF seg # NIL THEN SwapIn[seg];
IF (long ← frame.code.highByte = 0) THEN lls ← fcb.longbase
ELSE ls ← FileSegmentAddress[frame.code.handle] + mth.code.offset;
END
ELSE BEGIN long ← FALSE; ls ← LOOPHOLE[frame] END;
IF long THEN lls ← lls - mth.frame.length ELSE ls ← ls - mth.frame.length;
dirty ← FALSE;
END;
WriteLink: PROCEDURE [offset: CARDINAL, link: ControlDefs.ControlLink] =
BEGIN
dirty ← TRUE;
IF long THEN WriteLongControlLink[link, lls + offset]
ELSE (ls + offset)↑ ← link;
END;
WriteLongControlLink: PROCEDURE [ControlLink, LONG POINTER] = MACHINE CODE
BEGIN Mopcodes.zWBL, 0 END;
ReadLongControlLink: PROCEDURE [LONG POINTER] RETURNS [ControlLink] = MACHINE
CODE BEGIN Mopcodes.zRBL, 0 END;
ReadLink: PROCEDURE [offset: CARDINAL] RETURNS [link: ControlDefs.ControlLink] =
BEGIN
RETURN[IF long THEN ReadLongControlLink[lls + offset] ELSE (ls + offset)↑];
END;
CloseLinkSpace: PROCEDURE [frame: GlobalFrameHandle] =
BEGIN OPEN SegmentDefs;
seg: FileSegmentHandle ← FrameOps.CodeHandle[frame];
IF frame.codelinks AND seg # NIL THEN
BEGIN
Unlock[seg];
IF dirty THEN BEGIN seg.write ← TRUE; SwapUp[seg]; seg.write ← FALSE; END;
END;
END;
FinalizeUtilities: PUBLIC PROCEDURE =
BEGIN
f: FileItem;
FOR f ← files, files UNTIL f = NIL DO
files ← f.link;
IF f.handle.segcount = 0 THEN SegmentDefs.ReleaseFile[f.handle];
Storage.Free[f];
ENDLOOP;
tableopen ← FALSE;
END;
InitializeUtilities: PUBLIC PROCEDURE [bcd: BcdBase] =
BEGIN
loadee ← bcd;
ssb ← LOOPHOLE[loadee + loadee.ssOffset];
ftb ← LOOPHOLE[loadee + loadee.ftOffset];
IF tableopen THEN FinalizeUtilities[];
tableopen ← TRUE;
END;
END....