Last Edited by: Teitelman, April 15, 1983 2:37 pm
DIRECTORY
AMBridge USING [GetWorld, IsRemote, OctalRead, RefFromTV, SomeRefFromTV, TVForReferent, TVToCardinal, TVToLC],
AMTypes USING [IndexToTV, NameToIndex, IsNil, IsRope, Referent, TVToName, TVType],
Atom USING [TypePutProp, MakeAtom, PropList],
BasicUserExec USING [CorrectionProc, Interface],
BBInterp USING [Tree],
ConvertUnsafe USING [AppendRope],
Heap USING [systemMDSZone],
IO USING [atom, AttachRefPrintProc, AttachTVPrintProc, card, char, CR, Flush, LookupData, NewLine, Put, PutChar, PutF, PutRope, RefPrintProc, ROPE, rope, SP, STREAM, string, time, tv, TVPrintProc, type],
PilotSwitches USING [switches],
PrintTV USING [PutProc, PutClosure],
PPUtil USING [PrettyPrint],
PPTree USING [Handle],
PPLeaves USING [HTIndex, LTIndex],
Rope USING [Flatten, IsEmpty, Length, ROPE, Text, ToRefText],
RTBasic USING [TV, Type],
RTTypesPrivate USING [TypedVariableRec],
RTTypesRemotePrivate USING [RemoteTypeToLocal],
System USING [GreenwichMeanTime, gmtEpoch],
UnsafeStorage USING [GetSystemUZone],
UserExec USING [GetStreams, HistoryList, ExecHandle],
UserExecExtras USING [],
ViewerClasses USING [Viewer]
BasicUserExecImpl: CEDAR MONITOR
IMPORTS AMBridge, AMTypes, Atom, ConvertUnsafe, Heap, IO, PilotSwitches, PPUtil, Rope, RTTypesRemotePrivate, UnsafeStorage, UserExec
EXPORTS BasicUserExec, UserExecExtras
SHARES Atom, IO
IO: name field in streamProcs
Atom: TypePutProp
= BEGIN OPEN IO, BasicUserExec;
TV: TYPE = RTBasic.TV;
Type: TYPE = RTBasic.Type;
Printing Strings, Ref Text
StringPrintProc: TVPrintProc =
TRUSTED {
-- AMBridge
-- IF AMBridge.IsRemote[tv] THEN
TVStringPut[tv, stream, width * depth + 16]; -- the algorithm used for printing ropes in PrintTVImpl
ELSE {
s: STRING ← LOOPHOLE[AMBridge.TVToCardinal[tv], STRING];
stream.Put[char['"], string[s], char['"]];
};
}; -- of StringPrintProc
LongStringPrintProc: TVPrintProc =
TRUSTED {
-- AMBridge
IF AMBridge.IsRemote[tv] THEN TVStringPut[tv, stream, width * depth + 16] -- the algorithm used for printing ropes in PrintTVImpl
ELSE {
s: LONG STRING ← LOOPHOLE[AMBridge.TVToLC[tv], LONG STRING];
stream.Put[char['"], string[s], char['"]];
};
}; -- of LongStringPrintProc
TVStringPut:
PROC [strTV:
TV, out:
STREAM, limit:
CARDINAL] = {
IF AMTypes.IsNil[strTV] THEN out.PutRope["NIL"]
ELSE TVTextPut[AMTypes.Referent[strTV], out, limit]; -- strTV is a pointer to TEXT. must use the referent to describe actual storage
};
TVTextPut:
PROC [tv:
TV, out:
STREAM, limit:
CARDINAL] =
TRUSTED {
len: CARDINAL ← AMBridge.OctalRead[tv, 0]; -- the length of the string
max: CARDINAL ← AMBridge.OctalRead[tv, 1]; -- the maxLength of the string
limit ← MIN[len, limit];
out.PutChar['"];
FOR i:
CARDINAL
IN [0..limit)
DO
wordIndex: CARDINAL ← i/2+2;
word: PACKED ARRAY [0..1] OF CHAR ← LOOPHOLE[AMBridge.OctalRead[tv, wordIndex]];
out.PutChar[word[i MOD 2]]; -- should do more to output funny characters
ENDLOOP;
IF limit < len THEN out.PutRope["..."];
out.PutChar['"];
};
RefTextPrintProc: TVPrintProc =
TRUSTED {
TVTextPut[AMTypes.Referent[tv], stream, width * depth + 16]; -- the algorithm used for printing ropes in PrintTVImpl
};
RefTextPrintProc: RefPrintProc = {
stream.Put[char['"], text[NARROW[ref, REF READONLY TEXT]], char['"]];
};
TextPrintProc: TVPrintProc = {
TVTextPut[tv, stream, width * depth + 16]; -- the algorithm used for printing ropes in PrintTVImpl
};
Printing Nat, Time, Type, TV
NatPrintProc: TVPrintProc =
TRUSTED {
-- AMBridge
stream.Put[card[AMBridge.TVToLC[tv]]];
};
TypePrintProc: TVPrintProc =
TRUSTED {
-- AMBridge
t: RTBasic.Type;
IF AMBridge.IsRemote[tv]
THEN
t ← RTTypesRemotePrivate.RemoteTypeToLocal[world: AMBridge.GetWorld[tv], remoteType: LOOPHOLE[AMBridge.TVToCardinal[tv]]]
ELSE t ← LOOPHOLE[AMBridge.TVToCardinal[tv]]; stream.Put[type[t]];
};
TimePrintProc: TVPrintProc =
TRUSTED {
-- AMBridge
t: System.GreenwichMeanTime;
IF AMBridge.IsRemote[tv] THEN ERROR; -- shouldnt be called. TVPrintProc says can't handle remote.
t ← LOOPHOLE[AMBridge.TVToLC[tv]];
IF t = System.gmtEpoch THEN stream.PutRope["{current time}"]
ELSE stream.Put[time[t]];
};
tvPrintProc: RefPrintProc =
TRUSTED {
stream.PutF["{tv for: %g}", tv[LOOPHOLE[ref]]];
};
Printing STREAM, Viewer, etc.
InterfacePrintProc: RefPrintProc =
{
r: BasicUserExec.Interface = NARROW[ref];
stream.PutF["{Interface: %g}", rope[r^]];
};
TreePrintProc: RefPrintProc =
TRUSTED {
stream.PutRope["{tree for: "];
PPUtil.PrettyPrint[
root: LOOPHOLE[ref, BBInterp.Tree],
put: PrintTV.PutClosure[proc: TreePrintPutProc, data: NEW[TreePrintRecord ← [stream]]]
];
stream.PutChar['}];
};
TreePrintRecord: TYPE = RECORD[stream: IO.STREAM, skipSpaces: BOOLEAN ← FALSE];
TreePrintPutProc: PrintTV.PutProc
-- [data: REF, c: CHAR] -- = {
r: REF TreePrintRecord = NARROW[data];
SELECT c
FROM
-- skips CR and any leading spaces following it. i.e. flattens out the prettyprinting.
CR => {r.skipSpaces ← TRUE; r.stream.PutChar[SP]};
SP => IF ~r.skipSpaces THEN r.stream.PutChar[c];
ENDCASE => {r.stream.PutChar[c]; r.skipSpaces ← FALSE};
};
STREAMPrintProc: TVPrintProc =
TRUSTED {
IF AMBridge.IsRemote[tv]
THEN {
-- differences: does not look up name on property list of stream, prints streamprocs.name with "'s around it.
RemoteSTREAMPrintProc[tv, stream];
}
ELSE {
h: IO.STREAM = NARROW[AMBridge.RefFromTV[AMTypes.Referent[tv]]];
name: Rope.ROPE = NARROW[IO.LookupData[self: h, key: $Name]];
stream.PutF["{%bB - %g Stream", card[LOOPHOLE[h, LONG CARDINAL]], rope[h.streamProcs.name]];
IF NOT Rope.IsEmpty[name] THEN stream.PutF[" on %g", rope[name]];
stream.PutChar['}];
};
};
RemoteSTREAMPrintProc:
PROC[tv: RTBasic.
TV, stream:
IO.
STREAM] =
TRUSTED {
address: LONG CARDINAL = AMBridge.TVToLC[tv];
tv ← AMTypes.Referent[tv];
tv ← AMTypes.IndexToTV[tv, AMTypes.NameToIndex[AMTypes.TVType[tv], "streamProcs"]]; -- tv for REF streamProcs
tv ← AMTypes.Referent[tv];
tv ← AMTypes.IndexToTV[tv, AMTypes.NameToIndex[AMTypes.TVType[tv], "name"]]; -- tv for the name field
stream.PutF["{%bB - %g Stream", card[address], IO.tv[tv]];
IF NOT Rope.IsEmpty[name] THEN stream.PutF[" on %g", rope[name]];
stream.PutChar['}];
};
HistoryPrintProc: RefPrintProc = {
stream.PutRope["{history list}"];
};
ViewerPrintProc: TVPrintProc =
TRUSTED {
IF AMBridge.IsRemote[tv]
THEN {
-- differences: does not look up name on property list of stream, prints streamprocs.name with "'s around it.
RemoteViewerPrintProc[tv, stream];
}
ELSE {
viewer: ViewerClasses.Viewer = NARROW[AMBridge.RefFromTV[AMTypes.Referent[tv]]];
stream.PutF["{Viewer - class: %g, name: %g}", atom[viewer.class.flavor], rope[IF Rope.Length[viewer.name] # 0 THEN viewer.name ELSE "(no name)"]];
};
};
RemoteViewerPrintProc:
PROC[tv: RTBasic.
TV, stream:
IO.
STREAM] =
TRUSTED {
name, flavor: TV;
tv ← AMTypes.Referent[tv];
name ← AMTypes.IndexToTV[tv, AMTypes.NameToIndex[AMTypes.TVType[tv], "name"]]; -- tv for the name field
tv ← AMTypes.IndexToTV[tv, AMTypes.NameToIndex[AMTypes.TVType[tv], "class"]]; -- tv for the class field
tv ← AMTypes.Referent[tv];
flavor ← AMTypes.IndexToTV[tv, AMTypes.NameToIndex[AMTypes.TVType[tv], "flavor"]]; -- tv for the class field
stream.PutF["{Viewer - class: %g, name: %g}", IO.tv[flavor], IF AMTypes.IsNil[name] THEN rope["(no name)"] ELSE IO.tv[name]];
};
ExecHandlePrintProc: TVPrintProc =
TRUSTED {
id: TV;
tv ← AMTypes.Referent[tv];
tv ← AMTypes.IndexToTV[tv, AMTypes.NameToIndex[AMTypes.TVType[tv], "privateStuff"]]; -- tv for the privateStuff field
tv ← AMTypes.Referent[tv];
id ← AMTypes.IndexToTV[tv, AMTypes.NameToIndex[AMTypes.TVType[tv], "id"]]; -- tv for the id field
stream.PutF["{UserExecHandle: %g}", IO.tv[id]];
};
Type Correction
AttachDefaultArgVal:
PUBLIC PROCEDURE [type: Type, default:
TV] =
{
Atom.TypePutProp[type, $DefaultValue, default];
}; -- of AttachDefaultArgVal
AttachTypeCorrectionProc:
PUBLIC
PROCEDURE [type: Type, proc: CorrectionProc] = {
-- associates a correctionProc with a type.
Atom.TypePutProp[type, $WrongTypeProc, NEW[CorrectionProc ← proc]];
}; -- of AttachTypeCorrectionProc
CorrectToAtom: CorrectionProc =
TRUSTED {
-- AMBridge
OPEN IO;
out: STREAM = UserExec.GetStreams[exec].out;
out.NewLine[];
out.PutF["*%g -> $%g\n", rope[undefinedId], rope[undefinedId]];
out.Flush[];
RETURN[TRUE, AMBridge.TVForReferent[NEW[ATOM ← Atom.MakeAtom[undefinedId]]]];
}; -- of CorrectAtom
CorrectToRefAny: CorrectionProc
-- [targetType: Type, undefinedId: ROPE ← NIL, wrongValue: TV ← NIL, exec: ExecHandle] RETURNS[flag: BOOLEAN ← FALSE, shouldBe: TV ← NIL] -- =
TRUSTED {
-- AMBridge
OPEN IO;
IF undefinedId #
NIL
THEN
{UserExec.GetStreams[exec].out.PutF["*n%g -> $%g\n", rope[undefinedId], rope[undefinedId] ];
RETURN[TRUE, AMBridge.TVForReferent[NEW[ATOM ← Atom.MakeAtom[undefinedId]]]];
}
ELSE
IF
NOT AMBridge.IsRemote[wrongValue]
THEN
RETURN[TRUE, AMBridge.TVForReferent[NEW[REF ANY ← AMBridge.SomeRefFromTV[wrongValue]]]]
;
}; -- of CorrectToRefAny
CorrectToString: CorrectionProc
-- [targetType: Type, undefinedId: ROPE ← NIL, wrongValue: TV ← NIL] RETURNS[flag: BOOLEAN ← FALSE, shouldBe: TV ← NIL] -- =
TRUSTED {
-- AMBridge
type: Type ;
IF undefinedId # NIL THEN RETURN;
type ← AMTypes.TVType[wrongValue];
IF AMTypes.IsRope[wrongValue]
THEN
-- rope typed in.
{r: ROPE = AMTypes.TVToName[wrongValue];
s: STRING = Heap.systemMDSZone.NEW[StringBody[Rope.Length[r]]];
ConvertUnsafe.AppendRope[to: s, from: r];
RETURN[TRUE, AMBridge.TVForReferent[NEW[STRING ← s]]];
};
}; -- of CorrectToString
CorrectToLongString: CorrectionProc
-- [targetType: Type, undefinedId: ROPE ← NIL, wrongValue: TV ← NIL] RETURNS[flag: BOOLEAN ← FALSE, shouldBe: TV ← NIL] -- =
TRUSTED {
-- AMBridge
type: Type ;
IF undefinedId # NIL THEN RETURN;
type ← AMTypes.TVType[wrongValue];
IF AMTypes.IsRope[wrongValue]
THEN
-- rope typed in, LONG STRING .
{r: ROPE = AMTypes.TVToName[wrongValue];
s: LONG STRING = UnsafeStorage.GetSystemUZone[].NEW[StringBody[Rope.Length[r]]];
ConvertUnsafe.AppendRope[to: s, from: r];
RETURN[TRUE, AMBridge.TVForReferent[NEW[LONG STRING ← s]]];
};
}; -- of CorrectToLongString
CorrectToRefText: CorrectionProc
-- [targetType: Type, undefinedId: ROPE ← NIL, wrongValue: TV ← NIL] RETURNS[flag: BOOLEAN ← FALSE, shouldBe: TV ← NIL] -- =
TRUSTED {
-- AMBridge
type: Type ;
IF undefinedId # NIL THEN RETURN;
type ← AMTypes.TVType[wrongValue];
IF AMTypes.IsRope[wrongValue]
THEN
-- rope typed in, REF TEXT wanted.
{r: ROPE = AMTypes.TVToName[wrongValue];
t: REF TEXT = Rope.ToRefText[r];
RETURN[TRUE, AMBridge.TVForReferent[NEW[REF TEXT ← t]]];
};
}; -- of CorrectToRefText
CorrectToRefReadOnlyText: CorrectionProc
-- [targetType: Type, undefinedId: ROPE ← NIL, wrongValue: TV ← NIL] RETURNS[flag: BOOLEAN ← FALSE, shouldBe: TV ← NIL] -- =
TRUSTED {
-- AMBridge
type: Type;
IF undefinedId # NIL THEN RETURN;
type ← AMTypes.TVType[wrongValue];
IF AMTypes.IsRope[wrongValue]
THEN
-- rope typed in, REF TEXT wanted.
{r: ROPE = AMTypes.TVToName[wrongValue];
t: REF TEXT = Rope.ToRefText[r];
RETURN[TRUE, AMBridge.TVForReferent[NEW[REF READONLY TEXT ← t]]];
};
}; -- of CorrectToRefReadOnlyText
CorrectToRopeText: CorrectionProc
-- [targetType: Type, undefinedId: ROPE ← NIL, wrongValue: TV ← NIL] RETURNS[flag: BOOLEAN ← FALSE, shouldBe: TV ← NIL] -- =
TRUSTED {
-- AMBridge
type: Type;
IF undefinedId # NIL THEN RETURN;
type ← AMTypes.TVType[wrongValue];
IF AMTypes.IsRope[wrongValue]
THEN
-- rope typed in, Rope.Text wanted.
{r: ROPE = AMTypes.TVToName[wrongValue];
t: Rope.Text = Rope.Flatten[r];
RETURN[TRUE, AMBridge.TVForReferent[NEW[Rope.Text ← t]]];
};
}; -- of CorrectToRopeText
CorrectToProcAnyAny: CorrectionProc
-- [targetType: Type, undefinedId: ROPE ← NIL, wrongValue: TV ← NIL] RETURNS[flag: BOOLEAN ← FALSE, shouldBe: TV ← NIL] -- =
{
IF undefinedId # NIL THEN RETURN;
}; -- of CorrectProcAnyAny
Init:
PUBLIC
PROC = {
ENABLE ANY => CONTINUE; -- SHOULD GO TO ERROR LOG
AttachRefPrintProc[refType: CODE[PPTree.Handle], refPrintProc: TreePrintProc ! ANY => CONTINUE];
AttachRefPrintProc[refType: CODE[PPLeaves.HTIndex], refPrintProc: TreePrintProc ! ANY => CONTINUE];
AttachRefPrintProc[refType: CODE[PPLeaves.LTIndex], refPrintProc: TreePrintProc ! ANY => CONTINUE];
AttachRefPrintProc[refType: CODE[STREAM], refPrintProc: IOPrintProc];
AttachRefPrintProc[refType: CODE[UserExec.HistoryList], refPrintProc: HistoryPrintProc ! ANY => CONTINUE];
AttachRefPrintProc[refType: CODE[ViewerClasses.Viewer], refPrintProc: ViewerPrintProc];
AttachRefPrintProc[refType: CODE[BasicUserExec.Interface], refPrintProc: InterfacePrintProc ! ANY => CONTINUE];
AttachRefPrintProc[refType: CODE[REF RTTypesPrivate.TypedVariableRec], refPrintProc: tvPrintProc ! ANY => CONTINUE];
AttachTVPrintProc[type: CODE[ViewerClasses.Viewer], tvPrintProc: ViewerPrintProc, canHandleRemote: TRUE ! ANY => CONTINUE];
AttachTVPrintProc[type: CODE[STREAM], tvPrintProc: STREAMPrintProc, canHandleRemote: TRUE ! ANY => CONTINUE];
AttachTVPrintProc[type: CODE[UserExec.ExecHandle], tvPrintProc: ExecHandlePrintProc, canHandleRemote: TRUE ! ANY => CONTINUE];
AttachTVPrintProc[type: CODE[REF TEXT], tvPrintProc: RefTextPrintProc, canHandleRemote: TRUE ! ANY => CONTINUE];
AttachTVPrintProc[type: CODE[REF READONLY TEXT], tvPrintProc: RefTextPrintProc, canHandleRemote: TRUE ! ANY => CONTINUE];
AttachTVPrintProc[type: CODE[TEXT], tvPrintProc: TextPrintProc, canHandleRemote: TRUE ! ANY => CONTINUE];
AttachTVPrintProc[type: CODE[STRING], tvPrintProc: StringPrintProc, canHandleRemote: TRUE ! ANY => CONTINUE];
AttachTVPrintProc[type: CODE[LONG STRING], tvPrintProc: LongStringPrintProc, canHandleRemote: TRUE ! ANY => CONTINUE];
AttachTVPrintProc[type: CODE[NAT], tvPrintProc: NatPrintProc, canHandleRemote: TRUE ! ANY => CONTINUE];
AttachTVPrintProc[type: CODE[Type], tvPrintProc: TypePrintProc, canHandleRemote: TRUE ! ANY => CONTINUE];
AttachTVPrintProc[type: CODE[System.GreenwichMeanTime], tvPrintProc: TimePrintProc, canHandleRemote: FALSE ! ANY => CONTINUE];
AttachTypeCorrectionProc[type: CODE[ATOM], proc: CorrectToAtom ! ANY => CONTINUE];
AttachTypeCorrectionProc[type: CODE[REF ANY], proc: CorrectToRefAny ! ANY => CONTINUE];
AttachTypeCorrectionProc[type: CODE[STRING], proc: CorrectToString ! ANY => CONTINUE];
AttachTypeCorrectionProc[type: CODE[LONG STRING], proc: CorrectToLongString ! ANY => CONTINUE];
AttachTypeCorrectionProc[type: CODE[REF TEXT], proc: CorrectToRefText ! ANY => CONTINUE];
AttachTypeCorrectionProc[type: CODE[REF READONLY TEXT], proc: CorrectToRefReadOnlyText ! ANY => CONTINUE];
AttachTypeCorrectionProc[type: CODE[Rope.Text], proc: CorrectToRopeText ! ANY => CONTINUE];
AttachTypeCorrectionProc[type: CODE[PROC ANY RETURNS ANY], proc: CorrectToProcAnyAny ! ANY => CONTINUE];
AttachDefaultArgVal[type: CODE[PROC ANY RETURNS ANY], default: NIL];
TRUSTED {
AttachDefaultArgVal[type: CODE[PROCESS], default: AMBridge.TVForReferent[NEW[PROCESS ← NIL]]];
AttachDefaultArgVal[type: CODE[UNSAFE PROCESS], default: AMBridge.TVForReferent[NEW[UNSAFE PROCESS ← NIL]]];
};
};
IF PilotSwitches.switches.n#down THEN Init[];
END. -- of BasicUserExecImpl
Edited on February 27, 1983 2:49 pm, by Teitelman
added default value for Process.
changes to: Init
Edited on opMarch 5, 1983 4:04 pmMarch 5, 1983 3:43 pm, by Teitelman
changes to: STREAMPrintProc, RemoteSTREAMPrintProc, DIRECTORY, HistoryPrintProc, ViewerPrintProc, RemoteViewerPrintProc, Init, eDIRECTORY, nViewerPrintProc