├── .travis.yml ├── LICENCE ├── README.md ├── ccl.lisp ├── endianness.lisp ├── network.lisp ├── package.lisp ├── portable.lisp ├── sbcl-defknowns.lisp ├── sbcl-vops.lisp ├── sbcl.lisp ├── swap-bytes.asd ├── test.lisp └── version.sexp /.travis.yml: -------------------------------------------------------------------------------- 1 | os: linux 2 | dist: focal 3 | language: generic 4 | 5 | env: 6 | jobs: 7 | - LISP=sbcl 8 | - LISP=ccl 9 | - LISP=ecl 10 | - LISP=abcl 11 | - LISP=clisp 12 | # - LISP=allegro 13 | # - LISP=ccl32 14 | # - LISP=sbcl32 15 | # - LISP=cmucl 16 | 17 | matrix: 18 | fast_finish: true 19 | allow_failures: 20 | - env: LISP=ccl32 21 | - env: LISP=sbcl32 22 | # - env: LISP=cmucl 23 | 24 | notifications: 25 | email: 26 | on_success: change 27 | on_failure: always 28 | irc: 29 | channels: 30 | - "chat.freenode.net#iolib" 31 | on_success: change 32 | on_failure: always 33 | use_notice: true 34 | skip_join: true 35 | 36 | install: 37 | - curl -L https://raw.githubusercontent.com/lispci/cl-travis/master/install.sh | sh 38 | - cl -e "(cl:in-package :cl-user) 39 | (dolist (p '(:trivial-features :fiveam)) 40 | (ql:quickload p :verbose t))" 41 | 42 | script: 43 | - cl -e "(cl:in-package :cl-user) 44 | (print (lisp-implementation-version))(terpri) 45 | (ql:quickload :swap-bytes/test :verbose t) 46 | (uiop:quit (if (5am:run! :bordeaux-threads-2) 0 -1))" 47 | -------------------------------------------------------------------------------- /LICENCE: -------------------------------------------------------------------------------- 1 | Copyright (C) 2010, Stas Boukarev 2 | Copyright (C) 2010-2013, Stelian Ionescu 3 | 4 | Permission is hereby granted, free of charge, to any person obtaining 5 | a copy of this software and associated documentation files (the 6 | "Software"), to deal in the Software without restriction, including 7 | without limitation the rights to use, copy, modify, merge, publish, 8 | distribute, sublicense, and/or sell copies of the Software, and to 9 | permit persons to whom the Software is furnished to do so, subject to 10 | the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be 13 | included in all copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 16 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 17 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 18 | NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 19 | LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 20 | OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 21 | WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | SWAP-BYTES 2 | ========== 3 | 4 | A library for changing endianness of unsigned integers of 5 | length 1/2/4/8. Very useful in implementing various network protocols 6 | and file formats. 7 | 8 | -------------------------------------------------------------------------------- /ccl.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: Lisp; indent-tabs-mode: nil -*- 2 | 3 | (in-package :ccl) 4 | 5 | #+(or x8632-target x8664-target) 6 | (defx8632lapfunction swap-bytes::%swap-bytes-16 ((fixnum arg_z)) 7 | (unbox-fixnum fixnum imm0) 8 | (xchg (% ah) (% al)) 9 | (box-fixnum imm0 fixnum) 10 | (single-value-return)) 11 | 12 | #+x8632-target 13 | (defx8632lapfunction swap-bytes::%swap-bytes-32 ((number arg_z)) 14 | ; Extract the u32 from the number, swap the bytes, make and return 15 | ; a bignum. 16 | (save-simple-frame) 17 | (call-subprim .SPgetu32) 18 | (bswapl (% imm0)) 19 | (restore-simple-frame) 20 | (jmp-subprim .SPmakeu32)) 21 | 22 | #+x8664-target 23 | (defx86lapfunction swap-bytes::%swap-bytes-32 ((fixnum arg_z)) 24 | (unbox-fixnum fixnum imm0) 25 | (bswapl (% eax)) 26 | (box-fixnum imm0 fixnum) 27 | (single-value-return)) 28 | 29 | #+x8632-target 30 | (defun swap-bytes::%swap-bytes-64 (integer) 31 | (declare (type (unsigned-byte 64) integer) 32 | (optimize (speed 3) (safety 0) (debug 0))) 33 | (logior 34 | (swap-bytes:swap-bytes-32 (ldb (byte 32 32) integer)) 35 | (ash (swap-bytes:swap-bytes-32 (ldb (byte 32 0) integer)) 32))) 36 | 37 | #+x8664-target 38 | (defx86lapfunction swap-bytes::%swap-bytes-64 ((number arg_z)) 39 | ; Extract the u64 from the number (either a fixnum or bignum), swap the 40 | ; bytes, make and return a bignum. 41 | (save-simple-frame) 42 | (call-subprim .SPgetu64) 43 | (bswapq (% imm0)) 44 | (restore-simple-frame) 45 | (jmp-subprim .SPmakeu64)) 46 | 47 | 48 | (in-package :swap-bytes) 49 | 50 | (declaim (inline swap-bytes-16)) 51 | (defun swap-bytes-16 (integer) 52 | (declare (type (unsigned-byte 16) integer)) 53 | (%swap-bytes-16 integer)) 54 | 55 | (declaim (inline swap-bytes-32)) 56 | (defun swap-bytes-32 (integer) 57 | (declare (type (unsigned-byte 32) integer)) 58 | (%swap-bytes-32 integer)) 59 | 60 | (declaim (inline swap-bytes-64)) 61 | (defun swap-bytes-64 (integer) 62 | (declare (type (unsigned-byte 64) integer)) 63 | (%swap-bytes-64 integer)) 64 | -------------------------------------------------------------------------------- /endianness.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: Lisp; indent-tabs-mode: nil -*- 2 | 3 | (in-package :swap-bytes) 4 | 5 | (deftype endianness () 6 | '(member :big-endian :little-endian)) 7 | 8 | (deftype endianness-designator () 9 | '(member :big-endian :little-endian :network :local)) 10 | 11 | (defconstant +endianness+ 12 | #+big-endian :big-endian 13 | #+little-endian :little-endian) 14 | 15 | (defun endianness (endianness) 16 | (check-type endianness endianness-designator) 17 | (case endianness 18 | (:local +endianness+) 19 | (:network :big-endian) 20 | (t endianness))) 21 | 22 | (defun find-swap-byte-function (&key size from (to :local)) 23 | (let ((from (endianness from)) 24 | (to (endianness to))) 25 | (if (eql from to) 26 | 'identity 27 | (ecase size 28 | (1 'identity) 29 | (2 'swap-bytes-16) 30 | (4 'swap-bytes-32) 31 | (8 'swap-bytes-64))))) 32 | -------------------------------------------------------------------------------- /network.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: Lisp; indent-tabs-mode: nil -*- 2 | 3 | (in-package :swap-bytes) 4 | 5 | (declaim (inline htons ntohs htonl ntohl htonq ntohq)) 6 | 7 | (defun htons (integer) 8 | "Convert (unsigned-byte 16) from host order(little- or big-endian) 9 | to network order(always big-endian)." 10 | (declare (type (unsigned-byte 16) integer) 11 | (optimize (speed 3) (safety 0) (debug 0))) 12 | #+little-endian (swap-bytes-16 integer) 13 | #+big-endian integer) 14 | 15 | (defun ntohs (integer) 16 | "Convert (unsigned-byte 16) from network order(always big-endian) to 17 | host order(little- or big-endian)." 18 | (declare (type (unsigned-byte 16) integer) 19 | (optimize (speed 3) (safety 0) (debug 0))) 20 | #+little-endian (swap-bytes-16 integer) 21 | #+big-endian integer) 22 | 23 | (defun htonl (integer) 24 | "Convert (unsigned-byte 32) from host order(little- or big-endian) 25 | to network order(always big-endian)." 26 | (declare (type (unsigned-byte 32) integer) 27 | (optimize (speed 3) (safety 0) (debug 0))) 28 | #+little-endian (swap-bytes-32 integer) 29 | #+big-endian integer) 30 | 31 | (defun ntohl (integer) 32 | "Convert (unsigned-byte 32) from network order(always big-endian) to 33 | host order(little- or big-endian)." 34 | (declare (type (unsigned-byte 32) integer) 35 | (optimize (speed 3) (safety 0) (debug 0))) 36 | #+little-endian (swap-bytes-32 integer) 37 | #+big-endian integer) 38 | 39 | (defun htonq (integer) 40 | "Convert (unsigned-byte 64) from host order(little- or big-endian) 41 | to network order(always big-endian)." 42 | (declare (type (unsigned-byte 64) integer) 43 | (optimize (speed 3) (safety 0) (debug 0))) 44 | #+little-endian (swap-bytes-64 integer) 45 | #+big-endian integer) 46 | 47 | (defun ntohq (integer) 48 | "Convert (unsigned-byte 64) from network order(always big-endian) to 49 | host order(little- or big-endian)." 50 | (declare (type (unsigned-byte 64) integer) 51 | (optimize (speed 3) (safety 0) (debug 0))) 52 | #+little-endian (swap-bytes-64 integer) 53 | #+big-endian integer) 54 | -------------------------------------------------------------------------------- /package.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: Lisp; indent-tabs-mode: nil -*- 2 | 3 | (defpackage :swap-bytes 4 | (:use #:cl 5 | #+(and sbcl (or x86 x86-64)) 6 | #:sb-c 7 | #+(and sbcl (or x86 x86-64)) 8 | #:sb-assem) 9 | (:export #:swap-bytes-16 #:swap-bytes-32 #:swap-bytes-64 10 | #:htons #:ntohs #:htonl #:ntohl #:htonq #:ntohq 11 | #:endianness #:+endianness+ #:find-swap-byte-function)) 12 | -------------------------------------------------------------------------------- /portable.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: Lisp; indent-tabs-mode: nil -*- 2 | 3 | (in-package :swap-bytes) 4 | 5 | (declaim (inline swap-bytes-16 swap-bytes-32 swap-bytes-64)) 6 | 7 | (defun swap-bytes-16 (integer) 8 | (declare (type (unsigned-byte 16) integer) 9 | (optimize (speed 3) (safety 0) (debug 0))) 10 | (logior (ash (logand #xFF integer) 8) 11 | (ash integer -8))) 12 | 13 | (defun swap-bytes-32 (integer) 14 | (declare (type (unsigned-byte 32) integer) 15 | (optimize (speed 3) (safety 0) (debug 0))) 16 | (logior (ash (logand #x0000FF integer) 24) 17 | (ash (logand #x00FF00 integer) 8) 18 | (ash (logand #xFF0000 integer) -8) 19 | (ash integer -24))) 20 | 21 | (defun swap-bytes-64 (integer) 22 | (declare (type (unsigned-byte 64) integer) 23 | (optimize (speed 3) (safety 0) (debug 0))) 24 | (macrolet ((shift (mask shift) 25 | `(ash (logand ,mask integer) ,shift))) 26 | (logior 27 | (shift #x000000000000FF 56) 28 | (shift #x0000000000FF00 40) 29 | (shift #x00000000FF0000 24) 30 | (shift #x000000FF000000 8) 31 | (shift #x0000FF00000000 -8) 32 | (shift #x00FF0000000000 -24) 33 | (shift #xFF000000000000 -40) 34 | (ash integer -56)))) 35 | -------------------------------------------------------------------------------- /sbcl-defknowns.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: Lisp; indent-tabs-mode: nil -*- 2 | 3 | (in-package #:swap-bytes) 4 | 5 | (defknown swap-bytes-16 ((unsigned-byte 16)) (unsigned-byte 16) 6 | (movable foldable flushable) 7 | :overwrite-fndb-silently t) 8 | 9 | (defknown swap-bytes-32 ((unsigned-byte 32)) (unsigned-byte 32) 10 | (movable foldable flushable) 11 | :overwrite-fndb-silently t) 12 | 13 | #+x86-64 14 | (defknown swap-bytes-64 ((unsigned-byte 64)) (unsigned-byte 64) 15 | (movable foldable flushable) 16 | :overwrite-fndb-silently t) 17 | -------------------------------------------------------------------------------- /sbcl-vops.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: Lisp; indent-tabs-mode: nil -*- 2 | 3 | (in-package :swap-bytes) 4 | 5 | #+x86 6 | (define-vop (16bit-swap-bytes) 7 | (:policy :fast-safe) 8 | (:translate swap-bytes-16) 9 | (:note "inline 16-bit swap bytes") 10 | (:args (integer :scs (sb-vm::unsigned-reg) :target eax)) 11 | (:arg-types sb-vm::unsigned-num) 12 | (:temporary (:sc sb-vm::unsigned-reg 13 | :offset sb-vm::eax-offset :target res 14 | :from :eval) 15 | eax) 16 | (:results (res :scs (sb-vm::unsigned-reg))) 17 | (:result-types sb-vm::unsigned-num) 18 | (:generator 2 19 | (move eax integer) 20 | (inst xchg sb-vm::al-tn sb-vm::ah-tn) 21 | (move res eax))) 22 | 23 | #+x86-64 24 | (define-vop (16bit-swap-bytes) 25 | (:policy :fast-safe) 26 | (:translate swap-bytes-16) 27 | (:note "inline 16-bit swap bytes") 28 | (:args (integer :scs (sb-vm::unsigned-reg) :target res)) 29 | (:arg-types sb-vm::unsigned-num) 30 | (:results (res :scs (sb-vm::unsigned-reg))) 31 | (:result-types sb-vm::unsigned-num) 32 | (:generator 2 33 | (move res integer) 34 | #+#1=#.(cl:if (cl:ignore-errors (sb-ext:assert-version->= 1 5 9 17) t) '(and) '(or)) 35 | (inst rol :word res 8) 36 | #-#1# 37 | (inst rol (sb-vm::reg-in-size res :word) 8))) 38 | 39 | #+x86 40 | (define-vop (32bit-swap-bytes) 41 | (:policy :fast-safe) 42 | (:translate swap-bytes-32) 43 | (:note "inline 32-bit swap bytes") 44 | (:args (integer :scs (sb-vm::unsigned-reg) :target res)) 45 | (:arg-types sb-vm::unsigned-num) 46 | (:results (res :scs (sb-vm::unsigned-reg))) 47 | (:result-types sb-vm::unsigned-num) 48 | (:generator 2 49 | (move res integer) 50 | (inst bswap res))) 51 | 52 | #+x86-64 53 | (define-vop (32bit-swap-bytes) 54 | (:policy :fast-safe) 55 | (:translate swap-bytes-32) 56 | (:note "inline 32-bit swap bytes") 57 | (:args (integer :scs (sb-vm::unsigned-reg) :target res)) 58 | (:arg-types sb-vm::unsigned-num) 59 | (:results (res :scs (sb-vm::unsigned-reg))) 60 | (:result-types sb-vm::unsigned-num) 61 | (:generator 2 62 | (move res integer) 63 | #+#1=#.(cl:if (cl:ignore-errors (sb-ext:assert-version->= 1 5 9 17) t) '(and) '(or)) 64 | (inst bswap :dword res) 65 | #-#1# 66 | (inst bswap (sb-vm::reg-in-size res :dword)))) 67 | 68 | #+x86-64 69 | (define-vop (64bit-swap-bytes) 70 | (:policy :fast-safe) 71 | (:translate swap-bytes-64) 72 | (:note "inline 64-bit swap bytes") 73 | (:args (integer :scs (sb-vm::unsigned-reg) :target res)) 74 | (:arg-types sb-vm::unsigned-num) 75 | (:results (res :scs (sb-vm::unsigned-reg))) 76 | (:result-types sb-vm::unsigned-num) 77 | (:generator 2 78 | (move res integer) 79 | (inst bswap res))) 80 | 81 | -------------------------------------------------------------------------------- /sbcl.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: Lisp; indent-tabs-mode: nil -*- 2 | 3 | (in-package :swap-bytes) 4 | 5 | (defun swap-bytes-16 (integer) 6 | (declare (type (unsigned-byte 16) integer)) 7 | (swap-bytes-16 integer)) 8 | 9 | (defun swap-bytes-32 (integer) 10 | (declare (type (unsigned-byte 32) integer)) 11 | (swap-bytes-32 integer)) 12 | 13 | #+x86 14 | (defun swap-bytes-64 (integer) 15 | (declare (type (unsigned-byte 64) integer) 16 | (optimize (speed 3) (safety 0) (debug 0))) 17 | (logior 18 | (swap-bytes-32 (ldb (byte 32 32) integer)) 19 | (ash (swap-bytes-32 (ldb (byte 32 0) integer)) 32))) 20 | 21 | #+x86-64 22 | (defun swap-bytes-64 (integer) 23 | (declare (type (unsigned-byte 64) integer)) 24 | (swap-bytes-64 integer)) 25 | -------------------------------------------------------------------------------- /swap-bytes.asd: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: Lisp; indent-tabs-mode: nil -*- 2 | 3 | #.(unless (or #+asdf3.1 (version<= "3.1" (asdf-version))) 4 | (error "You need ASDF >= 3.1 to load this system correctly.")) 5 | 6 | (defsystem :swap-bytes 7 | :author "Stas Boukarev " 8 | :maintainer "Stelian Ionescu " 9 | :description "Optimized byte-swapping primitives." 10 | :version (:read-file-form "version.sexp") 11 | :licence "MIT" 12 | :defsystem-depends-on (:trivial-features) 13 | :depends-on (:trivial-features) 14 | :components ((:file "package") 15 | (:file "ccl" 16 | :if-feature (:and :ccl (:or :x86 :x86-64)) 17 | :depends-on ("package")) 18 | (:file "sbcl-defknowns" 19 | :if-feature (:and :sbcl (:or :x86 :x86-64)) 20 | :depends-on ("package")) 21 | (:file "sbcl-vops" 22 | :if-feature (:and :sbcl (:or :x86 :x86-64)) 23 | :depends-on ("package" "sbcl-defknowns")) 24 | (:file "sbcl" 25 | :if-feature (:and :sbcl (:or :x86 :x86-64)) 26 | :depends-on ("package" "sbcl-defknowns" "sbcl-vops")) 27 | (:file "portable" 28 | :if-feature (:not (:or (:and :ccl (:or :x86 :x86-64)) 29 | (:and :sbcl (:or :x86 :x86-64)))) 30 | :depends-on ("package" "ccl" "sbcl")) 31 | (:file "network" :depends-on ("package" "portable")) 32 | (:file "endianness" :depends-on ("package" "portable"))) 33 | :in-order-to ((test-op (test-op :swap-bytes/test)))) 34 | 35 | (defsystem :swap-bytes/test 36 | :author "Stas Boukarev " 37 | :maintainer "Stelian Ionescu " 38 | :description "Swap-bytes test suite." 39 | :version (:read-file-form "version.sexp") 40 | :depends-on (:swap-bytes :fiveam) 41 | :components ((:file "test")) 42 | :perform (test-op (o c) (symbol-call :5am :run! :swap-bytes))) 43 | -------------------------------------------------------------------------------- /test.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: Lisp; indent-tabs-mode: nil -*- 2 | 3 | (defpackage #:swap-bytes-test 4 | (:use #:cl #:fiveam #:swap-bytes) 5 | (:export #:run-tests)) 6 | 7 | (in-package #:swap-bytes-test) 8 | 9 | (def-suite :swap-bytes) 10 | (in-suite :swap-bytes) 11 | 12 | (defun sb16p (integer) 13 | (declare (type (unsigned-byte 16) integer)) 14 | (logior (ash (logand #xFF integer) 8) 15 | (ash integer -8))) 16 | 17 | (defun sb32p (integer) 18 | (declare (type (unsigned-byte 32) integer)) 19 | (logior (ash (logand #xFF integer) 24) 20 | (ash (logand #xFF00 integer) 8) 21 | (ash (logand #xFF0000 integer) -8) 22 | (ash integer -24))) 23 | 24 | (defun sb64p (integer) 25 | (declare (type (unsigned-byte 64) integer)) 26 | (macrolet ((shift (mask shift) 27 | `(ash (logand ,mask integer) ,shift))) 28 | (logior 29 | (shift #xFF 56) 30 | (shift #xFF00 40) 31 | (shift #xFF0000 24) 32 | (shift #xFF000000 8) 33 | (shift #xFF00000000 -8) 34 | (shift #xFF0000000000 -24) 35 | (shift #xFF000000000000 -40) 36 | (ash integer -56)))) 37 | 38 | (defparameter *test-table* 39 | '((#xcafe #xfeca swap-bytes-16 sb16p) 40 | (#xf457 #x57f4 swap-bytes-16 sb16p) 41 | (#x0000 #x0000 swap-bytes-16 sb16p) 42 | (#xffff #xffff swap-bytes-16 sb16p) 43 | (#xcafedead #xaddefeca swap-bytes-32 sb32p) 44 | (#xb116b00b #x0bb016b1 swap-bytes-32 sb32p) 45 | (#xbe47dead #xadde47be swap-bytes-32 sb32p) 46 | (#xdeadbeef #xefbeadde swap-bytes-32 sb32p) 47 | (#x00000000 #x00000000 swap-bytes-32 sb32p) 48 | (#xffffffff #xffffffff swap-bytes-32 sb32p) 49 | (#xb116b00b1ee7babe #xbebae71e0bb016b1 swap-bytes-64 sb64p) 50 | (#xdeadbeefcafebabe #xbebafecaefbeadde swap-bytes-64 sb64p) 51 | (#x0000000000000000 #x0000000000000000 swap-bytes-64 sb64p) 52 | (#xffffffffffffffff #xffffffffffffffff swap-bytes-64 sb64p))) 53 | 54 | (test identity/funcall 55 | "Swapping a number twice gives the identity" 56 | (loop for (num nil fun) in *test-table* 57 | do (is (= (funcall fun (funcall fun num)) num)))) 58 | 59 | (test identity/compiled 60 | "Swapping a number twice gives the identity" 61 | (loop for (num nil fun) in *test-table* 62 | do (is (= (funcall fun (funcall fun num)) num)))) 63 | 64 | (test result/funcall 65 | "Simple values" 66 | (loop for (num snum fun) in *test-table* 67 | do (is (= (funcall fun num) snum)))) 68 | 69 | (test result/compiled 70 | "Simple values" 71 | (loop for (num snum fun) in *test-table* 72 | do (is (= (funcall (compile nil `(lambda (n) (,fun n))) 73 | num) 74 | snum)))) 75 | 76 | (test portable/funcall 77 | "Simple values" 78 | (loop for (num nil fun pfun) in *test-table* 79 | do (is (= (funcall fun num) 80 | (funcall pfun num))))) 81 | 82 | (test portable/compiled 83 | "Simple values" 84 | (loop for (num nil fun pfun) in *test-table* 85 | do (is (= (funcall (compile nil `(lambda (n) (,fun n))) 86 | num) 87 | (funcall pfun num))))) 88 | -------------------------------------------------------------------------------- /version.sexp: -------------------------------------------------------------------------------- 1 | ;; -*- lisp -*- 2 | "1.2" 3 | --------------------------------------------------------------------------------