-- File: HistCommands.mesa   last edited by
-- Sandman on September 4, 1980  10:15 AM
-- Karlton on Jun 23, 1980 3:17 PM

DIRECTORY
  Inline USING [BITSHIFT, COPY, LongNumber],
  MsgSW USING [Post],
  PerfCommonOps USING [logSW, msgSW, Number, WriteLongNumber],
  PerfOps USING [
    GetBase, GetBuckets, GetHistBase, GetHistLeg, GetHistNode, GetLegTable,
    GetNodeTable, GetPCR, GetScale, histClass, histType, PutMessage],
  PerfPrivate USING [
    HistBase, HistIndex, Histogram, HistType, LegTab, MaxLegs, MaxNodes, NodeTab,
    NullHist, NullNode, Number, PCR],
  Put USING [CR, Decimal, Line, Number, Text],
  String USING [AppendChar, AppendDecimal],
  UserInput USING [ResetUserAbort, userAbort],
  Window USING [Handle];

HistCommands: PROGRAM
  IMPORTS Inline, PerfOps, UserInput, String, Put, MsgSW, PerfCommonOps
  EXPORTS PerfOps =PUBLIC

  BEGIN OPEN PerfCommonOps, PerfOps, PerfPrivate;

  handle: Window.Handle _ PerfCommonOps.logSW;

  AddHistogram: PUBLIC PROCEDURE =
    BEGIN
    hIndex: HistIndex;
    hist: POINTER TO Histogram;
    index: CARDINAL;
    size, scale, limit: CARDINAL;
    type: HistType _ PerfOps.histType;
    histBase: HistBase;
    nodeTab: POINTER TO NodeTab _ GetNodeTable[read];
    legTab: POINTER TO LegTab _ GetLegTable[read];
    pCR: PCR _ GetPCR[read];
    SELECT type FROM
      node =>
	BEGIN
	index _ GetHistNode[];
	IF index ~IN [0..pCR.nextNode) THEN GOTO invalidNode;
	IF (hIndex _ nodeTab[index].hist) # NullHist THEN
	  BEGIN PutHistError[alreadyOne]; DeleteHist[hIndex]; END;
	END;
      leg =>
	BEGIN
	index _ GetHistLeg[];
	IF index ~IN [0..pCR.nextLeg) THEN GOTO invalidLeg;
	IF (hIndex _ legTab[index].hist) # NullHist THEN
	  BEGIN PutHistError[alreadyOne]; DeleteHist[hIndex]; END;
	END;
      ENDCASE => ERROR;
    limit _ FindAvailableSpace[pCR.histFree];
    IF histClass = log THEN
      limit _ IF type = node THEN MIN[16, limit] ELSE MIN[32, limit];
    size _ CheckBuckets[limit ! Confused => GOTO return];
    scale _ CheckScale[type ! Confused => GOTO return];
    hIndex _ GrabHistogramSlot[size];
    Put.Text[handle, "Added Histogram for "L];
    IF histType = node THEN
      BEGIN
      [] _ GetNodeTable[write];
      nodeTab[index].hist _ hIndex;
      Put.Text[handle, "Node "L];
      END
    ELSE
      BEGIN
      [] _ GetLegTable[write];
      legTab[index].hist _ hIndex;
      Put.Text[handle, "Leg "L];
      END;
    Put.Decimal[handle, index];
    Put.CR[handle];
    histBase _ GetHistBase[write];
    hist _ @histBase[hIndex];
    Zero[hist, SIZE[Histogram] + size];
    hist.scale _ scale;
    hist.type _ type;
    hist.class _ histClass;
    hist.nBuckets _ size;
    hist.base _ GetBase[];
    EXITS
      return => NULL;
      invalidNode => PutHistError[invalidNode];
      invalidLeg => PutHistError[invalidLeg];
    END;

  Zero: PROC [p: POINTER, l: CARDINAL] = {
    IF l # 0 THEN {p^ _ 0; Inline.COPY[from: p, to: p + 1, nwords: l - 1]}};

  ValidateIndex: PROCEDURE [type: HistType, index: CARDINAL, pCR: PCR]
    RETURNS [hIndex: HistIndex] =
    BEGIN
    SELECT type FROM
      node =>
	BEGIN
	nodeTab: POINTER TO NodeTab _ GetNodeTable[read];
	IF index ~IN [0..pCR.nextNode) THEN SIGNAL Invalid;
	IF (hIndex _ nodeTab[index].hist) = NullHist THEN SIGNAL Confused;
	END;
      leg =>
	BEGIN
	legTab: POINTER TO LegTab _ GetLegTable[read];
	IF index ~IN [0..pCR.nextLeg) THEN SIGNAL Invalid;
	IF (hIndex _ legTab[index].hist) = NullHist THEN SIGNAL Confused;
	END;
      ENDCASE;
    RETURN
    END;

  Confused: SIGNAL = CODE;
  Invalid: SIGNAL = CODE;

  DeleteHistogram: PROCEDURE =
    BEGIN
    hIndex: HistIndex;
    type: HistType _ histType;
    index: CARDINAL;
    nodeTab: POINTER TO NodeTab _ GetNodeTable[read];
    legTab: POINTER TO LegTab _ GetLegTable[read];
    pCR: PCR _ GetPCR[read];
    index _ IF type = node THEN GetHistNode[] ELSE GetHistLeg[];
    hIndex _ ValidateIndex[
      type, index, pCR !
      Invalid => IF type = node THEN GOTO invalidNode ELSE GOTO invalidLeg;
      Confused => GOTO return];
    Put.Text[handle, "Deleted Histogram for "L];
    SELECT type FROM
      node =>
	BEGIN
	[] _ GetNodeTable[write];
	DeleteHist[hIndex];
	nodeTab[index].hist _ NullHist;
	Put.Text[handle, "Node "L];
	END;
      leg =>
	BEGIN
	[] _ GetLegTable[write];
	DeleteHist[hIndex];
	legTab[index].hist _ NullHist;
	Put.Text[handle, "Leg "L];
	END;
      ENDCASE;
    Put.Decimal[handle, index];
    Put.CR[handle];
    EXITS
      invalidNode => PutHistError[invalidNode];
      invalidLeg => PutHistError[invalidLeg];
      return => PutHistError[none];
    END;

  DeleteHist: PROCEDURE [hIndex: HistIndex] =
    BEGIN
    histBase: HistBase _ GetHistBase[read];
    nodeTab: POINTER TO NodeTab _ GetNodeTable[read];
    legTab: POINTER TO LegTab _ GetLegTable[read];
    pCR: PCR _ GetPCR[write];
    count, i: CARDINAL;
    from, to: HistIndex;
    to _ hIndex;
    from _ hIndex + SIZE[Histogram] + histBase[hIndex].nBuckets;
    UNTIL from = pCR.histFree DO
      FOR i IN [0..MaxNodes) DO
	IF nodeTab[i].hist = from THEN
	  BEGIN [] _ GetNodeTable[write]; nodeTab[i].hist _ to END;
	ENDLOOP;
      FOR i IN [0..MaxLegs) DO
	IF legTab[i].hist = from THEN
	  BEGIN [] _ GetLegTable[write]; legTab[i].hist _ to END;
	ENDLOOP;
      [] _ GetHistBase[write];
      count _ SIZE[Histogram] + histBase[from].nBuckets;
      Inline.COPY[from: @histBase[from], to: @histBase[to], nwords: count];
      from _ from + count;
      to _ to + SIZE[Histogram] + histBase[to].nBuckets;
      ENDLOOP;
    pCR.histFree _ to;
    END;

  PrintHistogram: PROCEDURE =
    BEGIN
    type: HistType _ PerfOps.histType;
    hIndex: HistIndex;
    index: CARDINAL _ IF type = node THEN GetHistNode[] ELSE GetHistLeg[];
    nodeTab: POINTER TO NodeTab _ GetNodeTable[read];
    legTab: POINTER TO LegTab _ GetLegTable[read];
    pCR: PCR _ GetPCR[read];
    Put.CR[handle];
    hIndex _ ValidateIndex[
      type, index, pCR !
      Invalid => IF type = node THEN GOTO invalidNode ELSE GOTO invalidLeg;
      Confused => GOTO return];
    ListHist[hIndex, index, type];
    EXITS
      invalidNode => PutHistError[invalidNode];
      invalidLeg => PutHistError[invalidLeg];
      return => PutHistError[none];
    END;

  ListHist: PROCEDURE [hIndex: HistIndex, index: CARDINAL, type: HistType] =
    BEGIN
    i: CARDINAL;
    histBase: HistBase _ GetHistBase[read];
    hist: POINTER TO Histogram _ @histBase[hIndex];
    Put.CR[handle];
    Put.Text[handle, "Histogram for "L];
    Put.Text[handle, IF type = node THEN "Node "L ELSE "Leg "L];
    Put.Decimal[handle, index];
    Put.CR[handle];
    Put.Text[handle, "Number of References  "L];
    WriteLongNumber[hist.count, 15];
    Put.CR[handle];
    Put.Text[handle, "Sum of Values         "L];
    WriteLongNumber[hist.sum, 15];
    Put.CR[handle];
    Put.Text[handle, "Average Value         "L];
    WriteLongNumber[IF hist.count = 0 THEN 0 ELSE hist.sum/hist.count, 15];
    Put.CR[handle];
    Put.Text[handle, "Scale Factor"L];
    Put.Text[handle, IF type = leg THEN " (2^n)"L ELSE "      "L];
    Put.Text[handle, "    "L];
    WriteLongNumber[hist.scale, 15];
    Put.CR[handle];
    IF hist.class = linear THEN
      BEGIN
      Put.Text[handle, "Base                  "L];
      WriteLongNumber[hist.base, 15];
      Put.CR[handle];
      END;
    Put.Line[handle, "     Value       Count"L];
    Put.Line[handle, " -------------- -------"L];
    IF hist.class = linear AND hist.base # 0 THEN
      BEGIN
      Put.Text[handle, "      Underflow"L];
      WriteLongNumber[hist.underflow, 8];
      Put.CR[handle];
      END;
    FOR i IN [0..hist.nBuckets) DO
      IF UserInput.userAbort THEN
	BEGIN PutMessage[aborted]; UserInput.ResetUserAbort[]; RETURN END;
      WriteLongNumber[ScaleBucket[i, hist], 15];
      WriteLongNumber[hist.buckets[i], 8];
      Put.CR[handle];
      ENDLOOP;
    Put.Text[handle, "       Overflow"L];
    WriteLongNumber[hist.overflow, 8];
    Put.CR[handle];
    END;

  ScaleBucket: PROCEDURE [bucket: CARDINAL, hist: POINTER TO Histogram]
    RETURNS [val: Number] =
    BEGIN
    SELECT hist.type FROM
      node =>
	SELECT hist.class FROM
	  linear => val _ LONG[bucket]*hist.scale;
	  ENDCASE => val _ TimesTwoToN[hist.scale, bucket];
      leg =>
	SELECT hist.class FROM
	  linear => val _ TimesTwoToN[bucket, hist.scale];
	  ENDCASE => val _ TimesTwoToN[1, bucket*(hist.scale + 1)];
      ENDCASE;
    IF hist.class = linear THEN val _ val + hist.base;
    END;

  TimesTwoToN: PROCEDURE [z: Number, n: CARDINAL] RETURNS [Number] =
    BEGIN OPEN Inline;
    y, x: LongNumber;
    x.lc _ z;
    IF n = 0 THEN RETURN[z];
    IF n > 31 THEN RETURN[0];
    IF n > 15 THEN
      BEGIN
      y.lowbits _ 0;
      y.highbits _ BITSHIFT[x.lowbits, n - 16];
      RETURN[y.lc]
      END;
    y.lowbits _ BITSHIFT[x.lowbits, n];
    y.highbits _ BITSHIFT[x.lowbits, n - 16] + BITSHIFT[x.highbits, n];
    RETURN[y.lc]
    END;

  LegLegal: PROCEDURE [index: CARDINAL] RETURNS [BOOLEAN] =
    BEGIN
    legTab: POINTER TO LegTab _ GetLegTable[read];
    pCR: PCR _ GetPCR[read];
    RETURN[index IN [0..pCR.nextLeg) AND legTab[index].from # NullNode];
    END;

  FindAvailableSpace: PROCEDURE [free: HistIndex] RETURNS [limit: CARDINAL] =
    BEGIN
    limit _ NullHist - free;
    RETURN[IF limit > SIZE[Histogram] THEN limit - SIZE[Histogram] ELSE 0];
    END;

  GrabHistogramSlot: PROCEDURE [size: CARDINAL] RETURNS [hist: HistIndex] =
    BEGIN
    pCR: PCR _ GetPCR[write];
    hist _ pCR.histFree;
    pCR.histFree _ hist + size + SIZE[Histogram];
    RETURN
    END;

  CheckScale: PROCEDURE [type: HistType] RETURNS [n: CARDINAL] =
    BEGIN
    n _ GetScale[];
    SELECT TRUE FROM
      type = leg AND n IN [0..31] => RETURN;
      type = node AND n # 0 => RETURN;
      ENDCASE;
    MsgSW.Post[
      sw: PerfCommonOps.msgSW, string: "Scale must be"L, endOfMsg: FALSE];
    MsgSW.Post[
      PerfCommonOps.msgSW,
      IF type = leg THEN " (2^n) [0..31]"L ELSE " [1..65,535]"L];
    ERROR Confused;
    END;

  CheckBuckets: PROCEDURE [top: CARDINAL] RETURNS [n: CARDINAL] =
    BEGIN OPEN String;
    s: STRING _ [5];
    n _ GetBuckets[];
    IF n IN [1..top] THEN RETURN;
    MsgSW.Post[
      sw: PerfCommonOps.msgSW, string: "Number of Buckets must be [1.."L,
      endOfMsg: FALSE];
    AppendDecimal[s, LOOPHOLE[top]];
    AppendChar[s, ']];
    MsgSW.Post[PerfCommonOps.msgSW, s];
    ERROR Confused;
    END;

  HistError: TYPE = {invalidLeg, invalidNode, alreadyOne, none};

  PutHistError: PROCEDURE [message: HistError] =
    BEGIN
    MsgSW.Post[
      PerfCommonOps.msgSW,
      SELECT message FROM
	invalidLeg => "!Invalid Leg"L,
	invalidNode => "!Invalid Node"L,
	alreadyOne => "Old Histogram deleted!"L,
	none => "No Histogram exists!"L,
	ENDCASE => "?"L];
    RETURN
    END;

  END.