/usr/share/common-lisp/source/clsql-uffi/uffi/clsql-uffi.lisp is in cl-sql-uffi 6.7.0-1build1.
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 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 | ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Name: clsql-uffi.cl
;;;; Purpose: Common functions for interfaces using UFFI
;;;; Programmers: Kevin M. Rosenberg
;;;; Date Started: Mar 2002
;;;;
;;;; This file, part of CLSQL, is Copyright (c) 2002-2010 by Kevin M. Rosenberg
;;;;
;;;; CLSQL users are granted the rights to distribute and use this software
;;;; as governed by the terms of the Lisp Lesser GNU Public License
;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;; *************************************************************************
(in-package #:clsql-uffi)
(defun canonicalize-type-list (types auto-list)
"Ensure a field type list meets expectations"
(declare (optimize (speed 3) (safety 0)))
(do ((i 0 (1+ i))
(new-types '())
(length-types (length types))
(length-auto-list (length auto-list)))
((= i length-auto-list)
(nreverse new-types))
(declare (fixnum length-types length-auto-list i))
(if (>= i length-types)
(push t new-types) ;; types is shorter than num-fields
(push
(case (nth i types)
(:int
(case (nth i auto-list)
(:int32
:int32)
(:int64
:int64)
(t
t)))
(:double
(case (nth i auto-list)
(:double
:double)
(t
t)))
(:int32
(if (eq :int32 (nth i auto-list))
:int32
t))
(:int64
(if (eq :int64 (nth i auto-list))
:int64
t))
(:blob
:blob)
(:uint
:uint)
(t
t))
new-types))))
(uffi:def-function "atoi"
((str (* :unsigned-char)))
:returning :int)
(uffi:def-function ("strtoul" c-strtoul)
((str (* :unsigned-char))
(endptr (* :unsigned-char))
(radix :int))
:returning :unsigned-long)
#-windows
(uffi:def-function ("strtoull" c-strtoull)
((str (* :unsigned-char))
(endptr (* :unsigned-char))
(radix :int))
:returning :unsigned-long-long)
#-windows
(uffi:def-function ("strtoll" c-strtoll)
((str (* :unsigned-char))
(endptr (* :unsigned-char))
(radix :int))
:returning :long-long)
#+windows
(uffi:def-function ("_strtoui64" c-strtoull)
((str (* :unsigned-char))
(endptr (* :unsigned-char))
(radix :int))
:returning :unsigned-long-long)
#+windows
(uffi:def-function ("_strtoi64" c-strtoll)
((str (* :unsigned-char))
(endptr (* :unsigned-char))
(radix :int))
:returning :long-long)
(uffi:def-function "atol"
((str (* :unsigned-char)))
:returning :long)
(uffi:def-function "atof"
((str (* :unsigned-char)))
:returning :double)
(uffi:def-constant +2^32+ 4294967296)
(uffi:def-constant +2^64+ 18446744073709551616)
(uffi:def-constant +2^32-1+ (1- +2^32+))
(defmacro make-64-bit-integer (high32 low32)
`(if (zerop (ldb (byte 1 31) ,high32))
(+ ,low32 (ash ,high32 32))
(- (+ ,low32 (ash ,high32 32)) +2^64+)))
;; From high to low ints
(defmacro make-128-bit-integer (a b c d)
`(+ ,d (ash ,c 32) (ash ,b 64) (ash ,a 96)))
(defmacro split-64-bit-integer (int64)
`(values (ash ,int64 -32) (logand ,int64 +2^32-1+)))
(uffi:def-type char-ptr-def (* :unsigned-char))
(defun strtoul (char-ptr)
(declare (optimize (speed 3) (safety 0) (space 0))
(type char-ptr-def char-ptr))
(c-strtoul char-ptr uffi:+null-cstring-pointer+ 10))
(defun strtoull (char-ptr)
(declare (optimize (speed 3) (safety 0) (space 0))
(type char-ptr-def char-ptr))
(c-strtoull char-ptr uffi:+null-cstring-pointer+ 10))
(defun strtoll (char-ptr)
(declare (optimize (speed 3) (safety 0) (space 0))
(type char-ptr-def char-ptr))
(c-strtoll char-ptr uffi:+null-cstring-pointer+ 10))
(defun convert-raw-field (char-ptr type &key length encoding)
(declare (optimize (speed 3) (safety 0) (space 0))
(type char-ptr-def char-ptr))
(unless (uffi:null-pointer-p char-ptr)
(case type
(:double (atof char-ptr))
(:int (atol char-ptr))
(:int32 (atoi char-ptr))
(:uint32 (strtoul char-ptr))
(:uint (strtoul char-ptr))
(:int64 (strtoll char-ptr))
(:uint64 (strtoull char-ptr))
(:blob
(if length
(uffi:convert-from-foreign-usb8 char-ptr length)
(error "Can't return blob since length is not specified.")))
(t
;; NB: this used to manually expand the arg list based on if length and encoding
;; were provided. If this is required the macro is aweful and should be rewritten
;; to accept nil args (as it appears to)
(uffi:convert-from-foreign-string
char-ptr
:null-terminated-p (null length)
:length length
:encoding encoding)))))
|