Paste number 139246: ip-range

Index of paste annotations: 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10

Paste number 139246: ip-range
Pasted by: stassats
When:1 year, 2 months ago
Share:Tweet this! | http://paste.lisp.org/+2ZFY
Channel:None
Paste contents:
Raw Source | XML | Display As
(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:1 year, 2 months ago
Share:Tweet this! | http://paste.lisp.org/+2ZFY/1
Paste contents:
Raw Source | Display As
(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:1 year, 2 months ago
Share:Tweet this! | http://paste.lisp.org/+2ZFY/2
Paste contents:
Raw Source | Display As
(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:1 year, 2 months ago
Share:Tweet this! | http://paste.lisp.org/+2ZFY/3
Paste contents:
Raw Source | Display As
(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:1 year, 2 months ago
Share:Tweet this! | http://paste.lisp.org/+2ZFY/4
Paste contents:
Raw Source | Display As
(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:1 year, 2 months ago
Share:Tweet this! | http://paste.lisp.org/+2ZFY/5
Paste contents:
Raw Source | Display As
(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:1 year, 2 months ago
Share:Tweet this! | http://paste.lisp.org/+2ZFY/6
Paste contents:
Raw Source | Display As
(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:1 year, 2 months ago
Share:Tweet this! | http://paste.lisp.org/+2ZFY/7
Paste contents:
Raw Source | Display As
(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:1 year, 2 months ago
Share:Tweet this! | http://paste.lisp.org/+2ZFY/8
Paste contents:
Raw Source | Display As
(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:1 year, 2 months ago
Share:Tweet this! | http://paste.lisp.org/+2ZFY/9
Paste contents:
Raw Source | Display As
(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:1 year, 2 months ago
Share:Tweet this! | http://paste.lisp.org/+2ZFY/A
Paste contents:
Raw Source | Display As
(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)))))

Colorize as:
Show Line Numbers

Lisppaste pastes can be made by anyone at any time. Imagine a fearsomely comprehensive disclaimer of liability. Now fear, comprehensively.