Merge branch 'master' of https://github.com/Araq/Nimrod into vm2

Conflicts:
	web/news.txt

4 files changed, 34 insertions, 28 deletions

diff --git a/lib/system/alloc.nim b/lib/system/alloc.nim
index 2bab79212..17258cf68 100644
--- a/lib/system/alloc.nim
+++ b/lib/system/alloc.nim
@@ -760,7 +760,7 @@ proc getOccupiedMem(a: TMemRegion): int {.inline.} =
 # ---------------------- thread memory region -------------------------------
 
 template InstantiateForRegion(allocator: expr) =
-  when false:
+  when defined(fulldebug):
     proc interiorAllocatedPtr*(p: pointer): pointer =
       result = interiorAllocatedPtr(allocator, p)
 
diff --git a/lib/system/excpt.nim b/lib/system/excpt.nim
index 7937d9738..9b6a64fb0 100644
--- a/lib/system/excpt.nim
+++ b/lib/system/excpt.nim
@@ -11,14 +11,13 @@
 # use the heap (and nor exceptions) do not include the GC or memory allocator.
 
 var
-  stackTraceNewLine*: string ## undocumented feature; it is replaced by ``<br>``
-                             ## for CGI applications
-
-template stackTraceNL: expr =
-  (if IsNil(stackTraceNewLine): "\n" else: stackTraceNewLine)
+  errorMessageWriter*: (proc(msg: string): void {.tags: [FWriteIO].})
+    ## Function that will be called
+    ## instead of stdmsg.write when printing stacktrace.
+    ## Unstable API.
 
 when not defined(windows) or not defined(guiapp):
-  proc writeToStdErr(msg: CString) = write(stdout, msg)
+  proc writeToStdErr(msg: CString) = write(stdmsg, msg)
 
 else:
   proc MessageBoxA(hWnd: cint, lpText, lpCaption: cstring, uType: int): int32 {.
@@ -27,6 +26,12 @@ else:
   proc writeToStdErr(msg: CString) =
     discard MessageBoxA(0, msg, nil, 0)
 
+proc showErrorMessage(data: cstring) =
+  if errorMessageWriter != nil:
+    errorMessageWriter($data)
+  else:
+    writeToStdErr(data)
+
 proc chckIndx(i, a, b: int): int {.inline, compilerproc.}
 proc chckRange(i, a, b: int): int {.inline, compilerproc.}
 proc chckRangeF(x, a, b: float): float {.inline, compilerproc.}
@@ -111,7 +116,7 @@ when defined(nativeStacktrace) and nativeStackTraceSupported:
             add(s, tempDlInfo.dli_sname)
         else:
           add(s, '?')
-        add(s, stackTraceNL)
+        add(s, "\n")
       else:
         if dlresult != 0 and tempDlInfo.dli_sname != nil and
             c_strcmp(tempDlInfo.dli_sname, "signalHandler") == 0'i32:
@@ -172,21 +177,18 @@ proc auxWriteStackTrace(f: PFrame, s: var string) =
         add(s, ')')
       for k in 1..max(1, 25-(s.len-oldLen)): add(s, ' ')
       add(s, tempFrames[j].procname)
-    add(s, stackTraceNL)
+    add(s, "\n")
 
 when hasSomeStackTrace:
   proc rawWriteStackTrace(s: var string) =
     when nimrodStackTrace:
       if framePtr == nil:
-        add(s, "No stack traceback available")
-        add(s, stackTraceNL)
+        add(s, "No stack traceback available\n")
       else:
-        add(s, "Traceback (most recent call last)")
-        add(s, stackTraceNL)
+        add(s, "Traceback (most recent call last)\n")
         auxWriteStackTrace(framePtr, s)
     elif defined(nativeStackTrace) and nativeStackTraceSupported:
-      add(s, "Traceback from system (most recent call last)")
-      add(s, stackTraceNL)
+      add(s, "Traceback from system (most recent call last)\n")
       auxWriteStackTraceWithBacktrace(s)
     else:
       add(s, "No stack traceback available\n")
@@ -207,7 +209,7 @@ proc raiseExceptionAux(e: ref E_Base) =
       pushCurrentException(e)
       c_longjmp(excHandler.context, 1)
   elif e[] of EOutOfMemory:
-    writeToStdErr(e.name)
+    showErrorMessage(e.name)
     quitOrDebug()
   else:
     when hasSomeStackTrace:
@@ -219,7 +221,7 @@ proc raiseExceptionAux(e: ref E_Base) =
       add(buf, " [")
       add(buf, $e.name)
       add(buf, "]\n")
-      writeToStdErr(buf)
+      showErrorMessage(buf)
     else:
       # ugly, but avoids heap allocations :-)
       template xadd(buf, s, slen: expr) =
@@ -235,7 +237,7 @@ proc raiseExceptionAux(e: ref E_Base) =
       add(buf, " [")
       xadd(buf, e.name, c_strlen(e.name))
       add(buf, "]\n")
-      writeToStdErr(buf)
+      showErrorMessage(buf)
     quitOrDebug()
 
 proc raiseException(e: ref E_Base, ename: CString) {.compilerRtl.} =
@@ -255,9 +257,9 @@ proc WriteStackTrace() =
   when hasSomeStackTrace:
     var s = ""
     rawWriteStackTrace(s)
-    writeToStdErr(s)
+    showErrorMessage(s)
   else:
-    writeToStdErr("No stack traceback available\n")
+    showErrorMessage("No stack traceback available\n")
 
 proc getStackTrace(): string =
   when hasSomeStackTrace:
@@ -298,13 +300,13 @@ when not defined(noSignalHandler):
       var buf = newStringOfCap(2000)
       rawWriteStackTrace(buf)
       processSignal(sig, buf.add) # nice hu? currying a la nimrod :-)
-      writeToStdErr(buf)
+      showErrorMessage(buf)
       GC_enable()
     else:
       var msg: cstring
       template asgn(y: expr) = msg = y
       processSignal(sig, asgn)
-      writeToStdErr(msg)
+      showErrorMessage(msg)
     when defined(endb): dbgAborting = True
     quit(1) # always quit when SIGABRT
 
diff --git a/lib/system/gc.nim b/lib/system/gc.nim
index d2b065d6b..68e8b423d 100644
--- a/lib/system/gc.nim
+++ b/lib/system/gc.nim
@@ -345,8 +345,9 @@ proc forAllChildrenAux(dest: Pointer, mt: PNimType, op: TWalkOp) =
 
 proc forAllChildren(cell: PCell, op: TWalkOp) =
   gcAssert(cell != nil, "forAllChildren: 1")
-  gcAssert(cell.typ != nil, "forAllChildren: 2")
-  gcAssert cell.typ.kind in {tyRef, tySequence, tyString}, "forAllChildren: 3"
+  gcAssert(isAllocatedPtr(gch.region, cell), "forAllChildren: 2")
+  gcAssert(cell.typ != nil, "forAllChildren: 3")
+  gcAssert cell.typ.kind in {tyRef, tySequence, tyString}, "forAllChildren: 4"
   let marker = cell.typ.marker
   if marker != nil:
     marker(cellToUsr(cell), op.int)
@@ -361,7 +362,7 @@ proc forAllChildren(cell: PCell, op: TWalkOp) =
         for i in 0..s.len-1:
           forAllChildrenAux(cast[pointer](d +% i *% cell.typ.base.size +%
             GenericSeqSize), cell.typ.base, op)
-    else: nil
+    else: discard
 
 proc addNewObjToZCT(res: PCell, gch: var TGcHeap) {.inline.} =
   # we check the last 8 entries (cache line) for a slot that could be reused.
@@ -408,8 +409,10 @@ proc addNewObjToZCT(res: PCell, gch: var TGcHeap) {.inline.} =
     add(gch.zct, res)
 
 {.push stackTrace: off, profiler:off.}
-proc gcInvariant*(msg: string) =
-  sysAssert(allocInv(gch.region), msg)
+proc gcInvariant*() =
+  sysAssert(allocInv(gch.region), "injected")
+  when defined(markForDebug):
+    markForDebug(gch)
 {.pop.}
 
 proc rawNewObj(typ: PNimType, size: int, gch: var TGcHeap): pointer =
diff --git a/lib/system/mmdisp.nim b/lib/system/mmdisp.nim
index 118272ee3..942b6778e 100644
--- a/lib/system/mmdisp.nim
+++ b/lib/system/mmdisp.nim
@@ -18,7 +18,8 @@ const
   logGC = false
   traceGC = false # extensive debugging
   alwaysCycleGC = false
-  alwaysGC = false # collect after every memory allocation (for debugging)
+  alwaysGC = defined(fulldebug) # collect after every memory
+                                # allocation (for debugging)
   leakDetector = false
   overwriteFree = false
   trackAllocationSource = leakDetector