(ero "initializing mu.. (takes ~5s)") ;; profiler (http://arclanguage.org/item?id=11556) ; Keeping this right on top as a reminder to profile before guessing at why my ; program is slow. (mac proc (name params . body) `(def ,name ,params ,@body nil)) (mac filter-log (msg f x) `(ret x@ ,x (prn ,msg (,f x@)))) (= times* (table)) (mac deftimed (name args . body) `(do (def ,(sym (string name "_core")) ,args ,@body) (def ,name ,args (let t0 (msec) (ret ans ,(cons (sym (string name "_core")) args) (update-time ,(string name) t0)))))) (proc update-time(name t0) ; call directly in recursive functions (or= times*.name (list 0 0)) (with ((a b) times*.name timing (- (msec) t0)) (= times*.name (list (+ a timing) (+ b 1))))) (def print-times() (prn (current-process-milliseconds)) (prn "gc " (current-gc-milliseconds)) (each (name time) (tablist times*) (prn name " " time))) ;; what happens when our virtual machine starts up (= initialization-fns* (queue)) (def reset () (each f (as cons initialization-fns*) (f))) (mac on-init body `(enq (fn () ,@body) initialization-fns*)) ;; persisting and checking traces for each test (= traces* (queue)) (= trace-dir* ".traces/") (ensure-dir trace-dir*) (= curr-trace-file* nil) (on-init (awhen curr-trace-file* (tofile (+ trace-dir* it) (each (label trace) (as cons traces*) (pr label ": " trace)))) (= curr-trace-file* nil) (= traces* (queue))) (def new-trace (filename) (prn "== @filename") ;? ) (= curr-trace-file* filename)) (= dump-trace* nil) (def trace (label . args) (when (or (is dump-trace* t) (and dump-trace* (is label "-")) (and dump-trace* (pos label dump-trace*!whitelist)) (and dump-trace* (no dump-trace*!whitelist) (~pos label dump-trace*!blacklist))) (apply prn label ": " args)) (enq (list label (apply tostring:prn args)) traces*) (car args)) (on-init (wipe dump-trace*)) (redef tr args ; why am I still returning to prn when debugging? Will this help? (do1 nil (apply trace "-" args))) (def tr2 (msg arg) (tr msg arg) arg) (def check-trace-contents (msg expected-contents) (unless (trace-contents-match expected-contents) (prn "F - " msg) (prn " trace contents") (print-trace-contents-mismatch expected-contents))) (def trace-contents-match (expected-contents) (each (label msg) (as cons traces*) (when (and expected-contents (is label expected-contents.0.0) (posmatch expected-contents.0.1 msg)) (pop expected-contents))) (no expected-contents)) (def print-trace-contents-mismatch (expected-contents) (each (label msg) (as cons traces*) (whenlet (expected-label expected-msg) expected-contents.0 (if (and (is label expected-label) (posmatch expected-msg msg)) (do (pr " * ") (pop expected-contents)) (pr " ")) (pr label ": " msg))) (prn " couldn't find") (each (expected-label expected-msg) expected-contents (prn " ! " expected-label ": " expected-msg))) (def check-trace-doesnt-contain (msg (label unexpected-contents)) (when (some (fn ((l s)) (and (is l label) (posmatch unexpected-contents msg))) (as cons traces*)) (prn "F - " msg) (prn " trace contents") (each (l msg) (as cons traces*) (if (and (is l label) (posmatch unexpected-contents msg)) (pr " X ") (pr " ")) (pr label ": " msg)))) ;; virtual machine state ; things that a future assembler will need separate memory for: ; code; types; args channel ; at compile time: mapping names to locations (on-init (= type* (table)) ; name -> type info (= memory* (table)) ; address -> value (make this a vector?) (= function* (table)) ; name -> [instructions] ; transforming mu programs (= location* (table)) ; function -> {name -> index into default-space} (= next-space-generator* (table)) ; function -> name of function generating next space ; each function's next space will usually always come from a single function (= next-routine-id* 0) (= continuation* (table)) ) (on-init (= type* (obj ; Each type must be scalar or array, sum or product or primitive type (obj size 1) ; implicitly scalar and primitive type-address (obj size 1 address t elem '(type)) type-array (obj array t elem '(type)) type-array-address (obj size 1 address t elem '(type-array)) location (obj size 1 address t elem '(location)) ; assume it points to an atom integer (obj size 1) boolean (obj size 1) boolean-address (obj size 1 address t elem '(boolean)) byte (obj size 1) byte-address (obj size 1 address t elem '(byte)) string (obj array t elem '(byte)) ; inspired by Go ; an address contains the location of a specific type string-address (obj size 1 address t elem '(string)) string-address-address (obj size 1 address t elem '(string-address)) string-address-array (obj array t elem '(string-address)) string-address-array-address (obj size 1 address t elem '(string-address-array)) string-address-array-address-address (obj size 1 address t elem '(string-address-array-address)) ; 'character' will be of larger size when mu supports unicode ; we're currently undisciplined about mixing 'byte' and 'character' ; realistic test of indiscipline in general character (obj size 1) ; int32 like a Go rune character-address (obj size 1 address t elem '(character)) ; a buffer makes it easy to append to a string/array ; todo: make this generic ; data isn't a 'real' array: its length is stored outside it, ; so for example, 'print-string' won't work on it. buffer (obj size 2 and-record t elems '((integer) (string-address)) fields '(length data)) buffer-address (obj size 1 address t elem '(buffer)) ; a stream makes it easy to read from a string/array stream (obj size 2 and-record t elems '((integer) (string-address)) fields '(pointer data)) stream-address (obj size 1 address t elem '(stream)) ; isolating function calls space (obj array t elem '(location)) ; by convention index 0 points to outer space space-address (obj size 1 address t elem '(space)) ; arrays consist of an integer length followed by that many ; elements, all of the same type integer-array (obj array t elem '(integer)) integer-array-address (obj size 1 address t elem '(integer-array)) integer-array-address-address (obj size 1 address t elem '(integer-array-address)) integer-address (obj size 1 address t elem '(integer)) ; pointer to int integer-address-address (obj size 1 address t elem '(integer-address)) ; and-records consist of a multiple fields of different types integer-boolean-pair (obj size 2 and-record t elems '((integer) (boolean)) fields '(int bool)) integer-boolean-pair-address (obj size 1 address t elem '(integer-boolean-pair)) integer-boolean-pair-array (obj array t elem '(integer-boolean-pair)) integer-boolean-pair-array-address (obj size 1 address t elem '(integer-boolean-pair-array)) integer-integer-pair (obj size 2 and-record t elems '((integer) (integer))) integer-integer-pair-address (obj size 1 address t elem '(integer-integer-pair)) integer-point-pair (obj size 2 and-record t elems '((integer) (integer-integer-pair))) integer-point-pair-address (obj size 1 address t elem '(integer-point-pair)) integer-point-pair-address-address (obj size 1 address t elem '(integer-point-pair-address)) ; tagged-values are the foundation of dynamic types tagged-value (obj size 2 and-record t elems '((type) (location)) fields '(type payload)) tagged-value-address (obj size 1 address t elem '(tagged-value)) tagged-value-array (obj array t elem '(tagged-value)) tagged-value-array-address (obj size 1 address t elem '(tagged-value-array)) tagged-value-array-address-address (obj size 1 address t elem '(tagged-value-array-address)) ; heterogeneous lists list (obj size 2 and-record t elems '((tagged-value) (list-address)) fields '(car cdr)) list-address (obj size 1 address t elem '(list)) list-address-address (obj size 1 address t elem '(list-address)) ; parallel routines use channels to synchronize channel (obj size 3 and-record t elems '((integer) (integer) (tagged-value-array-address)) fields '(first-full first-free circular-buffer)) ; be careful of accidental copies to channels channel-address (obj size 1 address t elem '(channel)) ; opaque pointer to a call stack ; todo: save properly in allocated memory continuation (obj size 1) ; editor line (obj array t elem '(character)) line-address (obj size 1 address t elem '(line)) line-address-address (obj size 1 address t elem '(line-address)) screen (obj array t elem '(line-address)) screen-address (obj size 1 address t elem '(screen)) ; fake screen terminal (obj size 5 and-record t elems '((integer) (integer) (integer) (integer) (string-address)) fields '(num-rows num-cols cursor-row cursor-col data)) terminal-address (obj size 1 address t elem '(terminal)) ; fake keyboard keyboard (obj size 2 and-record t elems '((integer) (string-address)) fields '(index data)) keyboard-address (obj size 1 address t elem '(keyboard)) ))) ;; managing concurrent routines (on-init ;? (prn "-- resetting memory allocation") (= Memory-allocated-until 1000) (= Allocation-chunk 100000)) ; routine = runtime state for a serial thread of execution (def make-routine (fn-name . args) (let curr-alloc Memory-allocated-until ;? (prn "-- allocating routine: @curr-alloc") (++ Memory-allocated-until Allocation-chunk) (annotate 'routine (obj alloc curr-alloc alloc-max Memory-allocated-until call-stack (list (obj fn-name fn-name pc 0 args args caller-arg-idx 0)))) ; other fields we use in routine: ; sleep: conditions ; limit: number of cycles this routine can use ; running-since: start of the clock for counting cycles this routine has used ; todo: do memory management in mu )) (defextend empty (x) (isa x 'routine) (no rep.x!call-stack)) (def stack (routine) ((rep routine) 'call-stack)) (def push-stack (routine op) (push (obj fn-name op pc 0 caller-arg-idx 0 t0 (msec)) rep.routine!call-stack)) (def pop-stack (routine) ;? (update-time label.routine (msec)) ;? 1 (pop rep.routine!call-stack)) (def top (routine) stack.routine.0) (def label (routine) (whenlet stack stack.routine (or= stack.0!label (label2 stack)))) (def label2 (stack) (string:intersperse "/" (map [_ 'fn-name] stack)));)) (def body (routine) (function* stack.routine.0!fn-name)) (mac pc (routine (o idx 0)) ; assignable `((((rep ,routine) 'call-stack) ,idx) 'pc)) (mac caller-arg-idx (routine (o idx 0)) ; assignable `((((rep ,routine) 'call-stack) ,idx) 'caller-arg-idx)) (mac caller-args (routine) ; assignable `((((rep ,routine) 'call-stack) 0) 'args)) (mac caller-operands (routine) ; assignable `((((rep ,routine) 'call-stack) 0) 'caller-operands)) (mac caller-results (routine) ; assignable `((((rep ,routine) 'call-stack) 0) 'caller-results)) (mac results (routine) ; assignable `((((rep ,routine) 'call-stack) 0) 'results)) (mac reply-args (routine) ; assignable `((((rep ,routine) 'call-stack) 0) 'reply-args)) (def waiting-for-exact-cycle? (routine) (is 'until rep.routine!sleep.0)) (def ready-to-wake-up (routine) (assert no.routine*) (case rep.routine!sleep.0 until (> curr-cycle* rep.routine!sleep.1) until-location-changes (~is rep.routine!sleep.2 (memory* rep.routine!sleep.1)) until-routine-done (find [and _ (is rep._!id rep.routine!sleep.1)] completed-routines*) )) (on-init (= running-routines* (queue)) ; simple round-robin scheduler ; set of sleeping routines; don't modify routines while they're in this table (= sleeping-routines* (table)) (= completed-routines* nil) ; audit trail (= routine* nil) (= abort-routine* (parameter nil)) (= curr-cycle* 0) (= scheduling-interval* 500) (= scheduler-switch-table* nil) ; hook into scheduler for debugging ) ; like arc's 'point' but you can also call ((abort-routine*)) in nested calls (mac routine-mark body (w/uniq (g p) `(ccc (fn (,g) (parameterize abort-routine* (fn ((o ,p)) (,g ,p)) ,@
#!/usr/bin/env python
# Copyright (C) 2009, 2010 Roman Zimbelmann <romanz@lavabit.com>
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
"""
Run all the benchmarks inside this directory.
Usage: ./all_benchmarks.py [count] [regexp-filters...]
"""
import os.path
import sys
rangerpath = os.path.join(os.path.dirname(__file__), '..')
if sys.path[1] != rangerpath:
sys.path[1:1] = [rangerpath]
import re
import time
if __name__ == '__main__':
count = int(sys.argv[1]) if len(sys.argv) > 1 else 10
regexes = [re.compile(fltr) for fltr in sys.argv[2:]]
modules = (fname[:-3] for fname in os.listdir(sys.path[0]) \
if fname[:3] == 'bm_' and fname[-3:] == '.py')
def run_benchmark(cls, methodname):
full_method_name = "{0}.{1}".format(cls.__name__, methodname)
if all(re.search(full_method_name) for re in regexes):
method = getattr(cls(), methodname)
t1 = time.time()
try:
method(count)
except:
print("{0} failed!".format(full_method_name))
raise
else:
t2 = time.time()
print("{0:60}: {1:10}s".format(full_method_name, t2 - t1))
for val in [__import__(module) for module in modules]:
for cls in vars(val).values():
if type(cls) == type:
for methodname in vars(cls):
if methodname.startswith('bm_'):
run_benchmark(cls, methodname)