-- BBBugOutImpl.mesa
-- Russ Atkinson, August 18, 1982 12:33 pm

DIRECTORY
AtomsPrivate USING [AtomRec],
BBBugOut USING [],
Convert USING [MapValue],
PPOps USING [ParseStream],
PrintTV USING [NullPutClosure, Print, PrintType, PutClosure, PutProc],
Rope USING [Map, ROPE],
RTBasic USING [TV, Type];

BBBugOutImpl: CEDAR MONITOR
IMPORTS Convert, PPOps, PrintTV, Rope
EXPORTS BBBugOut
= BEGIN OPEN BBBugOut, PrintTV, Rope, RTBasic;

Intercepted: CONDITION;
defaultPut: PutClosure ← NullPutClosure;

defaultWidth: NAT ← 32; -- default width for ShowTV
defaultDepth: NAT ← 2; -- default depth for ShowTV
debugParseAndPrint: BOOL ← FALSE;

-- use this routine to acquire the default closure
-- we do not return unless there has been an interception

GetClosure: PUBLIC ENTRY PROC RETURNS [PutClosure] = {
ENABLE UNWIND => NULL;
WHILE defaultPut = NullPutClosure DO
WAIT Intercepted;
ENDLOOP;
RETURN [defaultPut];
};

-- Intercept Routines exported to BBBugOut

GetDefaultPut: PUBLIC ENTRY PROC RETURNS [put: PutClosure] = {
ENABLE UNWIND => NULL;
put ← defaultPut;
};

SetDefaultPut: PUBLIC ENTRY PROC
[put: PutClosure ← NullPutClosure]
RETURNS [oldPut: PutClosure] = {
ENABLE UNWIND => NULL;
oldPut ← defaultPut;
defaultPut ← put;
BROADCAST Intercepted;
};

-- Output Routines exported to BBBugOut

ShowChar: PUBLIC PROC [c: CHAR, put: PutClosure ← NullPutClosure] = {
IF put = NullPutClosure THEN put ← GetClosure[];
put.proc[put.data, c];
};

ShowCR: PUBLIC PROC [put: PutClosure ← NullPutClosure] = {
IF put = NullPutClosure THEN put ← GetClosure[];
put.proc[put.data, '\n];
};

ShowDecimal: PUBLIC PROC [x: INT, put: PutClosure ← NullPutClosure] = {
put1: PROC [c: CHAR] = {put.proc[put.data, c]};
IF put = NullPutClosure THEN put ← GetClosure[];
IF x IN [0..10) THEN
{small: [0..10) ← x;
[] ← put1['0 + small];
RETURN;
};
Convert.MapValue[put1, [signed[x, 10]]]
};

ShowOctal: PUBLIC PROC [x: INT, put: PutClosure ← NullPutClosure] = {
put1: PROC [c: CHAR] = {put.proc[put.data, c]};
IF put = NullPutClosure THEN put ← GetClosure[];
IF x IN [0..8) THEN
{small: [0..8) ← x;
[] ← put1['0 + small];
RETURN;
};
Convert.MapValue[put1, [unsigned[LOOPHOLE[x, LONG CARDINAL], 8]]]
};

ShowRope: PUBLIC PROC [r: ROPE ← NIL, put: PutClosure ← NullPutClosure] = {
put1: PROC [c: CHAR] RETURNS [BOOL] = {put.proc[put.data, c]; RETURN [FALSE]};
IF put = NullPutClosure THEN put ← GetClosure[];
[] ← Rope.Map[base: r, action: put1]
};

ShowRopes: PUBLIC PROC [r1,r2,r3,r4: ROPE ← NIL, put: PutClosure ← NullPutClosure] = {
put1: PROC [c: CHAR] RETURNS [BOOL] = {put.proc[put.data, c]; RETURN [FALSE]};
IF put = NullPutClosure THEN put ← GetClosure[];
IF r1 # NIL THEN [] ← Rope.Map[base: r1, action: put1];
IF r2 # NIL THEN [] ← Rope.Map[base: r2, action: put1];
IF r3 # NIL THEN [] ← Rope.Map[base: r3, action: put1];
IF r4 # NIL THEN [] ← Rope.Map[base: r4, action: put1];
};

ShowLine: PUBLIC PROC [r: ROPE ← NIL, put: PutClosure ← NullPutClosure] = {
put1: PROC [c: CHAR] RETURNS [BOOL] = {put.proc[put.data, c]; RETURN [FALSE]};
IF put = NullPutClosure THEN put ← GetClosure[];
[] ← Rope.Map[base: r, action: put1];
[] ← put1[15C]
};

ShowAtom: PUBLIC PROC [atom: ATOM, put: PutClosure ← NullPutClosure] = TRUSTED {
IF atom # NIL THEN
{patom: REF AtomsPrivate.AtomRec = LOOPHOLE[atom];
ShowRope[patom.pName, put]};
};

ShowTV: PUBLIC PROC
[tv: TV, deltaDepth: INTEGER ← 0, put: PutClosure ← NullPutClosure] = {
IF put = NullPutClosure THEN put ← GetClosure[];
PrintTV.Print[tv, put, defaultDepth + deltaDepth, defaultWidth]
};

ShowType: PUBLIC PROC [type: Type, put: PutClosure ← NullPutClosure] = {
IF put = NullPutClosure THEN put ← GetClosure[];
PrintTV.PrintType[type, put]
};

SyntaxError: ERROR = CODE;
Errout: PrintTV.PutProc = {ERROR SyntaxError};

ParseAndPrint: PUBLIC PROC [program: ROPE, put: PutClosure ← NullPutClosure] = {
[] ←
PPOps.ParseStream
[source: program,
errPut: [proc: Errout, data: NIL],
prettyPut: put
! SyntaxError => GO TO oops];
EXITS oops => ERROR SyntaxError;
};

GetDefaultDepthAndWidth: PUBLIC PROC RETURNS [depth: NAT, width: NAT] = {
-- return default depth and width for printing
RETURN [defaultDepth, defaultWidth];
};

SetDefaultDepthAndWidth: PUBLIC PROC [depth: NAT ← 4, width: NAT ← 32] = {
-- set default depth and width for printing
defaultDepth ← depth;
defaultWidth ← width;
};

END.