Carp/core/Debug.carp

58 lines
2.2 KiB
Plaintext

(system-include "carp_debug.h")
(defmodule Debug
(doc sanitize-addresses "instructs the compiler to sanitize addresses.
This might not work on all compilers, but reasonably new versions of GCC and Clang are supported.")
(defndynamic sanitize-addresses []
(add-cflag "-fsanitize=address -Wno-macro-redefined"))
(doc check-allocations "will check the allocations made by the program
immediately, raising a `SIGABRT` if it fails.")
(defndynamic check-allocations []
(add-cflag "-DCHECK_ALLOCATIONS"))
(register memory-balance (Fn [] Long))
(register reset-memory-balance! (Fn [] ()))
(register log-memory-balance! (Fn [Bool] ()))
(doc memory-logged "logs all calls to memory allocation within the form. Requires the flag `--log-memory` to be passed during compilation.")
(defmacro memory-logged [form]
(list 'do
'(Debug.log-memory-balance! true)
form
'(Debug.log-memory-balance! false)))
(doc assert-balanced "raises an error if the memory balance (number of `alloc`s - number of `free`s) isn't `0`. Requires the flag `--log-memory` to be passed durng compilation.")
(defmacro assert-balanced [form]
(list 'let '[balance (Debug.memory-balance)]
(list 'do
(list 'let []
form)
'(if (= balance (Debug.memory-balance))
()
(do (IO.println &(fmt "Invalid memory balance: %d" (Debug.memory-balance)))
(System.exit 1)))
())))
(doc trace "prints the value of an expression to `stdout`, then returns its value.")
(defmacro trace [x]
(list 'let-do (array 'tmp x)
(list 'IO.println (list 'ref (list 'fmt "%s:%d:%d: %s" (file x) (line x) (column x) '&(str tmp))))
'tmp)
)
(doc leak-array "leaks some memory. This function is useful for testing tools that detect leaks.")
(register leak-array (Fn [a] ()) "Debug_leak_MINUS_array")
)
;; Crash the program with an error message unless the expression evaluates to 'true'.
(defmacro assert [expr]
(list 'if (list '= true expr)
()
(list 'do
(list 'println* (list 'fmt "Assertion '%s' failed at line %d, column %d in file %s" (str expr) (line) (column) (file)))
'(System.exit 1))))