-- NonResident.mesa; edited by Levin, January 25, 1979  8:31 AM

DIRECTORY
  AllocDefs: FROM "allocdefs" USING [AllocHandle, AllocInfo, GetAllocationObject],
  AltoDefs: FROM "altodefs" USING [BYTE, PageNumber, PageSize],
  CodeDefs: FROM "codedefs" USING [
    Codebase, CodeHandle, ReleaseCode],
  ControlDefs: FROM "controldefs" USING [
    Alloc, ControlLink, CSegPrefix, EntryVectorItem, EPRange, FrameCodeBase, FrameHandle, Free,
    GetReturnFrame, GetReturnLink, GFT, GFTIndex, GFTItem, GlobalFrameHandle,
    InstWord, Lreg, MainBodyIndex, MaxAllocSlot, NullEpBase, NullFrame,
    NullGlobalFrame, Port, PortHandle, SD, StateVector],
  CoreSwapDefs: FROM "CoreSwapDefs",
  FrameDefs: FROM "framedefs" USING [FrameSize],
  GlobalFrameDefs: FROM "GlobalFrameDefs" USING [GlobalFrameHandle],
  ImageDefs: FROM "imagedefs",
  InlineDefs: FROM "inlinedefs" USING [
    BITAND, BITNOT, BITSHIFT, BITXOR, COPY, DIVMOD, LDIVMOD, LongCARDINAL,
    LongDiv, LongDivMod, LongMult],
  LoadStateDefs: FROM "loadstatedefs" USING [
    ConfigIndex, ConfigNull, EnterGfi, InputLoadState, MapRealToConfig,
    ReleaseLoadState],
  MiscDefs: FROM "miscdefs",
  Mopcodes: FROM "mopcodes" USING [zDADD, zDCOMP, zDSUB, zINC, zPORTI],
  NucleusDefs: FROM "nucleusdefs",
  ProcessDefs: FROM "processdefs" USING [DisableInterrupts, EnableInterrupts],
  Resident: FROM "resident" USING [
    AllocTrap, Break, CodeTrap, CSPort, level, MemorySwap, Restart, Start,
    UnboundProcedureTrap, WBPort, WorryBreaker],
  SDDefs: FROM "sddefs" USING [
    sAllocTrap, sAlternateBreak, sBLTE, sBLTEC, sBreak, sBYTBLTE, sBYTBLTEC,
    sControlFault, sCopy, sCoreSwap, SD, sDivSS, sError, sGFTLength,
    sIOResetBits, sLongDiv, sLongDivMod, sLongMod, sLongMul, sRestart,
    sStackError, sStart, sStringInit, sSwapTrap, sUnbound, sUnNew],
  SegmentDefs: FROM "segmentdefs" USING [
    DeleteFileSegment, EnumerateFileSegments, FileSegmentHandle, SwapIn, SwapError, Unlock],
  TrapDefs: FROM "trapdefs" USING [UnboundProcedure],
  XMESA: FROM "XMesaPrivateDefs" USING [ChocolateToVanilla, VanillaToChocolate, WhichWay,
    XFileSegmentHandle, XMremote],
  XMesaDefs: FROM "XMesaDefs" USING [DefaultBase0, DefaultXMBase, GetMemoryConfig,
    LongAddressFromPage, LowHalfPtr, XFileSegmentAddress, XCOPY];

DEFINITIONS FROM ControlDefs;

NonResident: PROGRAM
  IMPORTS AllocDefs, FrameDefs, LoadStateDefs, ResidentPtr: Resident, SegmentDefs,
    TrapDefs, CodeDefs, XMESA, XMesaDefs							--XM
  EXPORTS FrameDefs, NucleusDefs, TrapDefs, XMESA, CoreSwapDefs
  SHARES XMESA, ControlDefs, ImageDefs, Resident = BEGIN


  -- Global Frame Table management

  gftrover: CARDINAL _ 0;  -- okay to start at 0 because incremented before used

  NoGlobalFrameSlots: PUBLIC SIGNAL [CARDINAL] = CODE;

  EnumerateGlobalFrames: PUBLIC PROCEDURE [
    proc: PROCEDURE [GlobalFrameHandle] RETURNS [BOOLEAN]]
    RETURNS [GlobalFrameHandle] =
    BEGIN
    i: GFTIndex;
    frame: GlobalFrameHandle;
    gft: POINTER TO ARRAY [0..0) OF GFTItem _ GFT;
    FOR i IN [0..SD[SDDefs.sGFTLength]) DO
      frame _ gft[i].frame;
      IF frame # NullGlobalFrame AND gft[i].epbase = 0
      AND proc[frame] THEN RETURN[frame];
      ENDLOOP;
    RETURN[NullGlobalFrame]
    END;

  EnterGlobalFrame: PUBLIC PROCEDURE [frame: GlobalFrameHandle, nslots: CARDINAL]
    RETURNS [entryindex: GFTIndex] =
    BEGIN
    gft: POINTER TO ARRAY [0..0) OF GFTItem _ GFT;
    i, imax, n, epoffset: CARDINAL;
    i _ gftrover;  imax _ SD[SDDefs.sGFTLength] - nslots;  n _ 0;
    DO
      IF (i _ IF i>=imax THEN 1 ELSE i+1) = gftrover
        THEN SIGNAL NoGlobalFrameSlots[nslots];
      IF gft[i].frame # NullGlobalFrame THEN n _ 0
      ELSE IF gft[i].epbase = NullEpBase THEN n _ 0
      ELSE IF (n _ n+1) = nslots THEN EXIT;
      ENDLOOP;
    entryindex _ (gftrover_i)-nslots+1;  epoffset _ 0;
    FOR i IN [entryindex..gftrover] DO
      gft[i] _ GFTItem[frame, epoffset];
      epoffset _ epoffset + EPRange;
      ENDLOOP;
    RETURN
    END;

  RemoveGlobalFrame: PUBLIC PROCEDURE [frame: GlobalFrameHandle] =
    BEGIN
    gft: POINTER TO ARRAY [0..0) OF GFTItem _ GFT;
    sd: POINTER TO ARRAY [0..0) OF CARDINAL _ SD;
    i: CARDINAL;
    FOR i _ frame.gfi, i+1
    WHILE i<sd[SDDefs.sGFTLength] AND gft[i].frame=frame DO
      gft[i] _ IF frame.copied THEN
        GFTItem[NullGlobalFrame,0] ELSE GFTItem[NullGlobalFrame,NullEpBase];
      ENDLOOP;
    RETURN
    END;

  -- Traps

  StackError: PUBLIC ERROR [FrameHandle] = CODE;

  StackErrorTrap: PROCEDURE =
    BEGIN
    state: StateVector;
    foo: BOOLEAN;
    state _ STATE;
    foo _ TRUE;
    IF foo THEN ERROR StackError[GetReturnFrame[]];
    END;

  NullPort: PortHandle = LOOPHOLE[0];

  PortFault: PUBLIC ERROR = CODE;
  LinkageFault: PUBLIC ERROR = CODE;
  ControlFault: PUBLIC SIGNAL [source: FrameHandle] RETURNS [ControlLink] = CODE;
  PORTI: PROCEDURE = MACHINE CODE BEGIN Mopcodes.zPORTI END;


  ControlFaultTrap: PROCEDURE =
    BEGIN
    errorStart, savedState: StateVector;
    p, q: PortHandle;
    sourceFrame, self: FrameHandle;
    savedState _ STATE;
    self _ REGISTER[Lreg];
    IF PortCall[self.returnlink] THEN
      BEGIN
      p _ self.returnlink.port;
      q _ p.dest.port;
      sourceFrame _ p.frame;
      IF q = NullPort THEN
        errorStart.stk[0] _ LinkageFault   
      ELSE
        BEGIN
        q^ _ Port[links[NullFrame,[indirect[port[p]]]]];
        errorStart.stk[0] _ PortFault;   
        END;
      errorStart.stk[1] _ 0;
      errorStart.instbyte _ 0;
      errorStart.stkptr _ 2;
      errorStart.source _ sourceFrame.returnlink;
      errorStart.dest _ SD[SDDefs.sError];
      IF savedState.stkptr = 0 THEN 
        RETURN WITH errorStart  --  RESPONDING port
      ELSE
        BEGIN
        p.frame _ self;
        TRANSFER WITH errorStart;
        PORTI;
        p.frame _ sourceFrame;
        savedState.source _ p;
        savedState.dest _ p.dest;
        RETURN WITH savedState;
        END;
      END
    ELSE
      BEGIN
      savedState.source _ self.returnlink;
      savedState.dest _ SIGNAL ControlFault[savedState.source];
      RETURN WITH savedState
      END;
    END;

  PortCall: PROCEDURE [source: ControlLink] RETURNS [BOOLEAN] =
    BEGIN
    portcall: BOOLEAN _ FALSE;
    WHILE source.tag = indirect DO
      source _ source.link^;
      ENDLOOP;
    IF source.tag = frame AND
      FrameDefs.ReturnByte[source.frame,0] = Mopcodes.zPORTI THEN
        portcall _ TRUE;
    RETURN[portcall]
    END;

  ReturnByte: PUBLIC PROCEDURE [frame: FrameHandle, byteoffset: INTEGER]
    RETURNS [byte: AltoDefs.BYTE] =
    BEGIN
    OPEN SegmentDefs;
    g: GlobalFrameHandle = frame.accesslink;
    iw: InstWord;										--XM
    bytePC: CARDINAL = byteoffset + (IF frame.pc<0
      THEN 2*(-frame.pc)+1 ELSE 2*frame.pc);
    XMesaDefs.XCOPY[from: CodeDefs.Codebase[g] + bytePC/2, to: LONG[@iw], nwords: SIZE[InstWord]];--XM
    byte _ IF bytePC MOD 2 # 0 THEN iw.oddbyte ELSE iw.evenbyte;
    CodeDefs.ReleaseCode[g];
    RETURN
    END;

  -- Frame manipulation

  InvalidGlobalFrame: PUBLIC SIGNAL [frame: GlobalFrameHandle] = CODE;

  ValidateGlobalFrame: PUBLIC PROCEDURE [g: GlobalFrameHandle] =
    BEGIN
    IF ~ValidGlobalFrame[g] THEN SIGNAL InvalidGlobalFrame[g];
    END;

  ValidGlobalFrame: PROCEDURE [g: GlobalFrameHandle]
    RETURNS[BOOLEAN] =
    BEGIN
    RETURN[LOOPHOLE[g, ControlLink].tag = frame AND g.gfi < SD[SDDefs.sGFTLength] AND		--XM
	   GFT[g.gfi].frame = g]								--XM
    END;

  GlobalFrame: PUBLIC PROCEDURE [link: UNSPECIFIED]
    RETURNS [GlobalFrameHandle] =
    BEGIN OPEN l: LOOPHOLE[link, ControlLink];
    DO SELECT l.tag FROM
      frame =>
        BEGIN
        IF link = 0 THEN RETURN[NullGlobalFrame];
        IF ValidGlobalFrame[link] THEN RETURN[link];
        IF ValidGlobalFrame[l.frame.accesslink] THEN
          RETURN[l.frame.accesslink];
        RETURN[NullGlobalFrame]
        END;
      procedure => RETURN[GFT[l.gfi].frame];
      indirect => link _ l.link^;
      unbound => link _ SIGNAL TrapDefs.UnboundProcedure[link];
      ENDCASE ENDLOOP
    END;

  Copy: PROCEDURE [old: GlobalFrameHandle] RETURNS [new: GlobalFrameHandle] =
    BEGIN
    linkspace: CARDINAL _ 0;
    codebase: LONG POINTER TO CSegPrefix;
    csegpfx: CSegPrefix;								--XM
    cseg: SegmentDefs.FileSegmentHandle;								--XM
    ValidateGlobalFrame[old];
    codebase _ CodeDefs.Codebase[old];
    [new, linkspace] _ AllocGlobalFrame[old, codebase];
    IF ~old.codelinks THEN									--XM
      BEGIN
      InlineDefs.COPY[from: old-linkspace, to: new, nwords: linkspace];			--XM
      new _ new+linkspace;									--XM
      END;
    cseg _ CodeDefs.CodeHandle[old];
    new^ _ [gfi:, unused: 0, alloced: TRUE, shared: TRUE, copied: TRUE,
      started: FALSE, trapxfers: FALSE, codelinks: old.codelinks,
      code:, codesegment: cseg, global:];
    XMesaDefs.XCOPY[from: codebase, to: LONG[@csegpfx], nwords: SIZE[CSegPrefix]]; --XM
    new.gfi _ FrameDefs.EnterGlobalFrame[new, csegpfx.ngfi];					--XM
    new.code.offset _ XMesaDefs.LowHalfPtr[codebase] -
			XMesaDefs.LowHalfPtr[XMesaDefs.XFileSegmentAddress[cseg]];		--XM
    new.code.swappedout _ TRUE;
    new.global[0] _ NullGlobalFrame;
    old.shared _ TRUE;
    CodeDefs.ReleaseCode[old];
    RETURN
    END;

  MakeFsi: PUBLIC PROCEDURE [words: CARDINAL] RETURNS [fsi: CARDINAL] =
    BEGIN
    FOR fsi IN [0..MaxAllocSlot) DO
      IF FrameDefs.FrameSize[fsi] >= words THEN RETURN;
      ENDLOOP;
    RETURN[words]
    END;

  AllocGlobalFrame: PROCEDURE [
    old: GlobalFrameHandle, cp: LONG POINTER TO CSegPrefix]
    RETURNS [frame: GlobalFrameHandle, linkspace: CARDINAL] =
    BEGIN
    size, nlinks: CARDINAL;
    FrameSizePair: TYPE = MACHINE DEPENDENT RECORD[size2, size1: CARDINAL];		--XM
    fsizes: FrameSizePair;									--XM
    csegpfx: CSegPrefix;								--XM
    mbEntry: EntryVectorItem;							--XM
    pbody: LONG POINTER;									--XM
    XMesaDefs.XCOPY[from: @cp.entry[MainBodyIndex], to: LONG[@mbEntry],
	nwords: SIZE[EntryVectorItem]];					--XM
    pbody _ cp+CARDINAL[mbEntry.initialpc];						--XM
    XMesaDefs.XCOPY[from: pbody-2, to: LONG[@fsizes], nwords: SIZE[FrameSizePair]];	--XM
    size _ IF mbEntry.framesize = MaxAllocSlot THEN fsizes.size2 ELSE fsizes.size1;		--XM
    XMesaDefs.XCOPY[from: cp, to: LONG[@csegpfx], nwords: SIZE[CSegPrefix]]; --XM
    nlinks _ csegpfx.nlinks;									--XM
    linkspace _ nlinks + InlineDefs.BITAND[-LOOPHOLE[nlinks, INTEGER], 3B];			--XM
    frame _ Alloc[MakeFsi[FrameDefs.FrameSize[size]+(IF old.codelinks THEN 0 ELSE linkspace)]];	--XM
    RETURN
    END;

  UnNew: PROCEDURE [frame: GlobalFrameHandle] =
    BEGIN
    csegpfx: CSegPrefix;								--XM
    cseg: SegmentDefs.FileSegmentHandle;
    sharer: GlobalFrameHandle _ NullGlobalFrame;
    original: GlobalFrameHandle _ NullGlobalFrame;
    copy: GlobalFrameHandle _ NullGlobalFrame;
    codebase: LONG POINTER TO CSegPrefix;
    fcb: FrameCodeBase;
    nothers: CARDINAL _ 0;
    nlinks: CARDINAL;
    RemoveAllTraces: PROCEDURE [f: GlobalFrameHandle] RETURNS [BOOLEAN] =
      BEGIN OPEN gf: LOOPHOLE[f, GlobalFrameDefs.GlobalFrameHandle];
      seg: SegmentDefs.FileSegmentHandle;
      IF f#frame THEN
        BEGIN
        IF f.global[0] = frame AND ~f.started THEN f.global[0] _ NullFrame;
	seg _ CodeDefs.CodeHandle[f];
	IF cseg = seg THEN
	  BEGIN
	  nothers _ nothers + 1;  sharer _ f;
	  ProcessDefs.DisableInterrupts[];
	  IF (IF f.code.swappedout THEN gf.code.offset = fcb.offset
	      ELSE gf.code.codebase = LOOPHOLE[frame, GlobalFrameDefs.GlobalFrameHandle].code.codebase)
	    THEN IF f.copied THEN copy _ f ELSE original _ f;
	  ProcessDefs.EnableInterrupts[];
	  END;
        END;
      RETURN[FALSE];
      END;
    ValidateGlobalFrame[frame];
    codebase _ CodeDefs.Codebase[frame];
    XMesaDefs.XCOPY[from: codebase, to: LONG[@csegpfx], nwords: SIZE[CSegPrefix]]; --XM
    nlinks _ csegpfx.nlinks;									--XM
    cseg _ CodeDefs.CodeHandle[frame];
    fcb.offset _ frame.code.codebase - XMesaDefs.LowHalfPtr[XMesaDefs.XFileSegmentAddress[cseg]]; --XM
    fcb.swappedout _ TRUE;
    [] _ FrameDefs.EnumerateGlobalFrames[RemoveAllTraces];
    CodeDefs.ReleaseCode[frame];
    IF original = NullGlobalFrame AND ~frame.copied AND copy # NullGlobalFrame THEN
      BEGIN OPEN LoadStateDefs;
      config: ConfigIndex;
      cgfi: GFTIndex;
      copy.copied _ FALSE;
      [] _ InputLoadState[];
      [cgfi: cgfi, config: config] _ MapRealToConfig[frame.gfi];
      EnterGfi[cgfi: 0, rgfi: frame.gfi, config: ConfigNull];
      EnterGfi[cgfi: cgfi, rgfi: copy.gfi, config: config];
      ReleaseLoadState[];
      END;
    IF frame.shared THEN
      BEGIN
      IF nothers = 1 THEN sharer.shared _ FALSE
      END
    ELSE 
      BEGIN OPEN SegmentDefs;
      DeleteFileSegment[cseg ! SwapError => CONTINUE];
      END;
    FrameDefs.RemoveGlobalFrame[frame];
    IF frame.alloced THEN
      BEGIN
      Align: PROCEDURE [POINTER, WORD] RETURNS [POINTER] =
	LOOPHOLE[InlineDefs.BITAND];
      IF frame.codelinks THEN Free[frame]
      ELSE Free[Align[frame - nlinks, 177774B]]
      END;
    END;



MoveLockedCode: PUBLIC PROCEDURE [direction: XMESA.WhichWay] =
  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 INTEGER;
      UpdateCodebase: PROCEDURE [f: GlobalFrameHandle] RETURNS [BOOLEAN] =
        BEGIN OPEN frame: LOOPHOLE[f, GlobalFrameDefs.GlobalFrameHandle];
        IF CodeDefs.CodeHandle[f] = fseg AND ~frame.code.swappedout THEN
	  SELECT direction FROM
	    up => frame.code.codebase _ LONG[frame.code.shortCodebase] + delta;
	    down =>
	      BEGIN
	      frame.code.codebase _ frame.code.codebase + delta;
	      IF frame.code.highHalf # 0 THEN ERROR;
	      frame.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[LOOPHOLE[newVMpage,INTEGER]] - LONG[LOOPHOLE[oldVMpage,INTEGER]]);
      [] _ 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
	    up =>
	      BEGIN
	      VtC: ChangeFlavorProc = 
		BEGIN
		RETURN[XMESA.VanillaToChocolate[fseg, newVMpage]] -- note variant changes here!!
		END;
	      MoveThisSegment[XMesaDefs.DefaultXMBase, VtC];
	      END;
	    down => NULL;
	    ENDCASE;
	remote =>
	  IF s.proc = XMESA.XMremote THEN
	    SELECT direction FROM
	      up => NULL;
	      down =>
		BEGIN
		CtV: ChangeFlavorProc = 
		  BEGIN
		  RETURN[XMESA.ChocolateToVanilla[@seg, newVMpage]] -- note variant changes here!!
		  END;
		MoveThisSegment[XMesaDefs.DefaultBase0, CtV];
		END;
	      ENDCASE;
	ENDCASE;
    RETURN[FALSE]
    END;

  -- body of MoveLockedCode

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

  -- unimplemented instructions

  BlockEqual: PROCEDURE [p1: POINTER, n: CARDINAL, p2: POINTER]
    RETURNS [BOOLEAN] =
    BEGIN
    i: CARDINAL;
    FOR i IN [0 .. n) DO
      IF (p1+i)^ # (p2+i)^ THEN RETURN[FALSE]; ENDLOOP;
    RETURN[TRUE]
    END;

  ByteArray: TYPE = PACKED ARRAY [0..0) OF AltoDefs.BYTE;				--XM
  PPA: TYPE = POINTER TO ByteArray;							--XM

  ByteBlockEqual: PROCEDURE [p1: PPA, n: CARDINAL, p2: PPA]
    RETURNS [BOOLEAN] =
    BEGIN
    RETURN[BlockEqual[p1: p1, p2: p2, n: n/2] AND p1[n-1] = p2[n-1]]
    END;

  BlockEqualCode: PROCEDURE [p1: POINTER, n: CARDINAL, offset: CARDINAL]
    RETURNS [result: BOOLEAN] =
    BEGIN
    frame: GlobalFrameHandle = GetReturnFrame[].accesslink;
    codebase: LONG POINTER _ CodeDefs.Codebase[frame]+offset;				--XM
    i: CARDINAL;
    imax, j: CARDINAL;										--XM
    bsize: CARDINAL = 10;									--XM
    codeblock: ARRAY [0..bsize) OF UNSPECIFIED;						--XM
    FOR j _ 0, j+bsize UNTIL j >= n								--XM
      DO											--XM
      imax _ MIN[bsize, n-j];									--XM
      XMesaDefs.XCOPY[from: codebase+j, to: LONG[@codeblock[0]], nwords: imax];		--XM
      FOR i IN [0..imax)									--XM
	DO IF codeblock[i] # (p1+j+i)^ THEN GOTO NotEqual; ENDLOOP;			--XM
      REPEAT											--XM
	NotEqual => result _ FALSE;								--XM
	FINISHED => result _ TRUE;								--XM
      ENDLOOP;											--XM
    CodeDefs.ReleaseCode[frame];
    RETURN
    END;

  ByteBlockEqualCode: PROCEDURE [p1: POINTER, n: CARDINAL, offset: CARDINAL]
    RETURNS [result: BOOLEAN] =
    BEGIN
    frame: GlobalFrameHandle = GetReturnFrame[].accesslink;
    i: CARDINAL;
    codebase: LONG POINTER _ CodeDefs.Codebase[frame]+offset;				--XM
    imax, j: CARDINAL;										--XM
    bsize: CARDINAL = 10;									--XM
    codeblock: ARRAY [0..bsize) OF UNSPECIFIED;						--XM
    FOR j _ 0, j+bsize UNTIL j >= n/2								--XM
      DO											--XM
      imax _ MIN[bsize, n/2-j];								--XM
      XMesaDefs.XCOPY[from: codebase+j, to: LONG[@codeblock[0]], nwords: imax];		--XM
      FOR i IN [0..imax)									--XM
	DO IF codeblock[i] # (p1+j+i)^ THEN GOTO NotEqual; ENDLOOP;			--XM
      REPEAT											--XM
	NotEqual => result _ FALSE;								--XM
	FINISHED =>
	  result _ LOOPHOLE[p1, PPA][n-1] = LOOPHOLE[@codeblock, PPA][imax*2-1]; 	--XM
      ENDLOOP;											--XM
    CodeDefs.ReleaseCode[frame];
    RETURN
    END;


  -- data shuffling

  StringInit: PROCEDURE [coffset, n: CARDINAL, reloc, dest: POINTER] =
    BEGIN OPEN ControlDefs;
    g: GlobalFrameHandle = GetReturnFrame[].accesslink; 
    i: CARDINAL;
    codebase: LONG POINTER _ CodeDefs.Codebase[g]+coffset;				--XM
    imax, j: CARDINAL;										--XM
    bsize: CARDINAL = 10;									--XM
    codeblock: ARRAY [0..bsize) OF UNSPECIFIED;						--XM
    FOR j _ 0, j+bsize UNTIL j >= n								--XM
      DO											--XM
      imax _ MIN[bsize, n-j];									--XM
      XMesaDefs.XCOPY[from: codebase+j, to: LONG[@codeblock[0]], nwords: imax];		--XM
      FOR i IN [0..imax)									--XM
	DO (dest+j+i)^ _ codeblock[i] + reloc; ENDLOOP;					--XM
      ENDLOOP;											--XM
    CodeDefs.ReleaseCode[g];
    RETURN
    END;

  -- long, signed and mixed mode arithmetic

  DIVMOD: PROCEDURE [n,d: CARDINAL] RETURNS [QR] =
    LOOPHOLE[InlineDefs.DIVMOD];
  LDIVMOD: PROCEDURE [nlow,nhigh,d: CARDINAL] RETURNS [QR] =
    LOOPHOLE[InlineDefs.LDIVMOD];
  QR: TYPE = RECORD [q, r: INTEGER];
  PQR: TYPE = POINTER TO QR;

  LongSignDivide: PROCEDURE [numhigh: INTEGER, pqr: PQR] =
    BEGIN
    negnum,negden: BOOLEAN _ FALSE;
    IF negden _ (pqr.r < 0) THEN pqr.r _ -pqr.r;
    IF negnum _ (numhigh < 0) THEN
      BEGIN
      IF pqr.q = 0 THEN numhigh _ -numhigh
      ELSE BEGIN pqr.q _ -pqr.q; numhigh _ InlineDefs.BITNOT[numhigh] END;
      END;
    pqr^ _ LDIVMOD[nlow: pqr.q, nhigh: numhigh, d: pqr.r];
    -- following assumes TRUE = 1; FALSE = 0
    IF InlineDefs.BITXOR[LOOPHOLE[negnum],LOOPHOLE[negden]] # 0 THEN
      pqr.q _ -pqr.q;
    IF negnum THEN pqr.r _ -pqr.r;
    RETURN
    END;

  DivSS: PROCEDURE =
    BEGIN
    state: StateVector;
    p: PQR;
    t: CARDINAL;
    state _ STATE;
    state.stkptr _ t _ state.stkptr-1;
    state.dest _ GetReturnLink[];
    p _ @state.stk[t-1];
    LongSignDivide[numhigh: (IF p.q<0 THEN -1 ELSE 0), pqr: p];
    RETURN WITH state
    END;

  LongCARDINAL: TYPE = InlineDefs.LongCARDINAL;
  DAdd: PROCEDURE [a,b: LongCARDINAL] RETURNS [LongCARDINAL] =
    MACHINE CODE BEGIN Mopcodes.zDADD END;
  DSub: PROCEDURE [a,b: LongCARDINAL] RETURNS [LongCARDINAL] =
    MACHINE CODE BEGIN Mopcodes.zDSUB END;
  DCompare: PROCEDURE [a,b: LongCARDINAL] RETURNS [{less, equal, greater}] =
    MACHINE CODE BEGIN Mopcodes.zDCOMP; Mopcodes.zINC END;

  DDivMod: PROCEDURE [num, den: LongCARDINAL]
    RETURNS [quotient, remainder: LongCARDINAL] =
    BEGIN OPEN InlineDefs;
    negNum, negDen: BOOLEAN _ FALSE;
    qq: CARDINAL;
    count: [0..31);
    lTemp: LongCARDINAL;
    IF LOOPHOLE[num.highbits, INTEGER] < 0 THEN
      BEGIN negNum _ TRUE; num _ DSub[[0,0],num]; END;
    IF LOOPHOLE[den.highbits, INTEGER] < 0 THEN
      BEGIN negDen _ TRUE; den _ DSub[[0,0],den]; END;
    IF den.highbits = 0 THEN
      BEGIN
      [quotient.highbits, qq] _
        LongDivMod[[lowbits:num.highbits,highbits:0],den.lowbits];
      [quotient.lowbits, remainder.lowbits] _
        LongDivMod[[lowbits:num.lowbits,highbits:qq],den.lowbits];
      remainder.highbits _ 0;
      END
    ELSE
      BEGIN
      count _ 0;
      quotient.highbits _ 0;
      lTemp _ den;
      WHILE lTemp.highbits # 0 DO -- normalize
        lTemp.lowbits _
          BITSHIFT[lTemp.lowbits,-1] + BITSHIFT[lTemp.highbits,15];
        lTemp.highbits _ BITSHIFT[lTemp.highbits,-1];
        count _ count + 1;
        ENDLOOP;
      qq _ LongDiv[num,lTemp.lowbits]; -- trial quotient
      qq _ BITSHIFT[qq,-count];
      lTemp _ LongMult[den.lowbits,qq]; -- multiply by trial quotient
      lTemp.highbits _ lTemp.highbits + den.highbits*qq;
      UNTIL DCompare[lTemp, num] # greater DO
        -- decrease quotient until product is small enough
        lTemp _ DSub[lTemp,den];
        qq _ qq - 1;
        ENDLOOP;
      quotient.lowbits _ qq;
      remainder _ DSub[num,lTemp];
      END;
    IF BITXOR[LOOPHOLE[negNum],LOOPHOLE[negDen]] # 0 THEN
      quotient _ DSub[[0,0],quotient];
    IF negNum THEN remainder _ DSub[[0,0],remainder];
    RETURN
    END;
  
  DDiv: PROCEDURE [a,b: LongCARDINAL] RETURNS [LongCARDINAL] =
    BEGIN OPEN InlineDefs;
    RETURN[DDivMod[a,b].quotient]
    END;

  DMod: PROCEDURE [a,b: LongCARDINAL] RETURNS [r: LongCARDINAL] =
    BEGIN OPEN InlineDefs;
    [remainder: r] _ DDivMod[a,b];
    RETURN
    END;

  DMultiply: PROCEDURE [a,b: LongCARDINAL]
    RETURNS [product: LongCARDINAL] =
    BEGIN OPEN InlineDefs;
    product _ LongMult[a.lowbits, b.lowbits];
    product.highbits _
      product.highbits + a.lowbits*b.highbits + a.highbits*b.lowbits;
    RETURN
    END;
  
  GetLevel: PUBLIC PROCEDURE RETURNS [INTEGER] =
    BEGIN RETURN[ResidentPtr.level] END;

  SetLevel: PUBLIC PROCEDURE [l: INTEGER] = BEGIN ResidentPtr.level _ l; END;

  Init: PROCEDURE =
    BEGIN OPEN SDDefs;
    sd: POINTER TO ARRAY [0..0) OF UNSPECIFIED _ SD;
    resident: POINTER TO FRAME [Resident] _ ResidentPtr;
    sd[sStackError] _ StackErrorTrap;
    sd[sControlFault] _ ControlFaultTrap;
    sd[sBLTE] _ BlockEqual;
    sd[sBYTBLTE] _ ByteBlockEqual;
    sd[sBLTEC] _ BlockEqualCode;
    sd[sBYTBLTEC] _ ByteBlockEqualCode;
    sd[sStringInit] _ StringInit;
    sd[sDivSS] _ DivSS;
    sd[sLongMul] _ DMultiply;
    sd[sLongDivMod] _ DDivMod;
    sd[sLongMod] _ DMod;
    sd[sLongDiv] _ DDiv;
    sd[sCopy] _ Copy;
    sd[sUnNew] _ UnNew;

    BEGIN OPEN resident;
    sd[sAllocTrap] _ AllocTrap[AllocTrap[NullFrame]];
    sd[sSwapTrap] _ CodeTrap;
    sd[sUnbound] _ UnboundProcedureTrap;
    sd[sStart] _ Start;
    sd[sRestart] _ Restart;
    sd[sBreak] _ Break;
    sd[sAlternateBreak] _ WorryBreaker[];
    sd[sIOResetBits] _ 3;
    LOOPHOLE[CSPort,Port].in _ MemorySwap;
    LOOPHOLE[CSPort,Port].out _ @WBPort;
    sd[sCoreSwap] _ LOOPHOLE[WBPort,Port].out _ @CSPort;
    WBPort[NIL];
    level _ -1;
    END;
    END;


-- Main Body;

Init[];

END...