Skip to content
Newer
Older
100644 175 lines (156 sloc) 7.56 KB
9897294 @mon-key * unicly-hash-table.lisp: New file. Moved `sxhash-uuid' and `make-has…
authored
1 ;;; :FILE-CREATED <Timestamp: #{2011-08-17T15:58:07-04:00Z}#{11333} - by MON>
2 ;;; :FILE unicly/unicly-byte-arrays.lisp
3 ;;; ==============================
4
5
6 (in-package #:unicly)
7 ;; *package*
8
04cc3b8 @mon-key * unicly-io.lisp (uuid-deserialize-byte-array-bytes): New function.
authored
9 (declaim (inline uuid-byte-array-16-zeroed))
10 (defun uuid-byte-array-16-zeroed ()
9897294 @mon-key * unicly-hash-table.lisp: New file. Moved `sxhash-uuid' and `make-has…
authored
11 (declare (optimize (speed 3)))
12 (the uuid-byte-array-16
13 (make-array (the uuid-bit-vector-16-length 16) :element-type 'uuid-ub8 :initial-element 0)))
14
a2e4ae2 @mon-key Add `type' to declarations. Add some Clisp specific stuff.
authored
15
16 ;; (uuid-get-namespace-bytes (uuid-princ-to-string (make-v5-uuid *uuid-namespace-dns* "bubba")))
17 ;; (uuid-get-namespace-bytes (make-uuid-from-string "eea1105e-3681-5117-99b6-7b2b5fe1f3c7"))
18 ;; ,----
19 ;; | x86-32 converting 1mil v4 UUIDs pre-cached in an array of 1mil elts in
20 ;; | consistently around 1.5 seconds real time:
21 ;; | 1.489 seconds of real time [ 0.143 seconds GC time, and 1.339 seconds non-GC time. ]
22 ;; | 99.53% CPU 4,454,788,950 processor cycles
23 ;; | 183,996,952 bytes consed
24 ;; `----
9897294 @mon-key * unicly-hash-table.lisp: New file. Moved `sxhash-uuid' and `make-has…
authored
25 (defun uuid-get-namespace-bytes (uuid)
26 (declare (type unique-universal-identifier uuid)
04cc3b8 @mon-key * unicly-io.lisp (uuid-deserialize-byte-array-bytes): New function.
authored
27 (inline uuid-byte-array-16-zeroed %unique-universal-identifier-null-p)
9897294 @mon-key * unicly-hash-table.lisp: New file. Moved `sxhash-uuid' and `make-has…
authored
28 (optimize (speed 3)))
29 (when (%unique-universal-identifier-null-p uuid)
04cc3b8 @mon-key * unicly-io.lisp (uuid-deserialize-byte-array-bytes): New function.
authored
30 (return-from uuid-get-namespace-bytes (the uuid-byte-array-16 (uuid-byte-array-16-zeroed))))
9897294 @mon-key * unicly-hash-table.lisp: New file. Moved `sxhash-uuid' and `make-has…
authored
31 (the uuid-byte-array-16
32 (with-slots (%uuid_time-low %uuid_time-mid %uuid_time-high-and-version
33 %uuid_clock-seq-and-reserved %uuid_clock-seq-low %uuid_node)
34 uuid
35 (declare (type uuid-ub32 %uuid_time-low)
36 (type uuid-ub16 %uuid_time-mid %uuid_time-high-and-version)
37 (type uuid-ub8 %uuid_clock-seq-and-reserved %uuid_clock-seq-low)
a2e4ae2 @mon-key Add `type' to declarations. Add some Clisp specific stuff.
authored
38 (type uuid-ub48 %uuid_node)
39 (inline uuid-disassemble-ub48 uuid-disassemble-ub32 uuid-disassemble-ub16))
9897294 @mon-key * unicly-hash-table.lisp: New file. Moved `sxhash-uuid' and `make-has…
authored
40 (make-array 16
41 :element-type 'uuid-ub8
a2e4ae2 @mon-key Add `type' to declarations. Add some Clisp specific stuff.
authored
42 :initial-contents (multiple-value-call #'list
43 (the (values uuid-ub8 uuid-ub8 uuid-ub8 uuid-ub8 &optional)
44 (uuid-disassemble-ub32 %uuid_time-low))
45 (the (values uuid-ub8 uuid-ub8 &optional)
46 (uuid-disassemble-ub16 %uuid_time-mid))
47 (the (values uuid-ub8 uuid-ub8 &optional)
48 (uuid-disassemble-ub16 %uuid_time-high-and-version))
9897294 @mon-key * unicly-hash-table.lisp: New file. Moved `sxhash-uuid' and `make-has…
authored
49 %uuid_clock-seq-and-reserved
50 %uuid_clock-seq-low
a2e4ae2 @mon-key Add `type' to declarations. Add some Clisp specific stuff.
authored
51 (the (values uuid-ub8 uuid-ub8 uuid-ub8 uuid-ub8 uuid-ub8 uuid-ub8 &optional)
52 (uuid-disassemble-ub48 %uuid_node)))))))
53cb230 @mon-key * unicly-bit-vectors.lisp (uuid-bit-vector-128-to-byte-array): New Fu…
authored
53
9897294 @mon-key * unicly-hash-table.lisp: New file. Moved `sxhash-uuid' and `make-has…
authored
54 ;;; ==============================
55 ;; :NOTE UNICLY:UUID-GET-NAMESPACE-BYTES is equivalent to
56 ;; UUID:UUID-TO-BYTE-ARRAY we provide it here for congruence.
57 ;; :SEE Bottom of file for our variation of the original definition.
58 ;;
59 (eval-when (:load-toplevel :execute)
60 (setf (fdefinition 'uuid-to-byte-array)
61 (fdefinition 'uuid-get-namespace-bytes)))
62
63
64 ;;; ==============================
a2e4ae2 @mon-key Add `type' to declarations. Add some Clisp specific stuff.
authored
65 ;; :TODO Finish `uuid-byte-array-version'
75331d6 @mon-key * unicly-types.lisp: Now defines predicates `string-with-fill-pointer…
authored
66 ;; :SEE ironclad:ub16ref/be for a fetcher to grab only the relevant portion of
67 ;; the `uuid-byte-array-16'.
a2e4ae2 @mon-key Add `type' to declarations. Add some Clisp specific stuff.
authored
68 ;; :SEE `uuid-request-integer'
69 ;; (uuid-request-integer <UUID-BYTE-ARRAY-16> <VERSION-BITS-OFFSET> <VERSION-BITS-LENGTH>)
70 ;;
9897294 @mon-key * unicly-hash-table.lisp: New file. Moved `sxhash-uuid' and `make-has…
authored
71 ;; (defun uuid-byte-array-version (uuid-byte-array)
a2e4ae2 @mon-key Add `type' to declarations. Add some Clisp specific stuff.
authored
72 ;; (declare (uuid-byte-array-16 uuid-byte-array))
73 ;; (let ((version-bits
74 ;; (uuid-request-integer <UUID-BYTE-ARRAY-16> <VERSION-BITS-OFFSET> <VERSION-BITS-LENGTH>)))
75 ;; { ... }
76 ;; ))
9897294 @mon-key * unicly-hash-table.lisp: New file. Moved `sxhash-uuid' and `make-has…
authored
77
e4a3c86 @mon-key * unicly-macros.lisp (%def-uuid-format-and-intern-symbol-type-predica…
authored
78
e55f0e4 @mon-key Tweak README
authored
79 ;;; ==============================
75331d6 @mon-key * unicly-types.lisp: Now defines predicates `string-with-fill-pointer…
authored
80 ;; :NOTE Following modelled after `ironclad::octets-to-integer'
81 ;; :SEE :FILE ironclad/src/public-key/public-key.lisp
82 ;; It originally had the following signature:
83 ;; octets-to-integer (octet-vec &key (start 0) end (big-endian t) n-bits)
84 ;; The BIG-ENDIAN key above refers to whether (aref uuid-ba-16 0) represents the LSB or MSB.
85 ;; Objects of type `uuid-byte-array-16' should always have their MSB at 0.
86 (defun uuid-byte-array-16-to-integer (uuid-ba-16)
87 (declare (type uuid-byte-array-16 uuid-ba-16)
88 (optimize (speed 3)))
89 (uuid-byte-array-16-check-type uuid-ba-16)
90 (do ((j 0 (1+ j))
91 (sum 0))
92 ;; ((>= j end) sum)
93 ((>= j 16) sum)
94 (setf sum (+ (aref uuid-ba-16 j) (ash sum 8)))))
95
53cb230 @mon-key * unicly-bit-vectors.lisp (uuid-bit-vector-128-to-byte-array): New Fu…
authored
96 ;; :NOTE Following adapted from `ironclad::integer-to-octets'
97 ;; :SEE :FILE ironclad/src/public-key/public-key.lisp
98 (defun uuid-integer-128-to-byte-array (uuid-integer)
99 (let ((octet-vec (make-array 16 :element-type 'uuid-ub8)))
100 (declare (type uuid-byte-array-16 octet-vec))
101 (loop
102 for i from 15 downto 0
103 for index from 0
104 ;; do (setf (aref octet-vec index) (ldb (byte 8 (ash i 3)) uuid-integer))
105 do (setf (aref octet-vec index) (ldb (byte 8 (* i 8)) uuid-integer))
106 finally (return octet-vec))))
75331d6 @mon-key * unicly-types.lisp: Now defines predicates `string-with-fill-pointer…
authored
107
53cb230 @mon-key * unicly-bit-vectors.lisp (uuid-bit-vector-128-to-byte-array): New Fu…
authored
108
75331d6 @mon-key * unicly-types.lisp: Now defines predicates `string-with-fill-pointer…
authored
109 ;;; ==============================
e55f0e4 @mon-key Tweak README
authored
110 ;; :NOTE the weird loop in the return value of the dotimes form is to accomodate
64d0154 @mon-key Tweak typos.
authored
111 ;; situations where the top bits of the class `unique-universal-identifier' are
e55f0e4 @mon-key Tweak README
authored
112 ;; such that the uuid has an integer representation with `cl:integer-length'
113 ;; less than 120 and we need to pad the array. On current system this will
114 ;; happen for 1 in 200 invocations of `make-v4-uuid's and we end up with
115 ;; something like this:
116 ;; (integer-length 169114161898150076209418180205435926)
117 ;; Following example will illustrate the problem, remove the loop in return of
64d0154 @mon-key Tweak typos.
authored
118 ;; `cl:dotimes' to play:
e55f0e4 @mon-key Tweak README
authored
119 ;;
120 ;; (let ((diff '()))
121 ;; (dotimes (i 1000 diff)
122 ;; (let* ((uuid (make-v4-uuid))
123 ;; (ba (uuid-to-byte-array uuid))
124 ;; (bv-int (uuid-bit-vector-to-integer (uuid-to-bit-vector uuid)))
125 ;; (int-ba-2 (tt--number-byte-array.2 bv-int))
126 ;; (inner-diff '()))
127 ;; (unless (equalp ba int-ba-2)
128 ;; (push (list :!ba/int-ba-2 ba int-ba-2 (uuid-princ-to-string uuid)) inner-diff))
129 ;; (unless (null inner-diff)
130 ;; (push inner-diff diff)))))
131 ;;
53cb230 @mon-key * unicly-bit-vectors.lisp (uuid-bit-vector-128-to-byte-array): New Fu…
authored
132 ;; :NOTE Now using code adapted from ironclad::integer-to-octets instead.
133 ;;
75331d6 @mon-key * unicly-types.lisp: Now defines predicates `string-with-fill-pointer…
authored
134 ;; (defun uuid-integer-128-to-byte-array (uuid-integer)
135 ;; (declare (uuid-ub128 uuid-integer)
136 ;; (optimize (speed 3)))
137 ;; (when (zerop uuid-integer)
138 ;; (return-from uuid-integer-128-to-byte-array (uuid-byte-array-16-zeroed)))
139 ;; (let* ((octet-count (nth-value 0 (truncate (+ (integer-length uuid-integer) 7) 8)))
140 ;; (bit-count (ash octet-count 3))
141 ;; (ba-out (uuid-byte-array-16-zeroed))
142 ;; (chk-byte '()))
143 ;; (declare (uuid-byte-array-16 ba-out))
144 ;; (dotimes (cnt 16
145 ;; (if (evenp octet-count)
146 ;; (the uuid-byte-array-16 ba-out)
147 ;; (loop
148 ;; with offset = ba-out
149 ;; with new = (the uuid-byte-array-16 (uuid-byte-array-16-zeroed))
150 ;; for x across offset
151 ;; for y from 1 below 16
152 ;; do (setf (aref new y) x)
153 ;; finally (return (the uuid-byte-array-16 new)))))
154 ;; (setf chk-byte (- bit-count (ash (1+ cnt) 3)))
155 ;; (if (minusp chk-byte)
156 ;; (setf (aref ba-out cnt)
157 ;; (ldb (byte 8 0) uuid-integer))
158 ;; (setf (aref ba-out cnt)
159 ;; (ldb (byte 8 chk-byte) uuid-integer))))))
53cb230 @mon-key * unicly-bit-vectors.lisp (uuid-bit-vector-128-to-byte-array): New Fu…
authored
160 ;;; ==============================
04cc3b8 @mon-key * unicly-io.lisp (uuid-deserialize-byte-array-bytes): New function.
authored
161
53cb230 @mon-key * unicly-bit-vectors.lisp (uuid-bit-vector-128-to-byte-array): New Fu…
authored
162 ;;; ==============================
e55f0e4 @mon-key Tweak README
authored
163
53cb230 @mon-key * unicly-bit-vectors.lisp (uuid-bit-vector-128-to-byte-array): New Fu…
authored
164
165 ;; Local Variables:
166 ;; indent-tabs-mode: nil
167 ;; show-trailing-whitespace: t
168 ;; mode: lisp-interaction
169 ;; package: unicly
170 ;; End:
9897294 @mon-key * unicly-hash-table.lisp: New file. Moved `sxhash-uuid' and `make-has…
authored
171
75331d6 @mon-key * unicly-types.lisp: Now defines predicates `string-with-fill-pointer…
authored
172
9897294 @mon-key * unicly-hash-table.lisp: New file. Moved `sxhash-uuid' and `make-has…
authored
173 ;;; ==============================
174 ;;; EOF
Something went wrong with that request. Please try again.