-- Miscellaneous.mesa; edited by Levin, July 25, 1979  9:39 AM
--			 edited for XMesa by Levin, April 18, 1979  12:53 PM

DIRECTORY
  AllocDefs: FROM "allocdefs" USING [AllocHandle, AllocInfo, GetAllocationObject, MakeSwappedIn],
  AltoDefs: FROM "altodefs" USING [MaxVMPage, PageNumber, PageSize],
  AltoFileDefs: FROM "altofiledefs" USING [TIME],
  BcdDefs: FROM "bcddefs" USING [
    NullLink, NullVersion, VersionID, VersionStamp, UnboundLink],
  BitBltDefs: FROM "bitbltdefs" USING [BBTable, BBptr, BITBLT, LongBBTable],
  BootDefs: FROM "bootdefs" USING [EnumerateObjects],
  ControlDefs: FROM "controldefs" USING [
    FrameHandle, GFT, GFTIndex, GlobalFrameHandle, NullEpBase,
    NullGlobalFrame],
  FrameDefs: FROM "framedefs" USING [
    EnumerateGlobalFrames, GlobalFrame, RemoveGlobalFrame,
    SwapInCode, SwapOutCode, UnNew, ValidateGlobalFrame],
  FrameOps: FROM "frameops" USING [
    CodeHandle, Free, GetReturnFrame, SetReturnLink],
  ImageDefs: FROM "imagedefs" USING [
    AbortMesa, CleanupItem, CleanupMask, CleanupProcedure, StopMesa],
  ImageFormat: FROM "imageformat" USING [ImageHeader, VersionID],
  InlineDefs: FROM "inlinedefs" USING [
    BITAND, BITOR, BITSHIFT, COPY, HighHalf, LongNumber, LowHalf],
  MemoryOps: FROM "memoryops" USING [
    BankIndex, Direction, DisableBank, EnableBank, MemoryConfig, memoryConfig],
  MiscDefs: FROM "miscdefs" USING [DAYTIME],
  Mopcodes: FROM "mopcodes" USING [zMISC, zSTARTIO],
  NovaOps: FROM "novaops" USING [NovaJSR],
  NucleusDefs: FROM "nucleusdefs" USING [Resident],
  OsStaticDefs: FROM "osstaticdefs" USING [OsStatics],
  ProcessDefs: FROM "processdefs" USING [DisableInterrupts, EnableInterrupts],
  SDDefs: FROM "sddefs" USING [SD, sGoingAway],
  SegmentDefs: FROM "segmentdefs" USING [
    DataSegmentHandle, DefaultBase, DeleteFileSegment, EnumerateFileSegments, FileSegmentAddress,
    FileSegmentHandle, MoveFileSegment, NewFileSegment, ObjectHandle, Read, SegmentHandle, SwapError,
    SwapIn, Unlock],
  XMESA: FROM "xmesaops" USING [
    BankMasks, ChocolateToVanilla, SwapOutFileSegment, VanillaToChocolate, XDataSegmentHandle,
    XFileSegmentHandle, XMremote, XObject],
  XMesaDefs: FROM "xmesadefs" USING [
    DefaultMDSBase, DefaultXMBase, LongAddressFromPage, PagesPerBank, XCOPY];

Miscellaneous: PROGRAM
  IMPORTS AllocDefs, BitBltDefs, BootDefs, FrameDefs, FrameOps,
    ImageDefs, InlineDefs, MiscDefs, MemoryOps, NovaOps, NucleusDefs,
    ProcessDefs, SegmentDefs, XMESA, XMesaDefs
  EXPORTS FrameDefs, FrameOps, ImageDefs, MemoryOps, MiscDefs,
    NucleusDefs, XMesaDefs
  SHARES MemoryOps, SegmentDefs, XMESA = PUBLIC
  BEGIN OPEN ControlDefs, MemoryOps;

  DeletedFrame: PROCEDURE [gfi: GFTIndex] RETURNS [BOOLEAN] =
    BEGIN
    RETURN[GFT[gfi] = [frame: NullGlobalFrame, epbase: NullEpBase]];
    END;

  LockCode: PROCEDURE [link: UNSPECIFIED] =
    BEGIN
    FrameDefs.SwapInCode[FrameDefs.GlobalFrame[link]];
    RETURN
    END;

  UnlockCode: PROCEDURE [link: UNSPECIFIED] =
    BEGIN OPEN FrameDefs;
    seg: SegmentDefs.FileSegmentHandle _ CodeHandle[GlobalFrame[link]];
    IF seg # NIL THEN SegmentDefs.Unlock[seg];
    RETURN
    END;

  CodeHandle: PROCEDURE [frame: GlobalFrameHandle]
    RETURNS [seg: SegmentDefs.FileSegmentHandle] =
    BEGIN
    FrameDefs.ValidateGlobalFrame[frame];
    RETURN[IF frame.code.highByte = 0 THEN XVMtoFileSegment[frame.code.longbase]		--XM
	    ELSE frame.code.handle]
    END;

  MoveCode: PROCEDURE [direction: Direction] =							--XM
    BEGIN OPEN SegmentDefs;
    alloc: AllocDefs.AllocHandle _ AllocDefs.GetAllocationObject[];
    CheckOne: PROCEDURE[fseg: FileSegmentHandle] RETURNS[BOOLEAN] =
      BEGIN OPEN seg: LOOPHOLE[fseg, XMESA.XFileSegmentHandle];
      ChangeFlavorProc: TYPE = PROCEDURE[newVMpage: AltoDefs.PageNumber] RETURNS[AltoDefs.PageNumber];
      MoveThisSegment: PROCEDURE[basePage: AltoDefs.PageNumber, proc: ChangeFlavorProc] =
	BEGIN OPEN XMesaDefs;
	ResidentCodeInfo: AllocDefs.AllocInfo = [0, hard, bottomup, initial, code, TRUE, FALSE];
	oldVMpage, newVMpage: AltoDefs.PageNumber;
	delta: LONG CARDINAL;
	UpdateCodebase: PROCEDURE[f: GlobalFrameHandle] RETURNS[BOOLEAN] =
	  BEGIN
	  IF CodeHandle[f] = fseg AND ~f.code.out THEN
	    SELECT direction FROM
	      outofMDS => f.code.longbase _ LONG[f.code.shortbase]+delta;
	      intoMDS =>
		BEGIN
		f.code.longbase _ f.code.longbase+delta;
		IF f.code.highHalf # 0 THEN ERROR;
		f.code.handle _ fseg;
		END;
	      ENDCASE;
	  RETURN[FALSE]
	  END;

	-- body of MoveThisSegment

	SwapIn[fseg];
	newVMpage _ alloc.alloc[basePage, fseg.pages, fseg, ResidentCodeInfo];
	ProcessDefs.DisableInterrupts[];
	oldVMpage _ proc[newVMpage];
	XCOPY[from: LongAddressFromPage[oldVMpage],
	      to: LongAddressFromPage[newVMpage],
	      nwords: AltoDefs.PageSize*fseg.pages];
	delta _ AltoDefs.PageSize * (LONG[newVMpage] - LONG[oldVMpage]);
	[] _ FrameDefs.EnumerateGlobalFrames[UpdateCodebase];
	alloc.update[oldVMpage, fseg.pages, free, NIL];
	alloc.update[newVMpage, fseg.pages, inuse, fseg];
	ProcessDefs.EnableInterrupts[];
	Unlock[fseg];
	END;

      -- body of CheckOne

      IF seg.class = code AND seg.lock > 0 THEN
	WITH s:seg SELECT FROM
	  disk =>
	    SELECT direction FROM
	      outofMDS =>
		BEGIN
		VtC: ChangeFlavorProc =
		  BEGIN
		  RETURN[XMESA.VanillaToChocolate[fseg, newVMpage]] -- note: variant changes here
		  END;
		MoveThisSegment[XMesaDefs.DefaultXMBase, VtC];
		END;
	      intoMDS => NULL;
	      ENDCASE;
	  remote =>
	    IF s.proc = XMESA.XMremote THEN
	      SELECT direction FROM
		outofMDS => NULL;
		intoMDS =>
		  BEGIN
		  CtV: ChangeFlavorProc =
		    BEGIN
		    RETURN[XMESA.ChocolateToVanilla[@seg, newVMpage]] -- note: variant changes here
		    END;
		  MoveThisSegment[XMesaDefs.DefaultMDSBase, CtV];
		  END;
		ENDCASE;
	  ENDCASE;
      RETURN[FALSE]
      END;

    -- body of MoveCode

    IF ~memConfig.useXM THEN RETURN;
    [] _ EnumerateFileSegments[CheckOne];
    END;

  -- EnableBank and DisableBank moved to the Swapper --						--XM

  EnableHyperspace: PROCEDURE =
    BEGIN
    i: CARDINAL;										--XM
    IF memConfig.useXM THEN									--XM
      FOR i IN (FIRST[BankIndex]..LAST[BankIndex]] DO						--XM
	IF InlineDefs.BITAND[XMESA.BankMasks[i], memConfig.banks] # 0 THEN EnableBank[i];	--XM
	ENDLOOP;										--XM
    END;											--XM

  ImmovableSegmentInXM: PUBLIC SIGNAL[SegmentDefs.SegmentHandle] = CODE;			--XM

  DisableHyperspace: PROCEDURE =								--XM
    BEGIN											--XM
    i: BankIndex;										--XM
    XSegment: PROCEDURE [op: SegmentDefs.ObjectHandle] RETURNS [BOOLEAN] =			--XM
      BEGIN OPEN objptr: LOOPHOLE[op, POINTER TO XMESA.XObject];				--XM
      WITH s: objptr SELECT FROM								--XM
        segment =>										--XM
  	WITH xs: s SELECT FROM									--XM
  	  data => IF xs.VMpage = 0 THEN SIGNAL ImmovableSegmentInXM[LOOPHOLE[@s]];		--XM
  	  file =>										--XM
  	    WITH x: xs SELECT FROM								--XM
  	      remote =>										--XM
  		IF x.proc = XMESA.XMremote THEN							--XM
  		  IF xs.lock # 0 THEN SIGNAL ImmovableSegmentInXM[LOOPHOLE[@s]]			--XM
  		  ELSE XMESA.SwapOutFileSegment[LOOPHOLE[@xs, SegmentDefs.FileSegmentHandle]];	--XM
  	      ENDCASE;										--XM
  	  ENDCASE;										--XM
        ENDCASE;										--XM
      RETURN[FALSE]										--XM
      END;											--XM

    FOR i IN (FIRST[BankIndex]..LAST[BankIndex]] DO DisableBank[i]; ENDLOOP;			--XM
    [] _ BootDefs.EnumerateObjects[segment, XSegment];						--XM
    RETURN
    END;											--XM

  IsXMesa: PROCEDURE RETURNS [BOOLEAN] = BEGIN RETURN[TRUE] END;				--XM

  GetMDS: PROCEDURE RETURNS[BankIndex] = BEGIN RETURN[memConfig.mdsBank] END;

  SetMDS: PROCEDURE[mds: BankIndex] = BEGIN memConfig.mdsBank _ mds; END;

  -- D0/Dorado hyperspace stuff

  MapFlags: TYPE = MACHINE DEPENDENT RECORD [
    LogSE, W, D, Ref: BOOLEAN];

  VacantFlags: MapFlags = [FALSE, TRUE, TRUE, FALSE];
  WriteProtectedFlags: MapFlags = [FALSE, TRUE, FALSE, FALSE];
  CleanFlags: MapFlags = [FALSE, FALSE, FALSE, FALSE];

  MapEntry: TYPE = MACHINE DEPENDENT RECORD [
    flags: MapFlags,
    realPage: [0..7777B]];

  Vacant: MapEntry = [VacantFlags,0];
  WriteProtected: MapEntry = [WriteProtectedFlags,0];
  Clean: MapEntry = [CleanFlags,0];

  ASSOC: PROCEDURE [CARDINAL, MapEntry] =
    MACHINE CODE BEGIN Mopcodes.zMISC, 0 END;

  SETF: PROCEDURE [CARDINAL, MapEntry] RETURNS [MapEntry] =
    MACHINE CODE BEGIN Mopcodes.zMISC, 1 END;

  memConfig: MemoryConfig;

  InitMemoryConfig: PROCEDURE =
    BEGIN
    t: MapEntry;
    memConfig _ memoryConfig^;
    IF memConfig.AltoType = D0 OR memConfig.AltoType = Dorado THEN
      BEGIN
      bankSize: CARDINAL = 256;
      pageCount: CARDINAL;
      banks: WORD _ 0;
      bit: WORD _ 10B;
      FOR pageCount _ bankSize, pageCount+1 DO
        t _ SETF[pageCount, Clean];
        IF t = Vacant THEN EXIT;
        ENDLOOP;
      WHILE pageCount >= bankSize AND bit # 0 DO
        banks _ InlineDefs.BITOR[banks, bit];
	bit _ InlineDefs.BITSHIFT[bit, -1];
        pageCount _ pageCount - bankSize;
	ENDLOOP;
      IF banks # 10B THEN
	BEGIN
	memConfig.banks _ banks;
	memConfig.useXM _ TRUE;
	END;
      END;
    END;

  GetMemoryConfig: PROCEDURE RETURNS [MemoryConfig] =
    BEGIN RETURN[memConfig] END;

  -- FrameOK deleted - unnecessary in XMesa --							--XM

  -- Procedures Exported to XMesaDefs --							--XM

  InvalidLongPointer: ERROR [ptr: LONG POINTER] = CODE;

  PAGEDISP: TYPE = MACHINE DEPENDENT RECORD[
    page: [0..AltoDefs.MaxVMPage],
    disp: [0..AltoDefs.PageSize)];

  -- LongAddressFromPage is in the Swapper (it must be resident for SwapInCode) --

  PageFromLongAddress: PROCEDURE[lp: LONG POINTER] RETURNS[page: AltoDefs.PageNumber] =
    BEGIN
    bank: BankIndex _ InlineDefs.HighHalf[lp];
    IF bank ~IN BankIndex THEN ERROR InvalidLongPointer[lp];
    RETURN[bank*XMesaDefs.PagesPerBank+LOOPHOLE[InlineDefs.LowHalf[lp],PAGEDISP].page];
    END;

  XVMtoSegment: PROCEDURE [a: LONG POINTER] RETURNS [SegmentDefs.SegmentHandle] = 
    BEGIN
    RETURN[AllocDefs.GetAllocationObject[].status[PageFromLongAddress[a]].seg]
    END;

  XSegmentAddress: PROCEDURE [seg: SegmentDefs.SegmentHandle] RETURNS [lp: LONG POINTER] = 
    BEGIN
    WITH s: seg SELECT FROM
      data => lp _ XDataSegmentAddress[@s];
      file => lp _ IF ~s.swappedin THEN NIL ELSE XFileSegmentAddress[@s];
      ENDCASE
    END;

  XVMtoDataSegment: PROCEDURE [a: LONG POINTER] RETURNS [SegmentDefs.DataSegmentHandle] = 
    BEGIN
    seg: SegmentDefs.SegmentHandle _ XVMtoSegment[a];
    IF seg # NIL THEN
      WITH ds: seg SELECT FROM data => RETURN[@ds]; ENDCASE;
    RETURN[NIL]
    END;

  XDataSegmentAddress: PROCEDURE [seg:SegmentDefs.DataSegmentHandle] RETURNS [LONG POINTER] =
    BEGIN OPEN s: LOOPHOLE[seg, XMESA.XDataSegmentHandle];
    vmpage: AltoDefs.PageNumber _ IF s.VMpage # 0 THEN seg.VMpage ELSE s.XMpage;
    RETURN[LOOPHOLE[LONG[vmpage]*AltoDefs.PageSize]]
    END;

  XVMtoFileSegment: PROCEDURE [a: LONG POINTER] RETURNS [SegmentDefs.FileSegmentHandle] =
    BEGIN
    seg: SegmentDefs.SegmentHandle _ XVMtoSegment[a];
    IF seg # NIL THEN
      WITH fs: seg SELECT FROM file => RETURN[@fs]; ENDCASE;
    RETURN[NIL]
    END;

  XFileSegmentAddress: PROCEDURE [seg: SegmentDefs.FileSegmentHandle] RETURNS [LONG POINTER] =
    BEGIN
    vmpage: AltoDefs.PageNumber _ seg.VMpage;
    IF ~seg.swappedin THEN ERROR SegmentDefs.SwapError[seg];
    WITH xs: LOOPHOLE[seg, XMESA.XFileSegmentHandle] SELECT FROM
	remote => IF xs.proc = XMESA.XMremote THEN vmpage _ xs.info.XMpage;
	ENDCASE;
    RETURN[XMesaDefs.LongAddressFromPage[vmpage]]
    END;

  NovaBBArgBlock: TYPE = MACHINE DEPENDENT RECORD
	[
	fill: [0..37777B],
	bank: BankIndex,
	bbt: BitBltDefs.BBptr
	];

  NovaCode: ARRAY [0..16) OF CARDINAL _
	[
	54415B,		-- STA	3 saveret
	115000B,	-- MOV	0 3		AC3: @arg
	22415B,		-- LDA	0 @bankno
	40413B,		-- STA	0 savebank	savebank _ EmulatorBankRegister
	21400B,		-- LDA	0 0,3
	42412B,		-- STA	0 @bankno	EmulatorBankRegister _ arg.bank
	31401B,		-- LDA	2 1,3		AC2: arg.bbt
	126400B,	-- SUB	1 1		AC1: 0
	61024B,		-- BITBLT
	20405B,		-- LDA	0 savebank
	42405B,		-- STA	0 @bankno	EmulatorBankRegister _ savebank
	34402B,		-- LDA	3 saveret
	1400B,		-- JMP	0 3
	0B,		-- saveret: 0
	0B,		-- savebank: 0
	177740B		-- bankno: 177740
	];

  XMNotAvailable: ERROR = CODE;

  XBitBlt: PROCEDURE[bbt: BitBltDefs.BBptr, bank: BankIndex] =
    BEGIN OPEN BitBltDefs, InlineDefs;
    IF ~bbt.sourcealt AND ~bbt.destalt THEN
      BEGIN BITBLT[bbt]; RETURN END;
    IF (bank ~IN BankIndex) OR ~memConfig.useXM OR
	BITAND[XMESA.BankMasks[bank],memConfig.banks] = 0 THEN
	    ERROR XMNotAvailable;
    IF memConfig.AltoType = D0 THEN
      BEGIN
      Even: PROCEDURE [a: UNSPECIFIED] RETURNS [UNSPECIFIED] = INLINE
	BEGIN RETURN[a+LOOPHOLE[a,CARDINAL] MOD 2] END;
      LP: PROCEDURE [low,high: UNSPECIFIED] RETURNS [LONG POINTER] =
	MACHINE CODE BEGIN END;
      BITBLTL: PROCEDURE [POINTER TO LongBBTable] =
	LOOPHOLE[BITBLT];
      lbbtable: ARRAY [0..SIZE[LongBBTable]] OF WORD;
      lbbt: POINTER TO LongBBTable _ Even[@lbbtable];
      InlineDefs.COPY[from:bbt, to:lbbt, nwords: SIZE[BBTable]];
      lbbt.ptrs _ D0;
      IF lbbt.sourcealt THEN
	BEGIN
	lbbt.slbca _ LP[low: lbbt.sbca, high: bank];
	lbbt.sourcealt _ FALSE;
	END
      ELSE lbbt.slbca _ LP[low: lbbt.sbca, high: memConfig.mdsBank];
      IF lbbt.destalt THEN
	BEGIN
	lbbt.dlbca _ LP[low: lbbt.dbca, high: bank];
	lbbt.destalt _ FALSE;
	END
      ELSE lbbt.dlbca _ LP[low: lbbt.dbca, high: memConfig.mdsBank];
      BITBLTL[lbbt];
      END
    ELSE
      BEGIN
      arg: NovaBBArgBlock _ [fill: 0, bank: bank, bbt: bbt];
      [] _ NovaOps.NovaJSR[code: JSR, address: @NovaCode, arg: @arg];
      END;
    END;




  MakeCodeResident: PROCEDURE [f: GlobalFrameHandle] =
    BEGIN OPEN SegmentDefs;
    seg: FileSegmentHandle;
    info: AllocDefs.AllocInfo = [unused: 0, effort: hard, direction: bottomup,
      request: initial, class: code, swapunlocked: TRUE, compact: FALSE];
    IF (seg _ FrameOps.CodeHandle[f]) = NIL THEN RETURN;
    IF seg.lock = 0 THEN FrameDefs.SwapOutCode[f];
    AllocDefs.MakeSwappedIn[seg, DefaultBase, info];
    RETURN
    END;

  GetCaller: PROCEDURE RETURNS [PROGRAM] =
    BEGIN
    RETURN[LOOPHOLE[FrameOps.GetReturnFrame[].returnlink.frame.accesslink]];
    END;

  IsBound: PROCEDURE [link: UNSPECIFIED] RETURNS [BOOLEAN] =
    BEGIN
    RETURN[link # BcdDefs.UnboundLink AND link # BcdDefs.NullLink];
    END;

  SelfDestruct: PROCEDURE =
    BEGIN
    destructee: FrameHandle _ FrameOps.GetReturnFrame[];
    FrameOps.SetReturnLink[destructee.returnlink];
    FrameDefs.UnNew[FrameDefs.GlobalFrame[destructee]];
    FrameOps.Free[destructee];
    RETURN
    END;

  -- data shuffling

  SetBlock: PROCEDURE [p:POINTER, v:UNSPECIFIED, l:CARDINAL] =
    BEGIN
    IF l=0 THEN RETURN;  p^ _ v;
    InlineDefs.COPY[from:p, to:p+1, nwords:l-1];
    END;


  -- Bcd Version and Time

  Version: PROCEDURE [frame: GlobalFrameHandle, type: {bcd, image}]
    RETURNS [version: BcdDefs.VersionStamp] =
    BEGIN OPEN SegmentDefs;
    codeseg: FileSegmentHandle _ FrameOps.CodeHandle[frame];
    seg: FileSegmentHandle;
    image: POINTER TO ImageFormat.ImageHeader;
    id: CARDINAL;
    p: POINTER TO RECORD [a, pages: CARDINAL];
    IF codeseg = NIL THEN RETURN[BcdDefs.NullVersion];
    seg _ NewFileSegment[codeseg.file, 1, 1, Read];
    SwapIn[seg];
    image _ p _ FileSegmentAddress[seg];
    IF type = image AND image.prefix.versionident # ImageFormat.VersionID THEN
      BEGIN
      base: CARDINAL _ p.pages+2;
      Unlock[seg];
      MoveFileSegment[seg, base, 1];
      SwapIn[seg];
      image _ FileSegmentAddress[seg];
      END;
    id _ image.prefix.versionident;
    version _ IF (type = image AND id = ImageFormat.VersionID) OR
      (type = bcd AND id = BcdDefs.VersionID)
      THEN image.prefix.version ELSE BcdDefs.NullVersion;
    Unlock[seg];
    DeleteFileSegment[seg];
    RETURN
    END;

  BcdVersion: PROCEDURE RETURNS [version: BcdDefs.VersionStamp] =
    BEGIN OPEN FrameDefs, FrameOps;
    RETURN[Version[frame: GlobalFrame[GetReturnFrame[]], type: bcd]]
    END;

  BcdTime: PROCEDURE RETURNS [time: LONG CARDINAL] =
    BEGIN OPEN FrameDefs, FrameOps;
    RETURN[Version[frame: GlobalFrame[GetReturnFrame[]], type: bcd].time]
    END;

  -- Image Version and Time

  ImageVersion: PROCEDURE RETURNS [version: BcdDefs.VersionStamp] =
    BEGIN OPEN FrameDefs;
    RETURN[Version[frame: GlobalFrame[NucleusDefs.Resident], type: image]]
    END;

  ImageTime: PROCEDURE RETURNS [time: LONG CARDINAL] =
    BEGIN
    RETURN[ImageVersion[].time]
    END;

  CurrentTime: PROCEDURE RETURNS [LONG CARDINAL] =
    BEGIN
    time: AltoFileDefs.TIME _ MiscDefs.DAYTIME[];
    RETURN[LOOPHOLE[
      InlineDefs.LongNumber[num[highbits: time.high, lowbits: time.low]]]];
    END;


  -- Fake Modules

  DestroyFakeModule: PROCEDURE [f: GlobalFrameHandle]
    RETURNS [seg: SegmentDefs.FileSegmentHandle, offset: CARDINAL] =
    BEGIN
    FrameDefs.ValidateGlobalFrame[f];
    seg _ CodeHandle[f];
    IF seg = NIL THEN RETURN[NIL, 0];
    IF ~f.shared THEN seg.class _ other;
    FrameDefs.RemoveGlobalFrame[f];
    ProcessDefs.DisableInterrupts[];
    IF f.code.out THEN
      BEGIN
      f.code.out _ FALSE;
      offset _ f.code.offset;
      END
    ELSE offset _ f.code.offset - seg.VMpage*AltoDefs.PageSize;
    ProcessDefs.EnableInterrupts[];
    RETURN
    END;

  -- Get Network Number
  
  wordsPerPup: INTEGER = 280;
  Byte: TYPE = [0..255];
  
  PupHeader:TYPE= MACHINE DEPENDENT RECORD [
    eDest, eSource: Byte,
    eWord2, pupLength: INTEGER,
    transportControl, pupType: Byte,
    pupID1, pupID2: INTEGER,
    destNet, destHost: Byte,
    destSocket1, destSocket2: INTEGER,
    sourceNet, sourceHost: Byte,
    sourceSocket1, sourceSocket2: INTEGER,
    xSum:CARDINAL];
  
  Pup:TYPE= MACHINE DEPENDENT RECORD [
    head:PupHeader,
    junk:ARRAY [0..100] OF WORD];
  
  EthernetDeviceBlock: TYPE = MACHINE DEPENDENT RECORD [
      EPLocMicrocodeStatus, EPLocHardwareStatus: Byte,
      EBLocInterruptBit: WORD,
      EELocInputFinishCount: INTEGER,
      ELLocCollisionMagic: WORD,
      EILocInputCount: INTEGER,
      EILocInputPointer: POINTER,
      EOLocOutputCount: INTEGER,
      EOLocOutputPointer: POINTER];
    
  
  timer: POINTER TO INTEGER = LOOPHOLE[430B];
  
  GetNetworkNumber: PROCEDURE RETURNS[CARDINAL] =
    BEGIN
    myHost: Byte _ OsStaticDefs.OsStatics.SerialNumber;
    then: INTEGER;
    now: INTEGER;
    device: POINTER TO EthernetDeviceBlock _ LOOPHOLE[600B];
    xpup: Pup;
    pup: POINTER TO Pup = @xpup;
    -- StartIO is Mesa bytecode used to control Ethernet interface
    StartIO: PROCEDURE [WORD] = MACHINE CODE BEGIN Mopcodes.zSTARTIO END;
    outputCommand: WORD = 1;
    inputCommand: WORD = 2;
    resetCommand: WORD = 3;
    gatewayRequest:PupHeader _ [
      eDest: 0,               eSource: myHost,
      eWord2: 1000B,          pupLength: 22,
      transportControl: 0,    pupType: 200B,
      pupID1:,                pupID2:,
      destNet: 0,             destHost: 0,
      destSocket1: 0,         destSocket2: 2,
      sourceNet: 0,           sourceHost: myHost,
      sourceSocket1: 0,       sourceSocket2: 2,
      xSum: 177777B];
    device.EBLocInterruptBit _ 0;
    THROUGH [0..2) DO
      StartIO[resetCommand];
      device^ _ EthernetDeviceBlock[
	EPLocMicrocodeStatus: 0,
	EPLocHardwareStatus: 0,
	EBLocInterruptBit: 0,
	EELocInputFinishCount: 0,
	ELLocCollisionMagic: 0,
	EILocInputCount: 0,
	EILocInputPointer: pup,
	EOLocOutputCount: 13,
	EOLocOutputPointer: @gatewayRequest];
      StartIO[outputCommand];
      then _ timer^;
      DO
	IF device.EPLocHardwareStatus#0 THEN
	  BEGIN
	  IF device.EPLocMicrocodeStatus = 0
	    AND pup.head.eWord2 = 1000B
	    AND wordsPerPup+2-device.EELocInputFinishCount > 13
	    AND pup.head.destSocket1 = 0
	    AND pup.head.destSocket2 = 2
	    AND pup.head.pupType = 201B
	    THEN RETURN[pup.head.sourceNet];
	  device^ _ EthernetDeviceBlock[
	      EPLocMicrocodeStatus: 0,
	      EPLocHardwareStatus: 0,
	      EBLocInterruptBit: 0 ,
	      EELocInputFinishCount: 0,
	      ELLocCollisionMagic: 0,
	      EILocInputCount: wordsPerPup+2,
	      EILocInputPointer: pup,
	      EOLocOutputCount: 0,
	      EOLocOutputPointer: NIL];
	  StartIO[inputCommand];
	  END;
	now _ timer^;
	IF now-then > 14 THEN EXIT;
	ENDLOOP;
      ENDLOOP;
    RETURN[0];
    END;

  -- procedure lists

  UserCleanupList: POINTER TO ImageDefs.CleanupItem _ NIL;

  AddCleanupProcedure: PROCEDURE [item: POINTER TO ImageDefs.CleanupItem] =
    BEGIN
    ProcessDefs.DisableInterrupts[];
    RemoveCleanupProcedure[item];
    item.link _ UserCleanupList;
    UserCleanupList _ item;
    ProcessDefs.EnableInterrupts[];
    END;

  RemoveCleanupProcedure: PROCEDURE [item: POINTER TO ImageDefs.CleanupItem] =
    BEGIN
    prev, this: POINTER TO ImageDefs.CleanupItem;
    IF UserCleanupList = NIL THEN RETURN;
    ProcessDefs.DisableInterrupts[];
    prev _ this _ UserCleanupList;
    IF this = item THEN UserCleanupList _ this.link
    ELSE UNTIL (this _ this.link) = NIL DO
      IF this = item THEN
	BEGIN prev.link _ this.link; EXIT END;
      prev _ this;
      ENDLOOP;
    ProcessDefs.EnableInterrupts[];
    END;

  UserCleanupProc: ImageDefs.CleanupProcedure =
    BEGIN -- all interrupts off if why = finish or abort
    this, next: POINTER TO ImageDefs.CleanupItem;
    this _ UserCleanupList;
    UserCleanupList _ NIL;
    WHILE this # NIL DO
      next _ this.link;
      IF InlineDefs.BITAND[ImageDefs.CleanupMask[why], this.mask] # 0 THEN
	this.proc[why !
	  ANY => IF why = Abort OR why = Finish THEN CONTINUE];
      AddCleanupProcedure[this];
      this _ next;
      ENDLOOP;
    SELECT why FROM
      Finish => ImageDefs.StopMesa[];
      Abort => ImageDefs.AbortMesa[];
      ENDCASE;
    END;

-- Main Body;

  InitMemoryConfig[];
  SDDefs.SD[SDDefs.sGoingAway] _ UserCleanupProc;

END...