Changeset 64-bit,6


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

Full pass.

File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r3 r6  
    4545  ())
    4646
    47 ;;;; dso+
     47;; TODO: Why doesn't this use with-temporary-allocations? -dso
    4848(defun handle-error (henv hdbc hstmt)
    4949  (let
    50       ((sql-state (alloc-chars 256)) ; TODO: How do we know this is
    51                                      ; big enough?
     50      ((sql-state (alloc-chars 256))
    5251       (error-message (alloc-chars #.$SQL_MAX_MESSAGE_LENGTH))
    5352       (error-code (cffi:foreign-alloc 'sql-integer))
    5453       (msg-length (cffi:foreign-alloc 'sql-small-int)))
    55     ;; TODO: Does this include null-terminator for error-message?
    5654    (SQLError henv
    5755              hdbc
    … …  
    7068;; problem: calling SQLError clears the error state
    7169;#+ignore
    72 ;;;; dso+
    7370(defun sql-state (henv hdbc hstmt)
    7471  (with-temporary-allocations
    … …  
    169166
    170167
    171 ;;;; dso+
    172168(defun %new-environment-handle ()
    173   (declare (ftype sql-h-env))
    174169  (cffi:with-foreign-object (phenv 'sql-h-env)
    175170    (with-error-handling
    … …  
    178173      (cffi:mem-ref phenv 'sql-h-env))))
    179174
    180 ;;;; dso+
    181175(defun %new-db-connection-handle (henv)
    182176  (cffi:with-foreign-object (phdbc 'sql-h-dbc)
    … …  
    186180      (cffi:mem-ref phdbc 'sql-h-dbc))))
    187181
    188 ;;;; dso+
    189182(defun %free-statement (hstmt option)
    190183  (with-error-handling
    … …  
    221214
    222215;;
    223 ;;;; dso+
    224216(defun %sql-driver-connect (henv hdbc connection-string completion-option)
    225217  (declare (string connection-string))
    … …  
    244236                              (length connection-string) ;$SQL_NTS
    245237                              complete-connection-str-ptr
    246                               1024      ; TODO: Should this 1023, for
    247                                         ; the terminating char?
     238                              1024
    248239                              length-ptr
    249240                              completion-option))
    250241        (get-string-nts complete-connection-str-ptr)))))
    251242
    252 ;;;; dso+
    253243(defun %disconnect (hdbc)
    254244  (with-error-handling
    … …  
    256246      (SQLDisconnect hdbc)))
    257247
    258 ;;;; dso+
    259248(defun %commit (henv hdbc)
    260249  (with-error-handling
    … …  
    263252       henv hdbc $SQL_COMMIT)))
    264253
    265 ;;;; dso+
    266254(defun %rollback (henv hdbc)
    267255  (with-error-handling
    … …  
    272260; col-nr is zero-based in Lisp
    273261; col-nr = :bookmark retrieves a bookmark.
    274 ;;;; dso+
    275262(defun %bind-column (hstmt column-nr c-type data-ptr precision out-len-ptr)
    276263  (declare ((integer 0) column-nr))
    … …  
    282269
    283270; parameter-nr is zero-based in Lisp
    284 ;;;; dso+
    285271(defun %sql-bind-parameter (hstmt parameter-nr parameter-type c-type
    286272                            sql-type precision scale data-ptr
    … …  
    300286                        )))
    301287
    302 ;;;; dso+
    303288(defun %sql-fetch (hstmt)
    304289  (with-error-handling
    … …  
    306291      (SQLFetch hstmt)))
    307292
    308 ;;;; dso+
    309293(defun %new-statement-handle (hdbc)
    310294  (with-temporary-allocations
    … …  
    315299      (cffi:mem-ref hstmt-ptr 'sql-h-stmt))))
    316300
    317 ;;;; dso+
    318301(defun %sql-get-info (hdbc info-type)
    319302  (ecase info-type
    … …  
    450433      #.$SQL_UNION)
    451434     (with-temporary-allocations
    452          ((info-ptr (cffi:foreign-alloc :uint32)) ; TODO: It'd be nice
    453                                                   ; to have this as a
    454                                                   ; sql-* type.
     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))
    455441          (info-length-ptr (cffi:foreign-alloc 'sql-small-int)))
    456442       (with-error-handling
    … …  
    481467         (cffi:mem-ref info-ptr 'sql-integer))))))
    482468
    483 ;;;; dso+
    484469(defun %sql-exec-direct (sql hstmt henv hdbc)
    485470  (declare (string sql))
    … …  
    489474        (SQLExecDirect hstmt sql-ptr $SQL_NTS))))
    490475
    491 ;;;; dso+
    492476(defun %sql-execute (hstmt)
    493477  (with-error-handling
    … …  
    495479      (SQLExecute hstmt)))
    496480
    497 ;;;; dso+
    498481(defun result-columns-count (hstmt)
    499482  (with-temporary-allocations
    … …  
    503486      (cffi:mem-ref columns-nr-ptr 'sql-small-int))))
    504487
    505 ;;;; dso+
    506488(defun result-rows-count (hstmt)
    507489  (with-temporary-allocations
    … …  
    516498
    517499;; Column counting is 1-based
    518 ;;;; dso+
    519500(defun %describe-column (hstmt column-nr)
    520501  (declare ((integer 1) column-nr))
    … …  
    528509    (with-error-handling (:hstmt hstmt)
    529510        (SQLDescribeCol hstmt column-nr column-name-ptr 256
    530                         ;; TODO: Does 256 leave room for terminating
    531                         ;; nulls?
    532511                        column-name-length-ptr
    533512                        column-sql-type-ptr
    … …  
    572551
    573552
    574 ;;;; dso+
    575553(defun %sql-prepare (hstmt sql)
    576554  (declare (string sql))
    … …  
    579557        (SQLPrepare hstmt sql-ptr $SQL_NTS))))
    580558
    581 ;;;; dso+
    582559(defun set-connection-option (hdbc option param)
    583560  (with-error-handling (:hdbc hdbc)
    … …  
    591568
    592569
    593 ***
     570;;;***
    594571;;; rav, 11.6.2005
    595572;;; added tracing support
    596573
    597 ;;;; dso+
    598574(defun set-connection-attr-integer (hdbc option val)
    599575  (with-error-handling (:hdbc hdbc)
    600576      (SQLSetConnectAttr_long hdbc option val 0)))
    601577
    602 ;;;; dso+
    603578(defun set-connection-attr-string (hdbc option val)
    604579  (with-error-handling  (:hdbc hdbc)
    … …  
    613588(defun %stop-connection-trace (hdbc)
    614589  (set-connection-attr-integer hdbc $SQL_ATTR_TRACE     $SQL_OPT_TRACE_OFF))
    615  
    616 
    617 (defun get-connection-attr-integer (hdbc attr)
    618   (with-temporary-allocations
    619       ((ptr (cffi:foreign-alloc :long))
    620        (lenptr (cffi:foreign-alloc :long)))
    621     (with-error-handling (:hdbc hdbc)
    622       (SQLGetConnectAttr hdbc attr ptr 0 lenptr))
    623     (cffi:mem-ref ptr :long)))
    624 
    625 (defun get-connection-attr-string (hdbc attr)
    626   (with-temporary-allocations
    627       ((ptr (alloc-chars 256))
    628        (lenptr (cffi:foreign-alloc :long)))
    629     (with-error-handling (:hdbc hdbc)
    630       (SQLGetConnectAttr hdbc attr ptr 256 lenptr))
    631     (get-string  ptr (cffi:mem-ref lenptr :long))))
    632 
    633 ;;; small test for the get-connection-attr
    634 (defun %get-current-catalog (hdbc)
    635   (get-connection-attr-string hdbc $SQL_ATTR_CURRENT_CATALOG))
    636 
    637 (defun %set-current-catalog (hdbc catalog)
    638   (set-connection-attr-string hdbc $SQL_ATTR_CURRENT_CATALOG catalog))
    639 
    640 
    641 
    642 (defun %connection-ok-p (hdbc)
    643   (with-error-handling (:hdbc hdbc)
    644     (ecase (get-connection-attr-integer hdbc $SQL_ATTR_CONNECTION_DEAD)
    645       (#.$sql_cd_true nil)
    646       (#.$sql_cd_false t))))
    647590
    648591;;;
    649592
    650593; column-nr is zero-based
    651 ;;;; dso+
    652594(defun %sql-get-data (hstmt column-nr c-type data-ptr precision out-len-ptr)
    653595  (declare ((integer 0) column-nr))
    … …  
    657599                  c-type data-ptr precision out-len-ptr)))
    658600
    659 ;;;; dso+
    660601(defun %sql-get-data-raw (hstmt position c-type data-ptr buffer-length ind-ptr)
    661602  (declare ((integer 0) position))
    … …  
    664605
    665606
    666 ;;;; dso+
    667607(defun %sql-param-data (hstmt param-ptr)
    668608  (with-error-handling (:hstmt hstmt :print-info t) ;; nil
    … …  
    670610
    671611
    672 ;;;; dso+
    673612(defun %sql-put-data (hstmt data-ptr size)
    674613  (with-error-handling
    … …  
    677616
    678617
    679 ;;;; dso+
    680618(defun %sql-more-results (hstmt)
    681619  (let ((res (SQLMoreResults hstmt)))
Note: See TracChangeset for help on using the changeset viewer.