-- GCTableFaultRecorder.mesa
-- inspired by FaultMeter, but watches last 45 page faults in GC Tables
-- process stuff stolen from Knutsen's Ben
-- last edit by Willie-Sue, 15-Sep-81 15:15:39
-- last edit by Paul Rovner, August 6, 1982 10:20 am

DIRECTORY
  Environment USING
    [wordsPerPage],
  Inline USING
    [HighHalf, LowHalf],
  PrincOps USING
    [BytePC, Frame, GlobalFrameHandle],
  Process USING
    [Detach, Pause, priorityInterrupt, SecondsToTicks, SetPriority],
  ProcessInternal USING
    [DisableInterrupts, EnableInterrupts],
  ProcessOperations USING
    [HandleToIndex, IndexToHandle, LongNotify, LongReEnter, LongWait, ReadPSB],
  PSB USING
    [Condition, FaultIndex, PDA, PDABase, PsbHandle, PsbIndex, PsbNull, qPageFault],
  RTRefCounts USING
    [GCState],
  RTOS USING
    [UnregisterCedarProcess],
  Runtime USING
    [CallDebugger],
  Space USING
    [Create, Delete, Handle, PageCount, LongPointer, Map, defaultWindow, virtualMemory],
  SpecialSpace USING
    [MakeGlobalFrameResident, MakeProcedureResident, MakeResident],
  Volume USING
    [InsufficientSpace];
  
GCTableFaultRecorder: MONITOR
  IMPORTS
    Inline, Process, ProcessInternal, ProcessOperations,
    RTOS, Runtime, SpecialSpace, Space, RTRefCounts, Volume
  = BEGIN OPEN Process;

  gcPageFaultInfo: TYPE = RECORD
   [ addrLo: CARDINAL,
     global: PrincOps.GlobalFrameHandle,
     pc: PrincOps.BytePC,
     process: PSB.PsbHandle,
     count: LONG CARDINAL
   ];

  faultInfo: TYPE = RECORD [str: STRING, index: INTEGER];

  gcStateAddrHi: CARDINAL;		-- who to watch
  BufferOfFaults: TYPE = ARRAY BufferIndex OF gcPageFaultInfo;
  bufferOfFaults: LONG POINTER TO BufferOfFaults;
  BufferIndex: TYPE = [0..256);
  bufferIndex: BufferIndex_ LAST[BufferIndex];
  numFaults: LONG CARDINAL _ 0;
  gcFaults: CARDINAL_ 0;
  lastgcFaultAddrLo: CARDINAL_ 0;
  seriousDebugging: BOOLEAN_ FALSE;
  whichGlobalFrame: PrincOps.GlobalFrameHandle_ NIL;

  GetCurrent: PROC RETURNS[PSB.PsbIndex] = INLINE
    {RETURN[ProcessOperations.HandleToIndex[ProcessOperations.ReadPSB[]]]};

  LongNakedNotify: PROC [pCondition: LONG POINTER TO CONDITION] = INLINE {
    -- used to notify a condition from outside the relevant monitor.
    pCond: LONG POINTER TO PSB.Condition = LOOPHOLE[pCondition];
    ProcessInternal.DisableInterrupts[];
    IF pCond^.tail=PSB.PsbNull
       THEN
         { pCond^.wakeup _ TRUE;
	   ProcessInternal.EnableInterrupts[] }
        ELSE
	 { ProcessInternal.EnableInterrupts[];
           ProcessOperations.LongNotify[pCondition] } };

  WaitForFault: PROC = INLINE {

    processFaulted: PSB.PsbHandle;
    addrFaulted: LONG POINTER;
    frameFaulted: POINTER TO local PrincOps.Frame;

    ProcessOperations.LongWait
      [@recorderLock, pPageFaultCONDITION, --timeout:-- 1];
    UNTIL ProcessOperations.LongReEnter
            [@recorderLock, pPageFaultCONDITION] DO
        NULL ENDLOOP;
    
    -- either a new page fault came along or we timed out..
    IF pda.fault[qPageFault].queue.tail = PSB.PsbNull
       THEN RETURN;  -- just timed out, so forget it

    processFaulted _ ProcessOperations.IndexToHandle[
        pda.block[pda.fault[qPageFault].queue.tail].link.next];  -- walk to tail, then to head.
    addrFaulted _ pda[pda[processFaulted].context.state].memPointer;

    -- conditionally wake up the Pilot fault handler:
    ProcessInternal.DisableInterrupts[];
    IF pPageFaultCondition^.tail # PSB.PsbNull
       THEN LongNakedNotify[pPageFaultCONDITION];
    ProcessInternal.EnableInterrupts[];

--  is this one of the pages we're interested in??

    numFaults _ numFaults + 1;
    IF Inline.HighHalf[addrFaulted] = gcStateAddrHi THEN
     { frameFaulted_ pda[pda[processFaulted].context.state].frame;
       bufferIndex_ IF bufferIndex = LAST[BufferIndex] THEN 0
         ELSE bufferIndex + 1;
       bufferOfFaults[bufferIndex]_
        [ addrLo: Inline.LowHalf[addrFaulted],
	  global:frameFaulted.accesslink,
	  pc: frameFaulted.pc,
	  process: processFaulted,
	  count: numFaults
	];

	gcFaults _ gcFaults + 1;
	IF seriousDebugging
	 THEN
	  { IF whichGlobalFrame = frameFaulted.accesslink
		THEN Runtime.CallDebugger["Global Frame of Interest"L]
		ELSE { IF Inline.LowHalf[addrFaulted] = lastgcFaultAddrLo
			THEN Runtime.CallDebugger["Same Page Twice"L]};
	  };
	lastgcFaultAddrLo_ Inline.LowHalf[addrFaulted];
     };
    };

  recorderLock: MONITORLOCK;
  pda: PSB.PDABase = PSB.PDA;
  qPageFault: PSB.FaultIndex = PSB.qPageFault;
  pPageFaultCondition: LONG POINTER TO PSB.Condition = @pda.fault[
    qPageFault].condition;
  pPageFaultCONDITION: LONG POINTER TO CONDITION =
    LOOPHOLE[pPageFaultCondition];
    
  FaultWatcher: PROC = {

    -- make the fault watcher resident
    nPages: Space.PageCount_
	SIZE[gcPageFaultInfo]*(LAST[BufferIndex]+1)/Environment.wordsPerPage;

    spH: Space.Handle = Space.Create[nPages, Space.virtualMemory];
    Space.Map[spH, Space.defaultWindow !
    	 Volume.InsufficientSpace => {Space.Delete[spH]; ERROR}];
    SpecialSpace.MakeResident[spH];

    gcStateAddrHi _ Inline.HighHalf[RTRefCounts.GCState];
--    bufferOfFaults_ LOOPHOLE[RTRefCounts.GCState+300B+16];
    bufferOfFaults_ Space.LongPointer[spH];
         
    SpecialSpace.MakeGlobalFrameResident[GCTableFaultRecorder ! ANY => CONTINUE];
    SpecialSpace.MakeProcedureResident[FaultWatcher];

    -- pause to allow Cedar to start up
    Process.Pause[Process.SecondsToTicks[20]];
 
    -- unregister self
    RTOS.UnregisterCedarProcess[GetCurrent[]];

    -- raise priority
    Process.SetPriority[Process.priorityInterrupt];
    DO
       WaitForFault[];
       ENDLOOP;
    };

 IPF: PROC[bi: BufferIndex] RETURNS[faultInfo] =
  { fi: faultInfo;
    addrLo: CARDINAL _ bufferOfFaults[bi].addrLo;
    IF addrLo < 100400B THEN
     { fi.str_ "MapPiRce"L; fi.index_ LOOPHOLE[addrLo-400B] } 
    ELSE
     { fi.str_ "MapOiOe"L; fi.index_ LOOPHOLE[(addrLo-100400B)/2]};
    RETURN[fi];
  };
    
  -- Mainline Code

  Detach[FORK FaultWatcher[]];
  
  END.