InterpreterCommandsImpl.mesa
Copyright © 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
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;
Commands registered with Commander
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
];
};
START EvalCommand HERE
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"];
};
Unify this some day with the stuff in InterpreterToolImpl
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};
};
START SetBreakCommand HERE
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";
};
initialization code
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"];