Skip to content

Commit

Permalink
Build a better KD-Tree by recognizing that empty space is good.
Browse files Browse the repository at this point in the history
  • Loading branch information
@eholk
eholk committed Sep 29, 2015
1 parent 51ad80b commit 499ca76
Show file tree
Hide file tree
Showing 4 changed files with 65 additions and 45 deletions.
86 changes: 45 additions & 41 deletions examples/kd-ray.kfc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -38,7 +38,7 @@
(define (left-of? axis plane shape)
(match (bounding-box shape axis)
((Range low high)
(< high plane))))
(<= high plane))))

(define (right-of? axis plane shape)
(match (bounding-box shape axis)
Expand Down Expand Up @@ -174,56 +174,60 @@
(kernel ((shape shapes))
(match (bounding-box shape axis)
((Range left right)
(let ((left (- left 0.0001))
(right (+ right 0.0001)))
(best-split (SplitCost axis
left
(eval-split axis
left
(match (split-box dims axis left)
((BoxPair left right)
(FloatPair (box-surface-area left)
(box-surface-area right))))
shapes))
(SplitCost axis
right
(eval-split axis
right
(match (split-box dims axis right)
((BoxPair left right)
(FloatPair (box-surface-area left)
(box-surface-area
right))))
shapes)))))))))
(best-split (SplitCost axis
left
(eval-split axis
left
(match (split-box dims axis left)
((BoxPair left right)
(FloatPair (box-surface-area left)
(box-surface-area right))))
shapes))
(SplitCost axis
right
(eval-split axis
right
(match (split-box dims axis right)
((BoxPair left right)
(FloatPair (box-surface-area left)
(box-surface-area
right))))
shapes))))))))

;; Bottom up approach to tree building.
;;
;; This is based on some pseudo code from
;; http://www.flipcode.com/archives/Raytracing_Topics_Techniques-Part_7_Kd-Trees_and_More_Speed.shtml
(define (build-tree shapes dims)
(println shapes)
(if (< (length shapes) (leaf-size))
;; TODO: Maybe deep copy shapes here break region dependencies.
(Leaf shapes)
(let ((best-x (find-split dims shapes (XAxis)))
(if (> (length shapes) 0)
(let ((nosplit-cost (* (box-surface-area dims)
(* (int->float (length shapes))
(intersection-cost))))
(best-x (find-split dims shapes (XAxis)))
(best-y (find-split dims shapes (YAxis)))
(best-z (find-split dims shapes (ZAxis))))
(println* "Best X split: " best-x)
(println* "Best Y split: " best-y)
(println* "Best Z split: " best-z)
(println* "Best X split: " best-x)
(println* "Best Y split: " best-y)
(println* "Best Z split: " best-z)
(println* "No-split cost: " nosplit-cost)
(match (best-split best-x (best-split best-y best-z))
((SplitCost axis plane _)
(let ((lefts (filter (lambda (shape)
(left-of? axis plane shape))
shapes))
(rights (filter (lambda (shape)
(right-of? axis plane shape))
shapes)))
(match (split-box dims axis plane)
((BoxPair left-box right-box)
(Split axis plane
(build-tree lefts left-box)
(build-tree rights right-box))))))))))
((SplitCost axis plane cost)
(println* "Splitting along " axis)
(if (< cost nosplit-cost)
(let ((lefts (filter (lambda (shape)
(left-of? axis plane shape))
shapes))
(rights (filter (lambda (shape)
(right-of? axis plane shape))
shapes)))
(match (split-box dims axis plane)
((BoxPair left-box right-box)
(Split axis plane
(build-tree lefts left-box)
(build-tree rights right-box)))))
(Leaf shapes)))))
(Leaf (vector))))

(define (print-tree tree)
(match tree
Expand Down
7 changes: 6 additions & 1 deletion harlan/compile-opts.scm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,7 @@
(harlan compile-opts)
(export
allow-complex-kernel-args
allow-kernel-printf
benchmark
danger-zone
generate-debug
Expand Down Expand Up @@ -32,6 +33,7 @@
(util compat))

(define allow-complex-kernel-args (make-parameter #f))
(define allow-kernel-printf (make-parameter #f))
(define danger-zone (make-parameter #f))
(define verbosity (make-parameter 0))
(define verify (make-parameter #f))
Expand Down Expand Up @@ -183,7 +185,10 @@
(dump-call-graph #t))
((("--Zallow-complex-kernel-args"))
"Allow unboxed complex kernel parameters"
(allow-complex-kernel-args #t))))
(allow-complex-kernel-args #t))
((("--Zallow-kernel-printf"))
"Allow Harlan to call printf from within kernels (doesn't work on NVIDIA GPUs"
(allow-kernel-printf #t))))

(define (string-search needle haystack)
(let loop ((i 0))
Expand Down
2 changes: 1 addition & 1 deletion harlan/middle/remove-danger.scm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -104,7 +104,7 @@
(< (var int ,i-var) (int 0)))
;; If we're in debug mode, print out more
;; information about what went wrong.
,(if (generate-debug)
,(if (and (allow-kernel-printf) (generate-debug))
`(begin
(do (call (c-expr (fn (str int str int) -> void) printf)
(str "attempted to access index %d on %s, which is only %d long")
Expand Down
15 changes: 13 additions & 2 deletions rt/harlan.cpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -107,7 +107,18 @@ void free_region(region *r)
fprintf(stderr, "freeing region %p. %d bytes of %d allocated\n",
r, r->alloc_ptr, r->size);
if(r->cl_buffer) {
clReleaseMemObject((cl_mem)r->cl_buffer);
cl_mem buffer = (cl_mem)r->cl_buffer;

// Get the reference count. It should just be one.
cl_uint count = 0;
cl_int status = clGetMemObjectInfo(buffer,
CL_MEM_REFERENCE_COUNT,
sizeof(count),
&count,
NULL);
fprintf(stderr, "releasing cl_mem associated with %p. rc=%d\n",
r, count);
clReleaseMemObject(buffer);
}
free(r);
}
Expand Down Expand Up @@ -237,7 +248,7 @@ void reserve_at_least(region **r, int size) {
assert(new_size > (*r)->size);
region *old = *r;
unsigned int old_size = (*r)->size;
//printf("realloc(%p, %d)\n", *r, new_size);
fprintf(stderr, "realloc(%p, %d)\n", *r, new_size);
(*r) = (region *)realloc(*r, new_size);

assert(*r != NULL);
Expand Down

0 comments on commit 499ca76

Please sign in to comment.