-- MMTraps.Mesa; edited by Sandman on May 17, 1979  3:14 PM
-- Edited by Forrest on July 15, 1980  8:14 PM

DIRECTORY
  AltoDefs USING [BYTE, PageSize],
  ControlDefs USING [
    AV, AVItem, ControlLink, ControlModule, EntryInfo, FrameHandle,
    FrameVec, GFT, GFTIndex, GFTItem, GlobalFrameHandle, LargeReturnSlot,
    MainBodyIndex, NullControl, NullFrame, NullGlobalFrame, PrefixHandle,
    PrefixInfo, ProcDesc, SpecialReturnSlot, StateVector, SVPointer],
  CoreSwapDefs USING [SVPointer],
  FrameDefs,
  FrameOps USING [
    Free, GetReturnFrame, GetReturnLink, MyLocalFrame, SetReturnFrame, Start],
  ImageDefs USING [PuntMesa],
  InlineDefs USING [
    BITNOT, BITOR, BITSHIFT, BITXOR, COPY, DIVMOD, LDIVMOD, LongDiv,
    LongDivMod, LongMult, LongNumber],
  MMInit,
  MMSDEntries,
  Mopcodes USING [zDESCBS, zKFCB, zRBL, zSFC],
  ProcessDefs USING [DisableInterrupts, EnableInterrupts],
  SDDefs USING [sAllocTrap, SD, sProcessBreakpoint],
  SegmentDefs USING [
    DataSegmentAddress, DataSegmentHandle, DeleteDataSegment,
    DefaultBase, MakeDataSegment],
  TrapDefs,
  TrapOps USING [ReadATP, ReadOTP];

MMTraps: PROGRAM 
  IMPORTS FrameOps, ImageDefs, InlineDefs, ProcessDefs,
    SegmentDefs, TrapOps
  EXPORTS FrameDefs, FrameOps, MMInit, MMSDEntries, TrapDefs =
PUBLIC BEGIN OPEN ControlDefs;

  -- allocation of frame space

  LargeFrameSlot: CARDINAL = 12;

  FrameSize: PUBLIC PROC [fsi: CARDINAL] RETURNS [CARDINAL] =
    { RETURN[FrameVec[fsi]] };

  pgft: TYPE = POINTER TO ARRAY [0..0) OF GFTItem;

  ItemPointer: TYPE = POINTER TO ControlDefs.AVItem;

  FrameSegment: TYPE = MACHINE DEPENDENT RECORD [
    segment: SegmentDefs.DataSegmentHandle,
    link: POINTER TO FrameSegment,
    size, fsi: CARDINAL];


  -- maintain a list of all new "permanent" frame segments;
  ExtraSpaceSize: CARDINAL = 128;
  ExtraSpace: ARRAY [0..ExtraSpaceSize) OF WORD;
  InitNewSpace: POINTER = LOOPHOLE[InlineDefs.BITOR[BASE[ExtraSpace],3]];
  InitWordsLeft: CARDINAL = BASE[ExtraSpace]+ExtraSpaceSize-InitNewSpace;

  NULLPtr: FrameHandle = LOOPHOLE[0];

  AllocTrap: PROC [otherframe: FrameHandle]
  RETURNS [myframe: FrameHandle] =
    BEGIN OPEN ProcessDefs, SegmentDefs;
    ATFrame: TYPE = POINTER TO FRAME [AllocTrap];
    state: StateVector;
    newframe: FrameHandle;
    newseg: DataSegmentHandle;
    long: BOOLEAN;
    i, fsize, fIndex: CARDINAL;
    p: POINTER;
    newG: GlobalFrameHandle;
    NewSpacePtr: POINTER;
    WordsLeft: CARDINAL _ 0;
    recurring: BOOLEAN _ otherframe = NULLPtr;
    alloc: BOOLEAN;
    dest, tempdest: ControlLink;
    gfi: GFTIndex;
    ep: CARDINAL;
    myframe _ FrameOps.MyLocalFrame[];
    state.dest _ myframe.returnlink;
    state.source _ 0;
    state.instbyte _ 0;
    state.stk[0] _ myframe;
    state.stkptr _ 1;

    ProcessDefs.DisableInterrupts[];  -- so that undo below works

    DO ENABLE ANY => ImageDefs.PuntMesa[];

    IF ~recurring THEN
      BEGIN
      LOOPHOLE[otherframe, ATFrame].NewSpacePtr _ InitNewSpace;
      LOOPHOLE[otherframe, ATFrame].WordsLeft _ InitWordsLeft;
      AV[SpecialReturnSlot] _ [data[0,empty]];
      END;

    -- the following RR and POP is to guarantee that there is no NOOP between
    -- the DWDC and the LST
    [] _ TrapOps.ReadATP[];
    ProcessDefs.EnableInterrupts[];  -- guarantees one more instruction
    TRANSFER WITH state;
    ProcessDefs.DisableInterrupts[];

    state _ STATE;
    dest _ TrapOps.ReadATP[];

    SDDefs.SD[SDDefs.sAllocTrap] _ otherframe;
    myframe.returnlink _ state.source;

    tempdest _ dest;
    DO 
      SELECT tempdest.tag FROM
	frame =>
	  { alloc _ TRUE; fIndex _ LOOPHOLE[tempdest, CARDINAL]/4; EXIT };
	procedure =>
	  BEGIN OPEN proc: LOOPHOLE[tempdest, ProcDesc];
	  gfi _ proc.gfi; ep _ proc.ep;
	  [frame: newG, epbase: fIndex] _ GFT[gfi];  -- use fIndex as temp
	  long _ newG.code.highByte = 0;
	  IF long THEN
	    BEGIN
	    GetEntryInfo: PROC [LONG POINTER] RETURNS [EntryInfo] = 
	      MACHINE CODE BEGIN Mopcodes.zRBL, 1 END;
	    info: EntryInfo _ GetEntryInfo[
	      @LOOPHOLE[newG.code.longbase, LONG PrefixHandle].entry[
	      fIndex + ep]];
	    fIndex _ info.framesize;
	    END
	  ELSE
	    fIndex _ LOOPHOLE[newG.code.shortbase, PrefixHandle].entry[
	      fIndex + ep].info.framesize;
	  alloc _ FALSE;
	  EXIT
	  END;
	indirect => tempdest _ tempdest.link^;
	ENDCASE => ImageDefs.PuntMesa[];
      ENDLOOP;

    IF ~recurring THEN FlushLargeFrames[]
    ELSE
      IF (p _ AV[SpecialReturnSlot].link) # LOOPHOLE[AVItem[data[0,empty]]] THEN
	BEGIN
	WordsLeft _ WordsLeft + (NewSpacePtr-p+1);
	NewSpacePtr _ p-1;
	AV[SpecialReturnSlot] _ [data[0,empty]];
	END;

    IF fIndex < LargeFrameSlot THEN
      BEGIN
      fsize _ FrameVec[fIndex]+1;  -- includes overhead word
      THROUGH [0..1] DO
	p _ NewSpacePtr+1;
	IF fsize <= WordsLeft THEN
	  BEGIN
	  newframe _ p;
	  (p-1)^ _ IF recurring THEN SpecialReturnSlot ELSE fIndex;
	  WordsLeft _ WordsLeft - fsize;
	  NewSpacePtr _ NewSpacePtr + fsize;
	  EXIT;
	  END
	ELSE
	  BEGIN
	  IF recurring THEN ImageDefs.PuntMesa[];
	  FOR i DECREASING IN [0..fIndex) DO
	    IF FrameVec[i] < WordsLeft THEN
	      { (p-1)^ _ i; p^ _ AV[i].link; AV[i].link _ p; EXIT };
	    ENDLOOP;
	  NewSpacePtr _
	    (p_DataSegmentAddress[newseg_
	      MakeDataSegment[DefaultBase,1,[hard, bottomup, frame]]]) + 3;
	  WordsLeft _ AltoDefs.PageSize-3;
	  END;
	ENDLOOP
      END
    ELSE
      BEGIN
      fsize _ FrameVec[fIndex];
      p _ DataSegmentAddress[
        newseg _ MakeDataSegment[
          DefaultBase, (fsize + AltoDefs.PageSize + 3)/AltoDefs.PageSize,
          [hard, bottomup, frame]]];
      newframe _ p + 4;
      LOOPHOLE[p, POINTER TO FrameSegment]^ _
	[segment: newseg, link: NIL, size: fsize, fsi: LargeReturnSlot];
      END;
    IF alloc THEN
      BEGIN
      state.dest _ myframe.returnlink;
      state.stk[state.stkptr] _ newframe;
      state.stkptr _ state.stkptr+1;
      END
    ELSE
      BEGIN
      state.dest _ dest;
      newframe.accesslink _ LOOPHOLE[AV[fIndex].link];
      AV[fIndex].frame _ newframe;
      state.source _ myframe.returnlink;
      END;
    SDDefs.SD[SDDefs.sAllocTrap] _ myframe;
    ENDLOOP;
    END;

  FlushLargeFrames: PUBLIC PROC =
    BEGIN
    p: POINTER;
    item: ItemPointer _ @AV[LargeReturnSlot];
    WHILE item.tag = frame DO
      p _ item.frame; item.frame _ p^;
      SegmentDefs.DeleteDataSegment[LOOPHOLE[(p-4)^]];
      ENDLOOP;
    END;

  -- other traps

  UnboundProcedure: PUBLIC SIGNAL [dest: ControlLink] RETURNS [ControlLink] = CODE;

  UnboundProcedureTrap: PROC =
    BEGIN
    dest: ControlLink;
    state: StateVector;
    ProcessDefs.DisableInterrupts[];
    state _ STATE;
    dest _ TrapOps.ReadOTP[];
    [] _ ERROR UnboundProcedure[dest];
    END;

  CodeTrap: PROC =
    BEGIN
    dest: ControlLink;
    state: StateVector;
    frame: GlobalFrameHandle;
    ProcessDefs.DisableInterrupts[];
    state _ STATE;
    dest _ TrapOps.ReadOTP[];
    ProcessDefs.EnableInterrupts[];
    state.dest _ dest;
    state.source _ FrameOps.GetReturnLink[];
    DO
      SELECT dest.tag FROM
	frame => BEGIN frame _ dest.frame.accesslink; EXIT END;
	procedure => BEGIN frame _ GFT[dest.gfi].frame; EXIT END;
	ENDCASE => dest _ dest.link^;
      ENDLOOP;
    IF ~frame.started THEN FrameOps.Start[[frame[frame]]];
    SwapInCode[frame];
    RETURN WITH state;
    END;

  SwapInCode: PUBLIC PROC [f: GlobalFrameHandle] =
    BEGIN
    IF ~f.code.out THEN RETURN;
    f.code.out _ FALSE;
    f.code.shortbase _ f.code.handle + f.code.offset;
    RETURN
    END;

  -- Getting the Debugger

  Break: PROC =
    -- executed by (non-worry) BRK instruction
    BEGIN
    ProcessBreakpoint: PROC [CoreSwapDefs.SVPointer] =
      MACHINE CODE BEGIN Mopcodes.zKFCB, SDDefs.sProcessBreakpoint END;
    f: FrameHandle;
    state: StateVector;
    state _ STATE;
    state.dest _ f _ state.source;
    state.source _ FrameOps.MyLocalFrame[];
    f.pc _ [IF f.pc < 0 THEN -f.pc ELSE (1-f.pc)];
    ProcessBreakpoint[@state];
    RETURN WITH state
    END;

  StackError: PUBLIC ERROR = CODE;

  StackErrorTrap: PROC =
    { state: StateVector; state _ STATE; ERROR StackError };

  ControlFault: PUBLIC SIGNAL [source: FrameHandle] RETURNS [ControlLink] = CODE;


  ControlFaultTrap: PROC =
    BEGIN
    savedState: StateVector;
    savedState _ STATE;
    [] _ ERROR ControlFault[FrameOps.MyLocalFrame[]];
    END;


  StartFault: PUBLIC SIGNAL [dest: GlobalFrameHandle] = CODE;

  MainBody: PROCEDURE [GlobalFrameHandle] RETURNS [ControlLink] = MACHINE CODE
    BEGIN Mopcodes.zDESCBS, MainBodyIndex END;
    
  Call: PROCEDURE [ControlLink] = MACHINE CODE BEGIN Mopcodes.zSFC END;
    
  Start: PUBLIC PROCEDURE [cm: ControlModule] =
    BEGIN
    state: StateVector;
    state _ STATE;
    IF ~cm.multiple THEN
      BEGIN
      IF cm.frame = NullGlobalFrame OR cm.frame.started THEN
	ERROR StartFault[cm.frame];
      -- FrameDefs.ValidateGlobalFrame[cm.frame];
      StartCM[cm.frame.global[0], cm.frame, @state];
      IF ~cm.frame.started THEN
	BEGIN cm.frame.started _ TRUE; StartWithState[cm.frame, @state]; END
      ELSE IF state.stkptr # 0 THEN SIGNAL StartFault[cm.frame];
      END
    ELSE
      BEGIN
      StartCM[cm, NIL, NIL];
      IF state.stkptr # 0 THEN SIGNAL StartFault[cm.frame];
      END;
    RETURN
    END;
    
  StartCM: PROCEDURE [
    cm: ControlModule, frame: GlobalFrameHandle, state: ControlDefs.SVPointer] =
    BEGIN
    SELECT TRUE FROM
      cm = NullControl => RETURN;
      cm.multiple =>
	BEGIN
	i, length: CARDINAL;
	cm.multiple _ FALSE;
	IF (length _ cm.list.nModules) = 0 THEN RETURN;
	cm.list.nModules _ 0;
	FOR i IN [0..length) DO
	  StartCM[[frame[cm.list.frames[i]]], frame, state]; ENDLOOP;
	FrameOps.Free[cm.list];
	END;
      cm.frame.started => RETURN;
      ENDCASE =>
	BEGIN
	control: ControlModule _ cm.frame.global[0];
	IF control # cm THEN StartCM[control, frame, state];
	IF ~cm.frame.started THEN
	  BEGIN
	  cm.frame.started _ TRUE;
	  IF frame # cm.frame THEN Call[MainBody[cm.frame]]
	  ELSE StartWithState[frame, state];
	  END;
	END;
    RETURN
    END;
    
  StartWithState: PROCEDURE [
    frame: GlobalFrameHandle, state: ControlDefs.SVPointer] =
    BEGIN OPEN ControlDefs;
    s: StateVector _ state^;
    retFrame: FrameHandle _ FrameOps.GetReturnLink[].frame;
    s.dest _ MainBody[frame];
    s.source _ retFrame.returnlink;
    FrameOps.Free[retFrame];
    RETURN WITH s;
    END;
    
  Restart: PUBLIC PROCEDURE [dest: GlobalFrameHandle] =
    BEGIN
    stops: BOOLEAN;
    frame: FrameHandle;
    IF dest = NullGlobalFrame THEN ERROR StartFault[dest];
    -- FrameDefs.ValidateGlobalFrame[dest];
    IF ~dest.started THEN Start[[frame[dest]]];
    -- FrameDefs.SwapInCode[dest];
    IF dest.code.highByte = 0 THEN
      BEGIN
      GetPrefixInfo: PROC [LONG POINTER] RETURNS [PrefixInfo] =
        MACHINE CODE BEGIN Mopcodes.zRBL, 1 END;
      stops _ GetPrefixInfo[dest.code.longbase].stops;
      END
    ELSE stops _ LOOPHOLE[dest.code.shortbase, PrefixHandle].header.info.stops;
    -- FrameOps.ReleaseCode[dest];
    IF ~stops THEN ERROR StartFault[dest];
    IF (frame _ dest.global[0]) # NullFrame THEN
      BEGIN
      frame.returnlink _ FrameOps.GetReturnLink[];
      FrameOps.SetReturnFrame[frame];
      END;
    RETURN
    END;
    
  -- unimplemented instructions

  BlockEqual: PROC [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;

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

  ByteBlockEqual: PROC [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: PROC [p1: POINTER, n: CARDINAL, offset: CARDINAL]
    RETURNS [BOOLEAN] =
    BEGIN
    frame: GlobalFrameHandle = FrameOps.GetReturnFrame[].accesslink;
    RETURN[BlockEqual[p1: p1, n: n, p2: frame.code.shortbase+offset]]
    END;

  ByteBlockEqualCode: PROC [p1: POINTER, n: CARDINAL, offset: CARDINAL]
    RETURNS [BOOLEAN] =
    BEGIN
    frame: GlobalFrameHandle = FrameOps.GetReturnFrame[].accesslink;
    RETURN[ByteBlockEqual[p1: p1, n: n, p2: frame.code.shortbase+offset]]
    END;


  -- data shuffling

  StringInit: PROC [coffset, n: CARDINAL, reloc, dest: POINTER] =
    BEGIN OPEN ControlDefs;
    g: GlobalFrameHandle = FrameOps.GetReturnFrame[].accesslink; 
    InlineDefs.COPY[from: g.code.shortbase+coffset, to: dest, nwords: n];
    FOR i: CARDINAL IN [0..n) DO (dest+i)^ _ (dest+i)^ + reloc ENDLOOP;
    RETURN
    END;

  -- long, signed and mixed mode arithmetic

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

  LongSignDivide: PROC [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[negnum, negden] # 0 THEN pqr.q _ -pqr.q;
    IF negnum THEN pqr.r _ -pqr.r;
    RETURN
    END;

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

  DDivMod: PROC [
    num, den: Number] RETURNS [quotient, remainder: Number] =
    BEGIN
    negNum, negDen: BOOLEAN _ FALSE;
    IF LOOPHOLE[num.highbits, INTEGER] < 0 THEN
      BEGIN negNum _ TRUE; num.li _ -num.li; END;
    IF LOOPHOLE[den.highbits, INTEGER] < 0 THEN
      BEGIN negDen _ TRUE; den.li _ -den.li; END;
    [quotient: quotient, remainder: remainder] _
      DUnsignedDivMod[num: num, den: den];
    IF InlineDefs.BITXOR[negNum,negDen] # 0 THEN
      quotient.li _ -quotient.li;
    IF negNum THEN remainder.li _ -remainder.li;
    RETURN
    END;
  
  DDiv: PROC [a,b: Number] RETURNS [Number] =
    { RETURN[DDivMod[a,b].quotient] };

  DMod: PROC [a,b: Number] RETURNS [r: Number] =
    { [remainder: r] _ DDivMod[a,b]; RETURN };

  DMultiply: PROC [a,b: Number] RETURNS [product: Number] =
    BEGIN
    product.lc _ InlineDefs.LongMult[a.lowbits, b.lowbits];
    product.highbits _
      product.highbits + a.lowbits*b.highbits + a.highbits*b.lowbits;
    RETURN
    END;
  
  Number: PRIVATE TYPE = InlineDefs.LongNumber;

  DUnsignedDivMod: PROC [
    num, den: Number] RETURNS [quotient, remainder: Number] =
    BEGIN OPEN InlineDefs;
    qq: CARDINAL;
    count: [0..31);
    lTemp: Number;
    IF den.highbits = 0 THEN
      BEGIN
      [quotient.highbits, qq] _ LongDivMod[
	LOOPHOLE[Number[num[lowbits:num.highbits, highbits:0]]], den.lowbits];
      [quotient.lowbits, remainder.lowbits] _ LongDivMod[
	LOOPHOLE[Number[num[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.lc, lTemp.lowbits]; -- trial quotient
      qq _ BITSHIFT[qq, -count];
      lTemp.lc _ LongMult[den.lowbits, qq]; -- multiply by trial quotient
      lTemp.highbits _ lTemp.highbits + den.highbits*qq;
      UNTIL lTemp.lc <= num.lc DO
	-- decrease quotient until product is small enough
	lTemp.lc _ lTemp.lc - den.lc;
	qq _ qq - 1;
	ENDLOOP;
      quotient.lowbits _ qq;
      remainder.lc _ num.lc - lTemp.lc;
      END;
    RETURN
    END;
  
  DUnsignedDiv: PROC [a,b: Number] RETURNS [Number] =
    { RETURN[DUnsignedDivMod[a,b].quotient] };

  DUnsignedMod: PROC [a,b: Number] RETURNS [r: Number] =
    { [remainder: r] _ DUnsignedDivMod[a,b]; RETURN };

END....