/usr/share/common-lisp/source/nibbles/macro-utils.lisp is in cl-nibbles 20150709-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 | ;;;; macro-utils.lisp -- functions for compile-time macros
(cl:in-package :nibbles)
(defun byte-fun-name (bitsize signedp big-endian-p desc)
(let ((*package* (find-package :nibbles)))
(intern (format nil "~A~D~A/~A"
(symbol-name (if signedp :sb :ub))
bitsize
(symbol-name desc)
(symbol-name (if big-endian-p :be :le))))))
(defun float-fun-name (float-type big-endian-p desc)
(let ((*package* (find-package :nibbles)))
(intern (format nil "~A-~A-~A/~A"
(symbol-name :ieee)
(symbol-name float-type)
(symbol-name desc)
(symbol-name (if big-endian-p :be :le))))))
(defun byte-ref-fun-name (bitsize signedp big-endian-p)
(byte-fun-name bitsize signedp big-endian-p :ref))
(defun float-ref-fun-name (float-type big-endian-p)
(float-fun-name float-type big-endian-p :ref))
(defun byte-set-fun-name (bitsize signedp big-endian-p)
(byte-fun-name bitsize signedp big-endian-p :set))
(defun float-set-fun-name (float-type big-endian-p)
(float-fun-name float-type big-endian-p :set))
(defun stream-ref-fun-name (bitsize readp signedp big-endian-p)
(let ((*package* (find-package :nibbles)))
(intern (format nil "~A-~A~D/~A"
(symbol-name (if readp :read :write))
(symbol-name (if signedp :sb :ub))
bitsize
(symbol-name (if big-endian-p :be :le))))))
(defun stream-float-ref-fun-name (float-type readp big-endian-p)
(let ((*package* (find-package :nibbles)))
(intern (format nil "~A-~A-~A/~A"
(symbol-name (if readp :read :write))
(symbol-name :ieee)
(symbol-name float-type)
(symbol-name (if big-endian-p :be :le))))))
(defun stream-seq-fun-name (bitsize readp signedp big-endian-p)
(let ((*package* (find-package :nibbles)))
(intern (format nil "~A-~A~D/~A-~A"
(symbol-name (if readp :read :write))
(symbol-name (if signedp :sb :ub))
bitsize
(symbol-name (if big-endian-p :be :le))
(symbol-name :sequence)))))
(defun stream-float-seq-fun-name (float-type readp big-endian-p)
(let ((*package* (find-package :nibbles)))
(intern (format nil "~A-~A-~A/~A-~A"
(symbol-name (if readp :read :write))
(symbol-name :ieee)
(symbol-name float-type)
(symbol-name (if big-endian-p :be :le))
(symbol-name :sequence)))))
(defun stream-into-seq-fun-name (bitsize signedp big-endian-p)
(let ((*package* (find-package :nibbles)))
(intern (format nil "~A-~A~D/~A-~A"
(symbol-name :read)
(symbol-name (if signedp :sb :ub))
bitsize
(symbol-name (if big-endian-p :be :le))
(symbol-name :into-sequence)))))
(defun stream-float-into-seq-fun-name (float-type big-endian-p)
(let ((*package* (find-package :nibbles)))
(intern (format nil "~A-~A/~A-~A"
(symbol-name :read-ieee)
(symbol-name float-type)
(symbol-name (if big-endian-p :be :le))
(symbol-name :into-sequence)))))
(defun internalify (s)
(let ((*package* (find-package :nibbles)))
(intern (concatenate 'string "%" (string s)))))
(defun format-docstring (&rest args)
(loop with docstring = (apply #'format nil args)
for start = 0 then (when pos (1+ pos))
for pos = (and start (position #\Space docstring :start start))
while start
collect (subseq docstring start pos) into words
finally (return (format nil "~{~<~%~1,76:;~A~>~^ ~}"
words))))
(defun ref-form (vector-name index-name byte-size signedp big-endian-p)
"Return a form that fetches a SIGNEDP BYTE-SIZE value from VECTOR-NAME,
starting at INDEX-NAME. The value is stored in the vector according to
BIG-ENDIAN-P."
(multiple-value-bind (low high increment compare)
(if big-endian-p
(values 0 (1- byte-size) 1 #'>)
(values (1- byte-size) 0 -1 #'<))
(do ((i (+ low increment) (+ i increment))
(shift (* (- byte-size 2) 8) (- shift 8))
(forms nil))
((funcall compare i high)
`(let* ((high-byte (aref , vector-name
(+ ,index-name ,low)))
;; Would be great if we could just sign-extend along
;; with the load, but this is as good as it gets in
;; portable Common Lisp.
(signed-high ,(if signedp
`(if (logbitp 7 high-byte)
(- high-byte 256)
high-byte)
'high-byte))
(shifted-into-place
(ash signed-high ,(* (1- byte-size) 8))))
(declare (type (unsigned-byte 8) high-byte))
(declare (type (,(if signedp 'signed-byte 'unsigned-byte) 8)
signed-high))
(logior shifted-into-place ,@(nreverse forms))))
(push `(ash (aref ,vector-name
(+ ,index-name ,i))
,shift)
forms))))
(defun set-form (vector-name index-name value-name byte-size big-endian-p)
"Return a form that stores a BYTE-SIZE VALUE-NAME into VECTOR-NAME,
starting at INDEX-NAME. The value is stored in the vector according to
BIG-ENDIAN-P. The form returns VALUE-NAME."
`(progn
,@(loop for i from 1 to byte-size
collect (let ((offset (if big-endian-p
(- byte-size i)
(1- i))))
`(setf (aref ,vector-name
(+ ,index-name ,offset))
(ldb (byte 8 ,(* 8 (1- i))) ,value-name))))
,value-name))
|