akkartik/mu
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

480 - trying to speed up chessboard

Browse Source 
Computing length of a 32-long list takes 2x a 16-long list.
But 64-long takes 3x 32-long.
Why? No idea yet. No insights from counting calls.
This commit is contained in:
Kartik K. Agaram 2015-01-02 11:22:39 -08:00
parent e605597d37
commit de4c631b86
3 changed files with 211 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
chessboard-rawterm.mu
View File

@ -5,32 +5,33 @@
N:literal P:literal _:literal _:literal _:literal _:literal p:literal n:literal
B:literal P:literal _:literal _:literal _:literal _:literal p:literal b:literal
Q:literal P:literal _:literal _:literal _:literal _:literal p:literal q:literal
K:literal P:literal _:literal _:literal _:literal _:literal p:literal k:literal
B:literal P:literal _:literal _:literal _:literal _:literal p:literal b:literal
N:literal P:literal _:literal _:literal _:literal _:literal p:literal n:literal
R:literal P:literal _:literal _:literal _:literal _:literal p:literal r:literal)
)
;? K:literal P:literal _:literal _:literal _:literal _:literal p:literal k:literal
;? B:literal P:literal _:literal _:literal _:literal _:literal p:literal b:literal
;? N:literal P:literal _:literal _:literal _:literal _:literal p:literal n:literal
;? R:literal P:literal _:literal _:literal _:literal _:literal p:literal r:literal)
; assert(length(initial-position) == 64)
;? (print-primitive (("list-length\n" literal)))
(len:integer <- list-length initial-position:list-address)
(correct-length?:boolean <- equal len:integer 64:literal)
;? (correct-length?:boolean <- equal len:integer 4:literal)
(assert correct-length?:boolean (("chessboard had incorrect size" literal)))
(b:board-address <- new board:literal 8:literal)
;? (b:board-address <- new board:literal 2:literal)
(col:integer <- copy 0:literal)
(curr:list-address <- copy initial-position:list-address)
{ begin
(done?:boolean <- equal col:integer 8:literal)
;? (done?:boolean <- equal col:integer 2:literal)
(break-if done?:boolean)
;? (print-primitive col:integer)
;? (print-primitive (("\n" literal)))
(file:file-address-address <- index-address b:board-address/deref col:integer)
(file:file-address-address/deref curr:list-address <- read-file curr:list-address)
(col:integer <- add col:integer 1:literal)
(loop)
}
(reply b:board-address)
;? (correct-length?:boolean <- equal len:integer 64:literal)
;? ;? (correct-length?:boolean <- equal len:integer 4:literal)
;? (assert correct-length?:boolean (("chessboard had incorrect size" literal)))
;? (b:board-address <- new board:literal 8:literal)
;? ;? (b:board-address <- new board:literal 2:literal)
;? (col:integer <- copy 0:literal)
;? (curr:list-address <- copy initial-position:list-address)
;? { begin
;? (done?:boolean <- equal col:integer 8:literal)
;? ;? (done?:boolean <- equal col:integer 2:literal)
;? (break-if done?:boolean)
;? ;? (print-primitive col:integer)
;? ;? (print-primitive (("\n" literal)))
;? (file:file-address-address <- index-address b:board-address/deref col:integer)
;? (file:file-address-address/deref curr:list-address <- read-file curr:list-address)
;? (col:integer <- add col:integer 1:literal)
;? (loop)
;? }
;? (reply b:board-address)
])
(function read-file [
@ -194,14 +195,14 @@
;? (print-primitive (("\u2654 \u265a" literal)))
(default-scope:scope-address <- new scope:literal 30:literal)
(b:board-address <- read-board)
(console-on)
{ begin
(clear-screen)
(print-board b:board-address)
(print-primitive (("? " literal)))
(m:move-address <- read-move)
(b:board-address <- make-move b:board-address m:move-address)
(loop)
}
(console-off)
;? (console-on)
;? { begin
;? (clear-screen)
;? (print-board b:board-address)
;? (print-primitive (("? " literal)))
;? (m:move-address <- read-move)
;? (b:board-address <- make-move b:board-address m:move-address)
;? (loop)
;? }
;? (console-off)
])

40
mu.arc
View File

@ -1740,21 +1740,53 @@
(freeze system-function*)
) ; section 100 for system software
(load "profiler.arc")
;; load all provided files and start at 'main'
(reset)
;? (new-trace "main")
;? (set dump-trace*)
(awhen (pos "--" argv)
(map add-code:readfile (cut argv (+ it 1)))
;? (= dump-trace* (obj whitelist '("run" "schedule" "add")))
;? (= dump-trace* (obj whitelist '("run")))
;? (= dump-trace* (obj whitelist '("schedule")))
;? (= dump-trace* (obj whitelist '("cn0")))
;? (set dump-trace*)
;? (freeze function*)
;? (prn function*!factorial)
;? (profile run)
;? (profile run-for-time-slice)
;? (profile make-routine)
;? (profile empty)
;? (profile stack)
;? (profile top)
;? (profile body)
;? (profile parse-instr)
;? (profile metadata)
;? (profile ty)
;? (profile literal?)
;? (profile typeinfo)
;? (profile m)
;? (profile setm)
;? (profile addr)
;? (profile addrs)
;? (profile canonize)
;? (profile array-len)
;? (profile sizeof)
;? (profile absolutize)
;? (profile lookup-space)
;? (profile deref)
;? (profile drop-one)
;? (profile new-scalar)
;? (profile new-array)
;? (profile new-string)
;? (profile convert-braces)
;? (profile convert-names)
(run 'main)
(if ($.current-charterm) ($.close-charterm))
(prn "\nmemory: " int-canon.memory*)
;? (if ($.current-charterm) ($.close-charterm))
;? (prn "\nmemory: " int-canon.memory*)
(each routine completed-routines*
(aif rep.routine!error (prn "error - " it)))
)
(reset)
;? (reset)
(profiles)

141
profiler.arc Normal file
View File

@ -0,0 +1,141 @@
; A simple call-counting profiler.
; https://bitbucket.org/fallintothis/profiler
(= profiles* (table) originals* (table))
; avoid infinite loops & other badness in profiled fn, e.g. (profile +)
(with (orig-+ +
orig-is is
orig-err err
orig-type type
orig-sref sref
orig-apply apply
orig-atomic-invoke atomic-invoke)
(mac profiled (f)
; (= (profiles* f) 0)
`(profiled-as ',f ,f))
; Not sure I like the order of the arguments, but probably rarely use this.
(def profiled-as (name f (o profile-data profiles*))
(if (orig-is (orig-is (orig-type f) 'fn) nil)
(orig-err "Can only profile functions:" f))
(fn args
(orig-atomic-invoke
(fn () (orig-sref profile-data
(orig-+ (profile-data name 0) 1)
name)))
(orig-apply f args)))
; Have to be careful here. (= profiles* (table)) won't work, since profiled-as
; has the table passed in as an arg: after a (= ...), old closed-over
; references from profiled-as will fail to update the profiles* table.
; (= glob* (table))
; (def foo ((o y glob*)) (fn (x) (= (y x) t)))
; (= bar (foo))
; (bar 5) ; glob* = #hash((5 . t))
; (= glob* (table)) ; glob* = #hash()
; (bar 5) ; glob* = #hash(), still
(def reset-profiles ((o fns))
(each f (or fns (keys profiles*))
(orig-atomic-invoke
(fn () (orig-sref profiles*
nil
f))))
'ok)
)
(mac profile (f)
`(do
(= (originals* ',f) ,f)
(= ,f (profiled ,f))
(warn (+ ,(string f)
" is being profiled; "
"do not redefine it until you (unprofile " ,(string f) ")"))
t))
(mac unprofile (f)
`(= ,f (originals* ',f ,f)
(originals* ',f) nil
(profiles* ',f) nil))
(def profiles ((o profiler-data profiles*))
(withs (data ; avoid counting stuff from the current call to (profiles)
(with (atomic-invokes (profiler-data 'atomic-invoke)
tables (profiler-data 'table)
srefs (profiler-data 'sref)
new (table))
(maptable (fn (k v) (= (new k) v)) profiler-data)
(= (new 'atomic-invoke) atomic-invokes
(new 'table) tables
(new 'sref) srefs)
new)
lhead "Function"
rhead "Call Count"
lwidth (apply max (map len:tostring:disp (cons lhead (keys data))))
prnrow (fn (l r)
(w/bars
(do (pr l) (sp (- lwidth (len l))))
(prn r))))
(prn)
(prnrow lhead rhead)
(each (f call-count) (sortable data)
(prnrow (tostring:disp f) call-count))
(prn)))
(mac profiling-just (fns . bod)
(unless (acons fns)
(zap list fns))
(w/uniq (profiles profiled)
(let originals (map [uniq] fns)
`(with (,profiles (table)
,profiled profiled-as
,@(mappend list originals fns))
; ,@(map (fn (f) `(= (,profiles ',f) 0)) fns)
,@(map (fn (f o) `(= ,f (,profiled ',f ,o ,profiles)))
fns
originals)
(after (do ,@bod)
(= ,@(apply + nil (map list fns originals)))
(if (> (,profiles 'protect 0) 1) ; from (after ...)
(-- (,profiles 'protect))
(wipe (,profiles 'protect)))
(profiles ,profiles))))))
(def all-fns ()
(let xdefs '(apply cons car cdr is err + - * / mod expt sqrt > < len annotate
type rep uniq ccc infile outfile instring outstring inside
stdout stdin stderr call-w/stdout call-w/stdin readc readb peekc
writec writeb write disp sread coerce open-socket socket-accept
setuid new-thread kill-thread break-thread current-thread sleep
system pipe-from table protect rand dir file-exists dir-exists
rmfile mvfile macex macex1 eval on-err details scar scdr sref
bound newstring trunc exact msec current-process-milliseconds
current-gc-milliseconds seconds client-ip atomic-invoke dead
flushout ssyntax ssexpand quit close force-close memory declare
timedate sin cos tan asin acos atan log)
(+ xdefs (keep [isa (eval _) 'fn] (keys sig*)))))
(mac profile-all ()
(with (fns (all-fns) orig-atomic-invoke (uniq) orig-sref (uniq))
`(with (,orig-sref sref
,orig-atomic-invoke atomic-invoke)
(do ,@(map (fn (f) `(profile ,f)) fns)
,@(map (fn (f) `(,orig-atomic-invoke
(fn () (,orig-sref profiles* nil ',f))))
fns)
t))))
(mac unprofile-all ()
`(do ,@(map (fn (f) `(unprofile ,f)) (keys originals*))))
(mac profiling code
`(profiling-just ,(all-fns) ,@code))
(mac profile-here (marker . code)
; (= (profiles* marker) 0)
`(do1 (do ,@code)
(++ (profiles* ',marker 0))))