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

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

    r1 r4  
    7777              column
    7878            ;(setf value-ptr (cffi:foreign-alloc :long buffer-length))
    79             (setf ind-ptr (cffi:foreign-alloc :long))
     79            (setf ind-ptr (cffi:foreign-alloc 'sql-len))
    8080            (%bind-column hstmt
    8181                          pos
    … …  
    112112          (cffi:foreign-alloc :char :count (slot-value column 'buffer-length))))
    113113
     114;; dso+
    114115(defmethod get-column-value ((column string-column))
    115   (let ((len (cffi:mem-ref (slot-value column 'ind-ptr) :long)))
     116  (let ((len (cffi:mem-ref (slot-value column 'ind-ptr) 'sql-len)))
    116117    (if (= len $SQL_NULL_DATA)
    117       nil
    118       (progn
    119         (get-string (slot-value column 'value-ptr) len)))))
     118        nil
     119        (progn
     120          (get-string (slot-value column 'value-ptr) len)))))
    120121;;;-------------------
    121122;;;   unicode-string
    … …  
    146147          (cffi:foreign-alloc :uchar :count (slot-value column 'buffer-length))))
    147148
     149;; dso+
    148150(defmethod get-column-value ((column unicode-string-column))
    149   (let ((len (cffi:mem-ref (slot-value column 'ind-ptr) :long)))
     151  (let ((len (cffi:mem-ref (slot-value column 'ind-ptr) 'sql-len)))
    150152    ;; len is size in bytes, not characters!
    151153    (if (= len $SQL_NULL_DATA)
    152       nil
    153       (progn
    154 ;        (break)
    155         (wchar-bytes-to-string (get-byte-vector (slot-value column 'value-ptr) len))))))
     154        nil
     155        (progn
     156          ;; (break)
     157          (wchar-bytes-to-string (get-byte-vector (slot-value column 'value-ptr) len))))))
    156158
    157159
    … …  
    166168  (declare (ignore args))
    167169  (setf (slot-value column 'c-type) $SQL_C_SLONG)
    168   (setf (slot-value column 'buffer-length)
    169           (cffi:foreign-type-size :long))
    170   (setf (slot-value column 'value-ptr)
    171           (cffi:foreign-alloc :long)))
    172 
    173 
     170  (setf (slot-value column 'buffer-length)
     171        (cffi:foreign-type-size 'sql-integer))
     172  (setf (slot-value column 'value-ptr)
     173        (cffi:foreign-alloc 'sql-integer)))
     174
     175
     176;; dso+
    174177(defmethod get-column-value ((column integer-column))
    175   (let ((len (cffi:mem-ref (slot-value column 'ind-ptr) :long)))
     178  (let ((len (cffi:mem-ref (slot-value column 'ind-ptr) 'sql-len)))
    176179    (if (= len $SQL_NULL_DATA)
    177       nil
    178       (cffi:mem-ref (slot-value column 'value-ptr) :long))))
     180        nil
     181        (cffi:mem-ref (slot-value column 'value-ptr) 'sql-integer))))
    179182
    180183
    … …  
    185188(defclass double-column (column) ())
    186189
     190;; dso+
    187191(defmethod initialize-column ((column double-column) args)
    188192  (declare (ignore args))
    … …  
    192196  (setf (slot-value column 'value-ptr) (cffi:foreign-alloc :double)))
    193197
     198;; dso+
    194199(defmethod get-column-value ((column double-column))
    195   ;(%get-long (slot-value column 'ind-ptr))
    196   ;(%get-double-float (slot-value column 'value-ptr))
    197    (let ((len (cffi:mem-ref (slot-value column 'ind-ptr) :long)))
    198      (if (= len $SQL_NULL_DATA)
    199        nil
    200        (progn
    201          (cffi:mem-ref (slot-value column 'value-ptr) :double)))))
     200  ;; (%get-long (slot-value column 'ind-ptr))
     201  ;; (%get-double-float (slot-value column 'value-ptr))
     202  (let ((len (cffi:mem-ref (slot-value column 'ind-ptr) 'sql-len)))
     203    (if (= len $SQL_NULL_DATA)
     204        nil
     205        (progn
     206          (cffi:mem-ref (slot-value column 'value-ptr) :double)))))
    202207
    203208;;;------------------------
    … …  
    206211(defclass date-column (column) ())
    207212
     213;; dso+
    208214(defmethod initialize-column ((column date-column) args)
    209215  (declare (ignore args))
    … …  
    213219  (setf (slot-value column 'value-ptr) (cffi:foreign-alloc :uchar :count 32)))
    214220
     221;; dso+
    215222(defmethod get-column-value ((column date-column))
    216    (let ((len (cffi:mem-ref (slot-value column 'ind-ptr) :long)))
     223  (let ((len (cffi:mem-ref (slot-value column 'ind-ptr) 'sql-len)))
    217224    (if (= len $SQL_NULL_DATA)
    218       nil
    219       (funcall *universal-time-to-date-dataype*
    220                (timestamp-to-universal-time (slot-value column 'value-ptr))))))
     225        nil
     226        (funcall *universal-time-to-date-dataype*
     227                 (timestamp-to-universal-time (slot-value column 'value-ptr))))))
    221228
    222229;;;--------------------------
    … …  
    251258(defclass bigint-column (column) ())
    252259
     260;; dso+
    253261(defmethod initialize-column ((column bigint-column) args)
    254262  (declare (ignore args))
    … …  
    259267  (setf (slot-value column 'value-ptr) (cffi:foreign-alloc :uchar :count 25)))
    260268
     269;; dso+
    261270(defmethod get-column-value ((column bigint-column))
    262   (let ((len (cffi:mem-ref (slot-value column 'ind-ptr) :long)))
    263     (if (= len $SQL_NULL_DATA) 
    264       nil
    265       (parse-integer (get-string (slot-value column 'value-ptr) len)))))
     271  (let ((len (cffi:mem-ref (slot-value column 'ind-ptr) 'sql-len)))
     272    (if (= len $SQL_NULL_DATA)
     273        nil
     274        (parse-integer (get-string (slot-value column 'value-ptr) len)))))
    266275
    267276;;;----------------------------
    … …  
    403412;;  fetch data via SQlGetData
    404413;; ------------------------------
     414;; dso+
    405415(defun get-character-data (hstmt position value-ptr buffer-length ind-ptr)
    406416  ;; local error handling, we can not use the general error handling
    … …  
    423433                                      ind-ptr)))
    424434      (handle-error sqlret)
    425       (let ((len (cffi:mem-ref ind-ptr :long)))
    426         ;(break)
     435      (let ((len (cffi:mem-ref ind-ptr 'sql-len)))
     436        ;;(break)
    427437        (cond
    428438          ((= len $sql_null_data) nil)
    429           ;; character data has a 0 byte appended, the length does not include it
    430           ;; but it is taken into account when placing the data into the buffer
     439          ;; character data has a 0 byte appended, the length does not
     440          ;; include it but it is taken into account when placing the
     441          ;; data into the buffer
    431442          ((and (/= len $SQL_NO_TOTAL)
    432443                (<= (+ 1 len) buffer-length))
    433             ;; the data fits into the buffer, return it
    434             (get-string value-ptr len))
     444           ;; the data fits into the buffer, return it
     445           (get-string value-ptr len))
    435446         
    436447          ;; we have to fetch the data in several steps
    437448          (t
    438             (let ((sos (make-string-output-stream)))
    439               (loop
    440                 (if (and (= sqlret $SQL_SUCCESS_WITH_INFO)
    441                          (equal (sql-state nil nil hstmt)
    442                                 "01004"))
     449           (let ((sos (make-string-output-stream)))
     450             (loop
     451              (if (and (= sqlret $SQL_SUCCESS_WITH_INFO)
     452                       (equal (sql-state nil nil hstmt)
     453                              "01004"))
    443454                  ;; an 0 byte is append to a string, ignore that
    444455                 
    … …  
    446457                    (write-string str sos)
    447458                    (setf sqlret (%sql-get-data-raw hstmt
    448                                             position
    449                                             $SQL_C_CHAR
    450                                             value-ptr
    451                                             buffer-length
    452                                             ind-ptr))
     459                                                    position
     460                                                    $SQL_C_CHAR
     461                                                    value-ptr
     462                                                    buffer-length
     463                                                    ind-ptr))
    453464                    (handle-error sqlret))
    454465                  (return)))
    455               ;; fetch the last part of the data
    456           (setf len (cffi:mem-ref ind-ptr :long))
    457           (let ((str (get-string value-ptr len)))
    458             (write-string str sos))
    459           (get-output-stream-string sos))))))))
     466             ;; fetch the last part of the data
     467             (setf len (cffi:mem-ref ind-ptr 'sql-len))
     468             (let ((str (get-string value-ptr len)))
     469               (write-string str sos))
     470             (get-output-stream-string sos))))))))
    460471
    461472;;; the version for 16bit unicode
    462473
    463 (defun get-unicode-character-data (hstmt position value-ptr buffer-length ind-ptr)
     474(defun get-unicode-character-data (hstmt position value-ptr buffer-length
     475                                   ind-ptr)
    464476  ;; local error handling, we can not use the general error handling
    465477  ;; since this resets the sql-state
    … …  
    481493                                      ind-ptr)))
    482494      (handle-error sqlret)
    483       (let ((len (cffi:mem-ref ind-ptr :long)))
     495      (let ((len (cffi:mem-ref ind-ptr 'sql-len)))
    484496        (cond
    485497          ((= len $sql_null_data) nil)
    486           ;; character data has a 0 byte appended, the length does not include it
    487           ;; but it is taken into account when placing the data into the buffer
     498          ;; character data has a 0 byte appended, the length does not
     499          ;; include it but it is taken into account when placing the
     500          ;; data into the buffer
    488501          ((and (/= len $SQL_NO_TOTAL)
    489502                (<= (+ 2 len) buffer-length))
    490             ;; the data fits into the buffer, return it
    491             (%get-unicode-string value-ptr len))
     503           ;; the data fits into the buffer, return it
     504           (%get-unicode-string value-ptr len))
    492505         
    493506          ;; we have to fetch the data in several steps
    494507          (t
    495             (let ((sos (make-string-output-stream :element-type 'character)))
    496               (loop
    497                 (if (and (= sqlret $SQL_SUCCESS_WITH_INFO)
    498                          (equal (sql-state nil nil hstmt)
    499                                 "01004"))
     508           (let ((sos (make-string-output-stream :element-type 'character)))
     509             (loop
     510              (if (and (= sqlret $SQL_SUCCESS_WITH_INFO)
     511                       (equal (sql-state nil nil hstmt)
     512                              "01004"))
    500513                  ;; an 0 byte is append to a string, ignore that
    501514                 
    502                   (let ((str (%get-unicode-string value-ptr (- buffer-length 2))))
     515                  (let ((str
     516                         (%get-unicode-string value-ptr (- buffer-length 2))))
    503517                    (write-string str sos)
    504518                    (setf sqlret (%sql-get-data-raw hstmt
    505                                             position
    506                                             $SQL_C_WCHAR
    507                                             value-ptr
    508                                             buffer-length
    509                                             ind-ptr))
     519                                                    position
     520                                                    $SQL_C_WCHAR
     521                                                    value-ptr
     522                                                    buffer-length
     523                                                    ind-ptr))
    510524                    (handle-error sqlret))
    511525                  (return)))
    512               ;; fetch the last part of the data
    513           (setf len (cffi:mem-ref ind-ptr :long))
    514           (let ((str (%get-unicode-string value-ptr len)))
    515             (write-string str sos))
    516           (get-output-stream-string sos))))))))
     526             ;; fetch the last part of the data
     527             (setf len (cffi:mem-ref ind-ptr 'sql-len))
     528             (let ((str (%get-unicode-string value-ptr len)))
     529               (write-string str sos))
     530             (get-output-stream-string sos))))))))
    517531   
     532;; dso+
    518533(defun get-binary-data (hstmt position value-ptr buffer-length ind-ptr)
    519534  ;; local error handling, we can not use the general error handling
    … …  
    530545               (error condition)))))
    531546 
    532   (let* ((sqlret (%sql-get-data-raw hstmt
    533                                     position
    534                                     $SQL_C_BINARY
    535                                     value-ptr
    536                                     buffer-length
    537                                     ind-ptr)))
    538     (handle-error sqlret)
    539     (let ((len (cffi:mem-ref ind-ptr :long)))
    540       (if (= len $sql_null_data)
    541         nil
    542         (let ((res (make-array 0 :element-type '(unsigned-byte 8) :adjustable t))
    543               (res-len 0))
    544           (loop
    545             (if (and (= sqlret $SQL_SUCCESS_WITH_INFO)
    546                      (equal (sql-state nil nil hstmt)
    547                           "01004"))
     547    (let* ((sqlret (%sql-get-data-raw hstmt
     548                                      position
     549                                      $SQL_C_BINARY
     550                                      value-ptr
     551                                      buffer-length
     552                                      ind-ptr)))
     553      (handle-error sqlret)
     554      (let ((len (cffi:mem-ref ind-ptr 'sql-len)))
     555        (if (= len $sql_null_data)
     556            nil
     557            (let ((res (make-array 0
     558                                   :element-type '(unsigned-byte 8)
     559                                   :adjustable t))
     560                  (res-len 0))
     561              (loop
     562               (if (and (= sqlret $SQL_SUCCESS_WITH_INFO)
     563                        (equal (sql-state nil nil hstmt)
     564                               "01004"))
    548565           
    549             (let ((vec (get-byte-vector value-ptr buffer-length)))
    550               (setf res (adjust-array res (+ res-len buffer-length)))
    551               (setf (subseq res res-len (+ res-len buffer-length)) vec)
    552               (setf res-len (length res))
    553               (setf sqlret (%sql-get-data-raw hstmt
    554                                               position
    555                                               $SQL_C_BINARY
    556                                               value-ptr
    557                                               buffer-length
    558                                               ind-ptr))
    559               (handle-error sqlret))
    560             (return)))
     566                   (let ((vec (get-byte-vector value-ptr buffer-length)))
     567                     (setf res (adjust-array res (+ res-len buffer-length)))
     568                     (setf (subseq res res-len (+ res-len buffer-length)) vec)
     569                     (setf res-len (length res))
     570                     (setf sqlret (%sql-get-data-raw hstmt
     571                                                     position
     572                                                     $SQL_C_BINARY
     573                                                     value-ptr
     574                                                     buffer-length
     575                                                     ind-ptr))
     576                     (handle-error sqlret))
     577                   (return)))
    561578       
    562         (setf len (cffi:mem-ref ind-ptr :long))
    563         (let ((vec (get-byte-vector value-ptr len)))
    564           (setf res (adjust-array res (+ res-len len)))
    565           (setf (subseq res res-len (+ res-len len)) vec))
    566         res))))))
    567 
     579              (setf len (cffi:mem-ref ind-ptr 'sql-len))
     580              (let ((vec (get-byte-vector value-ptr len)))
     581                (setf res (adjust-array res (+ res-len len)))
     582                (setf (subseq res res-len (+ res-len len)) vec))
     583              res))))))
Note: See TracChangeset for help on using the changeset viewer.