Paste number 139246: | ip-range |
Pasted by: | stassats |
When: | 8 years, 9 months ago |
Share: | Tweet this! | http://paste.lisp.org/+2ZFY |
Channel: | None |
Paste contents: |
(defun ip-range (start-integer-string end-integer-string)
"Transform a couple of integers to an IP4R ip range notation."
(declare (optimize speed))
(flet ((integer-to-ip-string (int)
(declare (type (unsigned-byte 32) int))
(format nil "~a.~a.~a.~a"
(ldb (byte 8 24) int)
(ldb (byte 8 16) int)
(ldb (byte 8 8) int)
(ldb (byte 8 0) int))))
(declare (inline integer-to-ip-string))
(let ((ip-start (integer-to-ip-string (parse-integer start-integer-string)))
(ip-end (integer-to-ip-string (parse-integer end-integer-string))))
(format nil "~a-~a" ip-start ip-end))))
Annotations for this paste:
Annotation number 1: | Faster version |
Pasted by: | bobbysmith007 |
When: | 8 years, 9 months ago |
Share: | Tweet this! | http://paste.lisp.org/+2ZFY/1 |
Paste contents: |
(defun %ip-range-name (start fixed-bits)
"This is significantly faster (15 to 1) than a naive approach with string builder"
(bind ((number-strings
;;a cache of the strings 0 - 255 sinse we will be repeatedly
;;concatenating these strings together
(load-time-value
(let ((vec (make-array 256 )))
(loop for i from 0 to 255
do (setf (aref vec i) (princ-to-string i)))
vec)))
(dot ".")
(slash "/")
(base start)
(fixed-bits (or fixed-bits 32))
(:flet (string-for-byte (bitshift) (aref number-strings (ldb (byte 8 bitshift) base))))
(args (list* (string-for-byte 24) dot
(string-for-byte 16) dot
(string-for-byte 8) dot
(string-for-byte 0)
(unless (= fixed-bits 32)
(list slash (aref number-strings fixed-bits))))))
(apply #'concatenate 'string args)))
Annotation number 2: | untitled |
Pasted by: | stassats |
When: | 8 years, 9 months ago |
Share: | Tweet this! | http://paste.lisp.org/+2ZFY/2 |
Paste contents: |
(defun ip-range (start-integer-string end-integer-string)
"Transform a couple of integers to an IP4R ip range notation."
(declare (optimize speed))
(let ((int1 (parse-integer start-integer-string))
(int2 (parse-integer end-integer-string))
(string (make-string (1+ (* 2 (+ (* 3 4) 3))) :element-type 'base-char))
(index 0))
(declare (dynamic-extent string))
(labels ((put-char (char)
(setf (char string index) char)
(incf index))
(put-digit-char (char)
(setf (char string index) (code-char (+ 48 char)))
(incf index))
(put-number (number)
(declare (type (unsigned-byte 8) number))
(cond ((< number 10)
(put-digit-char number))
((< number 100)
(multiple-value-bind (a b) (truncate number 10)
(put-digit-char a)
(put-digit-char b)))
(t
(multiple-value-bind (quote c) (truncate number 10)
(multiple-value-bind (a b) (truncate quote 10)
(put-digit-char a)
(put-digit-char b))
(put-digit-char c)))))
(integer-to-ip-string (int)
(declare (type (unsigned-byte 32) int))
(put-number (ldb (byte 8 24) int))
(put-char #\.)
(put-number (ldb (byte 8 16) int))
(put-char #\.)
(put-number (ldb (byte 8 8) int))
(put-char #\.)
(put-number (ldb (byte 8 0) int))))
(declare (inline put-number put-char put-digit-char
integer-to-ip-string))
(integer-to-ip-string int1)
(put-char #\-)
(integer-to-ip-string int2))
(subseq string 0 index)))
Annotation number 3: | more declarations |
Pasted by: | bobbysmith007 |
When: | 8 years, 9 months ago |
Share: | Tweet this! | http://paste.lisp.org/+2ZFY/3 |
Paste contents: |
(defparameter
+number-strings+
(let ((vec (make-array
256
:element-type 'simple-string :initial-element "" )))
(loop for i from 0 to 255
do (setf (aref vec i) (princ-to-string i)))
vec))
(defun ip-name (start)
"This is significantly faster (15 to 1) than a naive approach with string builder"
(declare (optimize speed)
(type (simple-array simple-string) +number-strings+)
(type (unsigned-byte 32) start))
(let* ((dot "."))
(funcall #'concatenate 'string
(aref +number-strings+ (ldb (byte 8 24) start)) dot
(aref +number-strings+ (ldb (byte 8 16) start)) dot
(aref +number-strings+ (ldb (byte 8 8) start)) dot
(aref +number-strings+ (ldb (byte 8 0) start)))))
Annotation number 4: | exploit cache |
Pasted by: | stassats |
When: | 8 years, 9 months ago |
Share: | Tweet this! | http://paste.lisp.org/+2ZFY/4 |
Paste contents: |
(defun int-to-ip (int)
(declare (optimize speed)
(type (unsigned-byte 32) int))
(let ((table (load-time-value
(let ((vec (make-array #x10000)))
(loop for i to #xFFFF
do (setf (aref vec i)
(coerce (format nil "~a.~a"
(ldb (byte 8 8) i)
(ldb (byte 8 0) i))
'simple-base-string)))
vec)
t)))
(declare (type (simple-array simple-base-string (*)) table))
(concatenate 'simple-base-string
(aref table (ldb (byte 16 16) int))
"."
(aref table (ldb (byte 16 0) int)))))
Annotation number 5: | untitled |
Pasted by: | stassats |
When: | 8 years, 9 months ago |
Share: | Tweet this! | http://paste.lisp.org/+2ZFY/5 |
Paste contents: |
(defun int-to-ip-3 (int)
"Transform a couple of integers to an IP4R ip range notation."
(declare (type (unsigned-byte 32) int)
(optimize speed))
(flet ((ip-length (part)
(cond ((< part 10)
1)
((< part 100)
2)
(t
3))))
(declare (inline ip-length))
(let* ((a (ldb (byte 8 24) int))
(b (ldb (byte 8 16) int))
(c (ldb (byte 8 8) int))
(d (ldb (byte 8 0) int))
(string (make-string (+ 3
(ip-length a)
(ip-length b)
(ip-length c)
(ip-length d)) :element-type 'base-char))
(index 0))
(declare (optimize (safety 0)))
(labels ((put-char (char)
(setf (char string index) char)
(incf index))
(put-digit-char (char)
(setf (char string index) (code-char (+ 48 char)))
(incf index))
(put-number (number)
(declare (type (unsigned-byte 8) number))
(loop with rem
do (setf (values number rem) (truncate number 10))
(put-digit-char rem)
while (plusp number))))
(declare (inline put-number put-char put-digit-char))
(put-number a)
(put-char #\.)
(put-number b)
(put-char #\.)
(put-number c)
(put-char #\.)
(put-number d)
string))))
Annotation number 6: | how about some sbclisms |
Pasted by: | stassats |
When: | 8 years, 9 months ago |
Share: | Tweet this! | http://paste.lisp.org/+2ZFY/6 |
Paste contents: |
(defun int-to-ip-contorted (int)
"Transform a couple of integers to an IP4R ip range notation."
(declare (type (unsigned-byte 32) int)
(optimize speed))
(flet ((ip-length (part)
(cond ((< part 10)
1)
((< part 100)
2)
(t
3))))
(declare (inline ip-length))
(let* ((table (load-time-value
(let ((vec (make-array #x10000 :element-type '(unsigned-byte 64))))
(loop for i to #xFFFF
do (setf (aref vec i)
(sb-kernel:%vector-raw-bits
(coerce (format nil "~a.~a"
(ldb (byte 8 8) i)
(ldb (byte 8 0) i))
'simple-base-string)
0)))
vec)
t))
(a (ldb (byte 8 24) int))
(b (ldb (byte 8 16) int))
(c (ldb (byte 8 8) int))
(d (ldb (byte 8 0) int))
(first-half-length (+ (ip-length a)
2
(ip-length b)))
(second-half-length (+ (ip-length c)
1
(ip-length d)))
(string (make-string (+ first-half-length
second-half-length)
:element-type 'base-char))
(sap (sb-sys:vector-sap string)))
(declare (optimize (safety 0)))
(sb-sys:with-pinned-objects (string)
(setf (sb-sys:sap-ref-word sap 0)
(aref table (ldb (byte 16 16) int)))
(setf (aref string (1- first-half-length)) #\.)
(setf (sb-sys:sap-ref-word sap first-half-length)
(aref table (ldb (byte 16 0) int)))
string))))
Annotation number 7: | untitled |
Pasted by: | stassats |
When: | 8 years, 9 months ago |
Share: | Tweet this! | http://paste.lisp.org/+2ZFY/7 |
Paste contents: |
(defun int-to-ip-extreme (int)
(declare (type (unsigned-byte 32) int)
(optimize speed))
(let* ((table (load-time-value
(let ((vec (make-array #x10000 :element-type '(unsigned-byte 64))))
(loop for i to #xFFFF
do (setf (aref vec i)
(sb-kernel:%vector-raw-bits
(coerce (format nil "~a.~a"
(ldb (byte 8 8) i)
(ldb (byte 8 0) i))
'simple-base-string)
0)))
vec)
t))
(length-table (load-time-value
(let ((vec (make-array #x10000 :element-type '(unsigned-byte 8))))
(loop for i to #xFFFF
do (setf (aref vec i)
(length (format nil "~a.~a"
(ldb (byte 8 8) i)
(ldb (byte 8 0) i)))))
vec)
t))
(first-half (ldb (byte 16 16) int))
(second-half (ldb (byte 16 0) int))
(first-half-length (+ (aref length-table first-half)
1))
(second-half-length (aref length-table second-half))
(string (make-string (+ first-half-length
second-half-length)
:element-type 'base-char))
(sap (sb-sys:vector-sap string)))
(declare (optimize (safety 0)))
(sb-sys:with-pinned-objects (string)
(setf (sb-sys:sap-ref-word sap 0) (aref table first-half))
(setf (aref string (1- first-half-length)) #\.)
(setf (sb-sys:sap-ref-word sap first-half-length) (aref table second-half))
string)))
Annotation number 8: | untitled |
Pasted by: | stassats |
When: | 8 years, 9 months ago |
Share: | Tweet this! | http://paste.lisp.org/+2ZFY/8 |
Paste contents: |
(defun int-to-ip-extreme-dirty (int)
(declare (type (unsigned-byte 32) int)
(optimize speed))
(let* ((table (load-time-value
(let ((vec (make-array #x10000 :element-type '(unsigned-byte 64))))
(loop for i to #xFFFF
do (setf (aref vec i)
(sb-kernel:%vector-raw-bits
(coerce (format nil "~a.~a."
(ldb (byte 8 8) i)
(ldb (byte 8 0) i))
'simple-base-string)
0)))
vec)
t))
(length-table (load-time-value
(let ((vec (make-array #x10000 :element-type '(unsigned-byte 8))))
(loop for i to #xFFFF
do (setf (aref vec i)
(length (format nil "~a.~a"
(ldb (byte 8 8) i)
(ldb (byte 8 0) i)))))
vec)
t))
(first-half (ldb (byte 16 16) int))
(second-half (ldb (byte 16 0) int))
(first-half-length (+ (aref length-table first-half)
1))
(second-half-length (aref length-table second-half))
(string (make-string (+ first-half-length
second-half-length)
:element-type 'base-char))
(sap (sb-sys:vector-sap string)))
(declare (optimize (safety 0)))
(sb-sys:with-pinned-objects (string)
(setf (sb-sys:sap-ref-word sap 0) (aref table first-half))
(setf (sb-sys:sap-ref-word sap first-half-length) (aref table second-half))
string)))
Annotation number 9: | Bug fixes for portable version, put number used to reverse the number |
Pasted by: | bobbysmith007 |
When: | 8 years, 9 months ago |
Share: | Tweet this! | http://paste.lisp.org/+2ZFY/9 |
Paste contents: |
(defun %ip-range-name (start fixed-bits)
"Transform an integer to an IP4R ip CIDR range notation.
Super efficient version from stassats on #lisp"
(declare (type (unsigned-byte 32) start)
(type (unsigned-byte 8) fixed-bits)
(optimize speed))
(flet ((ip-length (part)
(cond ((< part 10) 1)
((< part 100) 2)
(t 3))))
(declare (inline ip-length))
(let* ((a (ldb (byte 8 24) start))
(b (ldb (byte 8 16) start))
(c (ldb (byte 8 8) start))
(d (ldb (byte 8 0) start))
(fixed-len (cond ((= 32 fixed-bits) 0)
((< 10 fixed-bits) 3)
(T fixed-bits 2)))
(string (make-string
(+ 3
(ip-length a)
(ip-length b)
(ip-length c)
(ip-length d)
fixed-len)
:element-type 'base-char :initial-element #\.))
(index 0))
(declare (optimize (safety 0))
(type (unsigned-byte 8) index))
(labels ((put-char (char)
(setf (char string index) char)
(incf index))
(put-digit-char (char)
(declare (type (unsigned-byte 8) char))
(setf (char string index) (code-char (+ 48 char)))
(incf index))
(put-number (number &aux rem0 rem1 rem2)
(declare (type (unsigned-byte 8) number))
(setf (values number rem0) (truncate number 10))
(when (plusp number) (setf (values number rem1) (truncate number 10)))
(when (plusp number) (setf (values number rem2) (truncate number 10)))
(when rem2 (put-digit-char rem2))
(when rem1 (put-digit-char rem1))
(when rem0 (put-digit-char rem0))
))
(declare (inline put-number put-char put-digit-char))
(put-number a)(incf index)
(put-number b)(incf index)
(put-number c)(incf index)
(put-number d)
(when (< fixed-bits 32)
(put-char #\/)
(put-number fixed-bits))
string))))
Annotation number 10: | no consing |
Pasted by: | adeht |
When: | 8 years, 8 months ago |
Share: | Tweet this! | http://paste.lisp.org/+2ZFY/A |
Paste contents: |
(defun make-int-to-ip-function ()
(let ((table (load-time-value
(let ((vec (make-array #x10000 :element-type '(unsigned-byte 64))))
(loop for i to #xFFFF
do (setf (aref vec i)
(sb-kernel:%vector-raw-bits
(coerce (format nil "~a.~a."
(ldb (byte 8 8) i)
(ldb (byte 8 0) i))
'simple-base-string)
0)))
vec)
t))
(length-table (load-time-value
(let ((vec (make-array #x10000 :element-type '(unsigned-byte 8))))
(loop for i to #xFFFF
do (setf (aref vec i)
(length (format nil "~a.~a"
(ldb (byte 8 8) i)
(ldb (byte 8 0) i)))))
vec)
t))
(strings (coerce
(loop for i below 16
collect (make-string i :element-type 'base-char))
'vector)))
(lambda (int)
(declare (type (unsigned-byte 32) int)
(optimize speed))
(let* ((first-half (ldb (byte 16 16) int))
(second-half (ldb (byte 16 0) int))
(first-half-length (+ (aref length-table first-half)
1))
(second-half-length (aref length-table second-half))
(string (aref strings (+ first-half-length second-half-length)))
(sap (sb-sys:vector-sap string)))
(declare (optimize (safety 0)))
(sb-sys:with-pinned-objects (string)
(setf (sb-sys:sap-ref-word sap 0) (aref table first-half))
(setf (sb-sys:sap-ref-word sap first-half-length) (aref table second-half))
string)))))