DIRECTORY AMModel USING [Context, RootContext, Section], AMEvents USING [BreakAt], AMEventsPrivate USING [DuplicateBreakpoint], AMTypes USING [TVType, TV], AMViewerOps USING [ReportProc, ViewerFromSection, SectionFromSource], BackStop USING [Call], BasicTime USING [GMT, Now, Period], Commander USING [CommandProc, Register, Lookup], CommandExtras USING [MakeUninterpreted], CommandTool USING [ArgumentVector, Parse], Convert USING [IntFromRope], Interpreter USING [Evaluate], InterpreterOps USING [EvalHead, WorldFromHead], InterpreterToolPrivate USING [Break, BreakObject, nextBI], IO USING [PutF, PutRope, STREAM, int, Put, rope], List USING [Assoc, PutAssoc], PrintTV USING [Print, PrintType], ProcessProps USING [GetPropList], Rope USING [Fetch, ROPE, Length, IsEmpty, Substr, Concat, Cat], SafeStorage USING [IsCollectorActive, NWordsAllocated], SymTab USING [Create, Ref], UserProfile USING [Boolean], WorldVM USING [LocalWorld, World]; InterpreterCommandsImpl: CEDAR MONITOR IMPORTS AMEvents, AMEventsPrivate, AMModel, AMTypes, AMViewerOps, BackStop, BasicTime, Commander, CommandExtras, CommandTool, Convert, Interpreter, InterpreterOps, InterpreterToolPrivate, IO, List, PrintTV, ProcessProps, Rope, SafeStorage, SymTab, UserProfile, WorldVM = BEGIN OPEN InterpreterToolPrivate; ROPE: TYPE = Rope.ROPE; EvalCommand: Commander.CommandProc = { head: InterpreterOps.EvalHead = NARROW[List.Assoc[$EvalHead, ProcessProps.GetPropList[]]]; line: ROPE _ cmd.commandLine; context: AMModel.Context; symTab: SymTab.Ref; resultTV: AMTypes.TV; errorRope: ROPE; noResult: BOOL; depth: INT _ 4; width: INT _ 32; printType: BOOL _ FALSE; mark: BasicTime.GMT _ BasicTime.Now[]; seconds: INT; collections: INT _ SafeStorage.IsCollectorActive[].previousIncarnation; words: INT _ SafeStorage.NWordsAllocated[]; inner: PROC = { IF noResult THEN RETURN; IF printType THEN { cmd.out.PutRope["***Printing Type...\n"]; PrintTV.PrintType[ put: cmd.out, type: AMTypes.TVType[resultTV], depth: depth, width: width, verbose: depth > 4 ]; } ELSE PrintTV.Print[ put: cmd.out, tv: resultTV, depth: depth, width: width, verbose: depth > 4 ]; }; TRUSTED{ IF head = NIL THEN context _ AMModel.RootContext[WorldVM.LocalWorld[]] ELSE { context _ head.context; IF context = NIL THEN context _ AMModel.RootContext[InterpreterOps.WorldFromHead[head]]; }; symTab _ LOOPHOLE[List.Assoc[$SymTab, cmd.propertyList]]; IF symTab = NIL THEN { symTab _ SymTab.Create[]; [] _ List.PutAssoc[key: $SymTab, val: symTab, aList: cmd.propertyList]; }; }; line _ Rope.Substr[base: line, len: line.Length[] - 1]; -- remove the CR UNTIL line.IsEmpty[] -- strip postfix !'s and ?'s DO ch: CHAR _ line.Fetch[line.Length[] - 1]; SELECT ch FROM '! => {depth _ depth + 1; width _ width + width}; '? => printType _ TRUE; ENDCASE => EXIT; line _ Rope.Substr[base: line, len: line.Length[] - 1]; ENDLOOP; line _ line.Concat["\n"]; -- replace the CR [resultTV, errorRope, noResult] _ Interpreter.Evaluate[rope: Rope.Concat["& _ ", line], context: context, symTab: symTab]; IF errorRope # NIL THEN cmd.out.PutRope[Rope.Cat["Error: ", errorRope, "\n"]] ELSE cmd.out.PutRope[Rope.Concat[BackStop.Call[inner], "\n"]]; IF showStats THEN { seconds _ BasicTime.Period[from: mark, to: BasicTime.Now[]]; words _ SafeStorage.NWordsAllocated[] - words; collections _ SafeStorage.IsCollectorActive[].previousIncarnation - collections; cmd.out.PutRope["\n {"]; cmd.out.Put[IO.int[seconds]]; cmd.out.PutRope[" seconds"]; IF words # 0 THEN cmd.out.PutF[", %g words", [integer[words]]]; SELECT collections FROM 0 => {}; 1 => cmd.out.PutRope[", 1 GC"]; ENDCASE => cmd.out.PutF[", %g GCs", [integer[collections]]]; cmd.out.PutRope["}\n"]; }; }; -- end EvalCommand EvalStatsCommand: Commander.CommandProc = { out: IO.STREAM = cmd.out; showStats _ NOT showStats; IF out = NIL THEN RETURN; out.PutRope["Evaluation statistics "]; IF showStats THEN out.PutRope["on.\n"] ELSE out.PutRope["off.\n"]; }; SetBreakCommand: Commander.CommandProc = { out: IO.STREAM = cmd.out; world: WorldVM.World; break: Break _ NIL; argv: CommandTool.ArgumentVector _ CommandTool.Parse[cmd]; HighlightBreakPoint: PROC [break: Break] = { report: AMViewerOps.ReportProc = -- [msg: ROPE, severity: Severity] TRUSTED {out.PutRope[msg]}; inner: SAFE PROC = TRUSTED{ [] _ AMViewerOps.ViewerFromSection[break.section, report]; }; -- yekk. msg: ROPE _ BackStop.Call[inner]; IF msg # NIL THEN out.PutRope[msg]; }; inner: SAFE PROC = TRUSTED { section: AMModel.Section _ NIL; warning: REF; name: ROPE _ argv[1]; index: INT _ Convert.IntFromRope[argv[2]]; out.PutRope["Setting break..."]; [section, warning] _ AMViewerOps.SectionFromSource[world, name, index]; IF warning = NIL THEN out.PutRope["(possible source version mismatch)"]; break _ NEW[BreakObject _ [index: 0, breakID: NIL, world: world, section: section]]; break.breakID _ AMEvents.BreakAt[world, section, break ! AMEventsPrivate.DuplicateBreakpoint => {break _ NIL; CONTINUE}]; IF break # NIL THEN {break.index _ nextBI; nextBI _ nextBI + 1}; }; TRUSTED{world _ WorldVM.LocalWorld[]}; msg _ BackStop.Call[inner]; IF msg.Length[] = 0 AND break # NIL THEN { out.Put[IO.rope["Break #"], IO.int[break.index], IO.rope[" set.\n"]]; HighlightBreakPoint[break: break]; RETURN; }; IF msg.Length[] # 0 THEN {break _ NIL; result _ $Failure} ELSE msg _ "a break is already set here.\n"; }; showStats: BOOL _ UserProfile.Boolean["ShowEvalStatistics", FALSE]; Commander.Register["_", EvalCommand, "a simple evaluation command"]; CommandExtras.MakeUninterpreted[Commander.Lookup["_"]]; Commander.Register["eval", EvalCommand, "a simple evaluation command"]; CommandExtras.MakeUninterpreted[Commander.Lookup["eval"]]; Commander.Register["evalStats", EvalStatsCommand, "toggles evaluation statistics"]; Commander.Register["SetBreak", SetBreakCommand, "SetBreak fileName charPos"]; END. XInterpreterCommandsImpl.mesa Copyright c 1984 by Xerox Corporation. All rights reserved. Russ Atkinson, October 22, 1984 9:00:50 pm PDT Paul Rovner, January 11, 1984 1:09 pm Commands registered with Commander START EvalCommand HERE Unify this some day with the stuff in InterpreterToolImpl START SetBreakCommand HERE initialization code Э╩Ц "cedar" styleШЪ╧iЬЩJЪЬ ╧mЬ1ЩЧJШЪЯЬЯЬШJЪЬ<Ш