-- PerfBreakHandler.Mesa; edited by Sandman on September 4, 1980  3:30 PM  

DIRECTORY
  ControlDefs USING [
    FieldDescriptor, FrameHandle, StateVector, TraceNext, TrapStatus],
  CoreSwapDefs USING [ExternalStateVector, PuntInfo, UBBPointer, UserBreakBlock],
  FrameOps USING [GetReturnLink, MyLocalFrame, SetReturnFrame],
  ImageDefs USING [AbortMesa],
  Inline USING [BITSHIFT, LongNumber],
  KeyDefs USING [Keys],
  Mopcodes USING [zRFS],
  PerfPrivate USING [
    Histogram, Leg, LegTab, MaxLegs, MaxNodes, Node, NodeID, NodeTab, NullHist,
    NullNode, Number, PerfControlRecord],
  ProcessDefs USING [DisableInterrupts, EnableInterrupts],
  ProcessOps USING [CurrentPSB],
  TimingDefs USING [Fudge, HiLo, Machine, MaxTick, Pair, ReadTime, RealTime],
  TrapOps USING [ReadXTS, WriteXTS];

PerfBreakHandler: PROGRAM
  IMPORTS FrameOps, ImageDefs, Inline, ProcessDefs, TimingDefs, TrapOps
  SHARES ProcessDefs =

  BEGIN OPEN ControlDefs, PerfPrivate;

  WBPort: PORT [POINTER TO CoreSwapDefs.ExternalStateVector];
  ReadField: PROCEDURE [POINTER, FieldDescriptor] RETURNS [UNSPECIFIED] = MACHINE
    CODE BEGIN Mopcodes.zRFS END;

  BreakBlock: TYPE = RECORD [
    count: CARDINAL, blocks: ARRAY [0..MaxNodes) OF CoreSwapDefs.UserBreakBlock];

  perfRecord: PerfControlRecord;
  breakBlock: BreakBlock;
  machine: TimingDefs.Machine;
  fudge: TimingDefs.Fudge;
  activeFudge: TimingDefs.Pair;
  currentState: TimingDefs.HiLo;
  nodeTab: POINTER TO NodeTab;
  legTab: POINTER TO LegTab;

  GetFudge: PROCEDURE RETURNS [val: CARDINAL] = INLINE
    BEGIN
    val _ activeFudge.value;
    IF (activeFudge.factor _ activeFudge.factor - 1) = 0 THEN
      BEGIN
      currentState _ SELECT currentState FROM hi => lo, ENDCASE => hi;
      activeFudge _ fudge[currentState];
      END;
    RETURN
    END;

  MonitorBreaks: PROCEDURE =
    BEGIN OPEN Inline;
    state: StateVector;
    frame: FrameHandle;
    esv: CoreSwapDefs.ExternalStateVector;
    xferTrapStatus: TrapStatus;
    ubb: CoreSwapDefs.UBBPointer;
    pCR: POINTER TO PerfControlRecord;
    locL: POINTER;
    fd: FieldDescriptor;
    id: CARDINAL;
    value: CARDINAL;
    word: INTEGER;
    longval: LongNumber;
    hist: POINTER TO Histogram;
    timeSpent: LongNumber;
    timeOnEntry: Number;
    lastExit: Number;
    lastEntry: Number;
    lastPerfEntry: Number;
    lastOverhead: Number;
    lastLegTime: Number;
    breakType: {perf, normal, other};
    stillMustDoLastLeg: BOOLEAN;
    i: CARDINAL;
    free: BOOLEAN;
    node: POINTER TO Node;
    leg: POINTER TO Leg;
    enterTime, exitTime: TimingDefs.RealTime;
    nodeID: NodeID;
    state _ STATE;
    pCR _ @perfRecord;
    pCR.self _ FrameOps.MyLocalFrame[];
    state.dest _ FrameOps.GetReturnLink[];
    ProcessDefs.DisableInterrupts[];
    ProcessDefs.DisableInterrupts[];
    DO
      OPEN pCR;
      xferTrapStatus _ TrapOps.ReadXTS[];
      IF xferTrapStatus.state = on THEN TrapOps.WriteXTS[TraceNext];
      lastEntry _ timeOnEntry;
      exitTime _ TimingDefs.ReadTime[];
      ProcessDefs.EnableInterrupts[];
      ProcessDefs.EnableInterrupts[];
      TRANSFER WITH state;
      ProcessDefs.DisableInterrupts[];
      ProcessDefs.DisableInterrupts[];
      state _ STATE;
      enterTime _ TimingDefs.ReadTime[];
      FrameOps.SetReturnFrame[state.dest _ frame _ state.source];
      state.source _ FrameOps.MyLocalFrame[];
      frame.pc _ [IF frame.pc < 0 THEN -frame.pc ELSE (1 - frame.pc)];

      -- Fixup time
      timeOnEntry _
	LONG[
	  WITH enterTime.low SELECT machine FROM altoI => low, altoII => low,
	  d0 => low, ENDCASE => 0] + BITSHIFT[enterTime.high.whole, 10] +
	  LOOPHOLE[LongNumber[num[highbits: enterTime.high.high, lowbits: 0]],
	  LONG CARDINAL];

      lastExit _
	LONG[
	  WITH exitTime.low SELECT machine FROM altoI => low, altoII => low,
	  d0 => low, ENDCASE => 0] + BITSHIFT[exitTime.high.whole, 10] +
	  LOOPHOLE[LongNumber[num[highbits: exitTime.high.high, lowbits: 0]], LONG
	  CARDINAL];

      i _ GetFudge[];
      timeSpent.lc _ timeOnEntry - lastExit;
      IF lastExit > timeOnEntry THEN
	timeSpent.lc _ timeSpent.lc + TimingDefs.MaxTick;
      IF timeSpent.lc > i THEN lastExit _ lastExit + i
      ELSE lastExit _ lastExit + timeSpent.lc;


      IF ~measuringNow THEN
	BEGIN lastEntry _ lastExit; lastPerfEntry _ timeOnEntry; END;
      lastOverhead _ lastExit - lastEntry;
      IF lastEntry > lastExit THEN
	lastOverhead _ lastOverhead + TimingDefs.MaxTick;
      lastPerfEntry _ lastPerfEntry + lastOverhead;
      IF lastCall = perf THEN
	BEGIN
	perfTime _ perfTime + lastOverhead;
	totalTime _ totalTime + lastOverhead;
	END
      ELSE
	FOR leg _ @legTab[0], leg + SIZE[Leg] UNTIL leg = @legTab[nextLeg] DO
	  IF leg.owner # NIL THEN leg.start _ leg.start + lastOverhead; ENDLOOP;
      nodeID _ [pc: frame.pc, frame: frame.accesslink];
      breakType _ normal;
      FOR i IN [0..breakBlock.count) DO
	ubb _ @breakBlock.blocks[i];
	IF nodeID = [frame: ubb.frame, pc: ubb.pc] THEN
	  BEGIN
	  state.instbyte _ ubb.inst;
	  node _ @nodeTab[0];
	  IF process # NIL AND process # ProcessOps.CurrentPSB^ THEN
	    BEGIN breakType _ other; EXIT END;
	  FOR id IN [0..nextNode) DO
	    IF nodeID = node.id THEN GOTO foundEntry;
	    node _ node + SIZE[Node];
	    ENDLOOP;
	  IF nextNode < MaxNodes THEN
	    BEGIN
	    id _ nextNode;
	    nextNode _ nextNode + 1;
	    node^ _
	      [id: nodeID, hitsLow: 0, hitsHigh: 0, overflowed: FALSE,
		hist: NullHist];
	    GO TO foundEntry;
	    END
	  ELSE BEGIN breakType _ other; EXIT END;
	  END;
	REPEAT
	  foundEntry =>
	    BEGIN
	    breakType _ perf;
	    IF (node.hitsLow _ node.hitsLow + 1) = 0 THEN
	      IF (node.hitsHigh _ node.hitsHigh + 1) = 0 THEN
		node.overflowed _ TRUE;
	    IF node.hist # NullHist AND ~ubb.counterL THEN
	      BEGIN
	      locL _
		IF ubb.localL THEN frame + LOOPHOLE[ubb.ptrL, CARDINAL]
		ELSE ubb.ptrL;
	      fd _ [offset: 0, posn: ubb.posnL, size: ubb.sizeL];
	      value _ ReadField[locL, fd];
	      hist _ @histBase[node.hist];
	      hist.count _ hist.count + 1;
	      hist.sum _ hist.sum + value;
	      IF LOOPHOLE[hist.base, LongNumber].lowbits > value THEN
		hist.underflow _ hist.underflow + 1
	      ELSE
		BEGIN
		value _
		  (value - LOOPHOLE[hist.base, LongNumber].lowbits)/hist.scale;
		IF hist.class = log THEN
		  IF (word _ value) # 0 THEN
		    FOR value DECREASING IN [0..15] DO
		      IF word < 0 THEN EXIT; word _ word*2; ENDLOOP;
		IF value < hist.nBuckets THEN
		  hist.buckets[value] _ hist.buckets[value] + 1
		ELSE hist.overflow _ hist.overflow + 1;
		END;
	      END;
	    END;
	ENDLOOP;


      IF breakType = perf THEN
	BEGIN
	lastLegTime _ timeOnEntry - lastPerfEntry;
	IF lastPerfEntry > timeOnEntry THEN
	  lastLegTime _ lastLegTime + TimingDefs.MaxTick;
	totalTime _ totalTime + lastLegTime;
	IF trackLeg # none THEN
	  BEGIN
	  stillMustDoLastLeg _ TRUE;
	  FOR leg _ @legTab[0], leg + SIZE[Leg] UNTIL leg = @legTab[nextLeg] DO
	    IF leg.owner # NIL THEN
	      BEGIN
	      leg.start _ leg.start + lastOverhead;
	      IF id = leg.to THEN
		BEGIN
		IF leg.owner # ProcessOps.CurrentPSB^ THEN leg.someIgnored _ TRUE
		ELSE
		  BEGIN
		  leg.owner _ NIL;
		  IF lastID = leg.from THEN stillMustDoLastLeg _ FALSE;
		  IF (leg.hitsLow _ leg.hitsLow + 1) = 0 THEN
		    IF (leg.hitsHigh _ leg.hitsHigh + 1) = 0 THEN
		      leg.overflowed _ TRUE;
		  timeSpent.lc _ timeOnEntry - leg.start;
		  IF leg.start > timeOnEntry THEN
		    timeSpent.lc _ timeSpent.lc + TimingDefs.MaxTick;
		  leg.sum _ leg.sum + timeSpent.lc;
		  IF leg.hist # NullHist THEN
		    BEGIN
		    hist _ @histBase[leg.hist];
		    hist.count _ hist.count + 1;
		    hist.sum _ hist.sum + timeSpent.lc;
		    IF hist.base > timeSpent.lc THEN
		      hist.underflow _ hist.underflow + 1
		    ELSE
		      BEGIN
		      timeSpent.lc _ timeSpent.lc - hist.base;
		      longval.highbits _ BITSHIFT[
			timeSpent.highbits, -hist.scale];
		      longval.lowbits _
			BITSHIFT[timeSpent.lowbits, -hist.scale] + BITSHIFT[
			  timeSpent.highbits, 16 - hist.scale];
		      IF hist.class = log THEN
			IF (word _ longval.highbits) # 0 THEN
			  FOR value DECREASING IN [16..31] DO
			    IF word < 0 THEN EXIT; word _ word*2; ENDLOOP
			ELSE
			  IF (word _ longval.lowbits) # 0 THEN
			    FOR value DECREASING IN [0..15] DO
			      IF word < 0 THEN EXIT; word _ word*2; ENDLOOP
			  ELSE value _ 0
		      ELSE
			value _
			  IF longval.highbits # 0 THEN hist.nBuckets
			  ELSE longval.lowbits;
		      IF value < hist.nBuckets THEN
			hist.buckets[value] _ hist.buckets[value] + 1
		      ELSE hist.overflow _ hist.overflow + 1;
		      END;
		    END;
		  END;
		END
	      ELSE IF trackLeg = successor THEN leg.owner _ NIL;
	      END;
	    IF id = leg.from THEN
	      BEGIN
	      leg.start _ timeOnEntry;
	      IF leg.owner # NIL THEN leg.someIgnored _ TRUE;
	      leg.owner _ ProcessOps.CurrentPSB^;
	      END;
	    ENDLOOP;
	  free _ FALSE;
	  IF addLeg = successor AND stillMustDoLastLeg AND measuringNow THEN
	    BEGIN
	    FOR leg _ @legTab[0], leg + SIZE[Leg] UNTIL leg = @legTab[nextLeg] DO
	      IF ~leg.lock AND leg.from = NullNode THEN
		BEGIN free _ TRUE; EXIT; END;
	      ENDLOOP;
	    IF ~free AND nextLeg < MaxLegs THEN
	      BEGIN
	      leg _ @legTab[nextLeg];
	      nextLeg _ nextLeg + 1;
	      free _ TRUE
	      END;
	    IF free THEN
	      BEGIN
	      leg^ _
		[start: timeOnEntry, from: lastID, to: id, lock: FALSE,
		  someIgnored: FALSE, owner: NIL, hitsLow: 1, hitsHigh: 0,
		  sum: lastLegTime, hist: NullHist, overflowed: FALSE];
	      IF id = lastID THEN leg.owner _ ProcessOps.CurrentPSB^;
	      stillMustDoLastLeg _ FALSE;
	      END;
	    END;
	  END;
	END;
      SELECT breakType FROM
	perf =>
	  BEGIN
	  lastID _ id;
	  measuringNow _ TRUE;
	  totalBreaks _ totalBreaks + 1;
	  lastPerfEntry _ timeOnEntry;
	  lastCall _ perf;
	  END;
	normal =>
	  BEGIN
	  esv _ CoreSwapDefs.PuntInfo^.puntESV;
	  esv.state _ @state;
	  esv.reason _ worrybreak;
	  DO
	    WBPort[@esv]; --  now subtract out time spent in the debugging world
	    lastCall _ normal;
	    SELECT esv.reason FROM
	      proceed => EXIT;
	      kill => ImageDefs.AbortMesa[];
	      showscreen => UNTIL KeyDefs.Keys.Spare3 = down DO NULL ENDLOOP;
	      ENDCASE;
	    esv.reason _ return;
	    ENDLOOP;
	  END;
	ENDCASE => lastCall _ normal;

      ENDLOOP;
    END;

  END...