<<>>
    <<ThreadsCountLabel.mesa>>
        <<Copyright Ó 1990, 1992 by Xerox Corporation.  All rights reserved.>>
        <<Spreitze, November 5, 1990 10:14 am PST>>
        <<Weiser, May 26, 1992 10:08 pm PDT>>

    DIRECTORY Commander, CommanderOps, Convert, IO, Labels, Process, Real, RefText, Rope, ViewerClasses;

    ThreadsCountLabel: CEDAR PROGRAM
        IMPORTS Commander, CommanderOps, Convert, IO, Labels, Process, Real, RefText, Rope
        =

    BEGIN

    ROPE: TYPE ~ Rope.ROPE;
    Viewer: TYPE ~ ViewerClasses.Viewer;

    CirioNubThreadDataRep: TYPE ~ MACHINE DEPENDENT RECORD [ --translated from CirioNubTypes.h
        index, gen: CARD,
        sStat: CARD,
        pri: CARD,
        dbMsg: INT,
        dbFrozen: INT,
        pc, sp, fp: POINTER];

    Counts: TYPE ~ RECORD [f, ry, rn, m, c, o: NAT Ź 0];
    Style: TYPE ~ {twiddle, count};

    pause: INT Ź 15000;
    style: Style Ź twiddle;
    divisor: NAT Ź 1;
    nThreads: INT Ź 121;
    buf: REF TEXT Ź RefText.New[100];
    twiddle: ARRAY [0..3] OF CHAR Ź ['\\, '|, '/, '-];
    hexChars: ARRAY [0..15] OF CHAR ~ ['0, '1, '2, '3, '4, '5, '6, '7, '8, '9, 'A, 'B, 'C, 'D, 'E, 'F];

    LocalGetThread: UNSAFE PROC [idx: INT, buf: POINTER TO CirioNubThreadDataRep] RETURNS [INT]
        ~ UNCHECKED MACHINE CODE {"CirioNubLocalGetThread"};

    GetMaxThreads: PROC RETURNS [INT]
        ~ TRUSTED MACHINE CODE {"CirioNubLocalGetMaxThreads"};

    Watch: PROC [but: Viewer] ~ {
        twid: [0..255] Ź 0;
        rem: NAT Ź divisor;
        Process.SetPriority[Process.priorityForeground];
        DO
            counts: Counts Ź [];
            buf: CirioNubThreadDataRep;
            desc: ROPE;
            nThreads Ź GetMaxThreads[];
            FOR idx: NAT IN [0..nThreads) DO
                cc: INT;
                TRUSTED {cc Ź LocalGetThread[idx, @buf]};
                IF cc#0 THEN counts.f Ź counts.f.SUCC
                ELSE SELECT buf.sStat FROM
                    1 => counts.f Ź counts.f.SUCC;
                    2 => counts.ry Ź counts.ry.SUCC;
                    3 => counts.rn Ź counts.rn.SUCC;
                    4 => counts.m Ź counts.m.SUCC;
                    5 => counts.c Ź counts.c.SUCC;
                    ENDCASE => counts.o Ź counts.o.SUCC;
                ENDLOOP;
            IF (rem Ź rem.PRED) = 0 THEN {
                desc Ź FmtCounts[counts, style, twid];
                Labels.Set[but, desc];
                rem Ź divisor};
            Process.PauseMsec[pause];
            twid Ź (twid.SUCC) MOD 256;
            ENDLOOP;
        };

    Control: PROC [cmd: Commander.Handle] RETURNS [result: REF ANY Ź NIL, msg: ROPE Ź NIL] ~ {
        argv: CommanderOps.ArgumentVector ~ CommanderOps.Parse[cmd];
        i: NAT Ź 1;
        WHILE i < argv.argc DO
            len: INT ~ argv[i].Length;
            SELECT TRUE FROM
                len = 0 => RETURN [$Failure, usage];
                argv[i].Fetch[len-1]='s => {
                    rl: ROPE ~ argv[i].Substr[len: len-1];
                    period: REAL Ź 0.0;
                    period Ź Convert.RealFromRope[rl !Convert.Error => {
                        cmd.err.PutF["Convert.Error near %g trying to parse \"%q\" as a REAL.\n", [integer[index]], [rope[rl]] ];
                        GOTO Dont}];
                    IF period < 0.1 OR period > 1.0E3 THEN RETURN [$Failure, IO.PutFR1["Sample period should be in the range [0.1 .. 1000] seconds, not 
                    %g", [real[period]] ]];
                    pause Ź Real.Round[period*1000];
                    cmd.out.PutF1["Sampling period set to %g seconds.\n", [real[period]] ];
                    EXITS Dont => iŹi};
                argv[i].Fetch[0] = '/ => {
                    ri: ROPE ~ argv[i].Substr[start: 1];
                    d: INT ~ Convert.IntFromRope[ri !Convert.Error => {
                        cmd.err.PutF["Convert.Error near %g trying to parse \"%q\" as an INT.\n", [integer[index]], [rope[ri]] ];
                        GOTO Dont}];
                    IF d<1 OR d>65536 THEN RETURN [$Failure, IO.PutFR1["Painting divisor should be in the range [1 .. 65536], not %g", [integer[d]] ]];
                    divisor Ź d;
                    cmd.out.PutF1["Painting divisor set to %g.\n", [integer[d]] ];
                    EXITS Dont => iŹi};
                argv[i].Equal["twiddle", FALSE] => style Ź twiddle;
                argv[i].Equal["count", FALSE] => style Ź count;
                ENDCASE => RETURN [$Failure, usage];
            i Ź i.SUCC;
            ENDLOOP;
        RETURN};

    FmtCounts: PROC [counts: Counts, style: Style, it: [0..255]] RETURNS [ROPE] ~ {
        buf.length Ź 0;
        buf Ź RefText.AppendChar[buf, 'f];
        buf Ź Convert.AppendCard[buf, counts.f];
        buf Ź RefText.AppendRope[buf, " ry"];
        buf Ź Convert.AppendCard[buf, counts.ry];
        buf Ź RefText.AppendRope[buf, " rn"];
        buf Ź Convert.AppendCard[buf, counts.rn];
        buf Ź RefText.AppendRope[buf, " m"];
        buf Ź Convert.AppendCard[buf, counts.m];
        buf Ź RefText.AppendRope[buf, " c"];
        buf Ź Convert.AppendCard[buf, counts.c];
        buf Ź RefText.AppendRope[buf, " o"];
        buf Ź Convert.AppendCard[buf, counts.o];
        buf Ź RefText.AppendChar[buf, ' ];
        SELECT style FROM
            twiddle => buf Ź RefText.AppendChar[buf, twiddle[it MOD 4]];
            count => {
                buf Ź RefText.AppendChar[buf, hexChars[it/16]];
                buf Ź RefText.AppendChar[buf, hexChars[it MOD 16]]};
            ENDCASE => ERROR;
        RETURN Rope.FromRefText[buf]};

    usage: ROPE ~ "Usage: ThreadsCountLabel ( twiddle | count | <seconds>s | /<int>)*";

    Start: PROC ~ {
        n0: ROPE ~ FmtCounts[[f: 22, rn: 12, m: 13], count, 255];
        lab: Viewer ~ Labels.Create[[name: n0]];
        TRUSTED {Process.Detach[FORK Watch[lab]]};
        Commander.Register["ThreadsCountLabel", Control, usage];
        RETURN};

    Start[];

    END.