-- Counter.mesa; edited by Sandman on September 21, 1980  7:29 PM  

DIRECTORY
  ControlDefs USING [
    ControlLink, EPRange, FrameHandle, NullFrame, NullReason, Port, StateVector,
    TraceNext, TraceOff, TrapParameter, TrapReason, TrapStatus],
  CoreSwapDefs USING [BBHandle, ExternalStateVector, PuntInfo, UBBPointer],
  CountPrivate USING [ControlRecord, GroupIndex, VersionID],
  FrameDefs USING [MakeCodeResident],
  FrameOps USING [
    Free, GetReturnLink, MyGlobalFrame, MyLocalFrame, SetReturnFrame,
    SetReturnLink],
  ImageDefs USING [AbortMesa],
  Inline USING [BITSHIFT, LongNumber],
  KeyDefs USING [Keys],
  MiscDefs USING [Zero],
  OsStaticDefs USING [OsStatics],
  ProcessDefs USING [DisableInterrupts, EnableInterrupts],
  ProcessOps USING [CurrentPSB],
  SDDefs USING [
    sBreakBlock, sCoreSwap, SD, sGFTLength, sXferTrap, sXferTrapMonitor],
  Storage USING [Words],
  TimingDefs USING [
    Fudge, Fudges, HiLo, Machine, MaxTick, Pair, ReadTime, RealTime],
  TrapOps USING [ReadXTP, ReadXTS, WriteXTS],
  XferCountDefs USING [];

Counter: PROGRAM
  IMPORTS
    FrameDefs, FrameOps, ImageDefs, Inline, MiscDefs, ProcessDefs, Storage,
    TimingDefs, TrapOps
  EXPORTS XferCountDefs =

  BEGIN OPEN TimingDefs, Inline, CountPrivate, ControlDefs, FrameOps;

  WBPort: PORT [POINTER TO CoreSwapDefs.ExternalStateVector];
  machine: Machine;
  fudge: TimingDefs.Fudge;
  activeFudge: TimingDefs.Pair;
  currentState: TimingDefs.HiLo;
  cr: ControlRecord;

  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;

  HandleTraps: PROCEDURE =
    BEGIN
    state: StateVector;
    trapParam: TrapParameter;
    status: TrapStatus;
    frame: FrameHandle;
    ep, i: CARDINAL;
    link: ControlLink;
    previousProcess: UNSPECIFIED;
    exitTime, entryTime: RealTime;
    finish, time, start: LONG CARDINAL;
    reason: TrapReason;
    state _ STATE;
    state.dest _ GetReturnLink[];
    SDDefs.SD[SDDefs.sXferTrap] _ state.source _ FrameOps.MyLocalFrame[];
    ProcessDefs.DisableInterrupts[];
    ProcessDefs.DisableInterrupts[];
    DO
      IF cr.trace THEN TrapOps.WriteXTS[TraceNext];
      previousProcess _ ProcessOps.CurrentPSB^;
      exitTime _ ReadTime[];
      ProcessDefs.EnableInterrupts[];
      ProcessDefs.EnableInterrupts[];
      TRANSFER WITH state;
      ProcessDefs.DisableInterrupts[];
      ProcessDefs.DisableInterrupts[];
      state _ STATE;
      entryTime _ ReadTime[];
      trapParam _ TrapOps.ReadXTP[];
      status _ TrapOps.ReadXTS[];
      TrapOps.WriteXTS[TraceOff];

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

      start _
	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[];
      time _ finish - start;
      IF start > finish THEN time _ time + MaxTick;
      time _ IF time > i THEN time - i ELSE i;
      IF cr.newMeasurement THEN {cr.newMeasurement _ FALSE; cr.gfi _ 0}
      ELSE IF cr.mode = plain THEN {
	cr.times.plain[cr.gfi] _ cr.times.plain[cr.gfi] + time;
	IF ProcessOps.CurrentPSB^ = previousProcess THEN
	  cr.counts.plain[cr.gfi] _ cr.counts.plain[cr.gfi] + 1
	ELSE time _ time}
      ELSE {
	to, from: GroupIndex;
	to _ cr.groups[cr.gfi];
	from _ cr.groups[cr.prevGfi];
	cr.prevGfi _ cr.gfi;
	cr.times.matrix[to][from] _ cr.times.matrix[to][from] + time;
	IF ProcessOps.CurrentPSB^ = previousProcess THEN
	  cr.counts.matrix[to][from] _ cr.counts.matrix[to][from] + 1
	ELSE time _ time};
      SELECT (reason _ status.reason) FROM
	other => {
	  SetReturnLink[
	    IF state.source = NullFrame THEN trapParam.link ELSE state.source];
	  link _ trapParam.link;
	  DO
	    SELECT link.tag FROM
	      procedure => BEGIN cr.gfi _ link.gfi; EXIT; END;
	      indirect => link _ link.link^;
	      frame => BEGIN cr.gfi _ link.frame.accesslink.gfi; EXIT; END;
	      ENDCASE => BEGIN cr.gfi _ 0; EXIT; END;
	    ENDLOOP};
	localCall => {
	  ep _ (trapParam.ep - 2)/2;
	  frame _ state.source;
	  cr.gfi _ frame.accesslink.gfi;
	  trapParam.link _ ControlLink[
	    procedure[
	    tag: procedure, gfi: cr.gfi + ep/EPRange, ep: ep MOD EPRange]];
	  SetReturnFrame[frame]};
	return => {
	  frame _ trapParam.frame - 6;
	  link _ trapParam.link _ frame.returnlink;
	  SetReturnFrame[frame];
	  DO
	    SELECT link.tag FROM
	      procedure => BEGIN cr.gfi _ link.gfi; EXIT; END;
	      indirect => link _ link.link^;
	      frame => BEGIN cr.gfi _ link.frame.accesslink.gfi; EXIT; END;
	      ENDCASE => BEGIN cr.gfi _ 0; EXIT; END;
	    ENDLOOP};
	ENDCASE;
      IF (cr.process # NIL AND cr.process # ProcessOps.CurrentPSB^) THEN
	cr.gfi _ 0;
      state.dest _ trapParam.link;
      IF reason = return THEN
	BEGIN FrameOps.Free[frame]; state.source _ NullFrame; END;
      ENDLOOP;
    END;

  TraceOn: TrapStatus = [0, NullReason, 0, on];

  MonitorBreaks: PROCEDURE =
    BEGIN
    state: StateVector;
    frame: FrameHandle;
    esv: CoreSwapDefs.ExternalStateVector;
    bbHandle: CoreSwapDefs.BBHandle;
    ubb: CoreSwapDefs.UBBPointer;
    i: CARDINAL;
    state _ STATE;
    cr.self _ MyLocalFrame[];
    state.dest _ GetReturnLink[];
    ProcessDefs.DisableInterrupts[];
    DO
      ProcessDefs.EnableInterrupts[];
      TRANSFER WITH state;
      ProcessDefs.DisableInterrupts[];
      state _ STATE;
      SetReturnFrame[state.dest _ frame _ state.source];
      state.source _ FrameOps.MyLocalFrame[];
      frame.pc _ [IF frame.pc < 0 THEN -frame.pc ELSE (1 - frame.pc)];
      bbHandle _ SDDefs.SD[SDDefs.sBreakBlock];
      FOR i IN [0..bbHandle.length) DO
	ubb _ @bbHandle.blocks[i];
	IF frame.accesslink = ubb.frame AND frame.pc = ubb.pc THEN
	  BEGIN
	  IF ubb.counterL THEN
	    SELECT LOOPHOLE[ubb.ptrR, CARDINAL] FROM
	      0 => cr.trace _ TRUE;
	      1 => cr.trace _ ~cr.trace;
	      2 => cr.trace _ FALSE;
	      ENDCASE;
	  state.instbyte _ ubb.inst;
	  EXIT;
	  END;
	REPEAT
	  FINISHED =>
	    BEGIN
	    esv _ CoreSwapDefs.PuntInfo^.puntESV;
	    esv.state _ @state;
	    esv.reason _ worrybreak;
	    DO
	      WBPort[@esv];
	      SELECT esv.reason FROM
		proceed => EXIT;
		kill => ImageDefs.AbortMesa[];
		showscreen => UNTIL KeyDefs.Keys.Spare3 = down DO NULL ENDLOOP;
		ENDCASE;
	      esv.reason _ return;
	      ENDLOOP;
	    END;
	ENDLOOP;
      IF cr.trace THEN TrapOps.WriteXTS[TraceNext]
      ELSE BEGIN cr.gfi _ 0; TrapOps.WriteXTS[TraceOff] END;
      ENDLOOP;
    END;

  StartCounting: PUBLIC PROCEDURE =
    BEGIN TrapOps.WriteXTS[TraceNext]; cr.trace _ TRUE; RETURN END;

  StopCounting: PUBLIC PROCEDURE = BEGIN cr.trace _ FALSE; cr.gfi _ 0; RETURN END;

  Init: PROCEDURE =
    BEGIN
    sd: POINTER TO ARRAY [0..0) OF UNSPECIFIED _ SDDefs.SD;
    length: CARDINAL = MAX[SDDefs.SD[SDDefs.sGFTLength], 256];
    words: CARDINAL = length*SIZE[LONG CARDINAL]*2 + length;
    data: POINTER = Storage.Words[words];
    FrameDefs.MakeCodeResident[FrameOps.MyGlobalFrame[]];
    cr _
      [gfi: 0, version: VersionID, saveBreakHandler: NIL, length: length,
	newSession: TRUE, trace: FALSE, counts: data, self: NIL, mode: plain,
	times: data + length*SIZE[LONG CARDINAL], prevGfi: 0, process: NIL,
	groups: data + 2*length*SIZE[LONG CARDINAL], pulseConversion: 3810,
        newMeasurement: TRUE];
    MiscDefs.Zero[data, words];
    sd[SDDefs.sXferTrapMonitor] _ @cr;
    LOOPHOLE[WBPort, ControlDefs.Port] _
      [representation[in: 0, out: sd[SDDefs.sCoreSwap]]];
    SELECT OsStaticDefs.OsStatics.AltoVersion.engineeringnumber FROM
      2, 3, 5 => BEGIN machine _ altoII; fudge _ TimingDefs.Fudges[altoII] END;
      4 => BEGIN machine _ d0; fudge _ TimingDefs.Fudges[d0] END;
      ENDCASE => BEGIN machine _ altoI; fudge _ TimingDefs.Fudges[altoI] END;
    activeFudge _ fudge[currentState _ hi];
    HandleTraps[];
    MonitorBreaks[];
    END;

  Init[];

  END...