-- 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. Κ@– "Mesa" style˜Iprocš„Οc@œΟk œžœžœžœžœžœAžœžœ žœžœžœžœžœ"žœžœžœ3ž œ>žœœžœœžœžœqœΟn œžœžœžœžœžœžœžœžœžœžœžœžœ+œŸ œžœžœžœžœžœžœžœ%Ÿ œžœžœžœ2žœžœžœžœ6ž œ(œŸœžœžœžœ,žœžœ=Ÿœžœžœ,žœžœ?Ÿ œžœžœžœ2žœžœ!žœžœžœžœ žœDžœFŸ œžœžœžœ2žœžœ!žœžœžœžœžœCžœ2žœžœžœŸœžœžœžœžœ2žœžœžœžœžœžœžœžœKŸ œžœžœžœžœ2žœžœžœžœžœžœžœžœžœžœžœ,žœžœžœ,žœžœžœ,žœžœžœ5Ÿœžœžœžœžœ2žœžœžœžœžœžœžœžœ_Ÿœžœžœžœ&žœžœžœžœžœžœ;Ÿœžœžœ žœžœ0žœžœfŸœžœžœ8žœžœNžœžœžœŸ œžœžœ žœΒžœžœ žœ žœŸœžœžœžœ žœ žœ /œžœ)Ÿœžœžœ žœ žœ,œ>žœ˜…&—…—N