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
|
;;;
;;; types.lisp
;;;
;;; Created: 2005-03-12 by Zach Beane <xach@xach.com>
;;;
;;; Copyright (c) 2005 Zachary Beane, All Rights Reserved
;;;
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;;
;;; * Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;;
;;; * Redistributions in binary form must reproduce the above
;;; copyright notice, this list of conditions and the following
;;; disclaimer in the documentation and/or other materials
;;; provided with the distribution.
;;;
;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;;;
;;; $Id: types.lisp,v 1.4 2005/04/01 22:09:58 xach Exp $
(in-package :salza-types)
(deftype octet ()
'(unsigned-byte 8))
(deftype buffer-offset ()
'(integer 0 #.(1- array-dimension-limit)))
(deftype octet-vector ()
'(simple-array octet (*)))
;;; Macrology for porting effectively to various implementaions.
;;; LW 4.4 port by Dmitriy Ivanov
#+(and lispworks (not (or lispworks4.3 lispworks4.2 lispworks4.1 lispworks4.0)))
(eval-when (:compile-toplevel :execute)
(pushnew :lw-int32 *features*))
;;; Type use for compression trigram (or general-purpose?)
(deftype ub24 ()
#+lw-int32 'sys:int32
#-lw-int32 '(unsigned-byte 24))
(defmacro ub-octet (position arg)
;;; General pseudo-unsigned-byte accessor a la ldb.
;; Args: position - bit position.
#+lw-int32
`(the octet (sys:int32-to-integer (sys:int32-logand ,(if (eql position 0)
arg
`(sys:int32>> ,arg ,position))
#xFF)))
#-lw-int32
`(the octet (ldb (byte 8 ,position) ,arg)))
(defmacro ub24<<push (ub24 octet)
#+lw-int32
`(sys:int32-logior (sys:int32<< (sys:int32-logand ,ub24 #xFFFF) 8) (the octet ,octet))
#-lw-int32
`(the ub24 (logior (the ub24 (ash (the ub24 (logand ,ub24 #xFFFF)) 8))
(the octet ,octet))))
(define-symbol-macro +ub24-0+
#+lw-int32 sys:+int32-0+
#-lw-int32 0)
(deftype fixhash-integer ()
"#xFFFFFF is out of fixnum range on LispWorks."
#+lw-int32 'fixnum
#-lw-int32 '(integer 0 #xFFFFFF))
(defmacro ub24-fixhash (ub24)
#+lw-int32
`(the fixhash-integer (sys:int32-to-integer (sys:int32+ ,ub24 most-negative-fixnum)))
#-lw-int32
ub24)
|
