-- Swapper.Mesa  Edited by Sandman on Mar 15, 1979 12:06 PM
--		  Edited for XMesa by Levin on March 19, 1979  9:29 AM

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],
  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],
  SystemDefs: FROM "systemdefs" USING [FreePages],
  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, SystemDefs, 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];
    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;
      SystemDefs.FreePages[p];
      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 longP _ longP + info;					--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;
    lp: LONG POINTER _ TryBLTL[from, nwords, to];
    IF lp ~= from THEN RETURN;	-- BLTL executed in microcode --
    THROUGH [0..nwords) DO
      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.....