Ignore:
Timestamp:
11/28/2007 03:50:39 AM (19 years ago)
Author:
David Owen <dsowen@…>
branch-nick:
64-bit
revision id:
dsowen@tux-20071128035039-edmhe5hgjsmjzt4w
Message:

Second pass at 64-bit cleanness. Have now touched all files.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • combined/src/odbc/parameter.lisp

    r2.1.1 r2.1.2  
    5656;;;; dso: not so sure about this one and its callers
    5757(defun bind-parameter (hstmt pos param)
    58   (setf (slot-value param 'ind-ptr) 
     58  (setf (slot-value param 'ind-ptr)
    5959        (cffi:foreign-alloc 'sql-len))
    60   (%sql-bind-parameter 
     60  (%sql-bind-parameter
    6161   hstmt
    6262   pos
    … …  
    9797  ())
    9898
     99;; dso+
    99100(defmethod initialize-parameter ((param string-parameter) args)
    100101  (let ((length-of-buffer (or (car args) *default-string-parameter-size*)))
    … …  
    108109      (setf value-ptr (alloc-chars length-of-buffer)))))
    109110
     111;; dso+
    110112(defmethod set-parameter-value ((param string-parameter) value)
    111113  (cond
    112114    ((null value)
    113       (setf  (cffi:mem-ref (slot-value param 'ind-ptr) :long)
    114               $SQL_NULL_DATA)
    115       (put-string (slot-value param 'value-ptr) ""))
    116     (t
    117       (cffi:lisp-string-to-foreign value (slot-value param 'value-ptr) (1+ (length value)))
    118       (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long)
    119               (length  value)))))
    120 
     115     (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len)
     116           $SQL_NULL_DATA)
     117     (put-string (slot-value param 'value-ptr) ""))
     118    (t
     119     (cffi:lisp-string-to-foreign value
     120                                  (slot-value param 'value-ptr)
     121                                  (1+ (length value)))
     122     (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len)
     123           (length value)))))
     124
     125;; dso+
    121126(defmethod get-parameter-value ((param string-parameter))
    122   (let ((len (cffi:mem-ref (slot-value param 'ind-ptr) :long)))
     127  (let ((len (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len)))
    123128    (if (= len $SQL_NULL_DATA)
    124       nil
    125       (progn
    126         (get-string (slot-value param 'value-ptr) len)))))
     129        nil
     130        (progn
     131          (get-string (slot-value param 'value-ptr) len)))))
    127132
    128133;;------------------------
    … …  
    132137  ())
    133138
     139;; dso+
    134140(defmethod initialize-parameter ((param unicode-string-parameter) args)
    135   (let ((length-of-buffer (* 2 (or (car args) *default-string-parameter-size*))))
     141  (let ((length-of-buffer
     142         (* 2 (or (car args) *default-string-parameter-size*))))
    136143    (with-slots (value-type parameter-type buffer-length
    137144                            column-size value-ptr
    … …  
    143150      (setf value-ptr (cffi:foreign-alloc :uint8 :count length-of-buffer)))))
    144151
     152;; dso+
    145153(defmethod set-parameter-value ((param unicode-string-parameter) value)
    146154  (cond
    147155    ((null value)
    148       (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long)
    149               $SQL_NULL_DATA)
    150       ;; not necessary
    151       (%put-unicode-string (slot-value param 'value-ptr) ""))
    152     (t
    153       (%put-unicode-string (slot-value param 'value-ptr) value)
    154       (setf  (cffi:mem-ref (slot-value param 'ind-ptr) :long)
    155               (* 2 (length  value))))))
    156 
     156     (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len)
     157           $SQL_NULL_DATA)
     158     ;; not necessary
     159     (%put-unicode-string (slot-value param 'value-ptr) ""))
     160    (t
     161     (%put-unicode-string (slot-value param 'value-ptr) value)
     162     (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len)
     163           (* 2 (length value))))))
     164
     165;; dso+
    157166(defmethod get-parameter-value ((param unicode-string-parameter))
    158   (let ((len (cffi:mem-ref (slot-value param 'ind-ptr) :long)))
     167  (let ((len (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len)))
    159168    (if (= len $SQL_NULL_DATA)
    160       nil
    161       (progn
    162         (%get-unicode-string (slot-value param 'value-ptr) len)))))
     169        nil
     170        (progn
     171          (%get-unicode-string (slot-value param 'value-ptr) len)))))
    163172
    164173;;----------------------
    … …  
    169178  ())
    170179
     180;; dso+
    171181(defmethod initialize-parameter ((param integer-parameter) args)
    172182  (assert (not args))
    … …  
    179189
    180190(defmethod set-parameter-value ((param integer-parameter) value)
    181   (cond 
     191  (cond
    182192    ((null value)
    183       (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long)
    184               $SQL_NULL_DATA))
    185     (t (setf (cffi:mem-ref (slot-value param 'value-ptr) :long)
    186                value)
    187       (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long) 0))))
     193     (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len)
     194           $SQL_NULL_DATA))
     195    (t (setf (cffi:mem-ref (slot-value param 'value-ptr) 'sql-integer)
     196             value)
     197       (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len) 0))))
    188198
    189199(defmethod get-parameter-value ((param integer-parameter))
    190   (let ((len (cffi:mem-ref (slot-value param 'ind-ptr) :long)))
     200  (let ((len (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len)))
    191201    (if (= len $SQL_NULL_DATA)
    192       nil
    193       (progn
    194         (cffi:mem-ref (slot-value param 'value-ptr) :long)))))
     202        nil
     203        (progn
     204          (cffi:mem-ref (slot-value param 'value-ptr) 'sql-integer)))))
    195205
    196206
    … …  
    202212  ())
    203213
     214;; dso+
    204215(defmethod initialize-parameter ((param double-parameter) args)
    205216  (assert (not args))
    206    (with-slots (value-type parameter-type buffer-length value-ptr
    207                            ind-ptr) param
    208      (setf value-type $SQL_C_DOUBLE)
    209      (setf parameter-type $SQL_DOUBLE)
    210      (setf buffer-length 8)
    211      (setf value-ptr (cffi:foreign-alloc :double ))))
    212 
     217  (with-slots (value-type parameter-type buffer-length value-ptr
     218                          ind-ptr) param
     219    (setf value-type $SQL_C_DOUBLE)
     220    (setf parameter-type $SQL_DOUBLE)
     221    (setf buffer-length 8)
     222    (setf value-ptr (cffi:foreign-alloc :double))))
     223
     224;; dso+
    213225(defmethod set-parameter-value ((param double-parameter) value)
    214    (cond 
    215      ((null value)
    216        (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long)
    217                $SQL_NULL_DATA))
    218      (t
    219        (setf (cffi:mem-ref (slot-value param 'value-ptr) :double)
    220                (coerce value 'double-float))
    221        (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long) 8))))
    222 
     226  (cond
     227    ((null value)
     228     (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len)
     229           $SQL_NULL_DATA))
     230    (t
     231     (setf (cffi:mem-ref (slot-value param 'value-ptr) :double)
     232           (coerce value 'double-float))
     233     (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len) 8))))
     234
     235;; dso+
    223236(defmethod get-parameter-value ((param double-parameter))
    224     (if (= (cffi:mem-ref (slot-value param 'ind-ptr) :long) $SQL_NULL_DATA)
     237  (if (= (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len) $SQL_NULL_DATA)
    225238      nil
    226239      (cffi:mem-ref (slot-value param 'value-ptr) :double)))
    … …  
    243256     (setf value-ptr (cffi:foreign-alloc :uchar :count 24))))
    244257
    245 
     258;; dso+
    246259(defmethod set-parameter-value ((param date-parameter) value)
    247260  (if (null value)
    248     (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long)
     261      (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len)
    249262            $SQL_NULL_DATA)
    250     (progn
    251       ;; fixme warum 1?
    252       (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long) 1)
    253       (multiple-value-bind (sec min hour day month year)
    254           (decode-universal-time 
    255            (funcall *date-datatype-to-universal-time* value))
    256         (%put-sql-c-timestamp (slot-value param 'value-ptr) year month day hour min sec 0)))))
    257 
     263      (progn
     264        ;; fixme warum 1?
     265        (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len) 1)
     266        (multiple-value-bind (sec min hour day month year)
     267            (decode-universal-time
     268             (funcall *date-datatype-to-universal-time* value))
     269          (%put-sql-c-timestamp (slot-value param 'value-ptr) year month day hour min sec 0)))))
     270
     271;; dso+
    258272(defmethod get-parameter-value ((param date-parameter))
    259   (let ((len (cffi:mem-ref (slot-value param 'ind-ptr) :long)))
    260     (if (= len $SQL_NULL_DATA) 
    261       nil
    262       (funcall *universal-time-to-date-dataype*
    263                 (timestamp-to-universal-time (slot-value param 'value-ptr))))))
     273  (let ((len (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len)))
     274    (if (= len $SQL_NULL_DATA)
     275        nil
     276        (funcall *universal-time-to-date-dataype*
     277                 (timestamp-to-universal-time (slot-value param 'value-ptr))))))
    264278
    265279
Note: See TracChangeset for help on using the changeset viewer.