# logger.pkg
#
# See the overview comments in
#
# src/lib/src/lib/thread-kit/src/lib/logger.api#
# This version of this package is adapted from
# Cliff Krumvieda's utility for logging from
# threadkit programs.
#
# This package is heavily used by:
# src/lib/x-kit/xclient/src/stuff/xlogger.pkg#
# See also:
# src/lib/src/lib/thread-kit/src/lib/thread-deathwatch.pkg# src/lib/src/lib/thread-kit/src/lib/uncaught-exception-reporting.pkg# Compiled by:
# src/lib/std/standard.lib### "Einstein argued that there must be
### simplified explanations of nature,
### because God is not capricious or arbitrary.
###
### "No such faith comforts the software engineer."
###
### -- Fred Brooks, Jr.
# From: Hue White <hue.white@gmail.com>
# Subject: Re: [Mythryl] Mythryl 5.1.0: debug logging.
# To: cynbe@mythryl.org
# Cc: mythryl@mythryl.org
# Date: Tue, 27 Sep 2011 09:48:03 -0500
#
#
# Cynbe,
#
# I can't help but think of automatically logging entry into each function,
# although thunks are problematic. But having this capability at work has saved
# untold hours of confusion and ennui....
#
# Hue
#
# CrT: This might be an actual use for
#
# src/lib/compiler/debugging-and-profiling/profiling/tdp-instrument.pkg#
# -- Blume's hack supporting adding arbitrary code on a per-function basis.
# (in my impression at least). Presumably this would in practice be switched
# on using something like a per-file
#
# #DO set_control "function_entry_logging" "TRUE";
#
#
stipulate
include package threadkit; # threadkit is from src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg #
package fil = file__premicrothread; # file__premicrothread is from src/lib/std/src/posix/file--premicrothread.pkg package ns = number_string; # number_string is from src/lib/std/src/number-string.pkg package psx = posixlib; # posixlib is from src/lib/std/src/psx/posixlib.pkg package str = string; # string is from src/lib/std/string.pkg package th = microthread; # microthread is from src/lib/src/lib/thread-kit/src/core-thread-kit/microthread.pkg package u1w = one_word_unt; # one_word_unt is from src/lib/std/one-word-unt.pkg package tsc = thread_scheduler_control; # thread_scheduler_control is from src/lib/src/lib/thread-kit/src/posix/thread-scheduler-control.pkg package tsr = thread_scheduler_is_running; # thread_scheduler_is_running is from src/lib/src/lib/thread-kit/src/core-thread-kit/thread-scheduler-is-running.pkgherein
package logger
: (weak) Logger # Logger is from src/lib/src/lib/thread-kit/src/lib/logger.api {
#############################################################################################3
# Log server
# All log printing (i.e., calls to log_if)
# ultimately goes through this mailslot:
#
print_if_slot = make_mailslot(): Mailslot( String );
plea_slot = make_mailslot(): Mailslot (Void -> Void);
# Run_At is from src/lib/src/lib/thread-kit/src/core-thread-kit/run-at.api # Thread_Scheduler_Control is from src/lib/src/lib/thread-kit/src/glue/thread-scheduler-control.api # thread_scheduler_control is from src/lib/src/lib/thread-kit/src/posix/thread-scheduler-control.pkg # thread_scheduler_control_g is from src/lib/src/lib/thread-kit/src/glue/thread-scheduler-control-g.pkg my _ = { tsc::note_mailslot ("logging: log_if", print_if_slot);
tsc::note_mailslot ("logging: request", plea_slot);
tsc::note_imp
{
name => "logging: log-imp",
#
at_startup => start_log_imp,
at_shutdown => log_imp_shutdown
};
}
where
#
fun log_imp ()
=
for (;;) {
#
do_one_mailop [
#
take_from_mailslot' print_if_slot
==>
(\\ message = fil::logprint message),
take_from_mailslot' plea_slot
==>
(\\ f = f())
];
};
fun start_log_imp ()
=
{
# printf "start_log_imp/AAA -- logger.pkg\n";
make_thread "logging imp" log_imp;
();
};
fun log_imp_shutdown ()
=
{ *fil::logger_cleanup ();
#
fil::logger_cleanup
:=
(\\ () = ());
};
end;
stipulate
fun carefully f
=
if (tsr::thread_scheduler_is_running ())
#
put_in_mailslot (plea_slot, f);
else
f ();
fi;
fun carefully' f
=
if (tsr::thread_scheduler_is_running ())
#
reply_drop = make_oneshot_maildrop ();
put_in_mailslot (plea_slot, {. put_in_oneshot (reply_drop, f()); });
get_from_oneshot reply_drop;
else
f ();
fi;
herein
fun make_logtree_leaf arg = carefully' (\\ () = fil::make_logtree_leaf arg);
fun enable tm = carefully (\\ () = fil::enable tm); # Enable logging per log subtree.
fun disable tm = carefully (\\ () = fil::disable tm); # Disable logging per log subtree.
fun enable_node tm = carefully (\\ () = fil::enable_node tm); # Enable logging per logtree node.
fun set_logger_to f = carefully (\\ () = fil::set_logger_to f); # Select destination file/whatever.
fun subtree_nodes_and_log_flags root = carefully' (\\ () = fil::subtree_nodes_and_log_flags root);
end;
stipulate
fun drop_leading_blanks string
=
{ =~ = regex::(=~);
if (string =~ ./^\s*$/)
#
"";
#
else
# Drop leading whitespace:
#
string = case (regex::find_first_match_to_ith_group 1 ./^\s*(\S.*)$/ string)
THE x => x;
NULL => string;
esac;
string;
fi;
};
herein
fun make_logstring (fil::LOGTREE_NODE { name => logswitch_name, ... }, severity, make_message_string_fn)
=
{
# Construct the 'log_if' string to print,
# and then pass it to the log imp.
#
# The point of constructing the string here,
# rather than in the log_if call, is that
# this way we avoid the work of creating it
# if we're not going to print it (i.e., if
# logging is disabled for that call).
#
# NB: The line format we generate here should
# stay synched with those in
#
# src/lib/std/src/io/winix-text-file-for-os-g--premicrothread.pkg # src/c/main/error-reporting.c
# Get pid and left-pad with blanks to width 8:
#
pid = psx::get_process_id (); # Here we do sprintf "%08d" pid by hand to simplify maintenance
pid = int::to_string pid; # by keeping the code parallel to that in src/lib/std/src/io/winix-text-file-for-os-g--premicrothread.pkg pid = ns::pad_left '0' 8 pid; # where sprintf is not available due to package dependency graph acyclicity requirement.
ptid = hostthread::get_hostthread_ptid ();
ptid = u1w::to_string ptid;
ptid = ns::pad_left '0' 8 ptid; # where sprintf is not available.
thread = th::get_current_microthread ();
thread_id = th::get_thread's_id thread;
thread_name = th::get_thread's_name thread;
task = th::get_thread's_task thread;
task_id = th::get_task's_id task;
tid = int::to_string thread_id;
tid = ns::pad_left '0' 8 tid;
tad = int::to_string task_id;
tad = ns::pad_left '0' 8 tad;
nam = thread_name;
pad = ns::pad_right ' ' (48 - str::length_in_bytes nam) "";
# time_string = date::strftime "%Y-%m-%d:%H:%M:%S" (date::from_time_local (time::get_current_time_utc())); # "2010-01-05:14:17:23" or such.
time_string = time::format 6 (time::get_current_time_utc()); # "1262722876.273621" or such.
#
# NB: If you change the time_string content/format you
# should probably make corresponding changes in log_if in
#
# src/c/main/error-reporting.c
message_string
=
drop_leading_blanks (make_message_string_fn ());
# The intent here is
#
# 1) That doing unix 'sort' on a logfile will do the right thing:
# sort first by time, then by process id, then by thread id.
#
# 2) To facilitate egrep/perl processing, e.g. doing stuff like
# egrep 'pid=021456' logfile | egrep 'tnm=color-imp'
#
logstring = "time=" + time_string
+ " pid=" + pid
+ " ptid=" + ptid
+ " task=" + tad
+ " tid=" + tid
+ " sev=" + (int::to_string severity)
+ " name='" + nam
+ "'" + pad
+ " msg=" + message_string
+ " \t(" + logswitch_name
+ ")\n";
logstring;
};
end;
fun log_if (logtree_node as fil::LOGTREE_NODE { logging, name, ... }) severity make_message_string_fn
=
if (*logging)
if (not (tsr::thread_scheduler_is_running ()))
#
logstring = make_logstring (logtree_node, severity, make_message_string_fn);
fil::logprint logstring;
();
else
#
# Originally here we always did
#
# fil::logprint (make_logstring (logtree_node, make_message_string_fn));
#
# thus doing the print via our thread for mutual exclusion
# in standard concurrent-programming style. Unfortunately,
# this produces problems when trying to log through oddball
# code like the microthread_preemptive_scheduler itself, where thread-scheduling
# is off or SIGARLM is disabled or such.
#
# Since we're mostly just doing a single unbuffered write to a
# unix file descriptor on these calls, which unix semantics
# guarantees to be atomic anyhow, there is actually vanishingly
# little need for mutual exclusion except when we're actually
# opening the file (LOG_TO_FILE case).
#
# Consequently, we currently avoid going through print_if_slot
# and the log_if thread in all cases except LOG_TO_FILE:
#
#
logstring = make_logstring (logtree_node, severity, make_message_string_fn);
#
case (fil::logger_is_set_to ())
#
fil::LOG_TO_NULL => ();
fil::LOG_TO_FILE _ => put_in_mailslot (print_if_slot, logstring);
_ => fil::logprint logstring;
esac;
fi;
fi;
# if (*logging)
#
#
# if (tsr::thread_scheduler_is_running ())
# #
# logstring = make_logstring (logtree_node, make_message_string_fn);
# put_in_mailslot (print_if_slot, logstring);
# fi;
#
# # if (not (tsr::thread_scheduler_is_running ()))
# # #
# # # logprint logstring;
# # ();
# # else
# # case *log_to
# # #
# # LOG_TO_NULL => ();
# # LOG_TO_FILE _ => put_in_mailslot (print_if_slot, logstring);
# # _ => logprint logstring;
# # esac;
# # fi;
# fi;
# This is an ugly little hack to solve a package cycle problem in
# src/lib/src/lib/thread-kit/src/core-thread-kit/microthread-preemptive-scheduler.pkg #
stipulate
# This is going to be called at weird places
# within the thread scheduler, so we COMPLETELY
# skip going through the print_if_slot and our
# log_if thread:
#
fun log_if (logtree_node as fil::LOGTREE_NODE { logging, name, ... }) severity make_message_string_fn
=
if *logging
#
logstring = make_logstring (logtree_node, severity, make_message_string_fn);
#
fil::logprint logstring;
fi;
thread_scheduler_logging = make_logtree_leaf { parent => fil::all_logging, name => "thread_scheduler_logging", default => FALSE };
to_log = log_if thread_scheduler_logging 0;
herein
my _ = (microthread_preemptive_scheduler::trace_backpatchfn := to_log);
end;
}; # package logging
end;