Ignore:
Timestamp:
11/28/2007 03:49:48 AM (19 years ago)
Author:
David Owen <dsowen@…>
branch-nick:
64-bit
revision id:
dsowen@tux-20071128034948-of18hhgvistm196l
Message:

First pass at 64-bit cleanness.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • combined/src/odbc/odbc-functions.lisp

    r1 r2.1.1  
    1717  `(let (,@allocs)
    1818    (unwind-protect
    19       (progn ,@body)
    20       ,@(mapcar (lambda (alloc) (list 'cffi:foreign-free (first alloc))) allocs))))
    21 
    22              
     19         (progn ,@body)
     20      ,@(mapcar (lambda (alloc) (list 'cffi:foreign-free (first alloc)))
     21                allocs))))
     22
     23
    2324
    2425
    … …  
    4445  ())
    4546
     47;;;; dso+
    4648(defun handle-error (henv hdbc hstmt)
    47    (let
    48        ((sql-state (alloc-chars 256))
    49         (error-message (alloc-chars #.$SQL_MAX_MESSAGE_LENGTH))
    50         (error-code (cffi:foreign-alloc :long))
    51         (msg-length (cffi:foreign-alloc :short)))
    52      (SQLError henv
    53                hdbc
    54                hstmt sql-state
    55                error-code error-message
    56                $SQL_MAX_MESSAGE_LENGTH msg-length)
    57      (values
    58       (get-string-nts error-message)
    59       (get-string-nts sql-state)
    60       (cffi:mem-ref msg-length :short)
    61       (cffi:mem-ref error-code :long))))
     49  (let
     50      ((sql-state (alloc-chars 256)) ; TODO: How do we know this is
     51                                     ; big enough?
     52       (error-message (alloc-chars #.$SQL_MAX_MESSAGE_LENGTH))
     53       (error-code (cffi:foreign-alloc 'sql-integer))
     54       (msg-length (cffi:foreign-alloc 'sql-small-int)))
     55    ;; TODO: Does this include null-terminator for error-message?
     56    (SQLError henv
     57              hdbc
     58              hstmt sql-state
     59              error-code error-message
     60              $SQL_MAX_MESSAGE_LENGTH msg-length)
     61    (values
     62     (get-string-nts error-message)
     63     (get-string-nts sql-state)
     64     (cffi:mem-ref msg-length 'sql-small-int)
     65     (cffi:mem-ref error-code 'sql-integer))))
    6266
    6367
    … …  
    6670;; problem: calling SQLError clears the error state
    6771;#+ignore
     72;;;; dso+
    6873(defun sql-state (henv hdbc hstmt)
    69   (with-temporary-allocations 
     74  (with-temporary-allocations
    7075      ((sql-state (cffi:foreign-alloc :char :count 256))
    7176       (error-message (cffi:foreign-alloc :char :count $SQL_MAX_MESSAGE_LENGTH))
    72        (error-code (cffi:foreign-alloc :long))
    73        (msg-length (cffi:foreign-alloc :short)))
     77       (error-code (cffi:foreign-alloc 'sql-integer))
     78       (msg-length (cffi:foreign-alloc 'sql-small-int)))
    7479    (SQLError henv hdbc hstmt sql-state error-code
    7580              error-message $SQL_MAX_MESSAGE_LENGTH msg-length)
    76     (get-string sql-state 5) ;(%cstring-to-keyword sql-state)
     81    (get-string sql-state 5)          ;(%cstring-to-keyword sql-state)
    7782    ))
    7883
    … …  
    164169
    165170
     171;;;; dso+
    166172(defun %new-environment-handle ()
    167   (cffi:with-foreign-object (phenv 'sql-handle)
     173  (declare (ftype sql-h-env))
     174  (cffi:with-foreign-object (phenv 'sql-h-env)
    168175    (with-error-handling
    169       ()
    170       (SQLAllocEnv phenv)
    171       (cffi:mem-ref phenv 'sql-handle)
    172       )))
    173 
    174 (defun %sql-free-environment (henv)
    175   (with-error-handling
    176     (:henv henv)
    177     (SQLFreeEnv henv)))
    178 
     176        ()
     177        (SQLAllocEnv phenv)
     178      (cffi:mem-ref phenv 'sql-h-env))))
     179
     180;;;; dso+
    179181(defun %new-db-connection-handle (henv)
    180   (cffi:with-foreign-object (phdbc 'sql-handle) 
     182  (cffi:with-foreign-object (phdbc 'sql-h-dbc)
    181183    (with-error-handling
    182184        (:henv henv)
    183       (SQLAllocConnect henv phdbc)
    184       (cffi:mem-ref phdbc 'sql-handle))))
    185 
     185        (SQLAllocConnect henv phdbc)
     186      (cffi:mem-ref phdbc 'sql-h-dbc))))
     187
     188;;;; dso+
    186189(defun %free-statement (hstmt option)
    187   (with-error-handling 
     190  (with-error-handling
    188191      (:hstmt hstmt)
    189       (SQLFreeStmt 
    190        hstmt 
     192      (SQLFreeStmt
     193       hstmt
    191194       (ecase option
    192195         (:drop $SQL_DROP)
    … …  
    217220;; functional interface
    218221
    219 (defun %sql-connect (hdbc server uid pwd)
    220   (cffi:with-foreign-string (server-ptr server)
    221     (cffi:with-foreign-string (uid-ptr uid)
    222       (cffi:with-foreign-string (pwd-ptr pwd)
    223         (with-error-handling
    224             (:hdbc hdbc)
    225       (SQLConnect hdbc server-ptr $SQL_NTS uid-ptr
    226                   $SQL_NTS pwd-ptr $SQL_NTS))))))
    227 
    228222;;
     223;;;; dso+
    229224(defun %sql-driver-connect (henv hdbc connection-string completion-option)
     225  (declare (string connection-string))
    230226  (let ((completion-option
    231227         (ecase completion-option
    … …  
    234230           (:prompt $SQL_DRIVER_PROMPT)
    235231           (:noprompt $SQL_DRIVER_NOPROMPT))))
    236     (cffi:with-foreign-string (connection-str-ptr  connection-string)
     232    (cffi:with-foreign-string (connection-str-ptr connection-string)
    237233      (with-temporary-allocations
    238234          ((complete-connection-str-ptr (alloc-chars 1024))
    239            (length-ptr (cffi:foreign-alloc :short)))
    240         (with-error-handling 
     235           (length-ptr (cffi:foreign-alloc 'sql-small-int)))
     236        (with-error-handling
    241237            (:henv henv :hdbc hdbc)
    242          
    243           (SQLDriverConnect hdbc
    244                             (cffi:null-pointer) ; no window
    245                             connection-str-ptr
    246                             (length connection-string)
    247                                         ;$SQL_NTS
    248                             complete-connection-str-ptr
    249                             1024
    250                             length-ptr
    251                             completion-option))
     238           
     239            (SQLDriverConnect hdbc
     240                              (cffi:null-pointer) ; no window
     241                              connection-str-ptr ; TODO: How does
     242                                                 ; encoding affect the
     243                                                 ; length?
     244                              (length connection-string) ;$SQL_NTS
     245                              complete-connection-str-ptr
     246                              1024      ; TODO: Should this 1023, for
     247                                        ; the terminating char?
     248                              length-ptr
     249                              completion-option))
    252250        (get-string-nts complete-connection-str-ptr)))))
    253251
     252;;;; dso+
    254253(defun %disconnect (hdbc)
    255   (with-error-handling
    256     (:hdbc hdbc)
    257     (SQLDisconnect hdbc)))
    258 
     254  (with-error-handling
     255      (:hdbc hdbc)
     256      (SQLDisconnect hdbc)))
     257
     258;;;; dso+
    259259(defun %commit (henv hdbc)
    260   (with-error-handling
    261     (:henv henv :hdbc hdbc)
    262     (SQLTransact
    263      henv hdbc $SQL_COMMIT)))
    264 
     260  (with-error-handling
     261      (:henv henv :hdbc hdbc)
     262      (SQLTransact
     263       henv hdbc $SQL_COMMIT)))
     264
     265;;;; dso+
    265266(defun %rollback (henv hdbc)
    266   (with-error-handling 
    267     (:henv henv :hdbc hdbc)
    268     (SQLTransact
    269      henv hdbc $SQL_ROLLBACK)))
     267  (with-error-handling
     268      (:henv henv :hdbc hdbc)
     269      (SQLTransact
     270       henv hdbc $SQL_ROLLBACK)))
    270271
    271272; col-nr is zero-based in Lisp
    272273; col-nr = :bookmark retrieves a bookmark.
     274;;;; dso+
    273275(defun %bind-column (hstmt column-nr c-type data-ptr precision out-len-ptr)
    274   (with-error-handling
    275     (:hstmt hstmt)
    276     (SQLBindCol hstmt
    277                 (if (eq column-nr :bookmark) 0 (1+ column-nr))
    278                 c-type data-ptr precision out-len-ptr)))
     276  (declare ((integer 0) column-nr))
     277  (with-error-handling
     278      (:hstmt hstmt)
     279      (SQLBindCol hstmt
     280                  (if (eq column-nr :bookmark) 0 (1+ column-nr))
     281                  c-type data-ptr precision out-len-ptr)))
    279282
    280283; parameter-nr is zero-based in Lisp
     284;;;; dso+
    281285(defun %sql-bind-parameter (hstmt parameter-nr parameter-type c-type
    282                                       sql-type precision scale data-ptr
    283                                       max-value out-len-ptr)
    284   (with-error-handling
    285     (:hstmt hstmt)
    286     (SQLBindParameter hstmt (1+ parameter-nr)
    287                       parameter-type ;$SQL_PARAM_INPUT
    288                       c-type ;$SQL_C_CHAR
    289                       sql-type ;$SQL_VARCHAR
    290                       precision ;(1- (length str))
    291                       scale ;0
    292                       data-ptr
    293                       max-value
    294                       out-len-ptr ;#.(cffi:null-pointer)
    295                       )))
    296 
     286                            sql-type precision scale data-ptr
     287                            max-value out-len-ptr)
     288  (declare ((integer 0) parameter-nr))
     289  (with-error-handling
     290      (:hstmt hstmt)
     291      (SQLBindParameter hstmt (1+ parameter-nr)
     292                        parameter-type  ;$SQL_PARAM_INPUT
     293                        c-type          ;$SQL_C_CHAR
     294                        sql-type        ;$SQL_VARCHAR
     295                        precision       ;(1- (length str))
     296                        scale           ;0
     297                        data-ptr
     298                        max-value
     299                        out-len-ptr     ;#.(cffi:null-pointer)
     300                        )))
     301
     302;;;; dso+
    297303(defun %sql-fetch (hstmt)
    298304  (with-error-handling
    … …  
    300306      (SQLFetch hstmt)))
    301307
     308;;;; dso+
    302309(defun %new-statement-handle (hdbc)
    303   (with-temporary-allocations 
    304       ((hstmt-ptr (cffi:foreign-alloc 'sql-handle)))
    305     (with-error-handling 
     310  (with-temporary-allocations
     311      ((hstmt-ptr (cffi:foreign-alloc 'sql-h-stmt)))
     312    (with-error-handling
    306313        (:hdbc hdbc)
    307       (SQLAllocStmt hdbc hstmt-ptr)
    308       (cffi:mem-ref hstmt-ptr 'sql-handle))))
    309 
     314        (SQLAllocStmt hdbc hstmt-ptr)
     315      (cffi:mem-ref hstmt-ptr 'sql-h-stmt))))
     316
     317;;;; dso+
    310318(defun %sql-get-info (hdbc info-type)
    311319  (ecase info-type
    … …  
    344352      #.$SQL_TABLE_TERM
    345353      #.$SQL_USER_NAME)
    346      (with-temporary-allocations 
     354     (with-temporary-allocations
    347355         ((info-ptr (alloc-chars 1024))
    348           (info-length-ptr (cffi:foreign-alloc :short)))
    349        (with-error-handling 
    350          (:hdbc hdbc)
    351         #-pcl
     356          (info-length-ptr (cffi:foreign-alloc 'sql-small-int)))
     357       (with-error-handling
     358           (:hdbc hdbc)
     359          #-pcl
    352360         (SQLGetInfo hdbc info-type info-ptr 1023 info-length-ptr)
    353         #+pcl
     361        #+pcl
    354362         (SQLGetInfo-Str hdbc info-type info-ptr 1023 info-length-ptr)
     363         ;; TODO: I believe the following assumes that the buffer was
     364         ;; big enough to include the null-terminator.
    355365         (get-string-nts info-ptr))))
    356     ;; those returning a word
     366    ;; those returning a 16-bit integer
    357367    ((#.$SQL_ACTIVE_CONNECTIONS
    358368      #.$SQL_ACTIVE_STATEMENTS
    … …  
    383393      #.$SQL_TXN_CAPABLE)
    384394     (with-temporary-allocations
    385          ((info-ptr (cffi::foreign-alloc :short))
    386           (info-length-ptr (cffi::foreign-alloc :short)))
    387        (with-error-handling
    388         (:hdbc hdbc)
    389          (SQLGetInfo hdbc
    390                      info-type
    391                      info-ptr
    392                      255
    393                      info-length-ptr)
    394          (cffi:mem-ref info-ptr :short)))
    395      )
    396     ;; those returning a long bitmask
    397     ((#.$SQL_ALTER_TABLE
     395         ((info-ptr (cffi::foreign-alloc 'sql-small-int))
     396          (info-length-ptr (cffi::foreign-alloc 'sql-small-int)))
     397       (with-error-handling
     398           (:hdbc hdbc)
     399           (SQLGetInfo hdbc
     400                       info-type
     401                       info-ptr
     402                       0
     403                       info-length-ptr)
     404         (cffi:mem-ref info-ptr 'sql-small-int))))
     405    ;; those returning a 32-bit bitmask
     406    ((#.$SQL_ALTER_TABLE
    398407      #.$SQL_BOOKMARK_PERSISTENCE
    399408      #.$SQL_CONVERT_BIGINT
    … …  
    440449      #.$SQL_TXN_ISOLATION_OPTION
    441450      #.$SQL_UNION)
    442       (with-temporary-allocations
    443           ((info-ptr (cffi:foreign-alloc :unsigned-long))
    444            (info-length-ptr (cffi:foreign-alloc :short)))
    445        (with-error-handling
    446          (:hdbc hdbc)
    447          (SQLGetInfo hdbc
    448                      info-type
    449                      info-ptr
    450                      255
    451                      info-length-ptr)
    452          (cffi:mem-ref info-ptr :unsigned-long)))
    453      )
    454     ;; those returning a long integer
     451     (with-temporary-allocations
     452         ((info-ptr (cffi:foreign-alloc :uint32)) ; TODO: It'd be nice
     453                                                  ; to have this as a
     454                                                  ; sql-* type.
     455          (info-length-ptr (cffi:foreign-alloc 'sql-small-int)))
     456       (with-error-handling
     457           (:hdbc hdbc)
     458           (SQLGetInfo hdbc
     459                       info-type
     460                       info-ptr
     461                       0
     462                       info-length-ptr)
     463         (cffi:mem-ref info-ptr :uint32))))
     464    ;; those returning an integer
    455465    ((#.$SQL_DEFAULT_TXN_ISOLATION
    456466      #.$SQL_DRIVER_HDBC
    … …  
    462472      #.$SQL_MAX_BINARY_LITERAL_LEN
    463473      #.$SQL_MAX_CHAR_LITERAL_LEN
    464       #.$SQL_ACTIVE_ENVIRONMENTS
    465       )
    466      (with-temporary-allocations
    467          ((info-ptr (cffi:foreign-alloc :long))
    468           (info-length-ptr (cffi:foreign-alloc :short)))
    469        (with-error-handling
    470          (:hdbc hdbc)
    471          (SQLGetInfo hdbc info-type info-ptr 255 info-length-ptr)
    472          (cffi:mem-ref info-ptr :unsigned-long))))))
    473 
     474      #.$SQL_ACTIVE_ENVIRONMENTS)
     475     (with-temporary-allocations
     476         ((info-ptr (cffi:foreign-alloc 'sql-integer))
     477          (info-length-ptr (cffi:foreign-alloc 'sql-small-int)))
     478       (with-error-handling
     479           (:hdbc hdbc)
     480           (SQLGetInfo hdbc info-type info-ptr 0 info-length-ptr)
     481         (cffi:mem-ref info-ptr 'sql-integer))))))
     482
     483;;;; dso+
    474484(defun %sql-exec-direct (sql hstmt henv hdbc)
     485  (declare (string sql))
    475486  (cffi:with-foreign-string (sql-ptr sql)
    476487    (with-error-handling
    477488        (:hstmt hstmt :henv henv :hdbc hdbc)
    478       (SQLExecDirect hstmt sql-ptr $SQL_NTS))))
    479 
    480 (defun %sql-cancel (hstmt)
    481   (with-error-handling
    482     (:hstmt hstmt)
    483     (SQLCancel hstmt)))
    484 
     489        (SQLExecDirect hstmt sql-ptr $SQL_NTS))))
     490
     491;;;; dso+
    485492(defun %sql-execute (hstmt)
    486493  (with-error-handling
    487     (:hstmt hstmt)
    488     (SQLExecute hstmt)))
    489 
     494      (:hstmt hstmt)
     495      (SQLExecute hstmt)))
     496
     497;;;; dso+
    490498(defun result-columns-count (hstmt)
    491499  (with-temporary-allocations
    492       ((columns-nr-ptr (cffi:foreign-alloc :short)))
     500      ((columns-nr-ptr (cffi:foreign-alloc 'sql-small-int)))
    493501    (with-error-handling (:hstmt hstmt)
    494                          (SQLNumResultCols hstmt columns-nr-ptr)
    495       (cffi:mem-ref columns-nr-ptr :short))))
    496 
     502        (SQLNumResultCols hstmt columns-nr-ptr)
     503      (cffi:mem-ref columns-nr-ptr 'sql-small-int))))
     504
     505;;;; dso+
    497506(defun result-rows-count (hstmt)
    498507  (with-temporary-allocations
    499       ((row-count-ptr (cffi:foreign-alloc :long)))
     508      ((row-count-ptr (cffi:foreign-alloc 'sql-len)))
    500509    (with-error-handling (:hstmt hstmt)
    501                          (SQLRowCount hstmt row-count-ptr)
    502       (cffi:mem-ref row-count-ptr :long))))
     510        (SQLRowCount hstmt row-count-ptr)
     511      (cffi:mem-ref row-count-ptr 'sql-len))))
    503512
    504513
    … …  
    507516
    508517;; Column counting is 1-based
     518;;;; dso+
    509519(defun %describe-column (hstmt column-nr)
    510   (with-temporary-allocations ((column-name-ptr (alloc-chars 256))
    511                                (column-name-length-ptr (cffi:foreign-alloc :short))
    512                                (column-sql-type-ptr (cffi:foreign-alloc :short))
    513                                (column-precision-ptr (cffi:foreign-alloc :unsigned-long))
    514                                (column-scale-ptr (cffi:foreign-alloc :short))
    515                                (column-nullable-p-ptr (cffi:foreign-alloc :short)))
     520  (declare ((integer 1) column-nr))
     521  (with-temporary-allocations
     522      ((column-name-ptr (alloc-chars 256))
     523       (column-name-length-ptr (cffi:foreign-alloc 'sql-small-int))
     524       (column-sql-type-ptr (cffi:foreign-alloc 'sql-small-int))
     525       (column-precision-ptr (cffi:foreign-alloc 'sql-u-len))
     526       (column-scale-ptr (cffi:foreign-alloc 'sql-small-int))
     527       (column-nullable-p-ptr (cffi:foreign-alloc 'sql-small-int)))
    516528    (with-error-handling (:hstmt hstmt)
    517                          (SQLDescribeCol hstmt column-nr column-name-ptr 256
    518                                          column-name-length-ptr
    519                                          column-sql-type-ptr
    520                                          column-precision-ptr
    521                                          column-scale-ptr
    522                                          column-nullable-p-ptr)
     529        (SQLDescribeCol hstmt column-nr column-name-ptr 256
     530                        ;; TODO: Does 256 leave room for terminating
     531                        ;; nulls?
     532                        column-name-length-ptr
     533                        column-sql-type-ptr
     534                        column-precision-ptr
     535                        column-scale-ptr
     536                        column-nullable-p-ptr)
    523537      (values
    524538       (get-string-nts column-name-ptr)
    525        (cffi:mem-ref column-sql-type-ptr :short)
    526        (cffi:mem-ref column-precision-ptr :unsigned-long)
    527        (cffi:mem-ref column-scale-ptr :short)
    528        (cffi:mem-ref column-nullable-p-ptr :short)))))
    529 
    530 ;; parameter counting is 1-based
    531 (defun %describe-parameter (hstmt parameter-nr)
    532   (with-temporary-allocations ((column-sql-type-ptr (cffi:foreign-alloc :short))
    533                                (column-precision-ptr (cffi:foreign-alloc :long))
    534                                (column-scale-ptr (cffi:foreign-alloc :short))
    535                                (column-nullable-p-ptr (cffi:foreign-alloc :short)))
    536     (with-error-handling
    537       (:hstmt hstmt)
    538       (SQLDescribeParam hstmt parameter-nr
    539                         column-sql-type-ptr
    540                         column-precision-ptr
    541                         column-scale-ptr
    542                         column-nullable-p-ptr)
    543       (values
    544        (cffi:mem-ref column-sql-type-ptr :short)
    545        (cffi:mem-ref column-precision-ptr :unsigned-long)
    546        (cffi:mem-ref column-scale-ptr :short)
    547        (cffi:mem-ref column-nullable-p-ptr :short)))))
    548 
    549 (defun %column-attributes (hstmt column-nr descriptor-type)
    550   (with-temporary-allocations
    551       ((descriptor-info-ptr (alloc-chars  256))
    552        (descriptor-length-ptr (cffi:foreign-alloc :short))
    553        (numeric-descriptor-ptr (cffi:foreign-alloc :long)))
    554     (with-error-handling
    555       (:hstmt hstmt)
    556       (SQLColAttributes hstmt column-nr descriptor-type descriptor-info-ptr 256
    557                         descriptor-length-ptr
    558                         numeric-descriptor-ptr)
    559       (values
    560        (get-string-nts descriptor-info-ptr)
    561        (cffi:mem-ref numeric-descriptor-ptr :long)))))
     539       (cffi:mem-ref column-sql-type-ptr 'sql-small-int)
     540       (cffi:mem-ref column-precision-ptr 'sql-u-len)
     541       (cffi:mem-ref column-scale-ptr 'sql-small-int)
     542       (cffi:mem-ref column-nullable-p-ptr 'sql-small-int)))))
    562543
    563544
    … …  
    590571    (fetch-all-rows hstmt)))
    591572
    592 (defun %sql-data-sources (henv &key (direction :first))
    593   (with-temporary-allocations
    594       ((name-ptr (alloc-chars (1+ $SQL_MAX_DSN_LENGTH)))
    595        (name-length-ptr (cffi:foreign-alloc :short))
    596        (description-ptr (alloc-chars 1024))
    597        (description-length-ptr (cffi:foreign-alloc :short)))
    598     (let ((res (with-error-handling
    599                    (:henv henv)
    600                  (SQLDataSources henv
    601                                  (ecase direction
    602                                    (:first $SQL_FETCH_FIRST)
    603                                    (:next $SQL_FETCH_NEXT))
    604                                  name-ptr
    605                                  (1+ $SQL_MAX_DSN_LENGTH)
    606                                  name-length-ptr
    607                                  description-ptr
    608                                  1024
    609                                  description-length-ptr))))
    610       (unless (= res $SQL_NO_DATA_FOUND)
    611         (values (get-string-nts name-ptr)
    612                 (get-string-nts description-ptr))))))
    613 
    614 
     573
     574;;;; dso+
    615575(defun %sql-prepare (hstmt sql)
     576  (declare (string sql))
    616577  (cffi:with-foreign-string (sql-ptr sql)
    617578    (with-error-handling (:hstmt hstmt)
    618       (SQLPrepare hstmt sql-ptr $SQL_NTS))))
    619 
    620 ;; depending on option, we return a long int or a string; string not implemented
    621 (defun get-connection-option (hdbc option)
    622   (with-temporary-allocations
    623       ((param-ptr (cffi:foreign-alloc  :long))) ;#+ignore #.(1+ $SQL_MAX_OPTION_STRING_LENGTH)))
    624     (with-error-handling (:hdbc hdbc)
    625       (SQLGetConnectOption hdbc option param-ptr)
    626       (cffi:mem-ref param-ptr :long))))
    627 
     579        (SQLPrepare hstmt sql-ptr $SQL_NTS))))
     580
     581;;;; dso+
    628582(defun set-connection-option (hdbc option param)
    629583  (with-error-handling (:hdbc hdbc)
    630     (SQLSetConnectOption hdbc option param)))
     584      (SQLSetConnectOption hdbc option param)))
    631585
    632586(defun disable-autocommit (hdbc)
    … …  
    641595;;; added tracing support
    642596
     597;;;; dso+
    643598(defun set-connection-attr-integer (hdbc option val)
    644599  (with-error-handling (:hdbc hdbc)
    645     (SQLSetConnectAttr_long hdbc option val 0)))
    646 
     600      (SQLSetConnectAttr_long hdbc option val 0)))
     601
     602;;;; dso+
    647603(defun set-connection-attr-string (hdbc option val)
    648   (with-error-handling (:hdbc hdbc)
    649     (cffi:with-foreign-string (ptr val)
    650       (SQLSetConnectAttr_string hdbc option ptr (length val)))))
     604  (with-error-handling  (:hdbc hdbc)
     605      (cffi:with-foreign-string (ptr val)
     606        ;; TODO: Null-terminator with length?
     607        (SQLSetConnectAttr_string hdbc option ptr (length val)))))
    651608
    652609(defun %start-connection-trace (hdbc filename)
    … …  
    691648;;;
    692649
    693 
    694 (defun %sql-set-pos (hstmt row option lock)
    695   (with-error-handling
    696     (:hstmt hstmt)
    697     (SQLSetPos hstmt row option lock)))
    698 
    699 (defun %sql-extended-fetch (hstmt fetch-type row)
    700   (with-temporary-allocations
    701       ((row-count-ptr (cffi:foreign-alloc :unsigned-long))
    702        (row-status-ptr (cffi:foreign-alloc :short)))
    703     (with-error-handling (:hstmt hstmt)
    704       (SQLExtendedFetch hstmt fetch-type row row-count-ptr
    705                         row-status-ptr)
    706       (values (cffi:mem-ref row-count-ptr :unsigned-long)
    707               (cffi:mem-ref row-status-ptr :short)))))
    708 
    709650; column-nr is zero-based
     651;;;; dso+
    710652(defun %sql-get-data (hstmt column-nr c-type data-ptr precision out-len-ptr)
    711   (with-error-handling
    712     (:hstmt hstmt :print-info nil)
    713     (SQLGetData hstmt (if (eq column-nr :bookmark) 0 (1+ column-nr))
    714                 c-type data-ptr precision out-len-ptr)))
    715 
     653  (declare ((integer 0) column-nr))
     654  (with-error-handling
     655      (:hstmt hstmt :print-info nil)
     656      (SQLGetData hstmt (if (eq column-nr :bookmark) 0 (1+ column-nr))
     657                  c-type data-ptr precision out-len-ptr)))
     658
     659;;;; dso+
    716660(defun %sql-get-data-raw (hstmt position c-type data-ptr buffer-length ind-ptr)
     661  (declare ((integer 0) position))
    717662  (SQLGetData hstmt (1+ position)
    718663              c-type data-ptr buffer-length ind-ptr))
    719664
    720665
     666;;;; dso+
    721667(defun %sql-param-data (hstmt param-ptr)
    722668  (with-error-handling (:hstmt hstmt :print-info t) ;; nil
    … …  
    724670
    725671
     672;;;; dso+
    726673(defun %sql-put-data (hstmt data-ptr size)
    727674  (with-error-handling
    728675      (:hstmt hstmt :print-info t) ;; nil
    729     (SQLPutData hstmt data-ptr size)))
    730 
    731 
     676      (SQLPutData hstmt data-ptr size)))
     677
     678
     679;;;; dso+
    732680(defun %sql-more-results (hstmt)
    733681  (let ((res (SQLMoreResults hstmt)))
Note: See TracChangeset for help on using the changeset viewer.