Ignore:
Timestamp:
12/07/2007 02:13:22 PM (19 years ago)
Author:
raverkamp
revision id:
svn-v3-trunk1:1c22b0a8-4d0b-0410-a296-af6a2e6f35e3:plain-odbc%2Ftrunk:8
Message:

included changes for 64 bit linux

File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r1 r3  
    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;; TODO: Why doesn't this use with-temporary-allocations? -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))
     51       (error-message (alloc-chars #.$SQL_MAX_MESSAGE_LENGTH))
     52       (error-code (cffi:foreign-alloc 'sql-integer))
     53       (msg-length (cffi:foreign-alloc 'sql-small-int)))
     54    (SQLError henv
     55              hdbc
     56              hstmt sql-state
     57              error-code error-message
     58              $SQL_MAX_MESSAGE_LENGTH msg-length)
     59    (values
     60     (get-string-nts error-message)
     61     (get-string-nts sql-state)
     62     (cffi:mem-ref msg-length 'sql-small-int)
     63     (cffi:mem-ref error-code 'sql-integer))))
    6264
    6365
    … …  
    6769;#+ignore
    6870(defun sql-state (henv hdbc hstmt)
    69   (with-temporary-allocations 
     71  (with-temporary-allocations
    7072      ((sql-state (cffi:foreign-alloc :char :count 256))
    7173       (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)))
     74       (error-code (cffi:foreign-alloc 'sql-integer))
     75       (msg-length (cffi:foreign-alloc 'sql-small-int)))
    7476    (SQLError henv hdbc hstmt sql-state error-code
    7577              error-message $SQL_MAX_MESSAGE_LENGTH msg-length)
    76     (get-string sql-state 5) ;(%cstring-to-keyword sql-state)
     78    (get-string sql-state 5)          ;(%cstring-to-keyword sql-state)
    7779    ))
    7880
    … …  
    165167
    166168(defun %new-environment-handle ()
    167   (cffi:with-foreign-object (phenv 'sql-handle)
     169  (cffi:with-foreign-object (phenv 'sql-h-env)
    168170    (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)))
     171        ()
     172        (SQLAllocEnv phenv)
     173      (cffi:mem-ref phenv 'sql-h-env))))
    178174
    179175(defun %new-db-connection-handle (henv)
    180   (cffi:with-foreign-object (phdbc 'sql-handle) 
     176  (cffi:with-foreign-object (phdbc 'sql-h-dbc)
    181177    (with-error-handling
    182178        (:henv henv)
    183       (SQLAllocConnect henv phdbc)
    184       (cffi:mem-ref phdbc 'sql-handle))))
     179        (SQLAllocConnect henv phdbc)
     180      (cffi:mem-ref phdbc 'sql-h-dbc))))
    185181
    186182(defun %free-statement (hstmt option)
    187   (with-error-handling 
     183  (with-error-handling
    188184      (:hstmt hstmt)
    189       (SQLFreeStmt 
    190        hstmt 
     185      (SQLFreeStmt
     186       hstmt
    191187       (ecase option
    192188         (:drop $SQL_DROP)
    … …  
    217213;; functional interface
    218214
    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 
    228215;;
    229216(defun %sql-driver-connect (henv hdbc connection-string completion-option)
     217  (declare (string connection-string))
    230218  (let ((completion-option
    231219         (ecase completion-option
    … …  
    234222           (:prompt $SQL_DRIVER_PROMPT)
    235223           (:noprompt $SQL_DRIVER_NOPROMPT))))
    236     (cffi:with-foreign-string (connection-str-ptr  connection-string)
     224    (cffi:with-foreign-string (connection-str-ptr connection-string)
    237225      (with-temporary-allocations
    238226          ((complete-connection-str-ptr (alloc-chars 1024))
    239            (length-ptr (cffi:foreign-alloc :short)))
    240         (with-error-handling 
     227           (length-ptr (cffi:foreign-alloc 'sql-small-int)))
     228        (with-error-handling
    241229            (: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))
     230           
     231            (SQLDriverConnect hdbc
     232                              (cffi:null-pointer) ; no window
     233                              connection-str-ptr ; TODO: How does
     234                                                 ; encoding affect the
     235                                                 ; length?
     236                              (length connection-string) ;$SQL_NTS
     237                              complete-connection-str-ptr
     238                              1024
     239                              length-ptr
     240                              completion-option))
    252241        (get-string-nts complete-connection-str-ptr)))))
    253242
    254243(defun %disconnect (hdbc)
    255   (with-error-handling 
    256     (:hdbc hdbc)
    257     (SQLDisconnect hdbc)))
     244  (with-error-handling
     245      (:hdbc hdbc)
     246      (SQLDisconnect hdbc)))
    258247
    259248(defun %commit (henv hdbc)
    260   (with-error-handling 
    261     (:henv henv :hdbc hdbc)
    262     (SQLTransact
    263      henv hdbc $SQL_COMMIT)))
     249  (with-error-handling
     250      (:henv henv :hdbc hdbc)
     251      (SQLTransact
     252       henv hdbc $SQL_COMMIT)))
    264253
    265254(defun %rollback (henv hdbc)
    266   (with-error-handling 
    267     (:henv henv :hdbc hdbc)
    268     (SQLTransact
    269      henv hdbc $SQL_ROLLBACK)))
     255  (with-error-handling
     256      (:henv henv :hdbc hdbc)
     257      (SQLTransact
     258       henv hdbc $SQL_ROLLBACK)))
    270259
    271260; col-nr is zero-based in Lisp
    272261; col-nr = :bookmark retrieves a bookmark.
    273262(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)))
     263  (declare (type (integer 0) column-nr))
     264  (with-error-handling
     265      (:hstmt hstmt)
     266      (SQLBindCol hstmt
     267                  (if (eq column-nr :bookmark) 0 (1+ column-nr))
     268                  c-type data-ptr precision out-len-ptr)))
    279269
    280270; parameter-nr is zero-based in Lisp
    281271(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                       )))
     272                            sql-type precision scale data-ptr
     273                            max-value out-len-ptr)
     274  (declare (type (integer 0) parameter-nr))
     275  (with-error-handling
     276      (:hstmt hstmt)
     277      (SQLBindParameter hstmt (1+ parameter-nr)
     278                        parameter-type  ;$SQL_PARAM_INPUT
     279                        c-type          ;$SQL_C_CHAR
     280                        sql-type        ;$SQL_VARCHAR
     281                        precision       ;(1- (length str))
     282                        scale           ;0
     283                        data-ptr
     284                        max-value
     285                        out-len-ptr     ;#.(cffi:null-pointer)
     286                        )))
    296287
    297288(defun %sql-fetch (hstmt)
    … …  
    301292
    302293(defun %new-statement-handle (hdbc)
    303   (with-temporary-allocations 
    304       ((hstmt-ptr (cffi:foreign-alloc 'sql-handle)))
    305     (with-error-handling 
     294  (with-temporary-allocations
     295      ((hstmt-ptr (cffi:foreign-alloc 'sql-h-stmt)))
     296    (with-error-handling
    306297        (:hdbc hdbc)
    307       (SQLAllocStmt hdbc hstmt-ptr)
    308       (cffi:mem-ref hstmt-ptr 'sql-handle))))
     298        (SQLAllocStmt hdbc hstmt-ptr)
     299      (cffi:mem-ref hstmt-ptr 'sql-h-stmt))))
    309300
    310301(defun %sql-get-info (hdbc info-type)
    … …  
    344335      #.$SQL_TABLE_TERM
    345336      #.$SQL_USER_NAME)
    346      (with-temporary-allocations 
     337     (with-temporary-allocations
    347338         ((info-ptr (alloc-chars 1024))
    348           (info-length-ptr (cffi:foreign-alloc :short)))
    349        (with-error-handling 
    350          (:hdbc hdbc)
    351         #-pcl
     339          (info-length-ptr (cffi:foreign-alloc 'sql-small-int)))
     340       (with-error-handling
     341           (:hdbc hdbc)
     342          #-pcl
    352343         (SQLGetInfo hdbc info-type info-ptr 1023 info-length-ptr)
    353         #+pcl
     344        #+pcl
    354345         (SQLGetInfo-Str hdbc info-type info-ptr 1023 info-length-ptr)
     346         ;; TODO: I believe the following assumes that the buffer was
     347         ;; big enough to include the null-terminator.
    355348         (get-string-nts info-ptr))))
    356     ;; those returning a word
     349    ;; those returning a 16-bit integer
    357350    ((#.$SQL_ACTIVE_CONNECTIONS
    358351      #.$SQL_ACTIVE_STATEMENTS
    … …  
    383376      #.$SQL_TXN_CAPABLE)
    384377     (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
     378         ((info-ptr (cffi::foreign-alloc 'sql-small-int))
     379          (info-length-ptr (cffi::foreign-alloc 'sql-small-int)))
     380       (with-error-handling
     381           (:hdbc hdbc)
     382           (SQLGetInfo hdbc
     383                       info-type
     384                       info-ptr
     385                       0
     386                       info-length-ptr)
     387         (cffi:mem-ref info-ptr 'sql-small-int))))
     388    ;; those returning a 32-bit bitmask
     389    ((#.$SQL_ALTER_TABLE
    398390      #.$SQL_BOOKMARK_PERSISTENCE
    399391      #.$SQL_CONVERT_BIGINT
    … …  
    440432      #.$SQL_TXN_ISOLATION_OPTION
    441433      #.$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
     434     (with-temporary-allocations
     435         ;; TODO: It'd be nice to have this as a sql-* type.  However,
     436         ;; while the X/Open spec is usually quiet about data sizes,
     437         ;; it specifically says a 32-bit bitmask for these; so if
     438         ;; SQL-INTEGER changes to 64-bit, these may or may not change
     439         ;; as well. -dso
     440         ((info-ptr (cffi:foreign-alloc :uint32))
     441          (info-length-ptr (cffi:foreign-alloc 'sql-small-int)))
     442       (with-error-handling
     443           (:hdbc hdbc)
     444           (SQLGetInfo hdbc
     445                       info-type
     446                       info-ptr
     447                       0
     448                       info-length-ptr)
     449         (cffi:mem-ref info-ptr :uint32))))
     450    ;; those returning an integer
    455451    ((#.$SQL_DEFAULT_TXN_ISOLATION
    456452      #.$SQL_DRIVER_HDBC
    … …  
    462458      #.$SQL_MAX_BINARY_LITERAL_LEN
    463459      #.$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))))))
     460      #.$SQL_ACTIVE_ENVIRONMENTS)
     461     (with-temporary-allocations
     462         ((info-ptr (cffi:foreign-alloc 'sql-integer))
     463          (info-length-ptr (cffi:foreign-alloc 'sql-small-int)))
     464       (with-error-handling
     465           (:hdbc hdbc)
     466           (SQLGetInfo hdbc info-type info-ptr 0 info-length-ptr)
     467         (cffi:mem-ref info-ptr 'sql-integer))))))
    473468
    474469(defun %sql-exec-direct (sql hstmt henv hdbc)
     470  (declare (string sql))
    475471  (cffi:with-foreign-string (sql-ptr sql)
    476472    (with-error-handling
    477473        (: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)))
     474        (SQLExecDirect hstmt sql-ptr $SQL_NTS))))
    484475
    485476(defun %sql-execute (hstmt)
    486477  (with-error-handling
    487     (:hstmt hstmt)
    488     (SQLExecute hstmt)))
     478      (:hstmt hstmt)
     479      (SQLExecute hstmt)))
    489480
    490481(defun result-columns-count (hstmt)
    491482  (with-temporary-allocations
    492       ((columns-nr-ptr (cffi:foreign-alloc :short)))
     483      ((columns-nr-ptr (cffi:foreign-alloc 'sql-small-int)))
    493484    (with-error-handling (:hstmt hstmt)
    494                          (SQLNumResultCols hstmt columns-nr-ptr)
    495       (cffi:mem-ref columns-nr-ptr :short))))
     485        (SQLNumResultCols hstmt columns-nr-ptr)
     486      (cffi:mem-ref columns-nr-ptr 'sql-small-int))))
    496487
    497488(defun result-rows-count (hstmt)
    498489  (with-temporary-allocations
    499       ((row-count-ptr (cffi:foreign-alloc :long)))
     490      ((row-count-ptr (cffi:foreign-alloc 'sql-len)))
    500491    (with-error-handling (:hstmt hstmt)
    501                          (SQLRowCount hstmt row-count-ptr)
    502       (cffi:mem-ref row-count-ptr :long))))
     492        (SQLRowCount hstmt row-count-ptr)
     493      (cffi:mem-ref row-count-ptr 'sql-len))))
    503494
    504495
    … …  
    508499;; Column counting is 1-based
    509500(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)))
     501  (declare (type (integer 1) column-nr))
     502  (with-temporary-allocations
     503      ((column-name-ptr (alloc-chars 256))
     504       (column-name-length-ptr (cffi:foreign-alloc 'sql-small-int))
     505       (column-sql-type-ptr (cffi:foreign-alloc 'sql-small-int))
     506       (column-precision-ptr (cffi:foreign-alloc 'sql-u-len))
     507       (column-scale-ptr (cffi:foreign-alloc 'sql-small-int))
     508       (column-nullable-p-ptr (cffi:foreign-alloc 'sql-small-int)))
    516509    (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)
     510        (SQLDescribeCol hstmt column-nr column-name-ptr 256
     511                        column-name-length-ptr
     512                        column-sql-type-ptr
     513                        column-precision-ptr
     514                        column-scale-ptr
     515                        column-nullable-p-ptr)
    523516      (values
    524517       (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)))))
     518       (cffi:mem-ref column-sql-type-ptr 'sql-small-int)
     519       (cffi:mem-ref column-precision-ptr 'sql-u-len)
     520       (cffi:mem-ref column-scale-ptr 'sql-small-int)
     521       (cffi:mem-ref column-nullable-p-ptr 'sql-small-int)))))
    562522
    563523
    … …  
    590550    (fetch-all-rows hstmt)))
    591551
    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 
    614552
    615553(defun %sql-prepare (hstmt sql)
     554  (declare (string sql))
    616555  (cffi:with-foreign-string (sql-ptr sql)
    617556    (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))))
     557        (SQLPrepare hstmt sql-ptr $SQL_NTS))))
    627558
    628559(defun set-connection-option (hdbc option param)
    629560  (with-error-handling (:hdbc hdbc)
    630     (SQLSetConnectOption hdbc option param)))
     561      (SQLSetConnectOption hdbc option param)))
    631562
    632563(defun disable-autocommit (hdbc)
    … …  
    637568
    638569
    639 ***
     570;;;***
    640571;;; rav, 11.6.2005
    641572;;; added tracing support
    … …  
    643574(defun set-connection-attr-integer (hdbc option val)
    644575  (with-error-handling (:hdbc hdbc)
    645     (SQLSetConnectAttr_long hdbc option val 0)))
     576      (SQLSetConnectAttr_long hdbc option val 0)))
    646577
    647578(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)))))
     579  (with-error-handling  (:hdbc hdbc)
     580      (cffi:with-foreign-string (ptr val)
     581        ;; TODO: Null-terminator with length?
     582        (SQLSetConnectAttr_string hdbc option ptr (length val)))))
    651583
    652584(defun %start-connection-trace (hdbc filename)
    … …  
    656588(defun %stop-connection-trace (hdbc)
    657589  (set-connection-attr-integer hdbc $SQL_ATTR_TRACE     $SQL_OPT_TRACE_OFF))
    658  
    659 
    660 (defun get-connection-attr-integer (hdbc attr)
    661   (with-temporary-allocations
    662       ((ptr (cffi:foreign-alloc :long))
    663        (lenptr (cffi:foreign-alloc :long)))
    664     (with-error-handling (:hdbc hdbc)
    665       (SQLGetConnectAttr hdbc attr ptr 0 lenptr))
    666     (cffi:mem-ref ptr :long)))
    667 
    668 (defun get-connection-attr-string (hdbc attr)
    669   (with-temporary-allocations
    670       ((ptr (alloc-chars 256))
    671        (lenptr (cffi:foreign-alloc :long)))
    672     (with-error-handling (:hdbc hdbc)
    673       (SQLGetConnectAttr hdbc attr ptr 256 lenptr))
    674     (get-string  ptr (cffi:mem-ref lenptr :long))))
    675 
    676 ;;; small test for the get-connection-attr
    677 (defun %get-current-catalog (hdbc)
    678   (get-connection-attr-string hdbc $SQL_ATTR_CURRENT_CATALOG))
    679 
    680 (defun %set-current-catalog (hdbc catalog)
    681   (set-connection-attr-string hdbc $SQL_ATTR_CURRENT_CATALOG catalog))
    682 
    683 
    684 
    685 (defun %connection-ok-p (hdbc)
    686   (with-error-handling (:hdbc hdbc)
    687     (ecase (get-connection-attr-integer hdbc $SQL_ATTR_CONNECTION_DEAD)
    688       (#.$sql_cd_true nil)
    689       (#.$sql_cd_false t))))
    690590
    691591;;;
    692 
    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)))))
    708592
    709593; column-nr is zero-based
    710594(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)))
     595  (declare (type (integer 0) column-nr))
     596  (with-error-handling
     597      (:hstmt hstmt :print-info nil)
     598      (SQLGetData hstmt (if (eq column-nr :bookmark) 0 (1+ column-nr))
     599                  c-type data-ptr precision out-len-ptr)))
    715600
    716601(defun %sql-get-data-raw (hstmt position c-type data-ptr buffer-length ind-ptr)
     602  (declare (type (integer 0) position))
    717603  (SQLGetData hstmt (1+ position)
    718604              c-type data-ptr buffer-length ind-ptr))
    … …  
    727613  (with-error-handling
    728614      (:hstmt hstmt :print-info t) ;; nil
    729     (SQLPutData hstmt data-ptr size)))
     615      (SQLPutData hstmt data-ptr size)))
    730616
    731617
Note: See TracChangeset for help on using the changeset viewer.