refactored ebus code

14 files changed, 1671 insertions, 0 deletions

diff --git a/ebus-racket/3rdparty/bzlib/base/args.ss b/ebus-racket/3rdparty/bzlib/base/args.ss
new file mode 100644
index 0000000..dd4659a
--- /dev/null
+++ b/ebus-racket/3rdparty/bzlib/base/args.ss
@@ -0,0 +1,150 @@
+#lang scheme/base
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; BASE.plt 
+;; 
+;; 
+;; Bonzai Lab, LLC.  All rights reserved.
+;; 
+;; Licensed under LGPL.
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; args.ss - utility for helping processing syntax-based arguments (does not belong here)
+;; yc 9/21/2009 - first version 
+;; yc 9/25/2009 - move from port.plt to base.plt 
+(require (for-syntax scheme/base) 
+         scheme/match)
+
+;; convert an argument (and an optional argument) into an identifier
+;; p => p 
+;; (p v ...) => p 
+(define (arg->identifier stx)
+  (syntax-case stx ()
+    (p
+     (symbol? (syntax->datum #'p))
+     #'p)
+    ;; an optional arg.
+    ((p . _)
+     #'p)))
+
+;; (a (b v1) #:c (c v2)) => (a b c) 
+(define (args->identifiers stx)
+  (syntax-case stx () 
+    (()
+     #'())
+    ((p . rest)
+     (keyword? (syntax->datum #'p))
+     (args->identifiers #'rest))
+    ((p . rest)
+     #`(#,(arg->identifier #'p) . #,(args->identifiers #'rest)))))
+
+(define (args->kw+identifiers stx)
+  (syntax-case stx () 
+    (()
+     #'())
+    ((p . rest)
+     (keyword? (syntax->datum #'p))
+     #`(p . #,(args->identifiers #'rest)))
+    ((p . rest)
+     #`(#,(arg->identifier #'p) . #,(args->identifiers #'rest)))))
+
+(define (args->kw-identifiers stx)
+  (syntax-case stx () 
+    (()
+     #'())
+    ((p . rest) 
+     (keyword? (syntax->datum #'p))
+     #`(p . #,(args->identifiers #'rest)))
+    ((p . rest)
+     (args->kw-identifiers #'rest))))
+;; (trace args->kw-identifiers)
+
+(define (args->kw-args stx)
+  (syntax-case stx () 
+    (() 
+     #'())
+    ((p . rest)
+     (keyword? (syntax->datum #'p))
+     #'(p . rest))
+    ((p . rest)
+     (args->kw-args #'rest))))
+
+(define (args->non-kw-identifiers stx)
+  (syntax-case stx () 
+    (()
+     #'())
+    ((p . rest)
+     (keyword? (syntax->datum #'p))
+     #'())
+    ((p . rest)
+     #`(#,(arg->identifier #'p) . #,(args->non-kw-identifiers #'rest)))))
+
+(define (args->non-kw-args stx)
+  (syntax-case stx () 
+    (()
+     #'())
+    ((p . rest)
+     (keyword? (syntax->datum #'p))
+     #'())
+    ((p . rest)
+     #`(p . #,(args->non-kw-args #'rest)))))
+
+(provide arg->identifier 
+         args->identifiers 
+         args->kw+identifiers
+         args->kw-identifiers 
+         args->non-kw-identifiers
+         args->kw-args 
+         args->non-kw-args
+         )
+
+;;; typed args... 
+;;; a typed args look like an optional argument, except that 
+;;; it has the following: 
+;;; (id type?) (id type? default) 
+(define (typed-arg? stx)
+  (match (syntax->datum stx)
+    ((list (? symbol? _) _) #t)
+    ((list (? symbol? _) _ _) #t)
+    (else #f)))
+
+(define (typed-arg->arg stx)
+  (syntax-case stx () 
+    ((p type)
+     #'p)
+    ((p type default)
+     #'(p default))))
+
+(define (typed-args->args stx)
+  (syntax-case stx ()
+    (()
+     #'())
+    ((p . rest)
+     (keyword? (syntax->datum #'p))
+     #`(p . #,(typed-args->args #'rest)))
+    ((p . rest)
+     #`(#,(typed-arg->arg #'p) . #,(typed-args->args #'rest)))))
+
+(define (typed-arg->type stx)
+  (syntax-case stx () 
+    ((p type)
+     #'type)
+    ((p type default)
+     #'type)))
+
+(define (typed-args->types stx)
+  (syntax-case stx () 
+    (()
+     #'())
+    ((p . rest)
+     (keyword? (syntax->datum #'p))
+     (typed-args->types #'rest))
+    ((p . rest)
+     #`(#,(typed-arg->type #'p) . #,(typed-args->types #'rest)))))
+
+(provide typed-args->args
+         typed-args->types
+         typed-arg->arg
+         typed-arg->type
+         )
+
+
+
diff --git a/ebus-racket/3rdparty/bzlib/base/assert.ss b/ebus-racket/3rdparty/bzlib/base/assert.ss
new file mode 100644
index 0000000..aea9349
--- /dev/null
+++ b/ebus-racket/3rdparty/bzlib/base/assert.ss
@@ -0,0 +1,150 @@
+#lang scheme/base
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; BASE.plt 
+;; 
+;; 
+;; Bonzai Lab, LLC.  All rights reserved.
+;; 
+;; Licensed under LGPL.
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; assert.ss - utility for verifying result of the values... 
+;; yc 1/9/2010 - fixed let/assert! and let*/assert to allow for optional test function
+;; yc 2/10/2010 - move listof? to list.ss 
+(require (for-syntax scheme/base "args.ss")
+         "base.ss"
+         (only-in mzlib/etc identity)
+         (prefix-in c: scheme/contract)
+         )
+
+(define-struct (exn:assert! exn) (test? exp expected actual))
+
+(define (error/assert! test? exp expected actual (name 'assert!))
+  (raise (make-exn:assert! (if (not expected)
+                               (format "~a assert! (~a ~a); actual ~a" name test? exp actual)
+                               (format "~a assert! (~a ~a ~a); actual ~a" name test? exp expected actual))
+                           (current-continuation-marks) test? exp expected actual)))
+
+;; assert! v test? v2
+;; assert! v true? 
+;; assert! v v2 (use equal for comparison) => we can get rid of this form... 
+(define-syntax named-assert!
+  (syntax-rules () 
+    ((~ name exp test? expected)
+     (let ((actual exp))
+       (if (test? actual expected)
+           actual
+           (error/assert! 'test? 'exp 'expected actual 'name))))
+    ((~ name exp test?)
+     (let ((actual exp))
+       (if (test? actual)
+           actual
+           (error/assert! 'test? 'exp #f actual 'name))))
+    ((~ name exp)
+     (named-assert! name exp identity))
+    ))
+
+(define-syntax assert!
+  (syntax-rules () 
+    ((~ args ...)
+     (named-assert! assert! args ...))))
+
+
+(define-syntax let/assert!
+  (syntax-rules () 
+    ((~ ((id test? arg) ...) exp exp2 ...)
+     (let/assert! let/assert! ((id test? arg) ...) exp exp2 ...))
+    ((~ name ((id test? arg) ...) exp exp2 ...)
+     (let ((id arg) ...)
+       (let ((id (named-assert! name id test?)) ...) exp exp2 ...)))
+    ((~ ((id arg) ...) exp exp2 ...)
+     (let/assert! let/assert! ((id identity arg) ...) exp exp2 ...))
+    ((~ name ((id arg) ...) exp exp2 ...) 
+     (let/assert! name ((id identity arg) ...) exp exp2 ...)) 
+    ))
+
+(define-syntax let*/assert! 
+  (syntax-rules ()
+    ((~ name () exp exp2 ...)
+     (begin exp exp2 ...))
+    ((~ ((id test? arg) ...) exp exp2 ...)
+     (let*/assert! let*/assert! ((id test? arg) ...) exp exp2 ...))
+    ((~ name ((id test? arg) rest ...) exp exp2 ...)
+     (let/assert! name ((id test? arg))
+                  (let*/assert! name (rest ...) exp exp2 ...)))
+    ((~ ((id arg) ...) exp exp2 ...)
+     (let*/assert! ((id identity arg) ...) exp exp2 ...))
+    ((~ name ((id arg) ...) exp exp2 ...) 
+     (let*/assert! name ((id identity arg) ...) exp exp2 ...))
+    ))
+
+(define-syntax (lambda/assert! stx)
+  (syntax-case stx () 
+    ((~ name (a1 ... rest-id rest-type) exp exp2 ...) 
+     (and (symbol? (syntax->datum #'name)) 
+          (symbol? (syntax->datum #'rest-id)))
+     (with-syntax (((arg ...)
+                    (typed-args->args #'(a1 ...)))
+                   ((id ...)
+                    (args->identifiers #'(a1 ...)))
+                   ((type ...)
+                    (typed-args->types #'(a1 ...)))
+                   )
+       #'(lambda (arg ... . rest-id) 
+           (let/assert! name ((id type id) ...
+                              (rest-id rest-type rest-id))
+                        exp exp2 ...))))
+    ((~ name (a1 ...) exp exp2 ...) 
+     (symbol? (syntax->datum #'name)) 
+     (with-syntax (((arg ...)
+                    (typed-args->args #'(a1 ...)))
+                   ((id ...)
+                    (args->identifiers #'(a1 ...)))
+                   ((type ...)
+                    (typed-args->types #'(a1 ...)))
+                   )
+       #'(lambda (arg ...) ;; this is the general idea.. but this general idea doesn't fully work... 
+           (let/assert! name ((id type id) ...)
+                        exp exp2 ...))))
+    ((~ (a1 ...) exp exp2 ...)
+     #'(~ lambda/assert! (a1 ...) exp exp2 ...))
+    ))
+  
+(define-syntax define/assert!
+  (syntax-rules () 
+    ((~ (name . args) exp exp2 ...)
+     (define name 
+       (lambda/assert! name args exp exp2 ...)))))
+
+(provide define/assert!
+         lambda/assert!
+         let*/assert!
+         let/assert!
+         assert!
+         named-assert!
+         )
+
+(c:provide/contract
+ (struct exn:assert! ((message string?)
+                      (continuation-marks continuation-mark-set?)
+                      (test? c:any/c)
+                      (exp c:any/c)
+                      (expected c:any/c)
+                      (actual c:any/c)))
+ (error/assert! (c:->* (c:any/c c:any/c c:any/c c:any/c)
+                     (symbol?)
+                     c:any))
+ )
+
+#|
+;; if I want to define a contract... with the following form it can become quite complicated!!! 
+
+;; we can also guard the arguments @ regular lamda and also let statement... 
+;; guarding the arguments...
+(define/assert! (foo (a number?) (b number? 5) #:c (c number? 5))
+    (+ a b c))
+
+(define/assert! (foo2 (a number?) (b number? 10) . (rest (listof? number?)))
+  (apply + a b rest))
+(let/assert! ((a number? 3) (b number? 'abc)) 
+             (+ a b))
+;;|#
\ No newline at end of file
diff --git a/ebus-racket/3rdparty/bzlib/base/base.ss b/ebus-racket/3rdparty/bzlib/base/base.ss
new file mode 100644
index 0000000..6ec8496
--- /dev/null
+++ b/ebus-racket/3rdparty/bzlib/base/base.ss
@@ -0,0 +1,211 @@
+#lang scheme/base
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; BASE.plt - common routines that are shared by all other bzlib modules 
+;; 
+;; in a way, base.plt is the most fundamental module of the whole bzlib stack
+;; and as such it also is the lowest level code.  We are not likely to 
+;; fix the code any time soon, and hence any of the functions here are 
+;; explicitly likely to be obsoleted or moved elsewhere. 
+;; 
+;; Proceed with caution. 
+;; 
+;; 
+;; Bonzai Lab, LLC.  All rights reserved.
+;; 
+;; Licensed under LGPL.
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; base.ss - basic functionalities that do not belong anywhere else.
+;; yc 9/8/2009 - first version 
+;; yc 9/25/2009 - moved assert! & let/assert! to assert.ss 
+;; yc 1/12/2010 - add let*/if 
+;; yc 2/5/2010 - add define-case-test & case/equal? & case/string-ci=?
+;; yc 2/13/2010 - add isa/c 
+(require (for-syntax scheme/base)
+         scheme/list
+         scheme/port
+         mzlib/etc
+         mzlib/trace
+         scheme/contract
+         scheme/function 
+         )
+
+(define-syntax (trace-lambda stx)
+  (syntax-case stx ()
+    ((~ args exp exp2 ...)
+     #'(letrec ((func
+                 (lambda args exp exp2 ...)))
+         (trace func)
+         func))))
+
+(define-syntax (if-it stx)
+  (syntax-case stx ()
+    [(src-if-it test then else)
+     (syntax-case (datum->syntax (syntax src-if-it) 'it) ()
+       [it (syntax (let ([it test]) (if it then else)))])]))
+
+(define-syntax (when-it stx)
+  (syntax-case stx ()
+    ((~ test? exp exp2 ...)
+     (with-syntax ((it (datum->syntax #'~ 'it)))
+       #'(let ((it test?)) (when it exp exp2 ...))))))
+
+(define-syntax (cond-it stx)
+  (syntax-case stx (else)
+    ((cond-it (else exp exp2 ...))
+     #'(begin exp exp2 ...))
+    ((cond-it (test? exp exp2 ...))
+     (with-syntax ((it (datum->syntax #'cond-it 'it)))
+       #'(let ((it test?)) (when it exp exp2 ...))))
+    ((cond-it (test? exp exp2 ...) cond cond2 ...)
+     (with-syntax ((it (datum->syntax #'cond-it 'it)))
+       #'(let ((it test?))
+           (if it (begin exp exp2 ...)
+               (cond-it cond cond2 ...)))))))
+
+(define-syntax while
+  (syntax-rules ()
+    ((while test exp exp2 ...)
+     (let loop ()
+       (when test
+         exp exp2 ...
+         (loop))))
+    ))
+
+(define-syntax let*/if 
+  (syntax-rules () 
+    ((~ ((arg val)) exp exp2 ...) 
+     (let ((arg val)) 
+       (if (not arg) 
+           #f
+           (begin exp exp2 ...))))
+    ((~ ((arg val) (arg-rest val-rest) ...) exp exp2 ...) 
+     (let ((arg val)) 
+       (if (not arg) 
+           #f 
+           (let*/if ((arg-rest val-rest) ...) exp exp2 ...))))))
+
+(define-syntax case/pred?
+  (syntax-rules (else) 
+    ((~ pred? (else exp exp2 ...))
+     (begin exp exp2 ...))
+    ((~ pred? ((d d2 ...) exp exp2 ...))
+     (when (ormap pred? (list d d2 ...))
+       exp exp2 ...))
+    ((~ pred? ((d d2 ...) exp exp2 ...) rest ...)
+     (if (ormap pred? (list d d2 ...))
+         (begin exp exp2 ...)
+         (case/pred? pred? rest ...)))))
+
+(define-syntax define-case/test?
+  (syntax-rules () 
+    ((~ name test?)
+     (define-syntax name 
+       (syntax-rules ()
+         ((~ v clause clause2 (... ...))
+          (case/pred? (curry test? v) clause clause2 (... ...)))))
+    )))
+
+
+(define-case/test? case/equal? equal?)
+(define-case/test? case/string-ci=? string-ci=?)
+
+;;|#
+
+;; (trace load-proc)
+;; a generic version of apply & keyword-apply that requires
+;; no sorting of the parameter args... 
+(define (apply* proc . args)
+  (define (filter-kws args (acc '()))
+    (cond ((null? args) (reverse acc))
+          ((keyword? (car args))
+           (filter-kws (cdr args) (cons (car args) acc)))
+          (else
+           (filter-kws (cdr args) acc))))
+  (define (filter-kw-vals args (acc '()))
+    (cond ((null? args) (reverse acc))
+          ((keyword? (car args))
+           (if (null? (cdr args)) ;; this is wrong!!!
+               (error 'kw-apply "keyword ~a not followed by a value" (car args))
+               (filter-kw-vals (cddr args) (cons (cadr args) acc))))
+          (else
+            (filter-kw-vals (cdr args) acc))))
+   (define (filter-non-kw-vals args (acc '()))
+     (cond ((null? args) (reverse acc))
+           ((keyword? (car args))
+            (if (null? (cdr args))
+                (error 'kw-apply "keyword ~a not followed by a value" (car args))
+                (filter-non-kw-vals (cddr args) acc)))
+           (else
+            (filter-non-kw-vals (cdr args) (cons (car args) acc)))))
+   (define (sorted-kw+args args)
+     (let ((kw+args (sort (map (lambda (kw vals)
+                                 (cons kw vals))
+                               (filter-kws args)
+                               (filter-kw-vals args))
+                          (lambda (kv kv1)
+                            (keyword<? (car kv) (car kv1))))))
+       (values (map car kw+args) (map cdr kw+args))))
+   (define (normalize-args args)
+     (cond ((list? (last args))
+            (apply list* args))
+           (else (error 'apply* "Expect last arg as a list, given ~a" (last args)))))
+   (let ((args (normalize-args args)))
+     (let-values (((kws vals)
+                   (sorted-kw+args args)))
+       (keyword-apply proc kws vals
+                      (filter-non-kw-vals args)))))
+
+
+
+(define (value-or v (default #f))
+  (if (not v) default v))
+
+(define (null-or v (default #f))
+  (if (null? v) default v))
+
+(define (thunk? p)
+  (and (procedure? p)
+       (let ((a (procedure-arity p)))
+         (cond ((arity-at-least? a)
+                (= (arity-at-least-value a) 0))
+               ((number? a) (= a 0))
+               ((list? a) (member 0 a))))))
+
+;; isa/c 
+;; this is useful but I did not include it until a bit too late... hmm... 
+(define isa/c (-> any/c any))
+
+(define (typeof/c contract)
+  (-> contract any))
+
+(provide (all-from-out mzlib/etc
+                       scheme/function
+                       )
+         trace-lambda
+         if-it
+         when-it
+         cond-it
+         while
+         let*/if
+         case/pred?
+         define-case/test?
+         case/equal?
+         case/string-ci=?
+         isa/c
+         typeof/c
+         )
+
+
+(provide/contract
+ (apply* (->* (procedure?)
+              ()
+              #:rest (listof any/c)
+              any))
+ (value-or (->* (any/c)
+                (any/c)
+                any))
+ (null-or (->* (any/c)
+               (any/c)
+               any))
+ (thunk? (-> any/c boolean?))
+ )
diff --git a/ebus-racket/3rdparty/bzlib/base/bytes.ss b/ebus-racket/3rdparty/bzlib/base/bytes.ss
new file mode 100644
index 0000000..0edab66
--- /dev/null
+++ b/ebus-racket/3rdparty/bzlib/base/bytes.ss
@@ -0,0 +1,206 @@
+#lang scheme/base
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; BASE.plt - common routines that are shared by all other bzlib modules 
+;; 
+;; in a way, base.plt is the most fundamental module of the whole bzlib stack
+;; and as such it also is the lowest level code.  We are not likely to 
+;; fix the code any time soon, and hence any of the functions here are 
+;; explicitly likely to be obsoleted or moved elsewhere. 
+;; 
+;; Proceed with caution. 
+;; 
+;; 
+;; Bonzai Lab, LLC.  All rights reserved.
+;; 
+;; Licensed under LGPL.
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; bytes.ss - provides utility functions that works with bytes 
+;; yc 10/19/2009 - first version 
+;; yc 10/23/2009 - add read-bytes-avail that'll return the currently available bytes 
+;; yc 10/24/2009 - add read-byte-list & read-byte-list/timeout 
+;; yc 1/18/2010 - fix the issue that call-with-output-bytes was not available until v > 4.2
+;; yc 2/5/2010 - added string-char-ratios for accurately determien the ratio of ascii/latin-1/unicode chars 
+(require scheme/port scheme/contract "version-case.ss" "base.ss")
+
+;; call-with-output-bytes is not available until 4.1 
+(define *call-with-output-bytes 
+  (+:version>= "4.2" 
+               call-with-output-bytes
+               (lambda (proc)
+                 (let ((out (open-output-bytes))) 
+                   (dynamic-wind void 
+                                 (lambda () 
+                                   (proc out)) 
+                                 (lambda () 
+                                   (get-output-bytes out)))))))
+
+(define (port->bytes/charset in charset-in charset-out)
+  (*call-with-output-bytes 
+   (lambda (out)
+     (convert-stream charset-in in charset-out out))))
+
+(define (bytes->bytes/charset bytes charset-in charset-out)
+  (port->bytes/charset (open-input-bytes bytes) charset-in charset-out))
+
+(define (bytes/charset->bytes/utf-8 bytes charset)
+  (bytes->bytes/charset bytes charset "utf-8")) 
+
+(define (bytes/utf-8->bytes/charset bytes charset)
+  (bytes->bytes/charset bytes "utf-8" charset))
+
+;; there are more to handle (specifically charsets).
+(define (bytes/charset->string bytes charset)
+  (bytes->string/utf-8 (bytes/charset->bytes/utf-8 bytes charset)))
+
+(define (string->bytes/charset string charset)
+  (bytes/utf-8->bytes/charset (string->bytes/utf-8 string) charset))
+
+(define (char-latin-1? c)
+  (< 0 (char->integer c) 256))
+
+(define (char-ascii? c)
+  (< 0 (char->integer c) 128))
+
+(define (string-char-or? s test?)
+  (define (helper len i)
+    (if (= len i) #f
+        (if (test? (string-ref s i)) #t
+            (helper len (add1 i)))))
+  (helper (string-length s) 0)) 
+
+(define (string-char-and? s test?)
+  (define (helper len i)
+    (if (= len i) #t
+        (if (not (test? (string-ref s i))) #f
+            (helper len (add1 i)))))
+  (helper (string-length s) 0))
+
+(define (char-type c)
+  (let ((i (char->integer c))) 
+    (cond ((< i 128) 'ascii)
+          ((< i 256) 'latin-1)
+          (else 'unicode))))
+
+(define (string-char-ratios s) 
+  (define (helper ascii latin-1 unicode i len)
+    (if (= i len)
+        (values (/ ascii len)
+                (/ latin-1 len)
+                (/ unicode len))
+        (case (char-type (string-ref s i))
+          ((ascii) (helper (add1 ascii) latin-1 unicode (add1 i) len))
+          ((latin-1) (helper ascii (add1 latin-1) unicode (add1 i) len))
+          (else (helper ascii latin-1 (add1 unicode) (add1 i) len)))))
+  (if (= (string-length s) 0) 
+      (values 1 0 0)
+      (helper 0 0 0 0 (string-length s))))
+
+(define (string-type s)
+  (define (helper len i prev)
+    (if (= len i) prev
+        (let ((type (char-type (string-ref s i))))
+          (case type 
+            ((unicode) type)
+            ((latin-1) 
+             (helper len (add1 i) (case prev
+                                    ((ascii) type)
+                                    (else prev))))
+            (else (helper len (add1 i) prev))))))
+  (helper (string-length s) 0 'ascii))
+
+(define (string-latin-1? s)
+  (string-char-and? s char-latin-1?))
+
+(define (string-ascii? s)
+  (string-char-and? s char-ascii?))
+
+(define (char->bytes c)
+  (string->bytes/utf-8 (string c)))
+
+(define (split-string-by-bytes-count str num)
+  (define (maker chars)
+    (list->string (reverse chars)))
+  (define (helper str i chars blen acc)
+    (if (= i (string-length str)) ;; we are done here!!!... 
+        (reverse (if (null? chars) acc
+                     (cons (maker chars) acc)))
+        (let* ((c (string-ref str i))
+               (count (char-utf-8-length c))) 
+          (if (> (+ count blen) num) ;; we are done with this version....
+              (if (= blen 0) ;; this means the character itself is greater than the count.  
+                  (helper str (add1 i) '() 0 (cons (maker (cons c chars)) acc))
+                  (helper str i '() 0 (cons (maker chars) acc)))
+              (helper str (add1 i) (cons c chars) (+ count blen) acc)))))
+  (helper str 0 '() 0 '()))
+
+(define (read-bytes-avail num in)
+  (define (helper bytes)
+    (let ((len (read-bytes-avail!* bytes in 0 num)))
+      (cond ((eof-object? len) bytes)
+            ((number? len) (subbytes bytes 0 len))
+            (else ;; this is a *special* value... I don't know what to do with it yet...                                                                        
+             (len)))))
+  (helper (make-bytes num 0)))
+
+(define (read-byte-list num in)
+  (define (helper bytes)
+    (if (eof-object? bytes)
+        bytes
+        (bytes->list bytes)))
+  (helper (read-bytes num in)))
+
+(define (read-byte-list/timeout num in (timeout #f))
+  (define (helper alarm acc count)
+    (let ((evt (sync alarm in))) 
+      (if (eq? alarm evt)
+          (reverse acc)
+          (let ((b (read-byte in))) 
+            (cond ((eof-object? b) 
+                   (if (null? acc) 
+                       b
+                       (reverse acc)))
+                  ((= (add1 count) num)
+                   (reverse (cons b acc)))
+                  (else
+                   (helper alarm (cons b acc) (add1 count))))))))
+  (helper (alarm-evt (+ (current-inexact-milliseconds) (* 1000 (if (not timeout)
+                                                                   +inf.0
+                                                                   timeout)))) '() 0))
+
+(define (read-bytes/timeout num in (timeout #f))
+  (define (helper bytes)
+    (if (eof-object? bytes) 
+        bytes
+        (list->bytes bytes))) 
+  (helper (read-byte-list/timeout num in timeout))) 
+
+(define (positive-number? n)
+  (and (number? n) (> n 0))) 
+
+(provide/contract
+ (char-ascii? (typeof/c char?))
+ (char-latin-1? (typeof/c char?)) 
+ (string-char-or? (-> string? (-> char? any) any)) 
+ (string-char-and? (-> string? (-> char? any) any)) 
+ (string-latin-1? (typeof/c string?)) 
+ (string-ascii? (typeof/c string?)) 
+ (char-type (typeof/c char?)) 
+ (string-char-ratios (-> string? (values number? number? number?)))
+ (string-type (typeof/c string?))
+ (split-string-by-bytes-count (-> string? exact-positive-integer? (listof string?)))
+ (port->bytes/charset (-> input-port? string? string? any)) 
+ (bytes->bytes/charset (-> bytes? string? string? bytes?))
+ (bytes/charset->bytes/utf-8 (-> bytes? string? bytes?))
+ (bytes/utf-8->bytes/charset (-> bytes? string? bytes?))
+ (bytes/charset->string (-> bytes? string? string?))
+ (string->bytes/charset (-> string? string? bytes?)) 
+ (read-bytes-avail (-> exact-positive-integer? input-port? bytes?))
+ (read-byte-list (-> exact-positive-integer? input-port? bytes?)) 
+ (read-bytes/timeout (->* (exact-positive-integer? input-port?)
+                          ((or/c #f positive-number?))
+                          bytes?))
+ (read-byte-list/timeout (->* (exact-positive-integer? input-port?)
+                               ((or/c #f positive-number?)) 
+                               any))
+ )
+
diff --git a/ebus-racket/3rdparty/bzlib/base/info.ss b/ebus-racket/3rdparty/bzlib/base/info.ss
new file mode 100644
index 0000000..f07b881
--- /dev/null
+++ b/ebus-racket/3rdparty/bzlib/base/info.ss
@@ -0,0 +1,27 @@
+#lang setup/infotab
+(define name "bzlib/base: common utilities for bzlib")
+
+(define blurb
+  '((p "bzlib/base provides the common utilities that other bzlib packages depend on. Currently this package's interface might drastically change and will not be directly supported until it stablizes.")))
+
+(define release-notes
+  '((p "0.6 (1 6) - fixed syntax-identifier-append, added registry-clear!")
+    (p "0.5 (1 5) - adding read-bytes-avail, read-byte-list, read-byte-list/timeout, read-bytes/timeout, version.ss, version-case.ss, fixed let/assert!, added let*/assert, fixed bytes.ss needing (version) >= 4.1, added let*/if, added isa/c & typeof/c")
+    (p "0.4 (1 3) - adding bytes.ss & require.ss & syntax.ss (args.ss, assert.ss, syntax.ss, & require.ss are likely to be moved to another package)")
+    (p "0.3 (1 2) - added assert.ss, args.ss, and refactored group to here from dbd-memcached")
+    (p "0.2 (1 1) - added assert! & let/assert!")
+    (p "0.1 (1 0) - first release")))
+
+(define categories
+  '(devtools net misc))
+
+(define homepage "http://weblambda.blogspot.com")
+
+(define required-core-version "4.0")
+
+(define version "0.6")
+
+(define repositories '("4.x"))
+
+(define primary-file "main.ss")
+
diff --git a/ebus-racket/3rdparty/bzlib/base/list.ss b/ebus-racket/3rdparty/bzlib/base/list.ss
new file mode 100644
index 0000000..44b64f0
--- /dev/null
+++ b/ebus-racket/3rdparty/bzlib/base/list.ss
@@ -0,0 +1,109 @@
+
+#lang scheme/base
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; BASE.plt - common routines that are shared by all other bzlib modules 
+;; 
+;; in a way, base.plt is the most fundamental module of the whole bzlib stack
+;; and as such it also is the lowest level code.  We are not likely to 
+;; fix the code any time soon, and hence any of the functions here are 
+;; explicitly likely to be obsoleted or moved elsewhere. 
+;; 
+;; Proceed with caution. 
+;; 
+;; 
+;; Bonzai Lab, LLC.  All rights reserved.
+;; 
+;; Licensed under LGPL.
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; list.ss - basic functionalities that has to do with list processing.
+;; yc 9/8/2009 - first version 
+;; yc 9/25/2009 - moved group from bzlib/dbd-memcached/dht to here; exported scheme/list 
+;; yc 2/10/2010 - move listof? from assert.ss (not sure why it was there) to list.ss 
+(require "base.ss" scheme/list scheme/contract)
+
+(define (assoc/cdr key alist (default #f))
+  (if-it (assoc key alist)
+         (cdr it)
+         default))
+
+(define (assoc/s key alist (default '()))
+  (let ((it (filter (lambda (kv)
+                      (equal? (car kv) key))
+                    alist)))
+    (if (null? it) default it)))
+
+;; this function is a combo of member & assoc
+;; it's useful when we have a malformed alist, where when the
+;; pair has no value, the key is retained
+;; (or when there is no key, the value is retained)
+(define (assoc* key lst (default #f))
+  (define (helper rest)
+    (cond ((null? rest) default)
+          ;; assoc behavior
+          ((and (pair? (car rest))
+                (equal? key (caar rest)))
+           (car rest))
+          ;; member behavior
+          ((and (not (pair? (car rest)))
+                (equal? key (car rest)))
+           rest)
+          (else
+           (helper (cdr rest)))))
+  ;; (trace helper)
+  (helper lst))
+
+(define (assoc*/cdr key lst (default #f))
+  (if-it (assoc* key lst)
+         (cdr it)
+         default))
+
+
+(define (group alist)
+  ;; for each alist with the same key - group them together!!
+  (foldl (lambda (kv interim)
+           (if-it (assoc (car kv) interim) ;; the key already exists...
+               (cons (cons (car it) (cons (cdr kv) (cdr it)))
+                     (filter (lambda (kv)
+                               (not (equal? it kv))) interim))
+               (cons (list (car kv) (cdr kv)) interim)))
+         '()
+         alist))
+
+
+(define (list->unique lst (equal? equal?))
+  (reverse (foldl (lambda (item interim)
+                    (if (memf (lambda (item1)
+                                (equal? item item1))
+                              interim)
+                        interim
+                        (cons item interim)))
+                  '()
+                  lst)))
+
+(define (listof? type?)
+  (lambda (args)
+    (and (list? args)
+         (andmap type? args))))
+
+
+(provide/contract 
+ (assoc/cdr (->* (any/c list?)
+                 (any/c)
+                 any))
+ (assoc/s (->* (any/c list?)
+               (any/c)
+               any))
+ (assoc* (->* (any/c list?)
+              (any/c)
+              any))
+ (assoc*/cdr (->* (any/c list?)
+                  (any/c)
+                  any))
+ (group (-> (or/c null? pair?) any))
+ (list->unique (->* (pair?)
+                    (procedure?)
+                    any))
+ (listof? (-> isa/c isa/c))
+ )
+(provide (all-from-out scheme/list))
+
diff --git a/ebus-racket/3rdparty/bzlib/base/main.ss b/ebus-racket/3rdparty/bzlib/base/main.ss
new file mode 100644
index 0000000..b722783
--- /dev/null
+++ b/ebus-racket/3rdparty/bzlib/base/main.ss
@@ -0,0 +1,49 @@
+#lang scheme/base
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; BASE.plt - common routines that are shared by all other bzlib modules 
+;; 
+;; in a way, base.plt is the most fundamental module of the whole bzlib stack
+;; and as such it also is the lowest level code.  We are not likely to 
+;; fix the code any time soon, and hence any of the functions here are 
+;; explicitly likely to be obsoleted or moved elsewhere. 
+;; 
+;; Proceed with caution. 
+;; 
+;; 
+;; Bonzai Lab, LLC.  All rights reserved.
+;; 
+;; Licensed under LGPL.
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; main.ss - provide all other modules... 
+;; yc 9/8/2009 - first version 
+;; yc 9/11/2009 - added uuid.ss
+;; yc 9/25/2009 - added assert.ss & move args.ss from port.plt 
+;; yc 10/13/2009 - adding bytes.ss 
+;; yc 10/19/2009 - adding require.ss & syntax.ss (it seems that all syntax-based files can be splitted away)... 
+;; yc 1/18/2010 - added version.ss & version-case.ss 
+(require "args.ss"
+         "assert.ss"
+         "base.ss"
+         "bytes.ss"
+         "list.ss"
+         "registry.ss"
+         "require.ss"
+         "syntax.ss"
+         "text.ss"
+         "uuid.ss"
+         "version.ss"
+         "version-case.ss"
+         )
+(provide (all-from-out "args.ss"
+                       "assert.ss"
+                       "base.ss"
+                       "bytes.ss"
+                       "list.ss"
+                       "registry.ss"
+                       "require.ss"
+                       "syntax.ss"
+                       "text.ss"
+                       "uuid.ss"
+                       "version.ss"
+                       "version-case.ss"
+                       ))
diff --git a/ebus-racket/3rdparty/bzlib/base/registry.ss b/ebus-racket/3rdparty/bzlib/base/registry.ss
new file mode 100644
index 0000000..d0b0c72
--- /dev/null
+++ b/ebus-racket/3rdparty/bzlib/base/registry.ss
@@ -0,0 +1,215 @@
+#lang scheme/base 
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; BASE.plt - common routines that are shared by all other bzlib modules 
+;; 
+;; in a way, base.plt is the most fundamental module of the whole bzlib stack
+;; and as such it also is the lowest level code.  We are not likely to 
+;; fix the code any time soon, and hence any of the functions here are 
+;; explicitly likely to be obsoleted or moved elsewhere. 
+;; 
+;; Proceed with caution. 
+;; 
+;; 
+;; Bonzai Lab, LLC.  All rights reserved.
+;; 
+;; Licensed under LGPL.
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; registry.ss - generalized key/value access (including an extensible condition object)
+;; yc 9/8/2009 - first version 
+;; yc 7/7/2010 - add registry-clear! & modified registry definition. 
+(require mzlib/pconvert-prop
+         scheme/port
+         scheme/string
+         scheme/contract
+         "base.ss"
+         )
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; registry
+;; a abstraction over key/value pairs 
+
+(define-struct registry (get set del make (table #:mutable)))
+
+(define (registry-set! reg key val)
+  (set-registry-table! reg
+                     ((registry-set reg) (registry-table reg) key val)))
+
+(define (registry-del! reg key)
+  (set-registry-table! reg
+                     ((registry-del reg) (registry-table reg) key)))
+
+(define (registry-ref reg key (default #f))
+  ((registry-get reg) (registry-table reg) key default))
+;; (trace registry-ref)
+
+(define (registry-clear! reg) ;; clearing the registry... we need to fill it with a default value, of course. 
+  ;; that means we need a way to get the default value... does that mean we will have to empty out the whole value... 
+  ;; is there a way to do so without adding a new field? 
+  ;; it is completely unclear... hmm... 
+  ;; a hash's function is make-hash... 
+  ;; an immutable-hash's function is make-immutable-hash-helper... 
+  ;; an assoc's function
+  (set-registry-table! reg ((registry-make reg))))
+  
+
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; make-hash-registry
+(define (make-hash-registry (hash (make-hash)))
+  (define (set hash key val)
+    (hash-set! hash key val)
+    hash)
+  (define (del hash key)
+    (hash-remove! hash key)
+    hash)
+  (define (make (value (make-hash)))
+    (cond ((hash? value) value) 
+          ((list? value)
+           (let ((h (make-hash))) 
+             (for-each (lambda (kv)
+                         (hash-set! h (car kv) (cdr kv)))
+                       value)
+             h))
+          (else (error 'make-hash-unknown-input "~a" value))))
+  (make-registry hash-ref set del make (make hash)))
+
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; make-immutable-hash-registry
+(define (make-immutable-hash-registry (hash (make-immutable-hash '())))
+  (define (make (value (make-immutable-hash '())))
+    (cond ((and (immutable? value) (hash? value)) value)
+          ((hash? value) (make-immutable-hash (hash-map value cons)))
+          ((list? value) (make-immutable-hash value))
+          (else (error 'make-immutable-hash-unknown-input "~a" value))))
+  (make-registry hash-ref hash-set hash-remove make (make hash)))
+
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; make-assoc-registry (not thread safe if multiple addition & deletion)
+;; let's also a list registry via assoc.
+(define (assoc-ref lst key (default #f))
+  (define (assoc/cdr key value (default #f))
+    (let ((value (assoc key value)))
+      (if (not value) default
+          (cdr value))))
+  (assoc/cdr key lst default))
+;; (trace assoc-ref)
+;; if we just want to remove the first guy with the key... how to do that? not with filter.
+
+(define (assoc-del lst key)
+  (define (helper k kv)
+    (equal? k (car kv)))
+  ;; (trace helper)
+  (remove key lst helper))
+
+(define (assoc-set lst key val)
+  (let ((exists? #f))
+    (let ((lst (map (lambda (kv)
+                      (cons (car kv)
+                            (cond ((equal? (car kv) key)
+                                   (set! exists? #t)
+                                   val)
+                                  (else (cdr kv)))))
+                    lst)))
+      (if exists? lst
+          (cons (cons key val) lst)))))
+
+(define (make-list (lst '())) 
+    (if (list? lst) 
+        lst 
+        (error 'make-assoc-list-unknown-input "~a" lst)))
+
+(define (make-assoc-registry (lst '()))
+  (make-registry assoc-ref assoc-set assoc-del make-list (make-list lst)))
+
+;; what can be passed into ? it must be a list of lists.
+(define (list->assoc-registry lst)
+  (define (helper kvs)
+    (cons (car kvs)
+          (make-assoc-registry (cdr kvs))))
+  ;; (trace helper)
+  (make-assoc-registry (map helper lst)))
+
+(define (assoc-registry->list reg)
+  (map (lambda (kv)
+         (cons (car kv)
+               (registry-table (cdr kv))))
+       (registry-table reg)))
+
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; cond-registry (takes in a cond & result pair).
+(define (cond-ref lst key (default #f))
+  (let ((it (assf (lambda (cond)
+                    (cond key)) lst)))
+    (if (not it) default
+        (cdr it))))
+
+(define (make-cond-registry (lst '()))
+  (make-registry cond-ref assoc-set assoc-del make-list (make-list lst)))
+
+(provide/contract
+ (struct registry ((get (->* (any/c any/c)
+                             (any/c)
+                             any))
+                   (set (-> any/c any/c any/c any))
+                   (del (-> any/c any/c any))
+                   (make (->* () 
+                              (any/c) 
+                              any/c))
+                   (table any/c)))
+ (registry-ref (->* (registry? any/c)
+                    (any/c)
+                    any))
+ (registry-set! (-> registry? any/c any/c any))
+ (registry-del! (-> registry? any/c any))
+ (registry-clear! (-> registry? any))
+ (make-hash-registry (->* ()
+                          ((or/c list? hash?))
+                          registry?))
+ (make-immutable-hash-registry (->* ()
+                                    ((or/c list? (and/c immutable? hash?)))
+                                    registry?))
+ (assoc-ref (->* (list? any/c)
+                 (any/c)
+                 any))
+ (assoc-set (-> list? any/c any/c any))
+ (assoc-del (-> list? any/c any))
+ (make-assoc-registry (->* ()
+                           (list?)
+                           registry?))
+ (list->assoc-registry (-> list? registry?))
+ (assoc-registry->list (-> registry? list?))
+ (make-cond-registry (->* ()
+                          (list?)
+                          registry?))
+ )
+
+;; let's see how something can be flushed...
+(define (registry->out reg out)
+  (write (registry-table reg) out))
+
+(define (registry->string reg)
+  (let ((out (open-output-bytes)))
+    (registry->out reg out)
+    (get-output-string out)))
+
+(define (in->registry in)
+  (let ((value (read in)))
+    (cond ((list? value)
+           (make-assoc-registry value))
+          ((and (hash? value) (immutable? value))
+           (make-immutable-hash-registry value))
+          ((hash? value)
+           (make-hash-registry value))
+          ((eof-object? value)
+           (make-assoc-registry))
+          (else
+           (error 'in->registry "unknown registry type ~a" value)))))
+
+(define (string->registry string)
+  (in->registry (open-input-string string)))
+
+(provide/contract
+ (registry->out (-> registry? output-port? any))
+ (registry->string (-> registry? string?))
+ (in->registry (-> input-port? registry?))
+ (string->registry (-> string? registry?))
+ )
+
diff --git a/ebus-racket/3rdparty/bzlib/base/require.ss b/ebus-racket/3rdparty/bzlib/base/require.ss
new file mode 100644
index 0000000..fced045
--- /dev/null
+++ b/ebus-racket/3rdparty/bzlib/base/require.ss
@@ -0,0 +1,32 @@
+#lang scheme/base
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; BASE.plt - common routines that are shared by all other bzlib modules 
+;; 
+;; in a way, base.plt is the most fundamental module of the whole bzlib stack
+;; and as such it also is the lowest level code.  We are not likely to 
+;; fix the code any time soon, and hence any of the functions here are 
+;; explicitly likely to be obsoleted or moved elsewhere. 
+;; 
+;; Proceed with caution. 
+;; 
+;; 
+;; Bonzai Lab, LLC.  All rights reserved.
+;; 
+;; Licensed under LGPL.
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; require.ss - require-like syntaxes 
+;; yc 10/19/2009 - first version 
+(require (for-syntax scheme/base "syntax.ss")
+         )
+
+(define-syntax (provide/strip-prefix stx)
+  (syntax-case stx () 
+    ((~ prefix out ...) 
+     (with-syntax (((in ...)
+                    (syntax-map (lambda (s)
+                                  (syntax-identifier-append #'prefix s))
+                                #'(out ...))))
+       #'(provide (rename-out (in out) ...))))))
+
+(provide provide/strip-prefix)
+
diff --git a/ebus-racket/3rdparty/bzlib/base/syntax.ss b/ebus-racket/3rdparty/bzlib/base/syntax.ss
new file mode 100644
index 0000000..a5fbb27
--- /dev/null
+++ b/ebus-racket/3rdparty/bzlib/base/syntax.ss
@@ -0,0 +1,62 @@
+#lang scheme/base
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; BASE.plt - common routines that are shared by all other bzlib modules 
+;; 
+;; in a way, base.plt is the most fundamental module of the whole bzlib stack
+;; and as such it also is the lowest level code.  We are not likely to 
+;; fix the code any time soon, and hence any of the functions here are 
+;; explicitly likely to be obsoleted or moved elsewhere. 
+;; 
+;; Proceed with caution. 
+;; 
+;; 
+;; Bonzai Lab, LLC.  All rights reserved.
+;; 
+;; Licensed under LGPL.
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; synatx.ss - syntax helpers
+;; yc 10/19/2009 - first version 
+;; yc 7/6/2010 - fixed syntax-identifier-append 
+(require (for-syntax scheme/base)
+          syntax/stx scheme/string mzlib/trace
+          scheme/contract
+          )
+
+(define (syntax-map proc stx-lst)
+  (syntax-case stx-lst ()
+    (() #'())
+    ((id . rest) 
+     #`(#,(proc #'id) . #,(syntax-map proc #'rest)))))
+
+(define (syntax-identifier-append arg #:stx (stx #f) . args)
+  (define (get-first-syntax lst)
+    (define (helper lst)
+      (cond ((null? lst) (error 'syntax-identifier-append "no stx for context"))
+            ((syntax? (car lst)) (car lst))
+            (else (helper (cdr lst)))))
+    (if (not stx) (helper lst) stx))
+  (define (->string x)
+    (cond ((syntax? x) (->string (syntax->datum x)))
+          (else (format "~a" x))))
+  (define (helper args)
+    (datum->syntax (get-first-syntax args)
+                   (string->symbol (string-join (map ->string args) ""))))
+  (helper (cons arg args)))
+
+(define (syntax-id-part? stx)
+  (define (helper part)
+    (or (symbol? part) (bytes? part) (string? part) (number? part)))
+  (or (and (syntax? stx)
+           (helper (syntax->datum stx)))
+      (helper stx)))
+
+(provide/contract 
+ (syntax-map (-> (-> any/c any) stx-pair? any))
+ (syntax-identifier-append (->* (syntax-id-part?)
+                                (#:stx syntax?)
+                                #:rest (listof syntax-id-part?)
+                                syntax?))
+ )
+
+(provide (all-from-out syntax/stx))
+
diff --git a/ebus-racket/3rdparty/bzlib/base/text.ss b/ebus-racket/3rdparty/bzlib/base/text.ss
new file mode 100644
index 0000000..1185b17
--- /dev/null
+++ b/ebus-racket/3rdparty/bzlib/base/text.ss
@@ -0,0 +1,69 @@
+#lang scheme/base
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; BASE.plt - common routines that are shared by all other bzlib modules 
+;; 
+;; in a way, base.plt is the most fundamental module of the whole bzlib stack
+;; and as such it also is the lowest level code.  We are not likely to 
+;; fix the code any time soon, and hence any of the functions here are 
+;; explicitly likely to be obsoleted or moved elsewhere. 
+;; 
+;; Proceed with caution. 
+;; 
+;; 
+;; Bonzai Lab, LLC.  All rights reserved.
+;; 
+;; Licensed under LGPL.
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; text.ss - basic "text" (or string) service. 
+;; yc 9/8/2009 - first version 
+;; yc 2/1/2010 - adding the ability to extend the behavior of the string function... 
+(require "base.ss" 
+         scheme/string
+         "registry.ss"
+         scheme/function
+         scheme/contract
+         )
+
+(define default->string (curry format "~a"))
+
+(define string-converter-table (make-cond-registry '())) 
+
+(define (string-converter-ref obj)
+  (registry-ref string-converter-table obj default->string))
+
+(define (string-converter-set! type? converter)
+  (registry-set! string-converter-table type? converter))
+
+(define (string-converter-del! type?)
+  (registry-del! string-converter-table type?));;
+
+(define (stringify* arg . args)
+  (stringify (cons arg args)))
+
+(define (any->string v)
+  (cond ((string? v) v)
+        (else 
+         ((string-converter-ref v) v))))
+
+(define (stringify args)
+  (string-join (map any->string args) ""))
+
+(provide/contract 
+ (stringify* (->* (any/c)
+                 ()
+                 #:rest (listof any/c)
+                 string?))
+ (stringify (-> (listof any/c) string?))
+ ;;(string-converter-table registry?)
+ (string-converter-ref (-> any/c any))
+ (string-converter-set! (-> procedure? procedure? any))
+ (string-converter-del! (-> procedure? any))
+ (any->string (-> any/c string?)) 
+ (rename stringify* any*->string (->* (any/c)
+                                      () 
+                                      #:rest (listof any/c)
+                                      string?))
+ (rename stringify any/list->string (-> (listof any/c) string?))
+ )
+
+(provide (all-from-out scheme/string))
\ No newline at end of file
diff --git a/ebus-racket/3rdparty/bzlib/base/uuid.ss b/ebus-racket/3rdparty/bzlib/base/uuid.ss
new file mode 100644
index 0000000..d4cf293
--- /dev/null
+++ b/ebus-racket/3rdparty/bzlib/base/uuid.ss
@@ -0,0 +1,202 @@
+#lang scheme/base

+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

+;; BASE.plt - common routines that are shared by all other bzlib modules 

+;; 

+;; in a way, base.plt is the most fundamental module of the whole bzlib stack

+;; and as such it also is the lowest level code.  We are not likely to 

+;; fix the code any time soon, and hence any of the functions here are 

+;; explicitly likely to be obsoleted or moved elsewhere. 

+;; 

+;; Proceed with caution. 

+;; 

+;; 

+;; Bonzai Lab, LLC.  All rights reserved.

+;; 

+;; Licensed under LGPL.

+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

+;; uuid.ss  - provide uuid object (currently wrapping over zitterbewegung/uuid-v4) 

+;; yc 9/11/2009 - first version 

+(require (prefix-in z: "../../zitterbewegung/uuid/uuid-v4.ss")

+         "base.ss"

+         scheme/list

+         scheme/string

+         scheme/contract

+         ;; (planet vyzo/crypto/util)

+         )

+

+(define (bytes->integer bytes)

+  (define (helper rest num)

+    (if (null? rest) num

+        (helper (cdr rest) (+ (* num 255) (car rest)))))

+  (helper (bytes->list bytes) 0))

+

+(define (bytes->hex bytes)

+  (define (helper rest acc)

+    (if (null? rest) (list->string (map hex-byte->char (reverse acc)))

+        (helper (cdr rest) 

+                (let-values (((quotient remainder)

+                              (quotient/remainder (car rest) 16)))

+                  (list* remainder quotient acc)))))

+  (helper (bytes->list bytes) '()))

+

+;; *uuid structure - representing UUID, and holds bytes format... 

+(define-struct *uuid (bytes)

+  #:property prop:custom-write 

+  (lambda (u out write?)

+    (display (format "#<uuid:~a>" (uuid->string u)) out))

+  #:property prop:equal+hash 

+  (list (lambda (u1 u2 sub?)

+          (bytes=? (*uuid-bytes u1) (*uuid-bytes u2)))

+        (lambda (u recur)

+          (bytes->integer (*uuid-bytes u)))

+        (lambda (u recur)

+          (bytes->integer (*uuid-bytes u)))))

+

+(define (uuid-time-low u)

+  (integer-bytes->integer (subbytes (*uuid-bytes u) 0 4) #f #t))

+

+(define (uuid-time-mid u)

+  (integer-bytes->integer (subbytes (*uuid-bytes u) 4 6) #f #t))

+

+(define (uuid-time-high u)

+  (integer-bytes->integer (subbytes (*uuid-bytes u) 6 8) #f #t))

+

+(define (uuid-clock-high u)

+  (integer-bytes->integer (bytes-append (list->bytes (list 0)) 

+                                        (subbytes (*uuid-bytes u) 8 9)) #f #t))

+

+(define (uuid-clock-low u)

+  (integer-bytes->integer (bytes-append (list->bytes (list 0)) 

+                                        (subbytes (*uuid-bytes u) 9 10)) #f #t))

+

+(define (uuid-node u)

+  (integer-bytes->integer (bytes-append (list->bytes (list 0 0)) 

+                                        (subbytes (*uuid-bytes u) 10 16)) #f #t))

+

+(define (uuid->string u (dash? #t))

+  (define (sub start end)

+    (subbytes (*uuid-bytes u) start end)) 

+  (if (not dash?)

+      (bytes->hex (*uuid-bytes u))

+      (string-join (map (lambda (b)

+                          (bytes->hex b)) 

+                        (list (sub 0 4) (sub 4 6) (sub 6 8) (sub 8 10) (sub 10 16)))

+                   "-")))

+

+

+(define (uuid-string? u)

+  (and (string? u)

+       (regexp-match #px"^(?i:([0-9a-f]{,8})-?([0-9a-f]{,4})-?([0-9a-f]{,4})-?([0-9a-f]{,4})-?([0-9a-f]{,12}))$" u)))

+

+(define (uuid-symbol? u)

+  (and (symbol? u)

+       (uuid-string? (symbol->string u))))

+

+(define (uuid-bytes? u)

+  (and (bytes? u) 

+       (= (bytes-length u) 16)))

+

+;; an uuid should be one of the following:

+;; struct of *uuid

+;; 16-bytes byte string. 

+;; a string of 32 or 36 hex chars. 

+(define (uuid? u)

+  (or (*uuid? u)

+      (uuid-bytes? u)

+      (uuid-string? u)))

+

+(define (make-uuid (u (symbol->string (z:make-uuid))))

+  (cond ((*uuid? u)

+         (make-*uuid (*uuid-bytes u)))

+        ((uuid-bytes? u)

+         (make-*uuid u))

+        (else

+         (uuid-string->uuid u))))

+

+(define (hex-byte->char h)

+  (case h

+    ((0) #\0)

+    ((1) #\1)

+    ((2) #\2)

+    ((3) #\3)

+    ((4) #\4)

+    ((5) #\5)

+    ((6) #\6)

+    ((7) #\7)

+    ((8) #\8)

+    ((9) #\9)

+    ((10) #\a)

+    ((11) #\b)

+    ((12) #\c)

+    ((13) #\d)

+    ((14) #\e)

+    ((15) #\f)

+    (else (error 'hex-byte->char "Not an hex byte: ~a" h))))

+

+(define (hex-char->integer c)

+  (case c

+    ((#\1) 1)

+    ((#\2) 2)

+    ((#\3) 3)

+    ((#\4) 4)

+    ((#\5) 5)

+    ((#\6) 6)

+    ((#\7) 7)

+    ((#\8) 8)

+    ((#\9) 9)

+    ((#\0) 0)

+    ((#\a #\A) 10)

+    ((#\b #\B) 11)

+    ((#\c #\C) 12)

+    ((#\d #\D) 13)

+    ((#\e #\E) 14)

+    ((#\f #\F) 15)

+    (else (error 'hex-char->integer "char ~a out of range" c))))

+

+(define (hex-char? c)

+  (member c '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\a #\A #\b #\B #\c #\C #\d #\D #\e #\E #\f #\F)))

+

+(define (hex-chars->byte chars)

+  (define (helper rest num)

+    (if (null? rest)

+        num

+        (helper (cdr rest) (+ (* 16 num) (hex-char->integer (car rest))))))

+  (helper chars 0))

+

+(define (hex-string->bytes h)

+  (define (helper rest acc)

+    (cond ((null? rest) (reverse acc))

+          ((null? (cdr rest)) ;; wrong

+           (error 'hex-string->bytes "Uneven # of hexdecimal strings: ~a" h))

+          (else

+           (helper (cddr rest)

+                   (cons (hex-chars->byte (list (car rest) (cadr rest)))

+                         acc)))))

+  (helper (string->list h) '()))

+

+(define (uuid-string->uuid uuid)

+  (make-*uuid (list->bytes (flatten (map hex-string->bytes (cdr (uuid-string? uuid)))))))

+

+;; how quickly can all the generation take? 

+;; it seems that 

+(provide/contract 

+ (make-uuid (->* ()

+                 (uuid?)

+                 *uuid?))

+ (uuid->string (->* (*uuid?)

+                    (boolean?) 

+                    string?))

+ (rename *uuid-bytes uuid->bytes (-> *uuid? bytes?))

+ (uuid-string? (-> any/c any))

+ (uuid-bytes? (-> any/c any))

+ (uuid-time-low (-> *uuid? number?))

+ (uuid-time-mid (-> *uuid? number?))

+ (uuid-time-high (-> *uuid? number?))

+ (uuid-clock-low (-> *uuid? number?))

+ (uuid-clock-high (-> *uuid? number?))

+ (uuid-node (-> *uuid? number?))

+ (uuid? (-> any/c any))

+ (bytes->hex (-> bytes? string?))

+ (bytes->integer (-> bytes? number?))

+ )

+

diff --git a/ebus-racket/3rdparty/bzlib/base/version-case.ss b/ebus-racket/3rdparty/bzlib/base/version-case.ss
new file mode 100644
index 0000000..a9f60d7
--- /dev/null
+++ b/ebus-racket/3rdparty/bzlib/base/version-case.ss
@@ -0,0 +1,118 @@
+#lang scheme/base
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; BASE.plt - common routines that are shared by all other bzlib modules 
+;; 
+;; in a way, base.plt is the most fundamental module of the whole bzlib stack
+;; and as such it also is the lowest level code.  We are not likely to 
+;; fix the code any time soon, and hence any of the functions here are 
+;; explicitly likely to be obsoleted or moved elsewhere. 
+;; 
+;; Proceed with caution. 
+;; 
+;; 
+;; Bonzai Lab, LLC.  All rights reserved.
+;; 
+;; Licensed under LGPL.
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; version-case.ss - version-based macros 
+;; yc 1/18/2010 - first version 
+(require (for-syntax scheme/base
+                     "version.ss"
+                     )
+         "version.ss"
+         )
+
+(define-syntax (+:version stx)
+  (syntax-case stx (between > >= < <= = != else)
+    ((~) #'(void))
+    ((~ (else exp)) #'exp)
+    ((~ ((between min max) exp) rest ...)
+     (version<=? (syntax->datum #'min) 
+                 (version) 
+                 (syntax->datum #'max))
+     #'exp)
+    ((~ ((between min max) exp) rest ...)
+     #'(~ rest ...)) 
+    ((~ ((> v) exp) rest ...)
+     (version>? (version) (syntax->datum #'v))
+     #'exp)
+    ((~ ((> v) exp) rest ...)
+     #'(~ rest ...)) 
+    ((~ ((>= v) exp) rest ...)
+     (version>=? (version) (syntax->datum #'v))
+     #'exp)
+    ((~ ((>= v) exp) rest ...)
+     #'(~ rest ...)) 
+    ((~ ((< v) exp) rest ...)
+     (version<? (version) (syntax->datum #'v))
+     #'exp)
+    ((~ ((< v) exp) rest ...)
+     #'(~ rest ...)) 
+    ((~ ((<= v) exp) rest ...)
+     (version<=? (version) (syntax->datum #'v))
+     #'exp) 
+    ((~ ((<= v) exp) rest ...)
+     #'(~ rest ...)) 
+    ((~ ((= v) exp) rest ...)
+     (version=? (version) (syntax->datum #'v))
+     #'exp) 
+    ((~ ((= v) exp) rest ...)
+     #'(~ rest ...)) 
+    ((~ ((!= v) exp) rest ...)
+     (version!=? (version) (syntax->datum #'v))
+     #'exp)
+    ((~ ((!= v) exp) rest ...)
+     #'(~ rest ...)) 
+    )) 
+
+(define-syntax +:version-between
+  (syntax-rules ()
+    ((~ min max exp otherwise)
+     (+:version ((between min max) exp) (else otherwise)))
+    ))
+
+(define-syntax define-version-if 
+  (syntax-rules () 
+    ((~ name comp)
+     (define-syntax name 
+       (syntax-rules () 
+         ((~ v exp otherwise) 
+          (+:version ((comp v) exp) (else otherwise))))))
+    ))
+
+(define-version-if +:version> >)
+
+(define-version-if +:version>= >=)
+
+(define-version-if +:version< <)
+
+(define-version-if +:version<= <=)
+
+(define-version-if +:version= =)
+
+(define-version-if +:version!= !=)
+
+(define-syntax require/v 
+  (syntax-rules () 
+    ((~ (test s1 ...) ...) 
+     (+:version (test (require s1 ...)) ...))
+    ))
+
+(define-syntax provide/v
+  (syntax-rules () 
+    ((~ (test s1 ...) ...) 
+     (+:version (test (provide s1 ...)) ...))
+    ))
+
+(provide +:version
+         +:version-between
+         +:version>
+         +:version>=
+         +:version<
+         +:version<=
+         +:version=
+         +:version!=
+         require/v 
+         provide/v 
+         )
+
diff --git a/ebus-racket/3rdparty/bzlib/base/version.ss b/ebus-racket/3rdparty/bzlib/base/version.ss
new file mode 100644
index 0000000..0932012
--- /dev/null
+++ b/ebus-racket/3rdparty/bzlib/base/version.ss
@@ -0,0 +1,71 @@
+#lang scheme/base
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; BASE.plt - common routines that are shared by all other bzlib modules 
+;; 
+;; in a way, base.plt is the most fundamental module of the whole bzlib stack
+;; and as such it also is the lowest level code.  We are not likely to 
+;; fix the code any time soon, and hence any of the functions here are 
+;; explicitly likely to be obsoleted or moved elsewhere. 
+;; 
+;; Proceed with caution. 
+;; 
+;; 
+;; Bonzai Lab, LLC.  All rights reserved.
+;; 
+;; Licensed under LGPL.
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; version.ss - version comparison utilities as well as version-based macros 
+;; yc 1/18/2010 - first version 
+(require (prefix-in v: version/utils)
+         scheme/contract
+         (for-syntax scheme/base
+                     (prefix-in v: version/utils))
+         mzlib/trace
+         )
+
+(define (version? v)
+  (and (string? v)
+       (integer? (v:version->integer v))))
+
+(define (vcomp? comp? v v2 vs) 
+  (apply comp? (map v:version->integer (list* v v2 vs))))
+
+(define (version<? v v2 . vs)
+  (vcomp? < v v2 vs)) 
+;; (trace version<?)
+
+(define (version<=? v v2 . vs) 
+  (vcomp? <= v v2 vs)) 
+;; (trace version<=?)
+
+(define (version>=? v v2 . vs)
+  (vcomp? >= v v2 vs)) 
+;; (trace version>=?)
+
+(define (version>? v v2 . vs)
+  (vcomp? > v v2 vs))
+;; (trace version>?)
+
+(define (version=? v v2 . vs)
+  (vcomp? = v v2 vs)) 
+;; (trace version=?)
+
+(define (version!=? v v2 . vs)
+  (vcomp? (compose not =) v v2 vs))
+;; (trace version!=?)
+
+(define vcomp/c (->* (version? version?)
+                     ()
+                     #:rest (listof version?)
+                     boolean?))
+
+(provide/contract 
+ (version? (-> any/c boolean?))
+ (version<? vcomp/c) 
+ (version<=? vcomp/c)
+ (version>=? vcomp/c) 
+ (version>? vcomp/c) 
+ (version=? vcomp/c)
+ (version!=? vcomp/c)
+ )
+