
<<LogImpl.mesa>>
<<Simple Logging output, other general utilities; support for spy log stuff.>>
<<Last modified by D. Swinehart, January 9, 1985 4:26:06 pm PST>>

DIRECTORY
AMBridge USING [ TVToProc ],
AMEvents USING [ CallDebugger ],
AMTypes USING [ Error, TV ],
Atom USING [ PutProp, GetPName, GetProp, PropList ],
BasicTime USING [ GMT, Now, nullGMT, Unpack, Unpacked ],
Commander USING [ CommandProc, GetProperty, Handle, Register ], 
FS USING [ StreamOpen, Error ],
Interpreter USING [ Evaluate ],
IO,
IOUtils USING [ CopyPFProcs, PFCodeProc, SetPFCodeProc ],
Log,
PrincOps USING [ BytePC, FrameHandle, GFTIndex ],
PrincOpsUtils USING [ LongCOPY, GetReturnFrame ],
ProcessProps USING [ GetPropList ],
RefTab USING [ Create, Fetch, Ref, Store ],
Rope USING [ Flatten, InlineLength, ROPE, Text ],
SpyTypes USING [ DoWriteDataProc, IsActiveProc, WriteTraceProc ]
;

LogImpl: CEDAR MONITOR -- for CLog
IMPORTS
AMBridge,
AMEvents,
AMTypes,
Atom,
BasicTime,
Commander,
FS,
Interpreter,
IO,
IOUtils,
PrincOpsUtils,
ProcessProps,
RefTab,
Rope
EXPORTS Log = {
OPEN IO, SpyTypes;

<<Variables>>

pd: PUBLIC REF Log.PD _ NEW[Log.PD_[]];

<<Copies>>

ROPE: TYPE = Rope.ROPE;
STREAM: TYPE = IO.STREAM;
ThHandle: TYPE = LONG CARDINAL;
WhereToReport: TYPE = Log.WhereToReport;
WhereProc: TYPE = Log.WhereProc;

<<Reporting and Suspending>>
<<>>
WP: TYPE = REF WPRec;
WPRec: TYPE = RECORD [
proc: WhereProc,
fixedWhereData: REF,
defaultIfNotFound: Log.DNFProc_NIL
];

RegisterWhereToReport: PUBLIC PROC[
proc: WhereProc, where: WhereToReport, fixedWhereData: REF,
defaultIfNotFound: Log.DNFProc] = {
Atom.PutProp[$ReportStreams, where, NEW[WPRec_[proc: proc, fixedWhereData: fixedWhereData, defaultIfNotFound: defaultIfNotFound]]];
};

FindWhere: PUBLIC PROC[where: WhereToReport, whereData: REF] RETURNS [s: IO.STREAM] = {
wp: WP;
IF where=NIL THEN RETURN[pd.sysOut];
wp _ NARROW[Atom.GetProp[$ReportStreams, where]];
IF wp=NIL THEN RETURN[pd.sysOut];
s_wp.proc[wp.fixedWhereData, whereData];
IF s#NIL THEN RETURN[s];
RETURN[IF s#NIL THEN s ELSE IF wp.defaultIfNotFound=NIL OR wp.defaultIfNotFound[where, whereData] THEN pd.sysOut ELSE NIL];
};

Report: PUBLIC PROC[remark: ROPE, where: WhereToReport, whereData: REF _NIL] = {
reportS: STREAM _ FindWhere[where, whereData];
seconds: INT;
IF remark=NIL OR reportS = NIL THEN RETURN;
seconds _ LogTime[reportS, where];
reportS.PutF["   %02d: %s\n", int[seconds], rope[remark]]; -- wish I could affort looking up caller.
};

ReportFR: PUBLIC PROC[remark: ROPE, where: WhereToReport, whereData: REF,
a1, a2: IO.Value] = {
Report[IO.PutFR[remark, a1, a2], where, whereData];
};

Problem: PUBLIC PROC[
remark: ROPE, where: WhereToReport, whereData: REF] = TRUSTED {
IF remark=NIL THEN remark_"Unspecified problem";
Report[remark, where, whereData];
IF pd.attended THEN AMEvents.CallDebugger[remark];
};

ProblemFR: PUBLIC PROC[
remark: ROPE, where: WhereToReport, whereData: REF, a1, a2: IO.Value] = TRUSTED {
Problem[IO.PutFR[remark, a1, a2], where, whereData];
};

ProblemBool: PUBLIC PROC[
remark: ROPE, where: WhereToReport, bool: BOOL, whereData: REF]
RETURNS[sameBool: BOOL] = {
sameBool_bool;
Problem[remark, where, whereData];
};
<<>>
ProblemHandle: PUBLIC PROC[ remark: ROPE, where: WhereToReport, 
handle: ThHandle, whereData: REF]
RETURNS[sameHandle: ThHandle] = {
sameHandle_handle;
Problem[remark, where, whereData];
};

CmdWhere: WhereProc = {
pl: Atom.PropList _ ProcessProps.GetPropList[];
ch: Commander.Handle;
IF pl=NIL THEN RETURN[NIL];
ch _ NARROW[Commander.GetProperty[$CommanderHandle, pl]];
IF ch=NIL THEN RETURN[NIL];
RETURN[ch.err];
};

SetAttended: Commander.CommandProc = {
pd.attended _ TRUE;
Report["Attended[TRUE]", $Cmd, NIL];
};

ClearAttended: Commander.CommandProc = {
pd.attended _ FALSE;
Report["Attended[FALSE]", $Cmd, NIL];
};

LogTime: PROC[s: IO.STREAM, where: ATOM] RETURNS [seconds: INT] = {
oldT: REF BasicTime.Unpacked _ NARROW[RefTab.Fetch[logTimes, where].val];
now: BasicTime.GMT _ BasicTime.Now[];
nowU: BasicTime.Unpacked _ BasicTime.Unpack[now];
seconds _ nowU.second;
nowU.second _ 0;
nowU.secondsThisYear _ 0;
IF oldT=NIL THEN {
oldT_NEW[BasicTime.Unpacked];
[]_RefTab.Store[logTimes, where, oldT];
};
IF nowU=oldT^ THEN RETURN;
oldT^ _ nowU;
s.PutF["%g\n", time[now]];
};

logTimes: RefTab.Ref _ RefTab.Create[];
<<Associates Where atoms with print times.>>
<<>>
<<Procedures for performance monitoring and debugging>>

loggingGroups: PUBLIC CARDINAL_0;

Noop: PUBLIC PROC = {NULL};

RealLogInfo: TYPE = RECORD [
logD1: LONG CARDINAL,
logD2: LONG CARDINAL,
length: CARDINAL,
logCode: PACKED SEQUENCE maxLength: CARDINAL OF CHAR
];
rli: REF RealLogInfo _ NEW[RealLogInfo];

WriteTrace: WriteTraceProc _ NIL;
DoWriteData: DoWriteDataProc _ NIL;
IsActive: IsActiveProc _ NIL;

WriteData: PUBLIC PROC[info: Log.LogInfo] = TRUSTED {
logCode: Rope.Text;
nbytes: NAT;
IF loggingGroups=0 OR info.logCode =NIL THEN RETURN;
logCode_Rope.Flatten[Atom.GetPName[info.logCode]];
rli.logD1_info.logD1;
rli.logD2_info.logD2;
nbytes _ MIN[logCode.InlineLength[], 20];
rli.length_nbytes;
PrincOpsUtils.LongCOPY[
from: LOOPHOLE[logCode, LONG POINTER]+2,
to: LOOPHOLE[rli,         LONG POINTER]+6, nwords: (nbytes+1)/2];
DoWriteData[type: CODE[RealLogInfo], size: SIZE[RealLogInfo[nbytes]], data: LOOPHOLE[rli]];
};

Here: PUBLIC PROC = TRUSTED {
frame: PrincOps.FrameHandle;
IF loggingGroups=0 OR ~IsActive[] THEN RETURN;
frame _ PrincOpsUtils.GetReturnFrame[];
IF frame=NIL THEN RETURN;
WriteTrace[frame.accesslink.gfi, frame.pc];
};

DoLog: PUBLIC PROC[groups: CARDINAL_177777B] = {
IF WriteTrace=NIL THEN {
WriteTrace _ NARROW[FetchBinding[$WriteTrace], REF WriteTraceProc]^;
DoWriteData _ NARROW[FetchBinding[$WriteData], REF DoWriteDataProc]^;
IsActive _ NARROW[FetchBinding[$IsActive], REF IsActiveProc]^;
};
loggingGroups_ IF WriteTrace#NIL THEN groups ELSE 0;
};

FetchBinding: PROC[field: ATOM] RETURNS [REF] = {
RETURN[Atom.GetProp[$Interfaces, field]];
};

<<Command Logging, indirect execution.>>
<<Originally developed as part of ThMessageDBImpl>>
<<>>
CLog: TYPE = Log.CLog;

MakeCLog: PUBLIC PROC[fileName: ROPE, CommandProc: PROC[CLog]_NIL, new: BOOL_FALSE, keep: CARDINAL_2]
RETURNS[cLog: CLog_NIL] = {
logStream: IO.STREAM;
logStream _ FS.StreamOpen[fileName: fileName, keep: keep,
accessOptions: IF new THEN $create ELSE $append!
FS.Error => logStream_NIL];
IF logStream=NIL THEN RETURN[NIL];
cLog_NEW[Log.CLogBody_[logStream: logStream, CommandProc: CommandProc]];
logStream.SetIndex[0];
};

WriteCLog: PUBLIC ENTRY PROC[cLog: CLog, entry: ROPE] = {
WriteLog[cLog, entry];
};

CloseCLog: PUBLIC ENTRY PROC[cLog: CLog] RETURNS[nullCLog: CLog_NIL] = {
IF cLog=NIL THEN RETURN;
IF cLog.logStream#NIL THEN cLog.logStream.Close[];
cLog.logStream_NIL;
};

WriteLog: INTERNAL PROC[cLog: CLog, entry: ROPE] = {
cLog.logStream.SetIndex[cLog.logStream.GetLength[]];
cLog.logStream.PutRope[entry];
cLog.logStream.Flush[];
};

DoCLog: PUBLIC ENTRY PROC[cLog: CLog, entry: ROPE] = {
IF entry#NIL THEN WriteLog[cLog, entry];
DO
pos: INT _ cLog.logReadPos;
IF pos >= cLog.logStream.GetLength[] THEN EXIT;
cLog.logStream.SetIndex[cLog.logReadPos];
cLog.CommandProc[cLog]; 
cLog.logReadPos _ cLog.logStream.GetIndex[];
IF pos=cLog.logReadPos THEN ERROR; -- Not making progress!
ENDLOOP;
};

RedoCLog: PUBLIC PROC[cLog: CLog] = {
cLog.logReadPos_0;
DoCLog[cLog, NIL];
};

<<Runtime Binding>>
<<>>
GetBinding: PUBLIC PROC[qualifiedName: ROPE] RETURNS [tv: AMTypes.TV] = {
tv _ Interpreter.Evaluate[qualifiedName].result;
};

GetBindingToProc: PUBLIC PROC[qualifiedProcName: ROPE]
RETURNS [proc: PROC ANY RETURNS ANY] = TRUSTED {
tv: AMTypes.TV = Interpreter.Evaluate[qualifiedProcName].result;
IF tv=NIL THEN RETURN[NIL];
proc _ LOOPHOLE[AMBridge.TVToProc[tv!AMTypes.Error=>CONTINUE]];
};

<<Render null times harmless in printouts>>
<<>>

origPrintTime: IOUtils.PFCodeProc _ NIL;
<<<< This goes away when IOUtils inherits all the procedures it's supposed to have in it.>>>>
SDPFCProc: TYPE = PROC[char: CHAR, codeProc: IOUtils.PFCodeProc]
RETURNS [previous: IOUtils.PFCodeProc];
sDPFCProc: SDPFCProc;

PrintTime: IOUtils.PFCodeProc = TRUSTED {
ts: ROPE _ NIL;
i: INT _ 0;
zipTime: BasicTime.GMT _ LOOPHOLE[i];
WITH v: val SELECT FROM
time => {
SELECT v.value FROM
BasicTime.nullGMT => ts _ "<Doomsday>";
zipTime => ts_"<BigBang>";
ENDCASE;
IF ts#NIL THEN { stream.PutRope[ts]; RETURN; };
};
ENDCASE;
IF origPrintTime#NIL THEN origPrintTime[stream, val, format, char];
};

<<Initialization>>
{
<<<< This can all be simplified after IOUtils gets SetDefaultPFCodeProc. >>>>
r: REF = FetchBinding[$PrintTime];
origPrintTime _
IF r=NIL THEN IOUtils.SetPFCodeProc[IOUtils.CopyPFProcs[NIL], 't, PrintTime].previous
ELSE NARROW[r, REF IOUtils.PFCodeProc]^;
IF r=NIL THEN
Atom.PutProp[$Interfaces, $PrintTime, NEW[IOUtils.PFCodeProc _ PrintTime]];
IF sDPFCProc=NIL THEN -- Cedar 5.2
sDPFCProc _ LOOPHOLE[GetBindingToProc["IOUtils.SetDefaultPFCodeProc"]];
IF sDPFCProc=NIL THEN -- Cedar 5.3
sDPFCProc _ LOOPHOLE[GetBindingToProc["IOPrintImpl.SetDefaultPFCodeProc"]];
IF sDPFCProc#NIL THEN []_sDPFCProc['t, PrintTime];
};

pd.ch _ NARROW[Commander.GetProperty[$CommanderHandle, ProcessProps.GetPropList[]]];
IF pd.ch#NIL THEN { pd.sysIn _ pd.ch.in; pd.sysOut _ pd.ch.out; };
RegisterWhereToReport[CmdWhere, $Cmd, NIL, NIL];
Commander.Register["Attended", SetAttended, "Break on errors"];
Commander.Register["Unattended", ClearAttended, "Log on errors, then muddle on."];
}.