
<<LarkWorkCommandsB.mesa>>
<<L. Stewart, December 22, 1983 2:47 pm>>
    <<Swinehart, April 3, 1987 5:54:05 pm PST>>

DIRECTORY
Basics USING [BITSHIFT, LongNumber, LowHalf],
Convert USING [CardFromRope, Error],
IO,
LarkControl USING [FetchState, LarkData],
LarkPrograms USING [FindVariable, ProcedureEnclosing, Program, STObject],
LarkWork USING [LarkWorkProc, RegisterLarkWorkProc],
Rope USING [Concat, Length, ROPE],
RPCPkt,
TeleLoad USING [AddressSpace, Advice, Call, CallPkt, CallPktObject, CoreAddress, CoreBlock, CoreBlockObject, Failed, FlushWrites, 
GetCoreBlock, Handle, Read, ReadWord, ResetCache, SetCacheSize, Swab, WriteWord];

LarkWorkCommandsB: CEDAR PROGRAM
IMPORTS Basics, Convert, IO, LarkControl, LarkPrograms, LarkWork, Rope, TeleLoad =
BEGIN
BadCommRope: Rope.ROPE = "Communications Failure\n";
BadArgsRope: Rope.ROPE = "Bad Arguments\n";
<<Types>>

CoreWordBlock: TYPE = LONG POINTER TO RECORD [
advice: TeleLoad.Advice,
address: TeleLoad.CoreAddress,
data: SEQUENCE count: CARDINAL OF CARDINAL
];

headerSize: CARDINAL = SIZE[RPCPkt.Header]*2;

PBIRecord: TYPE = RECORD [
link: ShortCoreAddress, -- Queue word
queue: ShortCoreAddress, -- where to put after transmission
clientWord: WORD, -- give client a value in each PBI
pup: ShortCoreAddress -- The pup
];

PBI: TYPE = LONG POINTER TO PBIRecord;

ShortCoreAddress: TYPE = CARDINAL;

RPCCtx: TYPE = RECORD [
link: ShortCoreAddress, -- Queue word
stack: ShortCoreAddress, -- Saved stack top value when context inactive
stackMin: ShortCoreAddress, -- Limit
initialPC: ShortCoreAddress, -- Procedure forked by CreateNContext
name:    ShortCoreAddress,    -- C string describing context

<<RPCSystem substructure>>
maxrun: CARDINAL,
caller: ShortCoreAddress, -- caller of Block after maxrun
extra: ARRAY [0..6) OF UNSPECIFIED,

<<RPCUser substructure>>
myPSB: CARDINAL,        -- if a context that uses RPC, its PSB.
sigVec: ShortCoreAddress, -- where the signal vector is for this context.

stackArea: ARRAY [0..0) OF UNSPECIFIED -- the stack -- ];

DspCtxQ: LarkWork.LarkWorkProc = TRUSTED {
ENABLE {
Convert.Error => GOTO BadArgs;
TeleLoad.Failed => GOTO BadComm;
};
ctx: TeleLoad.CoreAddress _ 0;
ctxRunning: TeleLoad.CoreAddress _ 0;
out: IO.STREAM _ lark.h.log;
h: TeleLoad.Handle _ lark.h;
processCount: NAT _ 0;
IF argv.argc > 1 THEN ctxRunning _ Convert.CardFromRope[argv[1], 16];
IF argv.argc > 2 THEN ctx _ Convert.CardFromRope[argv[2], 16];
IF ctx=0 THEN {
ctxItem: LarkPrograms.STObject;
found: BOOL;
[item: ctxItem, found: found] _ LarkPrograms.FindVariable[lark.program, "ctxQ"];
IF found THEN ctx _ TeleLoad.ReadWord[h, ctxItem.addr]
ELSE RETURN["can't get symbol ctxQ\n"];
};
IF ctxRunning = 0 THEN {
cxtxRunningItem: LarkPrograms.STObject;
found: BOOL;
[item: cxtxRunningItem, found: found] _ LarkPrograms.FindVariable[lark.program, "CtxRunning"];
IF found THEN ctxRunning _ TeleLoad.ReadWord[h, cxtxRunningItem.addr];
};
IF ctxRunning#0 THEN DspCtxInternal[lark, ctxRunning, TRUE];
WHILE ctx#0 DO
IF processCount > 15 THEN RETURN["Probable context loop\n"];
IF ctx # ctxRunning THEN DspCtxInternal[lark, ctx, FALSE];
ctx _ TeleLoad.ReadWord[h, ctx];
processCount _ processCount + 1;
ENDLOOP;
EXITS
BadArgs => RETURN[BadArgsRope];
BadComm => RETURN[BadCommRope];
};

DspCtx: LarkWork.LarkWorkProc = TRUSTED {
ENABLE {
Convert.Error => GOTO BadArgs;
TeleLoad.Failed => GOTO BadComm;
};
ctx: TeleLoad.CoreAddress _ 0;
running: BOOL _ FALSE;
IF argv.argc > 2 THEN RETURN;
IF argv.argc = 2 THEN ctx _ Convert.CardFromRope[argv[1], 16]
ELSE {
ctxRunningItem: LarkPrograms.STObject;
found: BOOL;
running _ TRUE;
[item: ctxRunningItem, found: found] _ LarkPrograms.FindVariable[lark.program, "CtxRunning"];
IF found THEN ctx _ TeleLoad.ReadWord[lark.h, ctxRunningItem.addr]
ELSE RETURN["Can't find symbol CtxRunning\n"];
};
DspCtxInternal[lark, ctx, running];
EXITS
BadArgs => RETURN[BadArgsRope];
BadComm => RETURN[BadCommRope];
};


DspCtxInternal: PROC [lark: LarkControl.LarkData, addr: TeleLoad.CoreAddress, running: BOOLEAN_FALSE ] = TRUSTED {
out: IO.STREAM _ lark.h.log;
h: TeleLoad.Handle _ lark.h;
cb: TeleLoad.CoreBlock _ TeleLoad.GetCoreBlock[h, addr, SIZE[RPCCtx] * 2];
ctx: LONG POINTER TO RPCCtx = LOOPHOLE[@(LOOPHOLE[cb, CoreWordBlock]).data[0]];
bp, ip: ShortCoreAddress;
hwm: ShortCoreAddress;
zbCtx: LONG POINTER TO RPCCtx = LOOPHOLE[LONG[0]];
offsetSigVec: LONG CARDINAL = LOOPHOLE[@zbCtx.sigVec];
out.PutRope["Ctx: "];
DspCString[lark, TeleLoad.Swab[ctx.name]];
out.PutF["(%2x)%g at %4x, limit %4x",
IO.card[TeleLoad.Swab[ctx.myPSB]], IO.char[IF running THEN '@ ELSE ' ],
IO.card[addr], IO.card[TeleLoad.Swab[ctx.stackMin]]];
out.PutF[", sigVec at %4X\n", IO.card[LOOPHOLE[addr+offsetSigVec*2]]];
hwm _ HighWaterMark[h, TeleLoad.Swab[ctx.stackMin]];
out.PutF["    max run %4d(10) due to %4x, high water mark at %4x\n",
IO.card[TeleLoad.Swab[ctx.maxrun]], IO.card[TeleLoad.Swab[ctx.caller]], IO.card[hwm]];
IF running THEN { 
ok: BOOL;
[ok, lark.state] _ LarkControl.FetchState[h];
IF NOT ok THEN {
out.PutRope["Cannot read state\n"];
RETURN;
};
bp _ lark.state.Regs[BP];
ip _ lark.state.Regs[IP];
}
ELSE {
bp _ TeleLoad.ReadWord[h, TeleLoad.Swab[ctx.stack]];
ip _ TeleLoad.ReadWord[h, TeleLoad.Swab[ctx.stack] + 2 ];
};
DspStack[lark, bp, ip];
};

DspCString: PROC[lark: LarkControl.LarkData, addr: ShortCoreAddress] = {
FOR i: NAT IN [0..20) DO
c: CHAR _ LOOPHOLE[TeleLoad.Read[lark.h, addr+i]];
IF c = '\000 THEN RETURN;
IF c NOT IN [40C..176C] THEN c _ '.;
lark.h.log.PutChar[c];
ENDLOOP;
};

HighWaterMark: PROC [h: TeleLoad.Handle, stackLim: TeleLoad.CoreAddress] RETURNS [hwm: TeleLoad.CoreAddress] = {
addr: TeleLoad.CoreAddress _ stackLim;
DO
IF TeleLoad.ReadWord[h, addr]#0 THEN RETURN[addr+1];
addr _ addr+2;
ENDLOOP;
};

DspStack: PROC[lark: LarkControl.LarkData, bp: TeleLoad.CoreAddress, initPC: TeleLoad.CoreAddress] = {
out: IO.STREAM _ lark.h.log;
h: TeleLoad.Handle _ lark.h;
FOR i: NAT IN [0..15) DO -- limit depth
IF bp = 0 THEN EXIT;
out.PutF["   BP, IP = (%4X, %4X) [...", IO.card[bp], IO.card[initPC]];
out.PutF["%4X, %4X, %4X, %4X]",
IO.card[TeleLoad.ReadWord[h, bp-4]], IO.card[TeleLoad.ReadWord[h, bp-2]], IO.card[TeleLoad.ReadWord[h, bp+4]], 
IO.card[TeleLoad.ReadWord[h, bp+6]]];
out.PutF[" (in %g)\n", IO.rope[LarkPrograms.ProcedureEnclosing[lark.program, initPC].id]];
initPC _ TeleLoad.ReadWord[h, bp+2];
bp _ TeleLoad.ReadWord[h, bp];
IF bp = 0 THEN EXIT;
ENDLOOP;
out.PutChar['\n];
};

ClrCtxStats: LarkWork.LarkWorkProc = TRUSTED {
ENABLE {
Convert.Error => GOTO BadArgs;
TeleLoad.Failed => GOTO BadComm;
};
out: IO.STREAM _ lark.h.log;
h: TeleLoad.Handle _ lark.h;
ctx: TeleLoad.CoreAddress _ 0;
processCount: NAT _ 0;
zbCtx: LONG POINTER TO RPCCtx = LOOPHOLE[LONG[0]];
offsetMaxrun: LONG CARDINAL = LOOPHOLE[@zbCtx.maxrun];

IF argv.argc > 1 THEN ctx _ Convert.CardFromRope[argv[1], 16];
IF ctx = 0 THEN {
ctxItem: LarkPrograms.STObject;
found: BOOL;
[item: ctxItem, found: found] _ LarkPrograms.FindVariable[lark.program, "ctxQ"];
IF found THEN ctx _ TeleLoad.ReadWord[h, ctxItem.addr]
ELSE RETURN["can't get symbol ctxQ\n"];
};
TeleLoad.SetCacheSize[h, 2];
WHILE ctx # 0 DO
IF processCount > 15 THEN RETURN["Probable context loop\n"];
TeleLoad.WriteWord[h, ctx+offsetMaxrun*2, 0];
ctx _ TeleLoad.ReadWord[h, ctx];
processCount _ processCount + 1;
ENDLOOP;
TeleLoad.FlushWrites[h];
TeleLoad.SetCacheSize[h, 0];
EXITS
BadArgs => RETURN[BadArgsRope];
BadComm => RETURN[BadCommRope];
};

PrintFixed: LarkWork.LarkWorkProc = {
ENABLE TeleLoad.Failed => GOTO BadComm;
out: IO.STREAM _ lark.h.log;
h: TeleLoad.Handle _ lark.h;
end: LarkPrograms.STObject;
found: BOOL;
fobp: TeleLoad.CoreAddress;
fob: FOB;
caller, caller2: LarkPrograms.STObject;
[item: end, found: found] _ LarkPrograms.FindVariable[lark.program, "end"];
IF NOT found THEN RETURN["can't get symbol end\n"];
fobp _ end.addr;
IF (fobp MOD 2) # 0 THEN fobp _ fobp + 1;
DO
fob _ ReadFob[h: h, fobAddr: fobp];
IF fob.length = 0 THEN EXIT;
caller _ LarkPrograms.ProcedureEnclosing[lark.program, fob.owner];
caller2 _ LarkPrograms.ProcedureEnclosing[lark.program, fob.owner2];
out.PutF["adr: %04xH, len: %5d ", IO.card[fobp + 6], IO.card[fob.length]];
out.PutF["own: %g+%x ", IO.rope[caller.id], IO.card[fob.owner - caller.addr]];
out.PutF["own2: %g+%x\n", IO.rope[caller2.id], IO.card[fob.owner2 - caller2.addr]];
fobp _ fobp + (fob.length * 2) + 6;
ENDLOOP;
EXITS
BadComm => RETURN[BadCommRope];
};

FOB: TYPE = RECORD [
owner: CARDINAL,
owner2: CARDINAL,
length: CARDINAL
];

ReadFob: PROC [h: TeleLoad.Handle, fobAddr: TeleLoad.CoreAddress] RETURNS [f: FOB] = {
f.owner _ TeleLoad.ReadWord[h, fobAddr];
f.owner2 _ TeleLoad.ReadWord[h, fobAddr + 2];
f.length _ TeleLoad.ReadWord[h, fobAddr + 4];
};

DspPkt: LarkWork.LarkWorkProc = {
ENABLE {
Convert.Error => GOTO BadArgs;
TeleLoad.Failed => GOTO BadComm;
};
out: IO.STREAM _ lark.h.log;
addr: TeleLoad.CoreAddress _ 0;
IF argv.argc # 2 THEN RETURN;
addr _ Convert.CardFromRope[argv[1], 16];
DspPktInternal[lark, addr];
EXITS
BadArgs => RETURN[BadArgsRope];
BadComm => RETURN[BadCommRope];
};

DspPktInternal: PROC [lark: LarkControl.LarkData, addr: TeleLoad.CoreAddress] = TRUSTED {
out: IO.STREAM _ lark.h.log;
h: TeleLoad.Handle _ lark.h;
cb: TeleLoad.CoreBlock _ TeleLoad.GetCoreBlock[h, addr, (SIZE[RPCPkt.Header]+1)*2];
header: LONG POINTER TO RPCPkt.Header;
typ: Rope.ROPE;
offset: NAT;
IF cb=NIL THEN RETURN;
header _ LOOPHOLE[@(LOOPHOLE[cb, CoreWordBlock]).data[0]];
typ _ PktType[header.type];
offset _ IF typ.Length[]=0 THEN 0 ELSE headerSize;
out.PutF["--------------\n%d byte packet at %4X:\n%s (%3B)  ",
IO.card[header.length*2], IO.card[addr], IO.rope[typ], IO.card[cb.data[3]]];
out.PutF["[%2B#%3B#%2B](%4X)",
IO.card[header.destHost.net], IO.card[header.destHost.host], IO.card[header.destSoc.b],
IO.card[header.destPSB]];
out.PutF[" _ [%2B#%3B#%2B](%4X)\n",
IO.card[header.srceHost.net], IO.card[header.srceHost.host], IO.card[header.srceSoc.b],
IO.card[header.srcePSB]];
out.PutF["conv: %8Xx, id: [act: %4X, count: %8Xx, seq: %4X]\n",
MesaDbl[@header.conv], IO.card[header.pktID.activity],
MesaDbl[@header.pktID.callSeq], IO.card[header.pktID.pktSeq]];
out.PutF["disp: [mds: %4X, id: %8X, hint: %4X]\n",
IO.card[header.dispatcher.mds], MesaDbl[@header.dispatcher.dispatcherID],
IO.card[header.dispatcher.dispatcherHint]];
out.PutRope["Data:\n"];
IF header.length>0 AND header.length<105 THEN {
Show[h: h, addr: addr+offset, count: header.length*2-offset, words: TRUE, addressSpace: main];
};
};

PktType: PROC[type: RPCPkt.PktType] RETURNS [Rope.ROPE] = {
t: Rope.ROPE _ NIL;
IF type.subType # rpc THEN RETURN[NIL];
IF type.eom = notEnd THEN t _ "notEnd-";
IF type.ack = pleaseAck AND type.class=ack THEN RETURN[t.Concat["Ping"]];
t _ t.Concat[SELECT type.class FROM
call => "Call",
data => "Data",
ack => "Ack",
rfa => "Rfa",
ENDCASE=>"??"];
IF type.ack = pleaseAck THEN t _ t.Concat["/Ack"];
RETURN[t];
};

MesaDbl: PROC [addr: LONG POINTER] RETURNS [IO.Value] = TRUSTED {
ln: Basics.LongNumber _ LOOPHOLE[addr, LONG POINTER TO Basics.LongNumber]^;
ln.lo _ TeleLoad.Swab[ln.lo];
ln.hi _ TeleLoad.Swab[ln.hi];
RETURN[IO.card[ln.lc]];
};

DspPBI: LarkWork.LarkWorkProc = TRUSTED {
ENABLE {
Convert.Error => GOTO BadArgs;
TeleLoad.Failed => GOTO BadComm;
};
out: IO.STREAM _ lark.h.log;
h: TeleLoad.Handle _ lark.h;
addr: TeleLoad.CoreAddress;
cb: TeleLoad.CoreBlock;
pbi: PBI;
IF argv.argc # 2 THEN RETURN;
addr _ Convert.CardFromRope[argv[1], 16];
cb _ TeleLoad.GetCoreBlock[h, addr, SIZE[PBIRecord]*2];
IF cb=NIL THEN RETURN;
pbi _ LOOPHOLE[@(LOOPHOLE[cb, CoreWordBlock]).data[0]];
out.PutF["--------------\nPBI at %4X:\n", IO.card[addr]];
out.PutF["link: %4X, queue: %4X, pup: %4X\n", IO.card[TeleLoad.Swab[pbi.link]], IO.card[TeleLoad.Swab[pbi.queue]], 
IO.card[TeleLoad.Swab[pbi.pup]]];
out.PutF[" clientWord: %4X (in %g)X\n",
IO.card[TeleLoad.Swab[pbi.clientWord]],
IO.rope[LarkPrograms.ProcedureEnclosing[lark.program, TeleLoad.Swab[pbi.clientWord]].id]];
DspPktInternal[lark, TeleLoad.Swab[pbi.pup]];
EXITS
BadArgs => RETURN[BadArgsRope];
BadComm => RETURN[BadCommRope];
};

Dump: LarkWork.LarkWorkProc = {
ENABLE {
Convert.Error => GOTO BadArgs;
TeleLoad.Failed => GOTO BadComm;
};
out: IO.STREAM _ lark.h.log;
addr: TeleLoad.CoreAddress;
count: CARDINAL _ 0;
IF argv.argc < 2 THEN RETURN[];
addr _ Convert.CardFromRope[argv[1], 16];
IF argv.argc > 2 THEN count _ Basics.LowHalf[Convert.CardFromRope[argv[2], 16]]
ELSE count _ 64;
Show[h: lark.h, addr: addr, count: count, words: NOT capital, addressSpace: main];
EXITS
BadArgs => RETURN[BadArgsRope];
BadComm => RETURN[BadCommRope];
};

SlaveDump: LarkWork.LarkWorkProc = {
ENABLE {
Convert.Error => GOTO BadArgs;
TeleLoad.Failed => GOTO BadComm;
};
out: IO.STREAM _ lark.h.log;
addr: TeleLoad.CoreAddress;
count: CARDINAL _ 0;
IF argv.argc < 2 THEN RETURN[];
addr _ Convert.CardFromRope[argv[1], 16];
IF argv.argc > 2 THEN count _ Basics.LowHalf[Convert.CardFromRope[argv[2], 16]]
ELSE count _ 64;
Show[h: lark.h, addr: addr, count: count, words: NOT capital, addressSpace: slave];
EXITS
BadArgs => RETURN[BadArgsRope];
BadComm => RETURN[BadCommRope];
};

Show: PROC[h: TeleLoad.Handle, addr: TeleLoad.CoreAddress, count: CARDINAL, words: BOOL _ FALSE, addressSpace: 
TeleLoad.AddressSpace] = TRUSTED {
chars: STRING _ [16];
val, wval: CARDINAL;
{
IF h = NIL THEN RETURN;
TeleLoad.ResetCache[h];
TeleLoad.SetCacheSize[h, 0];
chars.length _ 16;
IF count = 0 THEN count _ 64
ELSE count _ count + (addr MOD 16);
addr _ addr - (addr MOD 16); -- round down to nearest multiple of 16
IF (count MOD 16) # 0 THEN count _ count + 16 - (count MOD 16);  -- and round up
FOR i: CARDINAL IN [0..count) DO
IF (i MOD 16) = 0 THEN {
IF addressSpace = main THEN h.log.PutChar[' ] ELSE h.log.PutChar['s];
h.log.PutF[IF addr + i > LAST[CARDINAL] THEN " %08x" ELSE " %04x", IO.card[addr + i]];
};
IF words THEN {
IF (i MOD 2) = 0 THEN {
val _ TeleLoad.Read[h, addr+i, addressSpace];
chars[i MOD 16] _ IF val IN [40B..176B] THEN LOOPHOLE[val] ELSE '.;
wval _ val;
val _ TeleLoad.Read[h, addr+i+1, addressSpace];
chars[(i + 1) MOD 16] _ IF val IN [40B..176B] THEN LOOPHOLE[val] ELSE '.;
wval _ wval + Basics.BITSHIFT[val, 8];
h.log.PutF[" %04x", IO.card[wval]];
};
}
ELSE {
val _ TeleLoad.Read[h, addr+i, addressSpace];
h.log.PutF[" %02x", IO.card[val]];
chars[i MOD 16] _ IF val IN [40B..176B] THEN LOOPHOLE[val] ELSE '.;
};
IF (i MOD 16) = 15 THEN {
h.log.PutF["  "];
FOR j: NAT IN [0..16) DO h.log.PutChar[chars[j]]; ENDLOOP;
h.log.PutChar['\n];
};
ENDLOOP;
};
};

CallProc: LarkWork.LarkWorkProc = TRUSTED {
ENABLE {
Convert.Error => GOTO BadArgs;
TeleLoad.Failed => GOTO BadComm;
};
out: IO.STREAM _ lark.h.log;
variableRope: Rope.ROPE;
ok: BOOL;
cb: TeleLoad.CoreBlock _ NEW[TeleLoad.CoreBlockObject[SIZE[TeleLoad.CallPktObject]*2]];
cp: TeleLoad.CallPkt _ LOOPHOLE[BASE[DESCRIPTOR[cb.data]]];
sym: LarkPrograms.STObject;
tries: NAT;
cb.address _ 0;
cb.advice _ [FALSE, FALSE, 0];
IF argv.argc = 1 THEN RETURN;
variableRope _ argv[1];
[item: sym, found: ok] _ LarkPrograms.FindVariable[lark.program, variableRope];
IF ok THEN cp.proc _ Basics.LowHalf[sym.addr]
ELSE cp.proc _ Basics.LowHalf[Convert.CardFromRope[variableRope, 16]];
IF cp.proc < 1024 THEN GOTO BadArgs;
IF argv.argc > 2 THEN cp.args[0] _ Basics.LowHalf[Convert.CardFromRope[argv[2], 16]];
IF argv.argc > 3 THEN cp.args[1] _ Basics.LowHalf[Convert.CardFromRope[argv[3], 16]];
IF argv.argc > 4 THEN cp.args[2] _ Basics.LowHalf[Convert.CardFromRope[argv[4], 16]];
IF argv.argc > 5 THEN cp.args[3] _ Basics.LowHalf[Convert.CardFromRope[argv[5], 16]];
IF argv.argc > 6 THEN cp.args[4] _ Basics.LowHalf[Convert.CardFromRope[argv[6], 16]];
cp.nargs _ MIN[5, argv.argc - 2];
cp.returnArg _ 0;
[ok, tries] _ TeleLoad.Call[lark.h, cb, 1];
IF ok THEN out.PutF["returns %d (%04xH)\n", IO.card[cp.returnArg], IO.card[cp.returnArg]]
ELSE RETURN["Call failed\n"];
EXITS
BadArgs => RETURN["Bad arguments\n"];
BadComm => RETURN["Bad communications\n"];
};

PrintCtxStats: LarkWork.LarkWorkProc = TRUSTED {
ENABLE TeleLoad.Failed => GOTO BadComm;
ctxStats: LarkPrograms.STObject;
found: BOOL;
h: TeleLoad.Handle _ lark.h;
[item: ctxStats, found: found] _ LarkPrograms.FindVariable[lark.program, "ctxListTime"];
IF NOT found THEN RETURN[". . cannot find symbol ctxListTime\n"];
PrintHistogramInternal[lark: lark, name: "Context list", histo: ctxStats.addr];
EXITS
BadComm => RETURN["Bad communications\n"];
};

PrintHistogram: LarkWork.LarkWorkProc = TRUSTED {
ENABLE TeleLoad.Failed => GOTO BadComm;
histoSym: LarkPrograms.STObject;
found: BOOL;
IF argv.argc # 2 THEN RETURN["Bad Arguments"];
[item: histoSym, found: found] _ LarkPrograms.FindVariable[lark.program, argv[1]];
IF NOT found THEN RETURN[". . cannot find symbol\n"];
PrintHistogramInternal[lark: lark, name: argv[1], histo: histoSym.addr];
EXITS
BadComm => RETURN["Bad communications\n"];
};

PrintHistogramInternal: PROC [lark: LarkControl.LarkData, name: Rope.ROPE, histo: TeleLoad.CoreAddress] = TRUSTED {
val: Basics.LongNumber;
out: IO.STREAM _ lark.h.log;
h: TeleLoad.Handle _ lark.h;
TeleLoad.ResetCache[h];
out.PutRope[name];
out.PutRope[" histogram:\n"];
out.PutRope["                0         20\n"];
FOR i: NAT IN [0..20) DO
val.lo _ TeleLoad.ReadWord[h, histo + (4*i)];
val.hi _ TeleLoad.ReadWord[h, histo + (4*i) + 2];
out.PutF["[%2d..%2d): %8d  ", IO.card[i], IO.card[i+1], IO.card[val.lc]];
val.lo _ TeleLoad.ReadWord[h, histo + 80 + (4*i)];
val.hi _ TeleLoad.ReadWord[h, histo + 80 + (4*i) + 2];
out.PutF["%8d\n", IO.card[val.lc]];
ENDLOOP;
val.lo _ TeleLoad.ReadWord[h, histo + (4*40)];
val.hi _ TeleLoad.ReadWord[h, histo + (4*40) + 2];
out.PutF["ov: %8d  ", IO.card[val.lc]];
val.lo _ TeleLoad.ReadWord[h, histo + (4*41)];
val.hi _ TeleLoad.ReadWord[h, histo + (4*41) + 2];
out.PutF["uf: %8d\n", IO.card[val.lc]];
};

ResetCtxStats: LarkWork.LarkWorkProc = {
ENABLE TeleLoad.Failed => GOTO BadComm;
ctxStats: LarkPrograms.STObject;
found: BOOL;
[item: ctxStats, found: found] _ LarkPrograms.FindVariable[lark.program, "ctxListTime"];
IF NOT found THEN RETURN[". . cannot find symbol ctxListTime\n"];
ResetHistogramInternal[lark: lark, histogram: ctxStats.addr];
EXITS
BadComm => RETURN["Bad communications\n"];
};

ResetHistogram: LarkWork.LarkWorkProc = {
ENABLE TeleLoad.Failed => GOTO BadComm;
histSym: LarkPrograms.STObject;
found: BOOL;
IF argv.argc # 2 THEN RETURN["Bad Arguments\n"];
[item: histSym, found: found] _ LarkPrograms.FindVariable[lark.program, argv[1]];
IF NOT found THEN RETURN[". . cannot find symbol\n"];
ResetHistogramInternal[lark: lark, histogram: histSym.addr];
EXITS
BadComm => RETURN["Bad communications\n"];
};

ResetHistogramInternal: PROC [lark: LarkControl.LarkData, histogram: TeleLoad.CoreAddress] = {
h: TeleLoad.Handle _ lark.h;
TeleLoad.ResetCache[h];
TeleLoad.SetCacheSize[h, 4];
FOR i: NAT IN [0..42) DO
TeleLoad.WriteWord[h, histogram + (4*i), 0];
TeleLoad.WriteWord[h, histogram + (4*i) + 2, 0];
ENDLOOP;
TeleLoad.FlushWrites[h];
TeleLoad.SetCacheSize[h, 0];
};

<<Register all the commands>>
<<>>
LarkWork.RegisterLarkWorkProc[proc: DspCtxQ, key: ".DspCtxQ", caseMatters: FALSE, doc: "Print all stacks", usage: ".DspCtxQ 
{ctxRunning ctx}"];
LarkWork.RegisterLarkWorkProc[proc: DspCtx, key: ".DspCtx", caseMatters: FALSE, doc: "Print information about a process", usage: 
".DspCtx ctx"];
LarkWork.RegisterLarkWorkProc[proc: ClrCtxStats, key: ".ClrCtxStats", caseMatters: FALSE, doc: "Reset context statistics", usage: 
"ClrCtxStats {ctx}"];
LarkWork.RegisterLarkWorkProc[proc: PrintFixed, key: ".PrintFixed", caseMatters: FALSE, doc: "PrintFixed"];
LarkWork.RegisterLarkWorkProc[proc: DspPkt, key: ".DspPkt", caseMatters: FALSE, doc: "Print a Pup", usage: "DspPkt pktAddress"];
LarkWork.RegisterLarkWorkProc[proc: DspPBI, key: ".DspPBI", caseMatters: FALSE, doc: "Print a PBI", usage: "DspPBI pbiAddress"];
LarkWork.RegisterLarkWorkProc[proc: Dump, key: "Dump", caseMatters: FALSE, doc: "Print memory contents", usage: "[Dd]ump address 
{count}. D for words, d for bytes"];
LarkWork.RegisterLarkWorkProc[proc: SlaveDump, key: "SlaveDump", caseMatters: FALSE, doc: "Print parts of slave address space", 
usage: "[s/S]laveDump address {count}, s => words, S => bytes"];
LarkWork.RegisterLarkWorkProc[proc: CallProc, key: "Call", caseMatters: FALSE, doc: "Call a Lark procedure", usage: "Call procedure 
{up to 5 arguments}"];
LarkWork.RegisterLarkWorkProc[proc: PrintCtxStats, key: ".PrintCtxStats", caseMatters: FALSE, doc: "Print process loop histogram"];
LarkWork.RegisterLarkWorkProc[proc: PrintHistogram, key: ".PrintHistogram", caseMatters: FALSE, doc: "Print a histogram", usage: 
"PrintHistogram histogramSymbol"];
LarkWork.RegisterLarkWorkProc[proc: ResetCtxStats, key: ".ResetCtxStats", caseMatters: FALSE, doc: "Clear process loop histogram"];
LarkWork.RegisterLarkWorkProc[proc: ResetHistogram, key: ".ResetHistogram", caseMatters: FALSE, doc: "Clear a histogram", usage: 
"ResetHistogram histogramSymbol"];
<<>>
END.
April 27, 1983 6:59 pm, LCS, created from TDX
April 29, 1983 2:05 pm, LCS, slave printing
June 6, 1983 1:19 pm, LCS, DspPBI printout
December 22, 1983 2:47 pm, LCS, Cedar 5