Changeset 64-bit,7


Ignore:
Timestamp:
11/28/2007 03:52:35 AM (19 years ago)
Author:
David Owen <dsowen@…>
branch-nick:
64-bit
revision id:
dsowen@tux-20071128035235-mieddjyp9gu0ifr4
Message:

Full pass. Not sure about *LOB stuff.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • 64-bit/src/odbc/parameter.lisp

    r4 r7  
    5454      param)))
    5555
    56 ;;;; dso: not so sure about this one and its callers
    5756(defun bind-parameter (hstmt pos param)
    5857  (setf (slot-value param 'ind-ptr)
    … …  
    9796  ())
    9897
    99 ;; dso+
    10098(defmethod initialize-parameter ((param string-parameter) args)
    10199  (let ((length-of-buffer (or (car args) *default-string-parameter-size*)))
    … …  
    109107      (setf value-ptr (alloc-chars length-of-buffer)))))
    110108
    111 ;; dso+
    112109(defmethod set-parameter-value ((param string-parameter) value)
    113110  (cond
    … …  
    123120           (length value)))))
    124121
    125 ;; dso+
    126122(defmethod get-parameter-value ((param string-parameter))
    127123  (let ((len (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len)))
    … …  
    137133  ())
    138134
    139 ;; dso+
    140135(defmethod initialize-parameter ((param unicode-string-parameter) args)
    141136  (let ((length-of-buffer
    … …  
    150145      (setf value-ptr (cffi:foreign-alloc :uint8 :count length-of-buffer)))))
    151146
    152 ;; dso+
    153147(defmethod set-parameter-value ((param unicode-string-parameter) value)
    154148  (cond
    … …  
    163157           (* 2 (length value))))))
    164158
    165 ;; dso+
    166159(defmethod get-parameter-value ((param unicode-string-parameter))
    167160  (let ((len (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len)))
    … …  
    178171  ())
    179172
    180 ;; dso+
    181173(defmethod initialize-parameter ((param integer-parameter) args)
    182174  (assert (not args))
    … …  
    185177    (setf value-type $SQL_C_LONG)
    186178    (setf parameter-type $SQL_INTEGER)
    187     (setf buffer-length 4)
     179    (setf buffer-length (cffi:foreign-type-size 'sql-integer))
    188180    (setf value-ptr (cffi:foreign-alloc 'sql-integer))))
    189181
    … …  
    212204  ())
    213205
    214 ;; dso+
    215206(defmethod initialize-parameter ((param double-parameter) args)
    216207  (assert (not args))
    … …  
    219210    (setf value-type $SQL_C_DOUBLE)
    220211    (setf parameter-type $SQL_DOUBLE)
    221     (setf buffer-length 8)
     212    (setf buffer-length (cffi:foreign-type-size :double))
    222213    (setf value-ptr (cffi:foreign-alloc :double))))
    223214
    224 ;; dso+
    225215(defmethod set-parameter-value ((param double-parameter) value)
    226216  (cond
    … …  
    231221     (setf (cffi:mem-ref (slot-value param 'value-ptr) :double)
    232222           (coerce value 'double-float))
    233      (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len) 8))))
    234 
    235 ;; dso+
     223     (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len)
     224           (cffi:foreign-type-size :double)))))
     225
    236226(defmethod get-parameter-value ((param double-parameter))
    237227  (if (= (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len) $SQL_NULL_DATA)
    … …  
    256246     (setf value-ptr (cffi:foreign-alloc :uchar :count 24))))
    257247
    258 ;; dso+
    259248(defmethod set-parameter-value ((param date-parameter) value)
    260249  (if (null value)
    … …  
    269258          (%put-sql-c-timestamp (slot-value param 'value-ptr) year month day hour min sec 0)))))
    270259
    271 ;; dso+
    272260(defmethod get-parameter-value ((param date-parameter))
    273261  (let ((len (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len)))
    … …  
    295283
    296284(defmethod set-parameter-value ((param binary-parameter) value)
    297 (if (null value)
    298   (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long)
    299           $SQL_NULL_DATA)
    300     (if (< (slot-value param 'buffer-length) (length value))
    301       (progn
    302         (error "buffer is to small")
    303         ; we could increase the buffer size with another bind parameter
    304         ; or set data_at_execution =1
    305         )
    306       (progn
    307         ;(break)
    308         (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long)
    309                 (length value))
    310         (put-byte-vector (slot-value param 'value-ptr) value)))))
     285  (if (null value)
     286      (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len)
     287            $SQL_NULL_DATA)
     288      (if (< (slot-value param 'buffer-length) (length value))
     289          (progn
     290            (error "buffer is to small")
     291            ;; we could increase the buffer size with another bind
     292            ;; parameter or set data_at_execution =1
     293            )
     294          (progn
     295            ;; (break)
     296            (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len)
     297                  (length value))
     298            (put-byte-vector (slot-value param 'value-ptr) value)))))
    311299
    312300
    313301(defmethod get-parameter-value ((param binary-parameter))
    314   (let ((len (cffi:mem-ref (slot-value param 'ind-ptr) :long)))
     302  (let ((len (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len)))
    315303    (if (= len $SQL_NULL_DATA)
    316       nil
    317       (get-byte-vector (slot-value param 'value-ptr) len))))
     304        nil
     305        (get-byte-vector (slot-value param 'value-ptr) len))))
    318306
    319307
    … …  
    338326    ;; the value-ptr will be needed to find the parameter, 
    339327    ;; we store the position there
    340     (setf buffer-length 4)
    341     (setf value-ptr (cffi:foreign-alloc 'sql-len))))
     328    (setf buffer-length (cffi:foreign-type-size 'sql-pointer))
     329    (setf value-ptr (cffi:foreign-alloc 'sql-pointer))))
    342330
    343331(defmethod set-parameter-value ((param clob-parameter) value)
    344332  (if (null value)
    345     (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long)
     333      (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len)
    346334            $SQL_NULL_DATA)
    347     (progn
    348       (setf (slot-value param 'temp-val) value)
    349       (setf (cffi:mem-ref (slot-value param 'value-ptr) :long)
    350                                 (slot-value param 'position))
    351       (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long)
     335      (progn
     336        (setf (slot-value param 'temp-val) value)
     337        (setf (cffi:mem-ref (slot-value param 'value-ptr) 'sql-pointer)
     338              (slot-value param 'position))
     339        (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len)
    352340              (%sql-len-data-at-exec (length value))))))
    353341
    … …  
    388376    ;; the value-ptr will be needed to find the parameter, 
    389377    ;; we store the position there
    390     (setf buffer-length 4)
    391     (setf value-ptr (cffi:foreign-alloc 'sql-len))))
     378    (setf buffer-length (cffi:foreign-type-size 'sql-pointer))
     379    (setf value-ptr (cffi:foreign-alloc 'sql-pointer))))
    392380
    393381(defmethod set-parameter-value ((param uclob-parameter) value)
    394382  (if (null value)
    395     (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long)
     383    (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len)
    396384            $SQL_NULL_DATA)
    397385    (progn
    398386      (setf (slot-value param 'temp-val) value)
    399       (setf (cffi:mem-ref (slot-value param 'value-ptr) :long)
     387      (setf (cffi:mem-ref (slot-value param 'value-ptr) 'sql-pointer)
    400388              (slot-value param 'position))
    401       (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long)
     389      (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len)
    402390                 (%sql-len-data-at-exec (* 2 (length value)))))))
    403391
    … …  
    437425    ;; the value-ptr will be needed to find the parameter,
    438426    ;; we store the position there
    439     (setf buffer-length 4)
    440     (setf value-ptr (cffi:foreign-alloc 'sql-len))))
     427    (setf buffer-length (cffi:foreign-type-size 'sql-pointer))
     428    (setf value-ptr (cffi:foreign-alloc 'sql-pointer))))
    441429
    442430(defmethod set-parameter-value ((param blob-parameter) value)
    443431  (if (null value)
    444     (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long)
     432    (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len)
    445433            $SQL_NULL_DATA)
    446434    (progn
    447435      (setf (slot-value param 'temp-val) value)
    448       (setf (cffi:mem-ref (slot-value param 'value-ptr) :long)
     436      (setf (cffi:mem-ref (slot-value param 'value-ptr) 'sql-pointer)
    449437              (slot-value param 'position))
    450       (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long)
     438      (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len)
    451439              (%sql-len-data-at-exec (length value))))))
    452440
Note: See TracChangeset for help on using the changeset viewer.