[draft] top-level profiling

M2/Macaulay2/bin/main.cpp

@@ -122,15 +122,10 @@ int main(/* const */ int argc, /* const */ char *argv[], /* const */ char *env[]
 
 /* ######################################################################### */
 
-std::ofstream prof_log;
-thread_local std::vector<char*> M2_stack;
-
-void stack_trace(std::ostream &stream, bool M2) {
-  if(M2) {
-    stream << "M2";
-    for (char* M2_frame : M2_stack)
-      stream << ";" << M2_frame;
-    stream << std::endl;
+void profiler_stacktrace(std::ostream &stream, int traceDepth) {
+  if(0 < traceDepth) {
+    // TODO: pipe output to the stream
+    profiler_stacktrace(traceDepth);
   } else {
     stream << "-* stack trace, pid: " << (long) getpid() << std::endl;
     stream << boost::stacktrace::stacktrace();
@@ -139,29 +134,19 @@ void stack_trace(std::ostream &stream, bool M2) {
 }
 
 void M2_flint_abort(void) {
-  stack_trace(std::cerr, false);
+  profiler_stacktrace(std::cerr, 0);
   abort();
 }
 
-extern "C" {
-  void M2_stack_trace() { stack_trace(std::cout, false); }
-#if PROFILING
-  void M2_stack_push(char* M2_frame) { M2_stack.emplace_back(M2_frame); }
-  void M2_stack_pop() { M2_stack.pop_back(); }
-#else
-  void M2_stack_push(char* M2_frame) {}
-  void M2_stack_pop() {}
-#endif
-}
-
 void* profFunc(ArgCell* p)
 {
   using namespace std::chrono_literals;
   std::string filename("profile-" + std::to_string(getpid())+ ".raw");
-  // std::cerr << "Saving profile data in " << filename << std::endl;
-  prof_log.open(filename, std::ios::out | std::ios::trunc );
+  std::cerr << "-- Storing profiling data in " << filename << std::endl;
+  std::ofstream prof_log(filename, std::ios::out | std::ios::trunc );
   while(true) {
-    std::this_thread::sleep_for(1000ms);
+    // use prime number to avoid oversampling scheduled tasks
+    std::this_thread::sleep_for(997ms);
     tryGlobalTrace();
   }
   return NULL;
@@ -235,7 +220,7 @@ extern "C" void oursignal(int sig, void (*handler)(int)) {
 
 void trace_handler(int sig) {
   if (tryGlobalTrace() == 0)
-    stack_trace(prof_log, true);
+    profiler_stacktrace(std::cerr, 1);
   oursignal(SIGUSR1,trace_handler);
 }
 
@@ -253,7 +238,7 @@ void segv_handler(int sig) {
     fprintf(stderr,"-- SIGSEGV handler called a second time, aborting\n");
     _exit(2);
   }
-  stack_trace(std::cerr, false);
+  profiler_stacktrace(std::cerr, 0);
   level --;
   _exit(1);
 }
@@ -292,7 +277,7 @@ void interrupt_handler(int sig) {
 	    }
 	  }
 	  if (buf[0]=='b' || buf[0]=='B') {
-	    stack_trace(std::cout, false);
+	    profiler_stacktrace(std::cout, 0);
 	    fprintf(stderr,"exiting\n");
 	    exit(12);
 	  }

M2/Macaulay2/d/CMakeLists.txt

@@ -84,6 +84,7 @@ set(DLIST
   xmlactors.d	# removed unless WITH_XML
   actors5.d
   chrono.dd
+  profiler.dd
   threads.dd
   python.d	# removed unless WITH_PYTHON
   interface.dd interface2.d

M2/Macaulay2/d/Makefile.files.in

@@ -88,6 +88,7 @@ M2_SRCFILES += xmlactors.d
 endif
 M2_DFILES += actors5.d
 M2_DFILES += chrono.dd
+M2_DFILES += profiler.dd
 M2_DFILES += threads.dd
 
 ifeq (@PYTHON@,yes)

M2/Macaulay2/d/actors4.d

@@ -1081,6 +1081,8 @@ setupfun("connectionCount", connectionCount);
 format(e:Expr):Expr := (
      when e
      is s:stringCell do toExpr("\"" + present(s.v) + "\"")
+     is ZZcell do e
+     is QQcell do e
      is RRcell do format(Expr(Sequence(e)))
      is RRicell do format(Expr(Sequence(e)))
      is CCcell do format(Expr(Sequence(e)))
@@ -1102,6 +1104,8 @@ format(e:Expr):Expr := (
 	  is Nothing do nothing else return WrongArgZZ(4);
 	  if n > 5 then when args.4 is p:stringCell do sep = p.v else return WrongArgString(5);
 	  when args.(n-1)
+	  is x:ZZcell do toExpr(concatenate(format(s,ac,l,t,sep,toRR(x.v,defaultPrecision))))
+	  is x:QQcell do toExpr(concatenate(format(s,ac,l,t,sep,toRR(x.v,defaultPrecision))))
 	  is x:RRcell do toExpr(concatenate(format(s,ac,l,t,sep,x.v)))
 	  is z:CCcell do toExpr(format(s,ac,l,t,sep,false,false,z.v))
 	  else WrongArgRR(n)

M2/Macaulay2/d/actors5.d

@@ -1741,8 +1741,10 @@ storeInHashTable(
      Expr(newCompiledFunction(storeGlobalDictionaries)));
 
 getcwdfun(e:Expr):Expr := (				    -- this has to be a function, because getcwd may fail
-     when e is s:Sequence do
-     if length(s) == 0 then cwd() else WrongNumArgs(0)
+    when e is s:Sequence do if length(s) != 0 then WrongNumArgs(0) else (
+	dir := getcwd();
+	if dir != "" then Expr(stringCell(dir))
+	else buildErrorPacket("can't get current working directory: " + syserrmsg()))
      else WrongNumArgs(0));
 setupfun("currentDirectory",getcwdfun);
 

M2/Macaulay2/d/binding.d

@@ -306,24 +306,25 @@ bumpPrecedence();
      export leftparen   := parens("(",")",precSpace, precRightParen, precRightParen);
      export leftbrace   := parens("{","}",precSpace, precRightParen, precRightParen);
      parseWORD.precedence = prec; parseWORD.binaryStrength = nopr; parseWORD.unaryStrength = nopr;
-     export timeS := special("time",unaryop,precSpace,wide);
-     export timingS := special("timing",unaryop,precSpace,wide);
-     export elapsedTimeS := special("elapsedTime",unaryop,precSpace,wide);
-     export elapsedTimingS := special("elapsedTiming",unaryop,precSpace,wide);
-     export shieldS := special("shield",unaryop,precSpace,wide);
-     export TestS := special("TEST",unaryop,precSpace,wide);
-     export throwS := special("throw",nunaryop,precSpace,wide);
-     export returnS := special("return",nunaryop,precSpace,wide);
-     export breakS := special("break",nunaryop,precSpace,wide);
-     export continueS := special("continue",nunaryop,precSpace,wide);
-     export stepS := special("step",nunaryop,precSpace,wide);
-     -- export codePositionS := special("codePosition",unaryop,precSpace,narrow);
-     special("new",unarynew,precSpace,narrow);
-     special("for",unaryfor,precSpace,narrow);
-     special("while",unarywhile,precSpace,wide);
-     special("if",unaryif,precSpace,wide);
-     special("try",unarytry,precSpace,wide);
-     special("catch",unarycatch,precSpace,wide);
+     export TestS          := special("TEST",          unaryop, precSpace, wide);
+     export timeS          := special("time",          unaryop, precSpace, wide);
+     export timingS        := special("timing",        unaryop, precSpace, wide);
+     export elapsedTimeS   := special("elapsedTime",   unaryop, precSpace, wide);
+     export elapsedTimingS := special("elapsedTiming", unaryop, precSpace, wide);
+     export breakpointS    := special("breakpoint",    unaryop, precSpace, wide);
+     export profileS       := special("profile",       unaryop, precSpace, wide);
+     export shieldS        := special("shield",        unaryop, precSpace, wide);
+     export throwS         := special("throw",        nunaryop, precSpace, wide);
+     export returnS        := special("return",       nunaryop, precSpace, wide);
+     export breakS         := special("break",        nunaryop, precSpace, wide);
+     export continueS      := special("continue",     nunaryop, precSpace, wide);
+     export stepS          := special("step",         nunaryop, precSpace, wide);
+     special("new",   unarynew,   precSpace, narrow);
+     special("for",   unaryfor,   precSpace, narrow);
+     special("while", unarywhile, precSpace, wide);
+     special("if",    unaryif,    precSpace, wide);
+     special("try",   unarytry,   precSpace, wide);
+     special("catch", unarycatch, precSpace, wide);
 bumpPrecedence();
      export ParenStarParenS := makeKeyword(postfix("(*)"));
 bumpPrecedence();
@@ -360,10 +361,10 @@ bumpPrecedence();
      --export UnderscoreSharpS := makeKeyword(postfix("_#"));
 bumpPrecedence();
      --why are these using precSpace and not prec?
-     special("symbol",unarysymbol,precSpace,prec);
-     special("global",unaryglobal,precSpace,prec);
-     special("threadLocal",unarythread,precSpace,prec);
-     special("local",unarylocal,precSpace,prec);
+     special("symbol",      unarysymbol, precSpace, prec);
+     special("global",      unaryglobal, precSpace, prec);
+     special("threadLocal", unarythread, precSpace, prec);
+     special("local",       unarylocal,  precSpace, prec);
 -----------------------------------------------------------------------------
 export GlobalAssignS := makeProtectedSymbolClosure("GlobalAssignHook");
 export GlobalAssignE := Expr(GlobalAssignS);

M2/Macaulay2/d/chrono.dd

@@ -30,15 +30,17 @@ cpuTime(e:Expr):Expr := (
     else WrongNumArgs(0));
 setupfun("cpuTime", cpuTime);
 
-cpuTimer(c:Code):Sequence := (
+export cpuTimer(c:Code):Sequence := (
     T0 := cpuTime();
     ret := eval(c);
     T1 := cpuTime();
     Sequence(toExpr(T1 - T0), ret));
 
-wallTimer(c:Code):Sequence := (
+export wallTimer(c:Code):Sequence := (
     T0 := Ccode(Chrono, "std::chrono::steady_clock::now()");
-    ret := eval(c);
+    -- Note: here we intentionally call evalraw so
+    -- that evalprof can call this function safely.
+    ret := evalraw(c);
     T1 := Ccode(Chrono, "std::chrono::steady_clock::now()");
     dT := double(Ccode(uint64_t, "(", T1, " - ", T0, ").count()"));
     dT  = dT/1000000000.;

M2/Macaulay2/d/debugging.dd

@@ -3,6 +3,15 @@ use common;
 use util;
 use hashtables;
 
+-- debugger is not defined until interp.dd
+-- so we use a pointer and populate it later.
+dummydebugger(f:Frame,c:Code):Expr := nullE;
+export debuggerpointer := dummydebugger;
+
+-- enters the debugger (defined in interp.dd) at that spot
+breakpoint(c:Code):Expr := debuggerpointer(localFrame, c);
+setupop(breakpointS, breakpoint);
+
 export tostring(c:Code):string := (
     when c
     is x:nullCode    do "(null)"

M2/Macaulay2/d/evaluate.d

@@ -4,6 +4,11 @@ use hashtables;
 use convertr;
 use debugging;
 
+-- evalprof is not defined until profiler.dd
+-- so we use a pointer and populate it later.
+dummyevalprof(c:Code):Expr := nullE;
+export evalprofpointer := dummyevalprof;
+
 export globalAssignmentHooks := newHashTableWithHash(mutableHashTableClass,nothingClass);
 setupconst("globalAssignmentHooks",Expr(globalAssignmentHooks));
 export threadLocal evalSequenceHadError := false;
@@ -14,6 +19,7 @@ threadLocal errorreturn := nullE;
 threadLocal recycleBin := new array(Frame) len 20 do provide dummyFrame;
 export trace := false;
 threadLocal export backtrace := true;
+threadLocal export profiling := false;
 threadLocal lastCode := dummyCode;
 threadLocal lastCodePosition := Position("",ushort(0),ushort(0),ushort(0),ushort(0),ushort(0),ushort(0),ushort(0));
 export chars := new array(Expr) len 256 do (
@@ -1340,9 +1346,7 @@ export handleError(c:Code,e:Expr):Expr := (
 	       if !err.printed || backtrace && localFrame != oldReportFrame then (
 		    if debuggingMode && !stopIfError && (! (p.filename === "stdio")) then (
 			 if !err.printed then printError(err);
-			 printErrorMessage(err.position,"--entering debugger (type help to see debugger commands)");
-			 z := debuggerFun(localFrame,c);
-			 -- printErrorMessage(err.position,"--leaving debugger");
+			 z := debuggerpointer(localFrame,c);
 			 when z is z:Error do (
 			      if z.message == breakMessage then buildErrorPacket(unwindMessage)
 			      else if z.message == returnMessage then (
@@ -1373,28 +1377,10 @@ export handleError(c:Code,e:Expr):Expr := (
 	       e))
      else e);
 
-header "extern void M2_stack_push(char*);";
-header "extern void M2_stack_pop();";
-header "extern void M2_stack_trace();";
-stacktrace(e:Expr):Expr := (
-    Ccode(void,"M2_stack_trace()"); e );
-setupfun("stacktrace",stacktrace);
-
-evalprof(c:Code):Expr;
-evalraw(c:Code):Expr;
 export eval(c:Code):Expr := (
-    if Ccode(bool,"PROFILING == 1")
-    then Ccode(Expr,"evaluate_evalprof(",c,")")
-    else Ccode(Expr,"evaluate_evalraw(",c,")"));
-export evalprof(c:Code):Expr := (
-    when c is f:semiCode do ( -- what makes semiCode special?
-        -- printErrorMessage(codePosition(c),"--evaluating a semiCode");
-        -- TODO: how to get f.name?
-        Ccode(void,"M2_stack_push(",tocharstar(tostring(codePosition(c))),")");
-        e := evalraw(c);
-        Ccode(void,"M2_stack_pop()");
-        e)
-    else evalraw(c));
+    if profiling -- see evalprof in profiling.dd
+    then Ccode(Expr, "evaluate_evalprofpointer(", c, ")")
+    else Ccode(Expr, "evaluate_evalraw(", c, ")"));
 export evalraw(c:Code):Expr := (
     -- # typical value: symbol SPACE, Function, Thing, Thing
      -- better would for cancellation requests to set exceptionFlag:

M2/Macaulay2/d/interp.dd

@@ -5,6 +5,7 @@ use evaluate;
 use parser;
 use texmacs;
 use actors5;
+use profiler;
 
 import dirname(s:string):string;
 
@@ -493,6 +494,7 @@ debugger(f:Frame,c:Code):Expr := (
      setDebuggingMode(false);
        oldDebuggerCode := getGlobalVariable(currentS);
        setGlobalVariable(currentS,Expr(PseudocodeClosure(f,c)));
+	 printMessage(codePosition(c), "entering debugger (enter 'help' to see commands)");
 	 incrementInterpreterDepth();
 	   if debuggerHook != nullE then (
 		r := applyEE(debuggerHook,True);
@@ -503,12 +505,14 @@ debugger(f:Frame,c:Code):Expr := (
 		r := applyEE(debuggerHook,False);
 		when r is Error do return r else nothing;
 		);
+	 if debugLevel != 0 then
+	 printMessage(codePosition(c), "leaving debugger");
 	 decrementInterpreterDepth();
        setGlobalVariable(currentS,oldDebuggerCode);
      setDebuggingMode(true);
      recursionDepth = oldrecursionDepth;
      ret);
-debuggerFun = debugger;
+debuggerpointer = debugger;
 
 currentString := setupvar("currentString", nullE);
 value(e:Expr):Expr := (