-- Swapper.Mesa Edited by Sandman on October 1, 1979 9:35 AM PM
-- Edited for XMesa by Levin on October 25, 1979 3:28 PM
DIRECTORY
AllocDefs: FROM "allocdefs" USING [
AllocHandle, AllocInfo, AllocObject, DefaultDataSegmentInfo,
DefaultFileSegmentInfo, DefaultFrameSegmentInfo, DefaultTableSegmentInfo,
PageState, SwappingProcedure, SwapStrategy],
AltoDefs: FROM "altodefs" USING [
BYTE, MaxVMPage, PageCount, PageNumber, PageSize],
AltoFileDefs: FROM "altofiledefs" USING [eofDA, vDC],
BootDefs: FROM "bootdefs" USING [
BusyPage, FreePage, PageMap, PositionSeg, SystemTable, SystemTableHandle,
Table, TableHandle],
ControlDefs: FROM "controldefs" USING [
GFT, GFTIndex, GlobalFrameHandle, NullGlobalFrame, PrefixHandle, PrefixHeader],
DiskDefs: FROM "diskdefs" USING [DiskRequest, SwapPages],
FrameDefs: FROM "framedefs" USING [ValidateGlobalFrame],
FrameOps: FROM "frameops" USING [CodeHandle, FlushLargeFrames],
InlineDefs: FROM "inlinedefs" USING [BITAND, DIVMOD, LongNumber],
LongCodeOps: FROM "longcodeops",
MemoryOps: FROM "memoryops" USING [BankIndex, GetMemoryConfig, MemoryConfig],
Mopcodes: FROM "mopcodes" USING [zBLTL, zPUSH, zRBL, zWBL],
NucleusDefs: FROM "nucleusdefs" USING [Miscellaneous],
OsStaticDefs: FROM "osstaticdefs" USING [OsStatics],
ProcessDefs: FROM "processdefs" USING [DisableInterrupts, EnableInterrupts],
SDDefs: FROM "sddefs" USING [SD, sGFTLength],
SegmentDefs: FROM "segmentdefs" USING [
ChangeDataToFileSegment, DataSegmentHandle, DefaultBase, DeleteFileSegment,
FileHint, FileSegmentHandle, FrobHandle, FrobLink, FrobNull,
InvalidSegmentSize, MaxLocks, MaxRefs, NewFileSegment, Object,
ObjectHandle, ObjectType, OpenFile, PageNumber, PagePointer, Read,
RemoteSegCommand, SegmentHandle, Write],
XMESA: FROM "xmesaops" USING [
Bank1X, BankMasks, BankOption, FreeSeal, InUseSeal, PageMapAllocInfo, XDataSegmentHandle,
XFileSegmentHandle, XFileSegmentObject, XMremote, XSegInfo, XSegInfoIndex, XSegInfoTable,
XSegmentHandle],
XMesaDefs: FROM "xmesadefs" USING [
DefaultBase0, DefaultBase3, DefaultMDSBase, DefaultXMBase, MaxXPage,
LongAddressFromPage, PagesPerBank, XCOPY, XDataSegmentAddress, XFileSegmentAddress];
Swapper: PROGRAM [ffvmp, lfvmp: AltoDefs.PageNumber]
IMPORTS BootDefs, DiskDefs, FrameDefs, FrameOps, InlineDefs,
MemoryOps, NucleusDefs, ProcessDefs, SegmentDefs, XMesaDefs
EXPORTS AllocDefs, BootDefs, FrameDefs, LongCodeOps, MemoryOps, NucleusDefs,
SegmentDefs, XMESA, XMesaDefs
SHARES MemoryOps, SegmentDefs, XMESA = BEGIN OPEN SegmentDefs;
AllocInfo: TYPE = AllocDefs.AllocInfo;
AllocHandle: TYPE = AllocDefs.AllocHandle;
PageState: TYPE = AllocDefs.PageState;
SwappingProcedure: TYPE = AllocDefs.SwappingProcedure;
SwapStrategy: TYPE = AllocDefs.SwapStrategy;
PageCount: TYPE = AltoDefs.PageCount;
PageNumber: TYPE = AltoDefs.PageNumber;
TableHandle: TYPE = BootDefs.TableHandle;
SegmentHandle: TYPE = SegmentDefs.SegmentHandle;
DataSegmentHandle: TYPE = SegmentDefs.DataSegmentHandle;
FileSegmentHandle: TYPE = SegmentDefs.FileSegmentHandle;
MaxVMPage: PageNumber = AltoDefs.MaxVMPage;
PageSize: CARDINAL = AltoDefs.PageSize;
PAGEDISP: TYPE = MACHINE DEPENDENT RECORD [
page: [0..MaxVMPage],
disp: [0..PageSize)];
PageFromAddress: PUBLIC PROCEDURE [a:POINTER] RETURNS [PageNumber] =
BEGIN
RETURN[LOOPHOLE[a,PAGEDISP].page]
END;
AddressFromPage: PUBLIC PROCEDURE [p:PageNumber] RETURNS [POINTER] =
BEGIN
RETURN[LOOPHOLE[PAGEDISP[p,0]]]
END;
PagePointer: PUBLIC PROCEDURE [a:POINTER] RETURNS [POINTER] =
BEGIN
LOOPHOLE[a,PAGEDISP].disp ← 0;
RETURN[a]
END;
-- Data Segments
DefaultBase: PageNumber = SegmentDefs.DefaultBase;
NewDataSegment: PUBLIC PROCEDURE [base:PageNumber, pages:PageCount]
RETURNS [seg:DataSegmentHandle] =
BEGIN
RETURN[MakeDataSegment[base, pages, AllocDefs.DefaultDataSegmentInfo]]
END;
NewFrameSegment: PUBLIC PROCEDURE [pages:PageCount]
RETURNS [seg:DataSegmentHandle] =
BEGIN
RETURN[MakeDataSegment[DefaultBase, pages, AllocDefs.DefaultFrameSegmentInfo]]
END;
MakeDataSegment: PUBLIC PROCEDURE [
base: PageNumber, pages: PageCount, info: AllocInfo]
RETURNS [seg: DataSegmentHandle] =
BEGIN
IF pages ~IN (0..MaxVMPage+1] THEN ERROR InvalidSegmentSize[pages];
seg ← AllocateDataSegment[];
seg↑ ← [busy:, body: segment[data[VMpage:, pages:, unused:]]];
base ← alloc.alloc[base, pages, seg, info
! UNWIND => LiberateDataSegment[seg]];
seg↑ ← [busy: FALSE,
body: segment[data[VMpage: base, pages: pages, unused: 0]]];
IF base > MaxVMPage THEN --XM
BEGIN --XM
OPEN s: LOOPHOLE[seg, XMESA.XDataSegmentHandle]; --XM
s.VMpage ← 0; s.XMpage ← base; --XM
END; --XM
alloc.update[base, pages, inuse, seg];
RETURN
END;
BootDataSegment: PUBLIC PROCEDURE [base:PageNumber, pages:PageCount]
RETURNS [seg:DataSegmentHandle] =
BEGIN OPEN AllocDefs;
i: PageNumber;
FOR i IN [base..base+pages) DO
IF alloc.status[i].status # busy THEN ERROR;
ENDLOOP;
seg ← AllocateDataSegment[];
seg↑ ← [busy: FALSE,
body: segment[data[VMpage: base, pages: pages, unused: 0]]];
alloc.update[base, pages, inuse, seg];
RETURN
END;
DeleteDataSegment: PUBLIC PROCEDURE [seg:DataSegmentHandle] =
BEGIN
base: PageNumber; pages: PageCount;
ValidateDataSegment[seg];
BEGIN OPEN s: LOOPHOLE[seg, XMESA.XDataSegmentHandle]; --XM
base ← IF s.VMpage = 0 THEN s.XMpage ELSE s.VMpage; --XM
END; --XM
pages ← seg.pages; --XM
alloc.update[base, pages, busy, NIL];
LiberateDataSegment[seg];
alloc.update[base, pages, free, NIL];
RETURN
END;
DataSegmentAddress: PUBLIC PROCEDURE [seg:DataSegmentHandle] RETURNS [POINTER] =
BEGIN
IF seg.VMpage = 0 THEN ERROR; --XM
RETURN[LOOPHOLE[PAGEDISP[seg.VMpage,0]]]
END;
-- Swapping Segments
SwapError: PUBLIC SIGNAL [seg:FileSegmentHandle] = CODE;
MakeSwappedIn: PUBLIC PROCEDURE [
seg: FileSegmentHandle, base: PageNumber, info: AllocInfo] =
BEGIN
vmpage: PageNumber;
IF seg.lock = MaxLocks THEN ERROR SwapError[seg];
ValidateObject[seg];
ProcessDefs.DisableInterrupts[];
IF seg.swappedin THEN --XM
BEGIN seg.lock ← seg.lock+1; ProcessDefs.EnableInterrupts[]; RETURN END; --XM
ProcessDefs.EnableInterrupts[];
IF seg.file.swapcount = MaxRefs THEN SIGNAL SwapError[seg];
IF ~seg.file.open THEN OpenFile[seg.file];
vmpage ← alloc.alloc[base, seg.pages, seg, info];
-- There is a funny side-effect of AllocVM that we have to worry about. In the course
-- of allocating space for the segment, it is possible that segments have been swapped in
-- (in order to call swapping procedures or execute instructions implemented in software).
-- In particular, it is possible that 'seg' itself has been swapped in this way. The exits
-- in the following block of code deal with this possibility.
BEGIN -- block for funny cases -- --XM
ENABLE UNWIND => alloc.update[vmpage, seg.pages, free, NIL];
ProcessDefs.DisableInterrupts[];
IF seg.swappedin THEN --XM
BEGIN seg.lock ← seg.lock+1; ProcessDefs.EnableInterrupts[]; GO TO Surprise END; --XM
ProcessDefs.EnableInterrupts[]; --XM
WITH s: seg SELECT FROM
disk =>
IF vmpage > MaxVMPage THEN --XM
BEGIN --XM
MakeSwappedIn[@s, XMesaDefs.DefaultMDSBase, AllocDefs.DefaultFileSegmentInfo]; --XM
IF s.loc ~= disk THEN GO TO Surprise; -- already in an XM bank -- --XM
XMesaDefs.XCOPY[from: XMesaDefs.LongAddressFromPage[s.VMpage], --XM
to: XMesaDefs.LongAddressFromPage[vmpage], --XM
nwords: s.pages*PageSize]; --XM
alloc.update[VanillaToChocolate[seg, vmpage], s.pages, free, NIL]; --XM
ProcessDefs.DisableInterrupts[]; --XM
END --XM
ELSE
BEGIN
seg.VMpage ← vmpage;
IF (s.hint.page # s.base OR s.hint.da = AltoFileDefs.eofDA)
AND BootDefs.PositionSeg[@s,TRUE] AND s.pages = 1
THEN NULL ELSE MapVM[@s, ReadD];
GO TO BumpCounts --XM
END;
remote => IF s.proc = XMESA.XMremote THEN ERROR --XM
ELSE BEGIN s.proc[@s, remoteRead]; GO TO BumpCounts END; --XM
ENDCASE;
EXITS
BumpCounts => -- normal termination of non-chocolate segment read-in -- --XM
BEGIN --XM
ProcessDefs.DisableInterrupts[]; --XM
seg.file.swapcount ← seg.file.swapcount+1; --XM
seg.lock ← seg.lock+1; --XM
seg.swappedin ← TRUE; --XM
END; --XM
Surprise => BEGIN alloc.update[vmpage, seg.pages, free, NIL]; RETURN END; --XM
END; -- block for funny cases -- --XM
alloc.update[vmpage, seg.pages, inuse, seg];
ProcessDefs.EnableInterrupts[];
RETURN
END;
SwapIn: PUBLIC PROCEDURE [seg:FileSegmentHandle] =
BEGIN
MakeSwappedIn[seg, DefaultBase, AllocDefs.DefaultFileSegmentInfo];
RETURN
END;
Unlock: PUBLIC PROCEDURE [seg:FileSegmentHandle] =
BEGIN OPEN seg;
IF lock = 0 THEN ERROR SwapError[seg];
ValidateObject[seg];
ProcessDefs.DisableInterrupts[];
lock ← lock-1;
ProcessDefs.EnableInterrupts[];
RETURN
END;
SwapUp: PUBLIC PROCEDURE [seg:FileSegmentHandle] =
BEGIN OPEN seg;
ValidateObject[seg];
IF swappedin AND write THEN
BEGIN
WITH s: seg SELECT FROM
disk =>
BEGIN
IF s.hint.page # base OR s.hint.da = AltoFileDefs.eofDA THEN
[] ← BootDefs.PositionSeg[@s,FALSE];
MapVM[@s, WriteD];
END;
remote =>
IF s.proc = XMESA.XMremote THEN --XM
BEGIN OPEN xs: LOOPHOLE[seg, POINTER TO remote XMESA.XFileSegmentObject]; --XM
mdsFileSeg: FileSegmentHandle ← NewFileSegment[xs.file, xs.base, xs.pages, Read+Write];
mdsDataSeg: DataSegmentHandle ← NewDataSegment[XMesaDefs.DefaultMDSBase, xs.pages]; --XM
XMesaDefs.XCOPY[from: XMesaDefs.XFileSegmentAddress[seg], --XM
to: XMesaDefs.XDataSegmentAddress[mdsDataSeg], --XM
nwords: xs.pages*PageSize]; --XM
ChangeDataToFileSegment[mdsDataSeg, mdsFileSeg]; --XM
Unlock[mdsFileSeg]; --XM
DeleteFileSegment[mdsFileSeg]; --XM
END --XM
ELSE s.proc[@s, remoteWrite];
ENDCASE;
END;
RETURN
END;
SwapOut: PUBLIC PROCEDURE [seg:FileSegmentHandle] =
BEGIN OPEN seg;
temp: PageNumber;
-- ValidateObject[seg]; -- --XM
SwapUp[seg];
ProcessDefs.DisableInterrupts[];
IF ~swappedin THEN BEGIN ProcessDefs.EnableInterrupts[]; RETURN END;
IF lock # 0 THEN
BEGIN ProcessDefs.EnableInterrupts[]; ERROR SwapError[seg] END;
busy ← TRUE;
WITH s: seg SELECT FROM
disk => BEGIN temp ← s.VMpage; s.VMpage ← 0; END;
remote =>
IF s.proc = XMESA.XMremote THEN temp ← ChocolateToVanilla[LOOPHOLE[seg],0] --XM
ELSE BEGIN temp ← s.VMpage; s.VMpage ← 0; END; --XM
ENDCASE; --XM
alloc.update[temp, pages, busy, NIL]; --XM
swappedin ← FALSE;
busy ← FALSE;
file.swapcount ← file.swapcount-1;
ProcessDefs.EnableInterrupts[];
-- IF swapcount = 0 THEN CloseFile[]; ???
alloc.update[temp, pages, free, NIL];
RETURN
END;
remoteRead: RemoteSegCommand = 0;
remoteWrite: RemoteSegCommand = 1;
SegmentFault: PUBLIC SIGNAL [seg:FileSegmentHandle, pages:PageCount] = CODE;
MapVM: PUBLIC PROCEDURE [seg:FileSegmentHandle, dc: AltoFileDefs.vDC] =
BEGIN OPEN seg;
page: PageNumber; byte: CARDINAL; temp: PageCount;
arg: swap DiskDefs.DiskRequest;
WITH s: seg SELECT FROM
disk =>
BEGIN
arg ← DiskDefs.DiskRequest[AddressFromPage[s.VMpage], @s.hint.da,
s.base, s.base+s.pages-1, @s.file.fp, FALSE, dc, dc, FALSE,
swap[NIL]];
IF s.hint.page # s.base THEN ERROR SwapError[@s];
[page,byte] ← DiskDefs.SwapPages[@arg];
temp ← page-base+(IF byte=0 THEN 0 ELSE 1);
IF temp=0 THEN ERROR SegmentFault[@s,0];
IF temp # pages THEN
BEGIN SIGNAL SegmentFault[@s,temp];
alloc.update[s.VMpage+temp, s.pages-temp, free, NIL];
s.pages ← temp;
END;
END;
remote => ERROR SwapError[@s];
ENDCASE;
RETURN
END;
-- Kludge to extend segment objects; will go away in XMesa 6.0 -- --XM
VanillaToChocolate: PUBLIC PROCEDURE [seg: FileSegmentHandle, newpage: PageNumber]
RETURNS [oldpage: PageNumber] =
BEGIN
xs: POINTER TO XMESA.XSegInfo ← AllocXSegInfo[];
oldpage ← seg.VMpage;
xs.XMpage ← seg.VMpage ← newpage; -- reset seg.VMpage for CopyNew --
WITH s: seg SELECT FROM disk => xs.body ← hint[s.hint]; ENDCASE => ERROR;
seg.location ← remote[XMESA.XMremote, xs]; -- note variant changes here!!!--
END;
ChocolateToVanilla: PUBLIC PROCEDURE [seg: XMESA.XFileSegmentHandle, newpage: PageNumber]
RETURNS [oldpage: PageNumber] =
BEGIN
WITH s: seg SELECT FROM
remote =>
IF s.proc = XMESA.XMremote THEN
BEGIN
fh: FileHint ← s.info.hint;
oldpage ← s.info.XMpage;
FreeXSegInfo[s.info];
seg.location ← disk[fh]; -- note that variant changes here!!!--
seg.VMpage ← newpage;
END
ELSE ERROR;
ENDCASE => ERROR;
END;
XSIhead: POINTER TO XMESA.XSegInfoTable ← NIL;
AllocXSegInfo: PROCEDURE RETURNS [xs: POINTER TO XMESA.XSegInfo] =
BEGIN
OPEN XMESA;
i: XSegInfoIndex;
p: POINTER TO XSegInfoTable;
ProcessDefs.DisableInterrupts[];
FOR p ← XSIhead, AddressFromPage[p.nextPage] UNTIL p = NIL DO
IF p.freeCount # 0 THEN
BEGIN
xs ← p.freeHead;
IF xs.seal # FreeSeal THEN ERROR;
EXIT
END;
REPEAT
FINISHED =>
BEGIN
p ← DataSegmentAddress[NewDataSegment[DefaultBase,1]];
p.nextPage ← PageFromAddress[XSIhead];
XSIhead ← p;
p.freeCount ← LAST[XSegInfoIndex]+1;
FOR i IN XSegInfoIndex DO
p.table[i].link ← @p.table[i+1];
p.table[i].seal ← FreeSeal;
ENDLOOP;
xs ← @p.table[0];
END;
ENDLOOP;
p.freeHead ← xs.link;
p.freeCount ← p.freeCount-1;
ProcessDefs.EnableInterrupts[];
xs.seal ← InUseSeal;
END;
FreeXSegInfo: PROCEDURE [xs: POINTER TO XMESA.XSegInfo] =
BEGIN
OPEN XMESA;
p: POINTER TO XSegInfoTable ← PagePointer[xs];
seg: SegmentHandle;
IF xs.seal # InUseSeal THEN ERROR;
xs.seal ← FreeSeal;
ProcessDefs.DisableInterrupts[];
xs.link ← p.freeHead;
p.freeHead ← xs;
p.freeCount ← p.freeCount+1;
IF p.freeCount = LAST[XSegInfoIndex]+1 THEN
BEGIN
prev: POINTER TO XSegInfoTable ← XSIhead;
IF prev = p THEN XSIhead ← AddressFromPage[p.nextPage]
ELSE
BEGIN
UNTIL prev = NIL DO
IF prev.nextPage = PageFromAddress[p] THEN EXIT;
prev ← AddressFromPage[prev.nextPage];
REPEAT
FINISHED => ERROR;
ENDLOOP;
prev.nextPage ← p.nextPage;
END;
IF (seg ← alloc.status[PageFromAddress[p]].seg) = NIL THEN ERROR;
WITH s: seg SELECT FROM
data => DeleteDataSegment[@s];
ENDCASE => ERROR;
END;
ProcessDefs.EnableInterrupts[];
END;
-- Code Swapping and Swap Strategies
trySwapInProgress: BOOLEAN ← FALSE;
TrySwapping: SwappingProcedure =
BEGIN
did: BOOLEAN;
sp, next: POINTER TO SwapStrategy;
ProcessDefs.DisableInterrupts[];
IF trySwapInProgress THEN
BEGIN
ProcessDefs.EnableInterrupts[];
RETURN[TryCodeSwapping[needed, info, seg]];
END;
trySwapInProgress ← TRUE;
ProcessDefs.EnableInterrupts[];
did ← TRUE;
FOR sp ← StrategyList, next UNTIL sp = NIL DO
next ← sp.link;
IF sp.proc[needed, info, seg] THEN EXIT;
REPEAT FINISHED => did ← FALSE;
ENDLOOP;
trySwapInProgress ← FALSE;
RETURN[did]
END;
CantSwap: PUBLIC SwappingProcedure =
BEGIN
RETURN[FALSE]
END;
-- These three variables are set by XAllocVM -- --XM
pageRover: AltoDefs.PageNumber ← 0;
roverMax: AltoDefs.PageNumber ← AltoDefs.MaxVMPage; --XM
roverMin: AltoDefs.PageNumber ← 0; --XM
TryCodeSwapping: PUBLIC SwappingProcedure =
BEGIN OPEN ControlDefs;
foundHole: BOOLEAN ← FALSE;
pass: {first, second, quit} ← first;
okay: BOOLEAN;
base, page: AltoDefs.PageNumber;
segment: XMESA.XSegmentHandle; --XM
status: AllocDefs.PageState;
p: PrefixHandle;
n, inc: PageCount;
page ← n ← 0;
ProcessDefs.DisableInterrupts[];
segment ← LOOPHOLE[alloc.status[pageRover].seg]; --XM
IF segment # NIL THEN
WITH s: segment SELECT FROM
data => pageRover ← IF s.VMpage = 0 THEN s.XMpage ELSE s.VMpage; --XM
file => --XM
WITH fs: s SELECT FROM --XM
disk => pageRover ← s.VMpage; --XM
remote => pageRover ← --XM
IF fs.proc = XMESA.XMremote THEN fs.info.XMpage ELSE fs.VMpage; --XM
ENDCASE; --XM
ENDCASE;
base ← pageRover;
DO -- until we've looked at them all twice
[segment, status] ← LOOPHOLE[alloc.status[pageRover], --XM
RECORD[XMESA.XSegmentHandle, AllocDefs.PageState]]; --XM
okay ← FALSE;
SELECT status FROM
inuse =>
WITH s: segment SELECT FROM
data => inc ← s.pages;
file =>
BEGIN
IF s.lock = 0 AND ~s.write THEN
BEGIN
IF s.class = code THEN
BEGIN
longP: LONG POINTER TO PrefixHeader; --XM
info: CARDINAL; --XM
ReadLRUInfo: PROCEDURE[LONG POINTER TO PrefixHeader] RETURNS[CARDINAL] = --XM
MACHINE CODE BEGIN Mopcodes.zRBL, 0; END; --XM
WriteLRUInfo: PROCEDURE[CARDINAL, LONG POINTER TO PrefixHeader] = --XM
MACHINE CODE BEGIN Mopcodes.zWBL, 0; END; --XM
WITH fs: s SELECT FROM --XM
remote => --XM
IF fs.proc = XMESA.XMremote THEN --XM
BEGIN --XM
longP ← XMesaDefs.LongAddressFromPage[fs.info.XMpage]; --XM
info ← ReadLRUInfo[longP]; --XM
IF info > 1 THEN --XM
BEGIN longP ← longP + info; info ← ReadLRUInfo[longP]; END; --XM
IF info = 0 THEN okay ← TRUE ELSE WriteLRUInfo[0, longP]; --XM
GO TO XMCodeProcessed --XM
END; --XM
ENDCASE; --XM
p ← AddressFromPage[s.VMpage];
IF p.header.swapinfo > 1 THEN p ← p + p.header.swapinfo;
IF p.header.swapinfo = 0 THEN okay ← TRUE
ELSE p.header.swapinfo ← 0;
EXITS --XM
XMCodeProcessed => NULL; --XM
END
ELSE IF s.inuse THEN s.inuse ← FALSE ELSE okay ← TRUE;
END;
inc ← s.pages;
END;
ENDCASE;
ENDCASE =>
BEGIN
IF status = free THEN okay ← TRUE;
inc ← 1;
END;
IF ~okay THEN
BEGIN page ← n ← 0; IF pass = quit THEN EXIT; END
ELSE
BEGIN
IF page = 0 THEN page ← pageRover;
IF (n ← n+inc) >= needed THEN
BEGIN foundHole ← TRUE; EXIT END;
END;
IF (pageRover ← pageRover+inc) > roverMax THEN --XM
IF pass = quit THEN EXIT ELSE BEGIN pageRover ← page ← roverMin; n ← 0; END; --XM
IF pageRover = base THEN pass ← IF pass = first THEN second ELSE quit;
ENDLOOP;
base ← pageRover ← page + n;
WHILE page < base DO
segment ← LOOPHOLE[alloc.status[page].seg]; --XM
IF segment # NIL THEN
WITH s: segment SELECT FROM
data =>
page ← (IF s.VMpage = 0 THEN s.XMpage ELSE s.VMpage) + s.pages; --XM
file =>
BEGIN
WITH fs: s SELECT FROM --XM
disk => page ← s.VMpage; --XM
remote => page ← IF fs.proc = XMESA.XMremote THEN fs.info.XMpage ELSE fs.VMpage; --XM
ENDCASE; --XM
IF s.lock = 0 THEN
BEGIN
IF s.class = code THEN UpdateCodebases[@s];
IF ~s.write THEN SwapOutUnlocked[@s];
alloc.update[page, s.pages, free, NIL];
END;
page ← page + s.pages;
END;
ENDCASE
ELSE page ← page + 1;
ENDLOOP;
ProcessDefs.EnableInterrupts[];
RETURN[foundHole]
END;
SwapOutCode: PUBLIC PROCEDURE [f: ControlDefs.GlobalFrameHandle] =
BEGIN OPEN SegmentDefs, ControlDefs;
cseg: SegmentDefs.FileSegmentHandle = FrameOps.CodeHandle[f];
FrameDefs.ValidateGlobalFrame[f];
IF cseg = NIL THEN RETURN;
ProcessDefs.DisableInterrupts[];
IF cseg.swappedin THEN
BEGIN
SwapIn[cseg]; -- lock it so it won't go away
UpdateCodebases[LOOPHOLE[cseg]]; --XM
Unlock[cseg]; SwapOut[cseg];
END;
ProcessDefs.EnableInterrupts[];
RETURN
END;
SwapInCode: PUBLIC PROCEDURE [f: ControlDefs.GlobalFrameHandle] =
BEGIN
seg: FileSegmentHandle;
gfi: ControlDefs.GFTIndex ← f.gfi;
-- It is believed that Disabling during SwapIn is unnecessary
-- as long as ALL interrupt code is locked. The
-- Swapper should have segment locks to help fix this.
info: AllocDefs.AllocInfo = [0,easy,bottomup,initial,code,FALSE,FALSE];
-- The following kludge permits us to leave CodeHandle (and everything it calls) in -- --XM
-- Miscellaneous, since if the code being swapped in is Miscellaneous itself, then -- --XM
-- f.code.highByte will never be 0. In effect, we are promising that if f is -- --XM
-- Miscellaneous, f.code.out will never be TRUE when f.code.highByte is 0. -- --XM
IF f.code.highByte = 0 THEN seg ← FrameOps.CodeHandle[f] --XM
ELSE seg ← f.code.handle; --XM
MakeSwappedIn[seg, DefaultBase, info]; --XM
ProcessDefs.DisableInterrupts[];
IF f.code.out THEN
BEGIN
offset: CARDINAL ← f.code.offset; --XM
BEGIN -- block for exits -- --XM
-- Don't call FileSegmentAddress; it's not locked!
WITH s: seg SELECT FROM --XM
remote => --XM
BEGIN OPEN xs: LOOPHOLE[seg, POINTER TO remote XMESA.XFileSegmentObject]; --XM
IF xs.proc ~= XMESA.XMremote THEN GO TO Short --XM
ELSE f.code.longbase ← LongAddressFromPage[xs.info.XMpage]+offset; --XM
END; --XM
ENDCASE => GO TO Short; --XM
EXITS --XM
Short => f.code.shortbase ← AddressFromPage[seg.VMpage]+offset; --XM
END; -- block for exits -- --XM
f.code.out ← FALSE;
END;
ProcessDefs.EnableInterrupts[];
RETURN
END;
ReleaseCode: PUBLIC PROCEDURE [f: ControlDefs.GlobalFrameHandle] =
BEGIN
Unlock[FrameOps.CodeHandle[f]]; --XM
RETURN
END;
LastResort: SwapStrategy ← SwapStrategy[NIL,TryCodeSwapping];
StrategyList: POINTER TO SwapStrategy ← @LastResort;
AddSwapStrategy: PUBLIC PROCEDURE [strategy:POINTER TO SwapStrategy] =
BEGIN
sp: POINTER TO SwapStrategy;
ProcessDefs.DisableInterrupts[];
FOR sp ← StrategyList, sp.link
UNTIL sp = NIL DO
IF sp = strategy THEN RETURN;
ENDLOOP;
strategy.link ← StrategyList;
StrategyList ← strategy;
ProcessDefs.EnableInterrupts[];
RETURN
END;
RemoveSwapStrategy: PUBLIC PROCEDURE [strategy:POINTER TO SwapStrategy] =
BEGIN
sp: POINTER TO SwapStrategy;
prev: POINTER TO SwapStrategy ← NIL;
ProcessDefs.DisableInterrupts[];
FOR sp ← StrategyList, sp.link UNTIL sp = NIL DO
IF sp = strategy THEN
BEGIN
IF prev = NIL
THEN StrategyList ← sp.link
ELSE prev.link ← sp.link;
EXIT END;
prev ← sp;
ENDLOOP;
ProcessDefs.EnableInterrupts[];
strategy.link ← NIL;
RETURN
END;
-- XMESA Utilities -- --XM
SwapOutFileSegment: PUBLIC PROCEDURE [seg: SegmentDefs.FileSegmentHandle] =
BEGIN
IF seg.class = code THEN
BEGIN
ProcessDefs.DisableInterrupts[];
SwapIn[seg]; -- lock it so it won't go away --
UpdateCodebases[LOOPHOLE[seg]];
Unlock[seg];
ProcessDefs.EnableInterrupts[];
END;
SwapOut[seg];
RETURN
END;
XCOPY: PUBLIC PROCEDURE [from: LONG POINTER, nwords: CARDINAL, to: LONG POINTER] =
BEGIN
TryBLTL: PROCEDURE[from: LONG POINTER, nwords: CARDINAL, to: LONG POINTER]
RETURNS [LONG POINTER] =
MACHINE CODE BEGIN Mopcodes.zBLTL; Mopcodes.zPUSH; Mopcodes.zPUSH; END;
Read: PROCEDURE[LONG POINTER] RETURNS [WORD] =
MACHINE CODE BEGIN Mopcodes.zRBL, 0; END;
Write: PROCEDURE[WORD, LONG POINTER] =
MACHINE CODE BEGIN Mopcodes.zWBL, 0; END;
word: WORD;
altoType: [0..7B] =
OsStaticDefs.OsStatics.AltoVersion.engineeringnumber;
lp: LONG POINTER ← TryBLTL[from, nwords, to];
IF lp ~= from THEN RETURN; -- BLTL executed in microcode --
IF altoType = 4 OR altoType = 5 THEN RETURN; -- D-machines implement BLTL --
THROUGH [0..nwords) DO -- Alto without BLTL microcode --
word ← Read[from]; Write[word, to];
from ← from + 1; to ← to + 1;
ENDLOOP;
END;
InvalidXMPage: PUBLIC ERROR[page: AltoDefs.PageNumber] = CODE;
LongAddressFromPage: PUBLIC PROCEDURE[page: AltoDefs.PageNumber] RETURNS[lp: LONG POINTER] =
BEGIN
bank: MemoryOps.BankIndex;
relpn: AltoDefs.PageNumber;
lc: InlineDefs.LongNumber;
IF page ~IN [0..XMesaDefs.MaxXPage] THEN ERROR InvalidXMPage[page];
[bank, relpn] ← InlineDefs.DIVMOD[page, XMesaDefs.PagesPerBank];
lc.lowbits ← LOOPHOLE[PAGEDISP[page: relpn, disp: 0], CARDINAL];
lc.highbits ← bank;
RETURN[lc.lu];
END;
-- Memory Allocator
-- Extra entries in PageMap are used exclusively to communicate with the Debugger -- --XM
PageMap: ARRAY [0..XMesaDefs.PagesPerBank+3) OF SegmentHandle; --XM
FreePage: SegmentHandle = BootDefs.FreePage;
BusyPage: SegmentHandle = BootDefs.BusyPage;
BankState: TYPE = RECORD --XM
[ --XM
ffvmp, lfvmp: PageNumber, -- first and last free pages (hint) -- --XM
bankAvailable: BOOLEAN, -- TRUE if bank can be accessed -- --XM
pageRover: PageNumber, -- first place to try swapping (hint) -- --XM
nFree: PageCount -- number of free pages in bank (hint) -- --XM
];
allocState: ARRAY MemoryOps.BankIndex OF BankState; --XM
PageMaps: ARRAY MemoryOps.BankIndex OF POINTER TO BootDefs.PageMap; --XM
-- *** The framesize of PageAvailable is depended on below ***
PageAvailable: PROCEDURE [page: PageNumber, info: AllocInfo]
RETURNS [available: BOOLEAN] =
BEGIN
seg: SegmentHandle;
bank: PageCount; --XM
relPage: PageNumber; --XM
dummy: ARRAY [0..4) OF WORD; -- ensure that this frame is suitably large! -- --XM
dummy[0]←0; --XM
available ← FALSE;
[bank, relPage] ← InlineDefs.DIVMOD[page, XMesaDefs.PagesPerBank]; --XM
IF bank ~IN MemoryOps.BankIndex THEN ERROR; --XM
IF PageMaps[bank] = NIL THEN RETURN; --XM
ProcessDefs.DisableInterrupts[];
seg ← PageMaps[bank][relPage]; --XM
IF seg = FreePage THEN available ← TRUE
ELSE IF seg # BusyPage THEN
WITH s: seg SELECT FROM
file =>
IF (info.effort = hard OR info.swapunlocked) AND
s.lock = 0 AND ~s.write AND ~s.busy THEN available ← TRUE;
ENDCASE;
ProcessDefs.EnableInterrupts[];
RETURN
END;
-- *** PageStatus' framesize must be <= PageAvailable's ***
PageStatus: PROCEDURE [page: PageNumber]
RETURNS [seg: SegmentHandle, status: PageState] =
BEGIN
bank: PageCount; --XM
relPage: PageNumber; --XM
[bank, relPage] ← InlineDefs.DIVMOD[page, XMesaDefs.PagesPerBank]; --XM
IF bank ~IN MemoryOps.BankIndex THEN ERROR; --XM
ProcessDefs.DisableInterrupts[];
IF PageMaps[bank] = NIL THEN seg ← BusyPage ELSE seg ← PageMaps[bank][relPage]; --XM
SELECT seg FROM
BusyPage => BEGIN status ← busy; seg ← NIL END;
FreePage => BEGIN status ← free; seg ← NIL END;
ENDCASE =>
IF seg.busy THEN BEGIN status ← free; seg ← NIL; END
ELSE status ← inuse;
ProcessDefs.EnableInterrupts[];
RETURN
END;
-- The following procedure replaces AllocVM in alloc.alloc. AllocVM is now called -- --XM
-- only as an internal procedure by XAllocVM. -- --XM
XAllocVM: PROCEDURE [base: PageNumber, pages: PageCount, seg: SegmentHandle, info: AllocInfo]
RETURNS [PageNumber] =
BEGIN
OPEN XMESA;
baseCopy: PageNumber ← DefaultBase;
i, bank: MemoryOps.BankIndex;
page: PageNumber;
worthwhile, allocSucceeded: BOOLEAN;
bankSelect: ARRAY MemoryOps.BankIndex OF BankOption;
SetForSingleBank: PROCEDURE[b: MemoryOps.BankIndex] =
BEGIN
bankSelect[0] ← b; bankSelect[1] ← LAST[BankOption];
END;
Swap: PROCEDURE[i,j: BankOption] =
BEGIN
temp: BankOption ← bankSelect[i];
bankSelect[i] ← bankSelect[j]; bankSelect[j] ← temp;
END;
OrderBanks: PROCEDURE[includeZero: BOOLEAN] =
BEGIN -- sort XM banks from most empty to fullest
bankSelect ← [1, 2, 3, 4];
IF allocState[bankSelect[0]].nFree < allocState[bankSelect[1]].nFree THEN Swap[0,1];
IF allocState[bankSelect[0]].nFree > allocState[bankSelect[2]].nFree THEN
BEGIN IF allocState[bankSelect[1]].nFree < allocState[bankSelect[2]].nFree THEN Swap[1,2] END
ELSE
BEGIN Swap[1,2]; Swap[0,1] END;
IF includeZero THEN bankSelect[LAST[MemoryOps.BankIndex]] ← 0;
END;
FrameOps.FlushLargeFrames[];
DO -- loop so that we can retry if InsufficientVM is RESUMEd
BEGIN
SELECT base FROM
< XMesaDefs.MaxXPage => -- explicit base given
BEGIN
baseCopy ← base;
SetForSingleBank[base/XMesaDefs.PagesPerBank];
END;
IN [XMesaDefs.DefaultBase0 .. XMesaDefs.DefaultBase3] =>
SetForSingleBank[base-XMesaDefs.DefaultBase0];
XMesaDefs.DefaultMDSBase =>
SetForSingleBank[0];
XMesaDefs.DefaultXMBase => OrderBanks[includeZero: FALSE];
ENDCASE => -- must be DefaultBase
IF info.class=code THEN OrderBanks[includeZero: TRUE] ELSE SetForSingleBank[0];
FOR i IN MemoryOps.BankIndex WHILE (bank ← bankSelect[i]) IN MemoryOps.BankIndex
DO
IF allocState[bank].bankAvailable THEN
BEGIN
[allocSucceeded, page] ← AllocVM[baseCopy, pages, seg, info, bank];
IF allocSucceeded THEN RETURN[page]
END;
ENDLOOP;
IF info.class=table OR info.class=frame THEN GOTO SendSignal;
FOR i IN MemoryOps.BankIndex WHILE (bank ← bankSelect[i]) IN MemoryOps.BankIndex
DO
IF allocState[bank].bankAvailable THEN
DO
pageRover ← allocState[bank].pageRover;
roverMin ← bank*XMesaDefs.PagesPerBank; roverMax ← roverMin+XMesaDefs.PagesPerBank-1;
worthwhile ← TrySwapping[pages, info, seg];
allocState[bank].pageRover ← pageRover;
IF worthwhile THEN
BEGIN
[allocSucceeded, page] ← AllocVM[baseCopy, pages, seg, info, bank];
IF allocSucceeded THEN RETURN[page];
END
ELSE EXIT;
ENDLOOP
ENDLOOP;
EXITS SendSignal => NULL;
END;
SIGNAL InsufficientVM[pages]; -- falling out of the second loop means really no room
ENDLOOP;
END;
InsufficientVM: PUBLIC SIGNAL [needed: PageCount] = CODE;
VMnotFree: PUBLIC SIGNAL [base: PageNumber, pages: PageCount] = CODE;
AllocVM: PROCEDURE [base: PageNumber, pages: PageCount, seg: SegmentHandle, info: AllocInfo,
bank: MemoryOps.BankIndex] --XM
RETURNS [success: BOOLEAN, p: PageNumber] = --XM
BEGIN
tempseg: XMESA.XSegmentHandle; --XM
n: CARDINAL;
direction: INTEGER;
vm: PageNumber;
IF base # DefaultBase THEN
DO -- repeat if requested VM not free
ProcessDefs.DisableInterrupts[];
FOR vm IN [base.. base+pages) DO
IF ~alloc.avail[vm, info] THEN EXIT;
REPEAT
FINISHED => GOTO found;
ENDLOOP;
ProcessDefs.EnableInterrupts[];
SIGNAL VMnotFree[base, pages];
REPEAT
found => NULL
ENDLOOP
ELSE
BEGIN --XM
ProcessDefs.DisableInterrupts[];
n ← 0; -- count of contiguous free pages
IF info.direction = bottomup THEN
BEGIN direction ← 1; base ← allocState[bank].ffvmp; END --XM
ELSE
BEGIN direction ← -1; base ← allocState[bank].lfvmp; END; --XM
WHILE base IN [allocState[bank].ffvmp..allocState[bank].lfvmp] DO --XM
IF ~alloc.avail[base, info] THEN n ← 0
ELSE IF (n ← n+1) = pages THEN
BEGIN IF direction>0 THEN base ← base-n+1; GOTO foundHole END;
base ← base+direction
ENDLOOP;
ProcessDefs.EnableInterrupts[];
RETURN[FALSE, 0]; -- leave strategies up to XAllocVM-- --XM
EXITS --XM
foundHole => NULL;
END; --XM
FOR vm IN [base..base+pages) DO
tempseg ← LOOPHOLE[alloc.status[vm].seg];
IF tempseg # NIL THEN
WITH s: tempseg SELECT FROM
file =>
BEGIN
csegBase: PageNumber ← s.VMpage; --XM
WITH fs: s SELECT FROM --XM
remote => IF fs.proc = XMESA.XMremote THEN csegBase ← fs.info.XMpage; --XM
ENDCASE; --XM
alloc.update[csegBase, s.pages, free, NIL]; --XM
IF s.class = code THEN UpdateCodebases[@s];
SwapOutUnlocked[@s];
END;
ENDCASE;
ENDLOOP;
alloc.update[base, pages, busy, seg];
ProcessDefs.EnableInterrupts[];
RETURN[TRUE, base] --XM
END;
-- *** UpdateVM's framesize must be <= PageAvailable's ***
UpdateVM: PROCEDURE [base: PageNumber, pages: PageCount, status: PageState,
seg: SegmentHandle] =
BEGIN
bank: PageCount; --XM
relPage: PageNumber; --XM
wereFree: PageCount ← 0; --XM
[bank, relPage] ← InlineDefs.DIVMOD[base, XMesaDefs.PagesPerBank]; --XM
IF bank ~IN MemoryOps.BankIndex OR PageMaps[bank] = NIL THEN ERROR; --XM
IF status = free THEN
BEGIN
ProcessDefs.DisableInterrupts[];
allocState[bank].ffvmp ← MIN[allocState[bank].ffvmp,base]; --XM
allocState[bank].lfvmp ← MAX[allocState[bank].lfvmp,base+pages-1]; --XM
allocState[bank].nFree ← allocState[bank].nFree+pages; --XM
ProcessDefs.EnableInterrupts[];
END;
seg ← SELECT status FROM
free => FreePage,
busy => BusyPage,
ENDCASE => IF seg = NIL THEN BusyPage ELSE seg;
ProcessDefs.DisableInterrupts[];
FOR base IN [relPage..relPage+pages) DO --XM
IF PageMaps[bank][base] = FreePage THEN wereFree ← wereFree+1; --XM
PageMaps[bank][base] ← seg; --XM
ENDLOOP;
allocState[bank].nFree ← allocState[bank].nFree-wereFree; --XM
ProcessDefs.EnableInterrupts[];
RETURN
END;
-- *** SwapOutUnlocked's framesize must be <= PageAvailable's ***
SwapOutUnlocked: PROCEDURE [seg: XMESA.XFileSegmentHandle] = --XM
BEGIN
ProcessDefs.DisableInterrupts[];
seg.swappedin ← FALSE;
WITH s: seg SELECT FROM --XM
remote => --XM
IF s.proc = XMESA.XMremote THEN -- seg.VMpage ← ChocolateToVanilla[seg,0] -- --XM
BEGIN OPEN XMESA; --XM
-- can't call ChocolateToVanilla because of possible frame trap, so... -- --XM
fh: FileHint ← s.info.hint; --XM
xsi: POINTER TO XSegInfo ← s.info; --XM
p: POINTER TO XSegInfoTable ← LOOPHOLE[xsi]; --XM
LOOPHOLE[p,PAGEDISP].disp ← 0; --XM
IF xsi.seal # InUseSeal THEN ERROR; --XM
xsi.seal ← FreeSeal; --XM
xsi.link ← p.freeHead; --XM
p.freeHead ← xsi; --XM
p.freeCount ← p.freeCount+1; --XM
seg.location ← disk[fh]; -- note that variant changes here -- --XM
END; -- don't try to release possibly empty page -- --XM
ENDCASE; --XM
seg.VMpage ← 0;
seg.file.swapcount ← seg.file.swapcount-1;
ProcessDefs.EnableInterrupts[];
END;
-- *** UpdateCodebases's framesize must be <= PageAvailable's ***
UpdateCodebases: PROCEDURE [seg: XMESA.XFileSegmentHandle] = --XM
BEGIN OPEN ControlDefs;
lastUser, f: ControlDefs.GlobalFrameHandle;
nUsers, i: CARDINAL;
epbase: CARDINAL;
segBase: PageNumber; --XM
zeroPtr: POINTER = LOOPHOLE[0]; --XM
vmpage: PageNumber; --XM
ProcessDefs.DisableInterrupts[];
nUsers ← 0;
FOR i IN [1..SDDefs.SD[SDDefs.sGFTLength]) DO
[frame: f, epbase: epbase] ← GFT[i];
IF f # NullGlobalFrame AND epbase = 0 THEN --XM
BEGIN
IF ~f.code.out THEN
BEGIN
vmpage ← LOOPHOLE[f.code.shortbase,PAGEDISP].page; --XM
IF f.code.highByte = 0 THEN vmpage ← vmpage + 256*f.code.otherByte; --XM
segBase ← seg.VMpage; --XM
WITH s:seg SELECT FROM --XM
remote => IF s.proc = XMESA.XMremote THEN segBase ← s.info.XMpage; --XM
ENDCASE; --XM
IF vmpage ~IN [segBase..segBase+seg.pages) THEN LOOP; --XM
f.code.offset ← f.code.offset - AltoDefs.PageSize*segBase; --XM
f.code.handle ← LOOPHOLE[seg]; --XM
f.code.out ← TRUE;
END
ELSE IF f.code.handle # LOOPHOLE[seg] THEN LOOP; --XM
IF ~f.shared THEN EXIT;
nUsers ← nUsers+1;
lastUser ← f;
END;
REPEAT
FINISHED => IF nUsers = 1 THEN lastUser.shared ← FALSE;
ENDLOOP;
ProcessDefs.EnableInterrupts[];
RETURN
END;
SetAllocationObject: PUBLIC PROCEDURE [new: AllocHandle]
RETURNS [old: AllocHandle] =
BEGIN
ProcessDefs.DisableInterrupts[];
old ← alloc;
alloc ← new;
ProcessDefs.EnableInterrupts[];
RETURN
END;
GetAllocationObject: PUBLIC PROCEDURE RETURNS [old: AllocHandle] =
BEGIN RETURN[alloc] END;
-- Primative Object Allocation
ObjectSeal: AltoDefs.BYTE = 21B;
InvalidObject: PUBLIC SIGNAL [object: POINTER] = CODE;
AllocateObject: PUBLIC PROCEDURE [size: CARDINAL] RETURNS [ObjectHandle] =
BEGIN OPEN BootDefs;
frob: FrobLink;
frobject: FrobHandle;
table: TableHandle;
base, length: CARDINAL;
ProcessDefs.DisableInterrupts[];
FOR table ← systemTable.table, table.link UNTIL table = NIL DO
IF table.free.fwdp # FIRST[FrobLink] THEN
BEGIN
base ← LOOPHOLE[table, CARDINAL];
FOR frob ← table.free.fwdp, frobject.fwdp UNTIL frob = FIRST[FrobLink] DO
frobject ← base+frob;
length ← frobject.size;
UNTIL frob+length > FrobNull DO
WITH n: LOOPHOLE[frobject+length, ObjectHandle] SELECT FROM
free => -- coalesce nodes
BEGIN
(base+n.fwdp).backp ← n.backp;
(base+n.backp).fwdp ← n.fwdp;
length ← length + n.size;
END;
ENDCASE => EXIT;
ENDLOOP;
SELECT length FROM
= size =>
BEGIN
(base+frobject.fwdp).backp ← frobject.backp;
(base+frobject.backp).fwdp ← frobject.fwdp;
table.free.size ← table.free.size + size;
ProcessDefs.EnableInterrupts[];
RETURN[frobject];
END;
> size =>
BEGIN
frobject.size ← length - size;
table.free.size ← table.free.size + size;
ProcessDefs.EnableInterrupts[];
RETURN[frobject+length-size];
END;
ENDCASE => frobject.size ← length;
ENDLOOP;
END;
ENDLOOP;
table ← AllocateTable[! UNWIND => ProcessDefs.EnableInterrupts[]];
frob ← table.free.fwdp;
frobject ← LOOPHOLE[table, CARDINAL]+frob;
frobject.size ← frobject.size - size;
table.free.size ← table.free.size + size;
ProcessDefs.EnableInterrupts[];
RETURN[frobject+frobject.size];
END;
LiberateObject: PUBLIC PROCEDURE [object: ObjectHandle] =
BEGIN
table: TableHandle ← SegmentDefs.PagePointer[object];
size, base: CARDINAL;
frob: FrobLink ← InlineDefs.BITAND[object, 377B];
base ← LOOPHOLE[table];
ValidateObject[object];
size ← WITH o: object SELECT FROM
segment => SELECT o.type FROM
data => SIZE[data segment Object],
ENDCASE => SIZE[file segment Object],
file => SIZE[file Object],
ENDCASE => SIZE[length Object];
ProcessDefs.DisableInterrupts[];
IF (table.free.size ← table.free.size - size) = 0 THEN
LiberateTable[table ! UNWIND => ProcessDefs.EnableInterrupts[]]
ELSE
BEGIN
object↑ ← Object[FALSE, free[seal: ObjectSeal, size: size,
fwdp: table.free.fwdp, backp: FIRST[FrobLink]]];
(base+table.free.fwdp).backp ← frob;
table.free.fwdp ← frob;
END;
ProcessDefs.EnableInterrupts[];
RETURN
END;
AllocateTable: PROCEDURE RETURNS [newTable: TableHandle] =
BEGIN OPEN BootDefs, SegmentDefs;
frob: FrobLink = LOOPHOLE[SIZE[Table]];
base: CARDINAL;
page: PageNumber;
page ←
alloc.alloc[DefaultBase, 1, NIL, AllocDefs.DefaultTableSegmentInfo];
newTable ← AddressFromPage[page];
newTable↑ ←
Table[[FALSE, free[ObjectSeal,0, frob, frob]],systemTable.table,NIL];
base ← LOOPHOLE[newTable];
(base+frob)↑ ← [FALSE, free[ObjectSeal, AltoDefs.PageSize-SIZE[Table],
FIRST[FrobLink], FIRST[FrobLink]]];
systemTable.table ← newTable;
systemTable.table.seg ← BootDataSegment[page, 1];
RETURN
END;
LiberateTable: PROCEDURE [table:TableHandle] =
BEGIN
current: TableHandle;
prev: TableHandle ← NIL;
FOR current ← systemTable.table, current.link UNTIL current = NIL DO
IF current = table THEN
BEGIN
IF prev = NIL
THEN systemTable.table ← current.link
ELSE prev.link ← current.link;
-- oops: this had better not recur!
DeleteDataSegment[current.seg];
RETURN
END;
prev ← current;
ENDLOOP;
ERROR InvalidObject[table];
END;
ValidateObject: PUBLIC PROCEDURE [object:ObjectHandle] =
BEGIN
t: TableHandle;
table: TableHandle = PagePointer[object];
BEGIN
IF object = NIL OR InlineDefs.BITAND[LOOPHOLE[object, CARDINAL], 1] = 1 OR
object.tag = free THEN GOTO invalid;
IF table.free.seal # ObjectSeal THEN GOTO invalid;
FOR t ← systemTable.table, t.link UNTIL t = NIL DO
IF t = table THEN EXIT;
REPEAT
FINISHED => GOTO invalid;
ENDLOOP;
EXITS
invalid => ERROR InvalidObject[object];
END;
RETURN
END;
EnumerateObjects: PUBLIC PROCEDURE [type: ObjectType,
proc:PROCEDURE [ObjectHandle] RETURNS [BOOLEAN]]
RETURNS [object: ObjectHandle] =
BEGIN
i, j: CARDINAL;
table: TableHandle;
FOR table ← systemTable.table, table.link UNTIL table = NIL DO
j ← i ← SIZE[BootDefs.Table];
FOR object ← @table.free + i, object + i UNTIL j >= AltoDefs.PageSize DO
i ← WITH obj:object SELECT FROM
segment => SELECT obj.type FROM
data => SIZE[data segment Object],
ENDCASE => SIZE[file segment Object],
file => SIZE[file Object],
free => obj.size,
ENDCASE => SIZE[length Object];
j ← j + i;
IF object.tag = type AND proc[object] THEN RETURN[object];
ENDLOOP;
ENDLOOP;
RETURN[NIL]
END;
-- Managing Data Segment Objects
AllocateDataSegment: PROCEDURE RETURNS [DataSegmentHandle] =
BEGIN
RETURN[LOOPHOLE[AllocateObject[SIZE[data segment Object]]]];
END;
ValidateDataSegment: PROCEDURE [DataSegmentHandle] = LOOPHOLE[ValidateObject];
LiberateDataSegment: PROCEDURE [DataSegmentHandle] = LOOPHOLE[LiberateObject];
GetSystemTable: PUBLIC PROCEDURE RETURNS [BootDefs.SystemTableHandle] =
BEGIN
RETURN[@systemTable];
END;
-- Memory Bank Management Initialization -- --XM
InitBank: PROCEDURE [bx: MemoryOps.BankIndex] =
BEGIN OPEN XMESA, XMesaDefs;
i: PageNumber;
bankPageMap: POINTER TO BootDefs.PageMap;
IF bx#0 THEN BEGIN ffvmp ← bx*PagesPerBank; lfvmp ← ffvmp+PagesPerBank-3; END;
allocState[bx] ←
[ffvmp: ffvmp, lfvmp: lfvmp, pageRover: ffvmp, nFree: lfvmp-ffvmp+1, bankAvailable: TRUE];
bankPageMap ← PageMaps[bx] ←
IF bx=0 THEN LOOPHOLE[@PageMap]
ELSE (PageMap[bx+Bank1X-1] ←
DataSegmentAddress[MakeDataSegment[DefaultBase0, 1, PageMapAllocInfo]]);
FOR i IN [0..PagesPerBank) DO
bankPageMap[i] ← IF i+bx*PagesPerBank IN [ffvmp .. lfvmp] THEN FreePage ELSE BusyPage;
ENDLOOP;
END;
EnableBank: PUBLIC PROCEDURE [b: MemoryOps.BankIndex] =
BEGIN
IF PageMaps[b] # NIL THEN allocState[b].bankAvailable ← TRUE
ELSE InitBank[b];
END;
DisableBank: PUBLIC PROCEDURE [b: MemoryOps.BankIndex] =
BEGIN
allocState[b].bankAvailable ← FALSE;
END;
-- Main body
systemTable: BootDefs.SystemTable ← BootDefs.SystemTable[LOOPHOLE[@PageMap], NIL];
systemObject: AllocDefs.AllocObject;
alloc: AllocHandle ← @systemObject;
-- The initialization code has been almost completely rewritten for XMesa -- --XM
Init: PROCEDURE =
BEGIN
bx: MemoryOps.BankIndex;
memConfig: MemoryOps.MemoryConfig ← MemoryOps.GetMemoryConfig[];
FOR bx IN MemoryOps.BankIndex
DO
IF (~memConfig.useXM AND bx # 0) OR
InlineDefs.BITAND[memConfig.banks, XMESA.BankMasks[bx]] = 0 THEN
BEGIN
allocState[bx].nFree ← 0; allocState[bx].bankAvailable←FALSE;
allocState[bx].ffvmp ← bx*XMesaDefs.PagesPerBank;
allocState[bx].lfvmp ← allocState[bx].ffvmp-1;
PageMaps[bx] ← PageMap[bx+XMESA.Bank1X-1] ← NIL;
END
ELSE InitBank[bx];
ENDLOOP;
END;
START NucleusDefs.Miscellaneous; --XM
alloc↑ ← [PageAvailable, PageStatus, UpdateVM, XAllocVM]; --XM
Init[];
END.....