ODBC interface

Simon TAYLOR stayl at students.cs.mu.oz.au
Tue Jul 22 19:39:19 AEST 1997


Hi,

This is the result of my hacking at Mission Critical's ODBC interface.

There are a couple of issues with this:

Microsoft's ODBC header files had to be altered slightly to compile
with gcc:
- removed some C++ style comments
- defined the calling convention for the ODBC functions
	using attribute((stdcall))
- removed some conflicting typedefs
Is it OK to distribute a patch for these header files, given that they
aren't in the section of the ODBC SDK which is redistributable?

Also I should probably get permission from the Mission Critical people 
before this goes in the release, but that shouldn't be a problem. What 
should go in the copyright message at the top of odbc.m?

There are two parts to this diff.

=======
Part 1:
=======

Estimated hours taken: 3

runtime/engine.h
runtime/engine.mod
	Added macros MR_setjmp and MR_longjmp which in save and restore
	the jmp_buf used to return from call_engine_inner. This is needed 
	to make longjmp work across C->Mercury calls.

runtime/mercury_string.h
	Added a macro make_aligned_string_copy, which is the same as
	make_aligned_string except that it is guaranteed to do the copy.
	This is useful for copying C strings out of buffers onto the 
	Mercury heap.

runtime/misc.c
	Avoid a segfault in debug grades when printing information about
	the bottom nondetstack frame.


Index: engine.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/engine.h,v
retrieving revision 1.12
diff -u -r1.12 engine.h
--- engine.h	1997/02/12 02:15:23	1.12
+++ engine.h	1997/07/22 06:39:15
@@ -13,6 +13,8 @@
 #ifndef	ENGINE_H
 #define	ENGINE_H
 
+#include <setjmp.h>
+
 #include "std.h"		/* for `bool' */
 #include "mercury_types.h"	/* for `Code *' */
 #include "goto.h"		/* for `Define_entry()' */
@@ -42,6 +44,58 @@
 #define	sregdebug	debugflag[SREGFLAG]
 #define	tracedebug	debugflag[TRACEFLAG]
 #define	detaildebug	debugflag[DETAILFLAG]
+
+	/* 
+	** MR_setjmp and MR_longjmp are wrappers around setjmp and longjmp 
+	** to ensure that
+	**	 call C -> setjmp -> call Mercury -> call C -> longjmp 
+	** works correctly. This is used by the exception handling code for
+	** the ODBC interface.
+	*/ 
+
+typedef struct {
+		jmp_buf *mercury_env;	/* 
+					** used to save MR_engine_jmp_buf 
+					*/
+		jmp_buf env;		/* 
+					** used by calls to setjmp and longjmp 
+					*/
+	} MR_jmp_buf;
+
+	/*
+	** MR_setjmp(MR_jmp_buf *env)
+	**
+	** Save MR_engine_jmp_buf, then call setjmp(env).
+	** setjmp can only occur as an expression, not a statement.
+	** I'm not certain that this is 100% portable. K&R p254 states
+	** that "a call to setjmp can only occur in certain contexts, 
+	** basically the test of if, switch and loops, and only in
+	** simple relational expressions". Is the expression below
+	** a simple relational expression?
+	*/
+#define MR_setjmp(setjmp_env)						\
+		(							\
+			(setjmp_env)->mercury_env = MR_engine_jmp_buf,	\
+			setjmp((setjmp_env)->env)			\
+		)
+
+	/*
+	** MR_longjmp(MR_jmp_buf *env, int return)
+	**
+	** Reset MR_engine_jmp_buf to the value stored in env, 
+	** then call longjmp().
+	*/
+#define	MR_longjmp(setjmp_env, ret)					\
+		do {							\
+			MR_engine_jmp_buf = (setjmp_env)->mercury_env;	\
+			longjmp((setjmp_env)->env, ret);		\
+		} while (0)
+
+	/* 
+	** engine_jmp_buf should only be referred to in engine.c
+	** and the MR_setjmp and MR_longjmp macros defined above.
+	*/
+extern	jmp_buf *MR_engine_jmp_buf;
 
 extern	bool	debugflag[];
 
Index: engine.mod
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/engine.mod,v
retrieving revision 1.41
diff -u -r1.41 engine.mod
--- engine.mod	1997/05/26 12:20:02	1.41
+++ engine.mod	1997/06/26 04:01:05
@@ -31,7 +31,7 @@
 
 bool	debugflag[MAXFLAG];
 
-static jmp_buf *engine_jmp_buf;
+jmp_buf *MR_engine_jmp_buf;
 
 /*
 ** init_engine() calls init_memory() which sets up all the necessary
@@ -128,25 +128,25 @@
 	jmp_buf		* volatile prev_jmp_buf;
 
 	/*
-	** Preserve the value of engine_jmp_buf on the C stack.
+	** Preserve the value of MR_engine_jmp_buf on the C stack.
 	** This is so "C calls Mercury which calls C which calls Mercury" etc.
 	** will work.
 	*/
 
-	prev_jmp_buf = engine_jmp_buf;
-	engine_jmp_buf = &curr_jmp_buf;
+	prev_jmp_buf = MR_engine_jmp_buf;
+	MR_engine_jmp_buf = &curr_jmp_buf;
 
 	/*
 	** Mark this as the spot to return to.
 	** On return, restore the registers (since longjmp may clobber
-	** them), restore the saved value of engine_jmp_buf, and then
+	** them), restore the saved value of MR_engine_jmp_buf, and then
 	** exit.
 	*/
 
 	if (setjmp(curr_jmp_buf)) {
 		debugmsg0("...caught longjmp\n");
 		restore_registers();
-		engine_jmp_buf = prev_jmp_buf;
+		MR_engine_jmp_buf = prev_jmp_buf;
 		return;
 	}
 
@@ -273,7 +273,7 @@
 	*/
 	save_registers();
 	debugmsg0("longjmping out...\n");
-	longjmp(*engine_jmp_buf, 1);
+	longjmp(*MR_engine_jmp_buf, 1);
 }} /* end call_engine_inner() */
 
 /* with nonlocal gotos, we don't save the previous locations */
@@ -302,7 +302,7 @@
 {
 	save_registers();
 	debugmsg0("longjmping out...\n");
-	longjmp(*engine_jmp_buf, 1);
+	longjmp(*MR_engine_jmp_buf, 1);
 }
 
 static Code *
Index: mercury_string.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_string.h,v
retrieving revision 1.4
diff -u -r1.4 mercury_string.h
--- mercury_string.h	1997/02/19 05:36:24	1.4
+++ mercury_string.h	1997/07/17 03:13:36
@@ -60,19 +60,34 @@
 */
 #define make_aligned_string(ptr, string) 				\
 	do { 								\
-	    Word make_aligned_string_tmp;				\
-	    char * make_aligned_string_ptr;				\
-									\
 	    if (tag((Word) (string)) != 0) { 				\
-	    	incr_hp_atomic(make_aligned_string_tmp, 		\
+		make_aligned_string_copy((ptr), (string));		\
+	    } else { 							\
+	    	(ptr) = (string);					\
+	    }								\
+	} while(0)
+
+/* void make_aligned_string_copy(ConstString &ptr, const char * string);
+**	Same as make_aligned_string(ptr, string), except that the string
+**	is guaranteed to be copied. This is useful for copying C strings
+**	onto the Mercury heap.
+**
+** BEWARE: this may modify `hp', so it must only be called from
+** places where `hp' is valid.  If calling it from inside a C function,
+** rather than inside Mercury code, you may need to call
+** save/restore_transient_regs().
+*/
+#define make_aligned_string_copy(ptr, string) 				\
+	do {								\
+		Word make_aligned_string_tmp;				\
+		char * make_aligned_string_ptr;				\
+									\
+	  	incr_hp_atomic(make_aligned_string_tmp,			\
 	    	    (strlen(string) + sizeof(Word)) / sizeof(Word));	\
 	    	make_aligned_string_ptr =				\
 		    (char *) make_aligned_string_tmp;			\
 	    	strcpy(make_aligned_string_ptr, (string));		\
 	    	(ptr) = make_aligned_string_ptr;			\
-	    } else { 							\
-	    	(ptr) = (string);					\
-	    }								\
 	} while(0)
 
 /*
Index: misc.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/misc.c,v
retrieving revision 1.9
diff -u -r1.9 misc.c
--- misc.c	1997/02/12 07:41:12	1.9
+++ misc.c	1997/06/26 02:09:35
@@ -301,9 +301,21 @@
 	printf("ptr 0x%p, offset %3ld words\n",
 		(const void *) s, (long) (Integer) (s - nondetstack_zone->min));
 #else
-	printf("ptr 0x%p, offset %3ld words, procedure %s\n",
-		(const void *) s, (long) (Integer) (s - nondetstack_zone->min),
-		(const char *) s[PREDNM]);
+	if (s - nondetstack_zone->min > 0) {
+		printf("ptr 0x%p, offset %3ld words, procedure %s\n",
+			(const void *) s, 
+			(long) (Integer) (s - nondetstack_zone->min),
+			(const char *) s[PREDNM]);
+	}
+	else {
+		/*
+		** This handles the case where the prevfr of the first frame
+		** is being printed.
+		*/
+		printf("ptr 0x%p, offset %3ld words\n",
+			(const void *) s, 
+			(long) (Integer) (s - nondetstack_zone->min));
+	}
 #endif
 	return;
 }


=======
Part 2:
=======

extras/odbc/odbc.m
	The ODBC interface.

extras/odbc/Mmakefile
	Configuration for the odbc interface.

extras/odbc/odbc_test.m
	A simple test program.


=====================
extras/odbc/Mmakefile
=====================

#-----------------------------------------------------------------------------#
# Copyright (C) 1997 University of Melbourne.
# This file may only be copied under the terms of the GNU General
# Public License - see the file COPYING in the Mercury distribution.
#-----------------------------------------------------------------------------#

# extras/odbc/Mmakefile - Mmake file for building the ODBC interface.

#-----------------------------------------------------------------------------#
# Configuration

# The driver manager.
# Legal values for MODBC_DRIVER are MODBC_IODBC and MODBC_MS.
# Feel free to add more (and handle them in odbc.m).
MODBC_DRIVER=MODBC_IODBC
#MODBC_DRIVER=MODBC_MS

# The database.
# Legal values for MODBC_DB are MODBC_MYSQL and MODBC_SQL_SERVER.
# Feel free to add more (and handle them in odbc.m).
# MODBC_DB=MODBC_SQL_SERVER
MODBC_DB = MODBC_MYSQL

# Pathname for iODBC (only for MODBC_IODBC)
IODBC_DIR=/home/mercury1/stayl/iodbc/iODBC-2.12

# Pathname for the ODBC SDK (only for MODBC_MS)
ODBC_SDK_DIR=/odbcsdk

#-----------------------------------------------------------------------------#

ifeq ($(MODBC_DRIVER),MODBC_MS)
	ODBC_INCL_DIR=$(ODBC_SDK_DIR)/include
	MLLIBS=-lodbc32
else 
	ODBC_LIB_DIR=$(IODBC_DIR)/lib
	ODBC_INCL_DIR=$(IODBC_DIR)
	MLLIBS=-L$(ODBC_LIB_DIR) -liodbc -ldl
endif

MAIN_TARGET=odbc_test

RM_C=:

#-----------------------------------------------------------------------------#

	# gcc aborts with optimization enabled.
MGNUCFLAGS =	-D$(MODBC_DRIVER) -D$(MODBC_DB) -O0 -I$(ODBC_INCL_DIR) -I../boehm_gc

#-----------------------------------------------------------------------------#
#-----------------------------------------------------------------------------#

==================
extras/odbc/odbc.m
==================

%---------------------------------------------------------------------------%
% XXX what should go here?
% Copyright (C) 1997 Mission Critical
% Copyright (C) 1997 University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
%---------------------------------------------------------------------------%
% File: odbc.m
% Authors: Renaud Paquay (rpa at miscrit.be), stayl
% ODBC version: 2.0
%
% The transaction interface used here is described in
%	Kemp, Conway, Harris, Henderson, Ramamohanarao and Somogyi,
% 	"Database transactions in a purely declarative 
%		logic programming language", 
%	Technical Report 96/45, Department of Computer Science, 
% 	University of Melbourne, December 1996.
%
% This has been tested with MySQL 3.20.19 and iODBC 2.12 under Solaris 2.5,
% and with Microsoft SQL Server 6.5 under Windows NT 4.0 with the GNU-Win32 
% tools beta 17.1.
%
% Notes:
% 	binary data is converted to a string of hexadecimal digits.
%
% To do:
%	improve the interface to the catalog functions
% 
%-----------------------------------------------------------------------------%
%
:- module odbc.
%
%-----------------------------------------------------------------------------%

:- interface.

:- import_module io, list.

%-----------------------------------------------------------------------------%

	% Predicates and types for transaction processing.	

:- type odbc__data_source	== string.
:- type odbc__user_name		== string.
:- type odbc__password		== string.

		% A closure to be executed atomically. 
:- type odbc__transaction(T)	== 	pred(T, odbc__state, odbc__state).
:- mode odbc__transaction	::	pred(out, di, uo) is det.

:- type odbc__state.

	% Perform the closure atomically on the given database connection.
	% On error, the transaction is rolled back.
:- pred odbc__transaction(odbc__data_source, odbc__user_name, odbc__password,
		odbc__transaction(T), odbc__result(T), io__state, io__state).
:- mode odbc__transaction(in, in, in, odbc__transaction, out, di, uo) is det.

	% Abort the current transaction, returning the given error message.
:- pred odbc__rollback(string, odbc__state, odbc__state).
:- mode odbc__rollback(in, di, uo) is erroneous.

%-----------------------------------------------------------------------------%

	% Predicates and types for execution of SQL statements.

:- type odbc__row	==	list(odbc__attribute).

:- type odbc__attribute
	--->	null		% SQL NULL value
	;	int(int)	
	;	string(string)
	;	float(float)
	;	time(string).	% Time string: "YYYY-MM-DD hh:mm:ss.mmm"

	% The odbc__state arguments threaded through odbc__execute/4 and
	% odbc__execute/3 enforce the restriction that database activity can
	% only occur within a transaction, since odbc__states are only 
	% available to the closure called by odbc__transaction/5.

	% Execute a command, returning a list of results. 
:- pred odbc__execute(string, list(odbc__row), odbc__state, odbc__state).
:- mode odbc__execute(in, out, di, uo) is det.

	% Execute an SQL statement which doesn't return any results, such
	% as DELETE.
:- pred odbc__execute(string, odbc__state, odbc__state).
:- mode odbc__execute(in, di, uo) is det.

%-----------------------------------------------------------------------------%

	% Predicates and types to get information about database tables.
	% This is very incomplete, it would be nice to be able to get 
	% information about the columns in a table and about privileges 
	% for tables and columns.

:- type odbc__source_desc
	--->	odbc__source_desc(
			odbc__data_source,	% name
			string			% description
		).

:- type odbc__search_pattern
	--->	any
	;	pattern(string).	% _ matches any single character
					% % matches a sequence of characters

	% Information about a table accessible by a transaction.
:- type odbc__table_desc
	--->	odbc__table_desc(
			string,			% table qualifier
			string,			% table owner
			string,			% table name
			string,			% table type
			string,			% description
			list(odbc__attribute)	% data source specific columns
		).

	% Get a list of all the available data sources.
	% Note that iODBC 2.12 doesn't implement this.
:- pred odbc__data_sources(odbc__result(list(odbc__source_desc)), 
		io__state, io__state).
:- mode odbc__data_sources(out, di, uo) is det.

	% odbc__tables(QualifierPattern, OwnerPattern, 
	% 	TableNamePattern, Result)
	% 
	% Get a list of database tables matching the given description.
	% Note that wildcards are not allowed in the CatalogPattern.
	% This is fixed in ODBC 3.0.
:- pred odbc__tables(odbc__search_pattern, odbc__search_pattern,
		odbc__search_pattern, list(odbc__table_desc),
		odbc__state, odbc__state).
:- mode odbc__tables(in, in, in, out, di, uo) is det.

%-----------------------------------------------------------------------------%

	% The following types are used to return status and error 
	% information from ODBC calls.

:- type odbc__result == pair(odbc__status, list(odbc__message)).

:- type odbc__status
	--->	ok
	;	error.

	% The message list returned from a transaction contains all errors 
	% and warnings reported by the driver during the transaction in
	% the order that they were reported.
:- type odbc__result(T) == pair(odbc__status(T), list(odbc__message)).

:- type odbc__status(T)
	--->	ok(T)
	;	error.

:- type odbc__message == pair(odbc__message_type, string).

:- type odbc__message_type
	--->	warning(odbc__warning)
	;	error(odbc__error).

:- type odbc__warning
	--->	disconnect_error
	;	fractional_truncation
	;	general_warning
	;	null_value_in_set_function
	;	privilege_not_revoked
	;	privilege_not_granted
	;	string_data_truncated
	.

:- type odbc__error
	--->	connection_error(odbc__connection_error)
	;	execution_error(odbc__execution_error)
	;	feature_not_implemented
	;	general_error
	;	internal_error
	;	timeout_expired
	;	transaction_error(odbc__transaction_error)
	;	user_requested_rollback
	.

:- type odbc__connection_error
	--->	unable_to_establish
	;	invalid_authorization
	;	connection_name_in_use
	;	nonexistent_connection
	;	connection_rejected_by_server
	;	connection_failure
	;	timeout_expired
	.

:- type odbc__execution_error
	--->	column_already_exists
	;	column_not_found
	;	division_by_zero
	;	general_error
	;	incorrect_count_field
	;	incorrect_derived_table_arity
	;	index_already_exists
	;	index_not_found
	;	integrity_constraint_violation
	;	interval_field_overflow
	;	invalid_cast_specification
	;	invalid_date_time
	;	invalid_escape
	;	invalid_insert_value_list
	;	invalid_schema_name
	;	invalid_use_of_default_parameter
	;	length_mismatch_in_string_data
	;	no_default_for_column
	;	overflow
	;	range_error
	;	restricted_data_type_violation
	;	string_data_length_mismatch
	;	string_data_truncated
	;	syntax_error_or_access_violation
	;	table_or_view_already_exists
	;	table_or_view_not_found
	.

:- type odbc__transaction_error
	--->	rolled_back
	;	still_active
	;	serialization_failure
	;	invalid_state
	.

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.

:- import_module assoc_list, int, require, std_util, string.

%-----------------------------------------------------------------------------%

:- type odbc__state == unit.

:- pragma c_header_code("

#include ""imp.h""
#include <stdio.h>
#include <stdlib.h>
#include <setjmp.h>	/* warning, dodgy code ahead */
#include <assert.h>
#include <sys/time.h>
#include <sys/times.h>

#define ODBC_VER 0x0250

#ifdef MODBC_IODBC

#include ""isql.h""
#include ""isqlext.h""
#include ""odbc_funcs.h""
#include ""odbc_types.h""

	/* 
	** iODBC 2.12 doesn't define SQL_NO_TOTAL, so we define it to
	** something random. It must be negative because a positive value 
	** where SQL_NO_TOTAL is returned is the length of the data.
	*/
#ifndef SQL_NO_TOTAL
#define SQL_NO_TOTAL (-1451)
#endif
	/*
	** Again, iODBC 2.12 doesn't define this, so define it to something
	** harmless.
	*/
#ifndef SQL_NO_DATA
#define SQL_NO_DATA SQL_NO_DATA_FOUND
#endif

#endif /* MODBC_IODBC */

#ifdef MODBC_MS

#include <windows.h>
#include ""sql.h""
#include ""sqlext.h""
#include ""sqltypes.h""

#endif /* MODBC_MS */

#include ""odbc.h""

#undef DEBUG

	/*
	** Assert the implication: a => b
	*/
#define MR_ASSERT_IMPLY(a,b)	MR_assert( !(a) || (b) )

	/*
	** Make sure floats get converted to the correct size by the driver. 
	** Doing the conversion in the driver means we might get warnings 
	** if precision is lost.
	*/
#ifdef USE_SINGLE_PREC_FLOAT

#define MODBC_SQL_FLOAT		SQL_FLOAT
#define MODBC_SQL_C_FLOAT	SQL_C_FLOAT

#else /* ! USE_SINGLE_PREC_FLOAT */

#define MODBC_SQL_FLOAT		SQL_DOUBLE
#define MODBC_SQL_C_FLOAT	SQL_C_DOUBLE

#endif /* ! USE_SINGLE_PREC_FLOAT */

	/*
	** All integers get converted to long by the driver, then to Integer.
	** XXX we should return some sort of message if a truncation
	** occurs, or use 64 bit integers. For now, storing integers longer
	** than a machine word in a database is a bad idea.
	*/
typedef long 			MODBC_SQL_INT;

	/*
	** Define some wrappers around setjmp and longjmp for exception 
	** handling. We need to use MR_setjmp and MR_longjmp because we'll 
	** be longjmping across C->Mercury calls, so we need to restore 
	** some state in runtime/engine.c.
	*/
#define odbc_catch() MR_setjmp(&odbc_trans_jmp_buf)
#define odbc_throw() MR_longjmp(&odbc_trans_jmp_buf, 1)

	/* 
	** odbc_trans_jmp_buf stores information saved by odbc_catch (setjmp)
	** to be used by odbc_throw (longjmp) when a database exception is 
	** found.
	*/
static MR_jmp_buf odbc_trans_jmp_buf;

	/*
	** odbc_env_handle is the output of SQLAllocEnv. SQLAllocEnv must
	** be called before attempting to open any connections.	
	*/
static SQLHENV	odbc_env_handle = SQL_NULL_HENV;	

	/* The connection being acted on by the current transaction.	*/
static SQLHDBC	odbc_connection = SQL_NULL_HDBC;

	/* The last return code from an ODBC system call. */
static SQLRETURN odbc_ret_code = SQL_SUCCESS;		

	/* 
	** The list of accumulated warnings and errors for the transaction 
	** in reverse order.
	*/
static Word odbc_message_list = list_empty();

	/* Mercury stuff to be restored on rollback */
static Word 	*odbc_saved_sp;
static Word	*odbc_saved_hp;
static Word	*odbc_saved_succip;
static Word	*odbc_saved_curfr;
static Word	*odbc_saved_maxfr;

static void odbc_transaction_c_code(Word type_info, Word Connection, 
			Word Closure, Word *Results, Word *Status, 
			Word *Msgs, Word IO0, Word *IO);
static bool odbc_check(SQLHENV, SQLHDBC, SQLHSTMT, SQLRETURN);

").

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

odbc__transaction(Source, User, Password, Closure, Result) -->
	% We could have separate open and close connection predicates in the 
	% interface, but that would just be more effort for the programmer 
	% for a very minor efficiency gain. The connection time will be 
	% insignificant for even trivial queries.
	odbc__open_connection(Source, User, Password, 
		ConnectStatus - ConnectMessages),
	(
		{ ConnectStatus = ok(Connection) },

		% Do the transaction.
		odbc__transaction_2(Connection, Closure, Data, 
			Status, RevMessages),
		{ list__reverse(RevMessages, TransMessages) },

		odbc__close_connection(Connection,
			CloseStatus - CloseMessages),
		{ list__condense(
			[ConnectMessages, TransMessages, CloseMessages], 
			Messages) },
		( { odbc__ok(Status), CloseStatus = ok } ->
			{ Result = ok(Data) - Messages }
		;
			{ Result = error - Messages }
		)
	;
		{ ConnectStatus = error },
		{ Result = error - ConnectMessages }
	).

:- pred odbc__transaction_2(odbc__connection,
		pred(T, odbc__state, odbc__state), T, 
		int, list(odbc__message), io__state, io__state).  
:- mode odbc__transaction_2(in, pred(out, di, uo) is det, 
		out, out, out, di, uo) is det.

:- pragma c_code(
		odbc__transaction_2(Connection::in, 
			Closure::pred(out, di, uo) is det,
			Results::out, Status::out, Msgs::out,
			IO0::di, IO::uo),
		may_call_mercury,
"
	/*
	** All this save_transient_registers()/restore_transient_registers()
	** nonsense here and elsewhere is necessary to stop the heap pointer 
	** being clobbered by the function call in non-GC or accurate GC 
	** grades.
	*/
	save_transient_registers();
	odbc_transaction_c_code(TypeInfo_for_T, Connection, Closure,
			&Results, &Status, &Msgs, IO0, &IO);
	restore_transient_registers();
").

%-----------------------------------------------------------------------------%

	%
	% We definitely don't recommend this method of simulating 
	% exceptions for general programming.
	%

:- pragma c_code(
"
static void 
odbc_transaction_c_code(Word TypeInfo_for_T, Word Connection, Word Closure,
	Word *Results, Word *Status, Word *Msgs, 
	Word IO0, Word *IO)
{
	Word DB0 = (Word)0;
	Word DB = (Word)0;
	SQLRETURN rc;

	restore_transient_registers();

	/*
	** Mercury state to restore on rollback. 
	*/
	odbc_saved_hp = hp;
	odbc_saved_succip = succip;
	odbc_saved_maxfr = maxfr;
	odbc_saved_curfr = curfr;
	odbc_saved_sp = sp;

	odbc_connection = (SQLHDBC) Connection;

	/* Set up a location to jump to on a database exception. */
	if (odbc_catch()) {
		/* if we get here, an exception has occurred */
		goto transaction_error;	
	}

	/*
	** Anything changed between the call to odbc_catch() and the call to
	** ML_odbc__do_transaction() must be declared volatile.
	*/

	ML_odbc__do_transaction(TypeInfo_for_T, Closure, Results, DB0, &DB);

	/*
	** MR_longjmp() cannot be called after here.
	*/

	rc = SQLTransact(odbc_env_handle, odbc_connection, SQL_COMMIT);
	save_transient_registers();
	if (! odbc_check(odbc_env_handle, odbc_connection, 
			SQL_NULL_HSTMT, rc)) {
		goto transaction_error;
	}
	restore_transient_registers();

	*Status = SQL_SUCCESS;

	goto transaction_done;

transaction_error:

	/*
	** Make the database rollback the transaction if it
	** hasn't already. 
	*/

	*Status = odbc_ret_code;

	rc = SQLTransact(odbc_env_handle, odbc_connection, SQL_ROLLBACK);
	odbc_check(odbc_env_handle, odbc_connection, SQL_NULL_HSTMT, rc);

	/* Get back the saved Mercury state. */
	restore_transient_registers();
	sp = odbc_saved_sp;
	succip = odbc_saved_succip;
	hp = odbc_saved_hp;
	curfr = odbc_saved_curfr;
	maxfr = odbc_saved_maxfr;

	/* Fall through. */

transaction_done:

	*Msgs = odbc_message_list;
	odbc_message_list = list_empty();
	odbc_connection = SQL_NULL_HDBC;
	odbc_ret_code = SQL_SUCCESS;
	*IO = IO0;
	save_transient_registers();

	return;
}
").

%-----------------------------------------------------------------------------%

	% Call the transaction closure.
:- pred odbc__do_transaction(odbc__transaction(T), T,
		odbc__state, odbc__state).
:- mode odbc__do_transaction(odbc__transaction, out, di, uo) is det.

:- pragma export(odbc__do_transaction(odbc__transaction, out, di, uo), 
		"ML_odbc__do_transaction").

odbc__do_transaction(Closure, Results) -->
	call(Closure, Results).

%-----------------------------------------------------------------------------%

odbc__rollback(Error) -->
	odbc__add_message(error(user_requested_rollback) - Error),
	odbc__throw.

:- pred odbc__add_message(odbc__message, odbc__state, odbc__state).
:- mode odbc__add_message(in, di, uo) is det.

:- pragma c_code(odbc__add_message(Error::in, DB0::di, DB::uo),
		will_not_call_mercury,
"
{
	odbc_message_list = list_cons(Error, odbc_message_list);
	DB = DB0;
}
").

:- pred odbc__throw(odbc__state, odbc__state).
:- mode odbc__throw(di, uo) is erroneous.

:- pragma c_code(odbc__throw(DB0::di, DB::uo),
		will_not_call_mercury,
"
{
	save_transient_registers();
	odbc_ret_code = SQL_ERROR;
	odbc_throw();
	DB = DB0;
}
").

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

	% Predicates and types to manage connections.

:- type odbc__connection.	% A connection to a specific source.

	% Given the data source to connect to and a user name and password,
	% open a connection.
:- pred odbc__open_connection(odbc__data_source, odbc__user_name, 
		odbc__password, odbc__result(odbc__connection), 
		io__state, io__state).
:- mode odbc__open_connection(in, in, in, out, di, uo) is det.

	% Close the connection to the given data source.
:- pred odbc__close_connection(odbc__connection, odbc__result,
		io__state, io__state).
:- mode odbc__close_connection(in, out, di, uo) is det.

%-----------------------------------------------------------------------------%

:- type odbc__connection == c_pointer.

odbc__open_connection(Source, User, Password, Result - Messages) -->
	odbc__do_open_connection(Source, User, Password, Handle,
		ConnectStatus, RevMessages),
	{ list__reverse(RevMessages, Messages) },
	( { odbc__ok(ConnectStatus) } ->
		{ Result = ok(Handle) }
	;
		{ Result = error }
	).

%-----------------------------------------------------------------------------%

:- pred odbc__do_open_connection(string, string, string,
		odbc__connection, int, list(odbc__message), 
		io__state, io__state).
:- mode odbc__do_open_connection(in, in, in, uo, out, out, di, uo) is det.

:- pragma c_code(
		odbc__do_open_connection(Source::in, User::in, Password::in,
			Handle::uo, Status::out, Messages::out,
			IO0::di, IO::uo),
		may_call_mercury, 
"
{
	SQLHDBC connect_handle;

	save_transient_registers();

	if (odbc_env_handle == SQL_NULL_HENV) {
		Status = SQLAllocEnv(&odbc_env_handle);
	}
	else {
		Status = SQL_SUCCESS;
	}

#ifdef DEBUG
	printf(""SQLAllocEnv status: %ld\\n"", Status);
#endif /* DEBUG */

	if (odbc_check(odbc_env_handle, SQL_NULL_HDBC, 
			SQL_NULL_HSTMT, Status)) {

#ifdef DEBUG
		printf(""connecting\n"");
#endif /* DEBUG */

		Status = SQLAllocConnect(odbc_env_handle, &connect_handle);

#ifdef DEBUG
		printf(""SQLAllocConnect status: %ld\\n"", Status);
#endif /* DEBUG */

		if (odbc_check(odbc_env_handle, connect_handle,
				SQL_NULL_HSTMT, Status)) {
			/* Put the connection into manual commit mode */
			Status = SQLSetConnectOption(connect_handle,
				SQL_AUTOCOMMIT, SQL_AUTOCOMMIT_OFF);
#ifdef DEBUG
			printf(""manual commit status: %ld\\n"", Status);
#endif /* DEBUG */
			odbc_check(odbc_env_handle, connect_handle,
				SQL_NULL_HSTMT, Status);
		}
	}

	IO = IO0;


	Status = SQLConnect(connect_handle, 
			(UCHAR *)Source, strlen(Source),
			(UCHAR *)User, strlen(User),
			(UCHAR *)Password, strlen(Password));

#ifdef DEBUG
	printf(""connect status: %ld\\n"", Status);
#endif /* DEBUG */

	odbc_check(odbc_env_handle, connect_handle, SQL_NULL_HSTMT, Status);

	Messages = odbc_message_list;
	odbc_message_list = list_empty();

	Handle = (Word) connect_handle;
	odbc_connection = SQL_NULL_HDBC;
	IO = IO0;

	restore_transient_registers();
}
").

%-----------------------------------------------------------------------------%

odbc__close_connection(Connection, Result) -->
	odbc__do_close_connection(Connection, Status, RevMessages),
	{ list__reverse(RevMessages, Messages) },
	( { Status = 0 } ->
		{ Result = ok - Messages }
	;
		{ Result = error - Messages }
	).

:- pred odbc__do_close_connection(odbc__connection, int, 
		list(odbc__message), io__state, io__state).
:- mode odbc__do_close_connection(in, out, out, di, uo) is det.

:- pragma c_code(
		odbc__do_close_connection(Handle::in, Status::out,
			Messages::out, IO0::di, IO::uo),
		may_call_mercury,
"
	save_transient_registers();

	Status = SQLDisconnect((SQLHDBC) Handle);
	if (odbc_check(odbc_env_handle, (SQLHDBC) Handle, 
			SQL_NULL_HSTMT, Status)) {
		Status = SQLFreeConnect((SQLHDBC) Handle);
		odbc_check(odbc_env_handle, (SQLHDBC) Handle, 
			SQL_NULL_HSTMT, Status);
	}

	Messages = odbc_message_list;
	odbc_message_list = list_empty();

	IO = IO0;

	restore_transient_registers();
").

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

odbc__execute(SQLString) -->
	odbc__alloc_statement(Statement0),
	odbc__execute_statement(SQLString, Statement0, Statement),
	odbc__cleanup_statement_check_error(Statement).
	
odbc__execute(SQLString, Results) -->
	odbc__get_result_set(odbc__execute_statement(SQLString), Results).

%-----------------------------------------------------------------------------%

:- pred odbc__get_result_set(pred(odbc__statement, odbc__statement, 
			odbc__state, odbc__state), 
			list(odbc__row), odbc__state, odbc__state).
:- mode odbc__get_result_set(pred(in, out, di, uo) is det, out, di, uo) is det.

odbc__get_result_set(Execute, Results) -->
	odbc__alloc_statement(Statement0),
	call(Execute, Statement0, Statement1),
	odbc__bind_columns(Statement1, Statement2),
	odbc__get_rows(Results, Statement2, Statement),
	odbc__cleanup_statement_check_error(Statement).

%-----------------------------------------------------------------------------%

	% Get the set of result rows from the statement.
:- pred odbc__get_rows(list(odbc__row), odbc__statement, odbc__statement, 
		odbc__state, odbc__state).
:- mode odbc__get_rows(out, in, out, di, uo) is det.

odbc__get_rows(Rows, Statement0, Statement) -->
	odbc__get_number_of_columns(Statement0, NumColumns),
	odbc__get_rows_2(NumColumns, Rows, Statement0, Statement).

:- pred odbc__get_rows_2(int, list(odbc__row), odbc__statement,
		odbc__statement, odbc__state, odbc__state).
:- mode odbc__get_rows_2(in, out, in, out, di, uo) is det.

odbc__get_rows_2(NumColumns, Rows, Statement0, Statement) -->
	% Try to fetch a new row.
	odbc__fetch(Statement0, Statement1, Status),
	( { odbc__no_data(Status) } ->
		{ Rows = [] },
		{ Statement = Statement1 }
	;
		odbc__get_attributes(1, NumColumns, Row, 
			Statement1, Statement2),
		odbc__get_rows_2(NumColumns, Rows1, Statement2, Statement),
		{ Rows = [Row | Rows1] }
	).

%-----------------------------------------------------------------------------%

	% Get the values from the current fetched row.
:- pred odbc__get_attributes(int, int, list(odbc__attribute), 
		odbc__statement, odbc__statement,
		odbc__state, odbc__state).
:- mode odbc__get_attributes(in, in, out, in, out, di, uo) is det.

odbc__get_attributes(CurrCol, NumCols, Row, Statement0, Statement) -->
	( { CurrCol =< NumCols } ->
		{ NextCol is CurrCol + 1 },
		odbc__get_attribute(CurrCol, Attribute, Statement0, Statement1),
		odbc__get_attributes(NextCol, NumCols, Row1, 
			Statement1, Statement),
		{ Row = [Attribute | Row1] }
	;
		{ Row = [] },
		{ Statement = Statement0 }
	).

%-----------------------------------------------------------------------------%

	% Get the value of a column in the current fetched row.
:- pred odbc__get_attribute(int, odbc__attribute, odbc__statement,
		odbc__statement, odbc__state, odbc__state) is det.
:- mode odbc__get_attribute(in, out, in, out, di, uo) is det.

odbc__get_attribute(NumColumn, Value, Statement0, Statement) -->
	odbc__get_data(NumColumn, Int, Float, String, TypeInt, 
		Statement0, Statement), 
	{ odbc__int_to_attribute_type(TypeInt, Type) },
	(
		{ Type = null },
		{ Value = null }
	;
		{ Type = string },
		{ Value = string(String) }
	;
		{ Type = time },
		{ Value = time(String) }
	; 
		{ Type = int },
		{ Value = int(Int) }
	;
		{ Type = float },
		{ Value = float(Float) }
	).

%-----------------------------------------------------------------------------%

:- type odbc__attribute_type
	--->	int
	;	float
	;	time
	;	string
	;	null.

:- pred odbc__int_to_attribute_type(int, odbc__attribute_type).
:- mode odbc__int_to_attribute_type(in, out) is det.

odbc__int_to_attribute_type(Int, Type) :-
	( odbc__int_to_attribute_type_2(Int, Type1) ->
		Type = Type1
	;
		error("odbc__int_to_attribute_type: invalid type")
	).

	% Keep this in sync with the C enum MODBC_AttrType below.
:- pred odbc__int_to_attribute_type_2(int, odbc__attribute_type).
:- mode odbc__int_to_attribute_type_2(in, out) is semidet.

odbc__int_to_attribute_type_2(0, int).
odbc__int_to_attribute_type_2(1, float).
odbc__int_to_attribute_type_2(2, time).
odbc__int_to_attribute_type_2(3, string).
odbc__int_to_attribute_type_2(4, string).
odbc__int_to_attribute_type_2(5, null).

%-----------------------------------------------------------------------------%

:- type odbc__statement	== c_pointer.

:- pragma c_header_code("

	/*
	** If the driver can't work out how much data is in a blob in advance,
	** get the data in chunks. The chunk size is fairly arbitrary.
	*/
#define MODBC_CHUNK_SIZE	4*1024

typedef enum {
	MODBC_INT	= 0,	/* Word-sized Integer */
	MODBC_FLOAT	= 1,	/* Mercury Float */
	MODBC_TIME	= 2,	/* time and/or date converted to a string */
	MODBC_STRING	= 3,	/* string, or type converted to a string */
	MODBC_VAR_STRING = 4,	/* string with no maximum length */
	MODBC_NULL	= 5
} MODBC_AttrType;

typedef enum { MODBC_BIND_COL, MODBC_GET_DATA } MODBC_BindType;

	/* Information about a column in a result set. */
typedef struct {
		size_t		size;		/* size of allocated buffer */
		MODBC_AttrType	attr_type;
		SWORD		sql_type;	/*
						** the actual type, 	   
						** e.g. SQL_LONG_VAR_CHAR 
						*/
		SWORD		conversion_type;/*
						** the type the data is 
						** being converted into,
						** e.g SQL_C_CHAR
						*/
		SDWORD		value_info;	/* 
						** size of returned data,
						** or SQL_NULL_DATA
						*/
		Word 		*data;
} MODBC_Column;


	/* Information about a result set. */
typedef struct {
		SQLHSTMT	stat_handle;	/* statement handle 	  */
		int		num_columns;	/* columns per row 	  */
		MODBC_Column	**row;		/* current row		  */
		int 		num_rows;	/* number of fetched rows */ 
		MODBC_BindType	binding_type;	/* 
						** are we using SQL_BIND_COL
						** or SQL_GET_DATA
						*/
} MODBC_Statement;

static SQLRETURN odbc_do_cleanup_statement(MODBC_Statement *stat);
static size_t sql_type_to_size(SWORD sql_type, UDWORD cbColDef, 
		SWORD ibScale, SWORD fNullable);
static SWORD attribute_type_to_sql_c_type(MODBC_AttrType AttrType);
static bool is_variable_length_sql_type(SWORD);
void odbc_do_get_data(MODBC_Statement *stat, int column_id);
void odbc_get_data_in_chunks(MODBC_Statement *stat, int column_id);
void odbc_get_data_in_one_go(MODBC_Statement *stat, int column_id);
").

%-----------------------------------------------------------------------------%

:- pred odbc__alloc_statement(odbc__statement, odbc__state, odbc__state).
:- mode odbc__alloc_statement(out, di, uo) is det.

:- pragma c_code(odbc__alloc_statement(Statement::out, DB0::di, DB::uo),
		may_call_mercury,
"
{
	MODBC_Statement *statement;
	SQLRETURN rc;

	save_transient_registers();

		/* Doing manual deallocation of the statement object. */
	statement = (MODBC_Statement *) newmem(sizeof(MODBC_Statement));
		
	statement->num_columns = 0;
	statement->row = NULL;
	statement->num_rows = 0;
	statement->stat_handle = SQL_NULL_HSTMT;

	rc = SQLAllocStmt(odbc_connection, &(statement->stat_handle));
	if (! odbc_check(odbc_env_handle, odbc_connection,
			statement->stat_handle, rc)) {
		odbc_throw();
		/* not reached */
	}

	MR_assert(statement->stat_handle != SQL_NULL_HSTMT);

	DB = DB0;
	Statement = (Word) statement;
	restore_transient_registers();
}
").

%-----------------------------------------------------------------------------%

:- pred odbc__execute_statement(string, odbc__statement, odbc__statement,
		odbc__state, odbc__state).
:- mode odbc__execute_statement(in, in, out, di, uo) is det.

:- pragma c_code(
		odbc__execute_statement(SQLString::in, Statement0::in,
			Statement::out, DB0::di, DB::uo),
		may_call_mercury,
"
{
	MODBC_Statement *statement = (MODBC_Statement *) Statement0;
	SQLRETURN rc;
	SQLHSTMT stat_handle = statement->stat_handle;

	save_transient_registers();

#ifdef DEBUG
	printf(""executing SQL string: %s\\n"", SQLString);
#endif /* DEBUG */


	rc = SQLPrepare(stat_handle, SQLString, strlen(SQLString));

	if (! odbc_check(odbc_env_handle, odbc_connection, stat_handle, rc)) {

		/*
		** We don't check the return status of this because 
		** the programmer is likely to be more interested 
		** in the earlier error.
		*/
		odbc_do_cleanup_statement(statement);
		odbc_throw();
		/* not reached */
	}

	rc = SQLExecute(stat_handle);
	if (! odbc_check(odbc_env_handle, odbc_connection, stat_handle, rc)) {
		odbc_do_cleanup_statement(statement);
		odbc_throw();
		/* not reached */
	}

#ifdef DEBUG
	printf(""execution succeeded\\n"");
#endif /* DEBUG */

	Statement = (Word) statement;
	DB = DB0;

	restore_transient_registers();
}").

%-----------------------------------------------------------------------------%

	%
	% There are two methods to get data back from an ODBC application.
	%
	% One involves binding a buffer to each column using SQLBindCol,
	% then calling SQLFetch repeatedly to read rows into the buffers.
	% The problem with this method is it doesn't work with variable 
	% length data, since if the data doesn't fit into the allocated
	% buffer it gets truncated and there's no way to have a second
	% try with a larger buffer.
	%
	% The other method is to not bind any columns. Instead, after
	% SQLFetch is called to update the cursor, SQLGetData is used
	% on each column to get the data. SQLGetData can be called repeatedly
	% to get all the data if it doesn't fit in the buffer. The problem 
	% with this method is that it requires an extra ODBC function call 
	% for each attribute received, which may have a significant impact 
	% on performance if the database is being accessed over a network.
	% 
	% Hybrid methods are also possible if all the variable length columns
	% come after the fixed length columns in the result set, but that 
	% is probably overkill. (SQLGetData can only be used on columns 
	% after those bound using SQLBindCol).
	%
	% The first method is used if there are no variable length columns,
	% otherwise the second method is used.
	%
:- pred odbc__bind_columns(odbc__statement, odbc__statement,
		odbc__state, odbc__state).
:- mode odbc__bind_columns(in, out, di, uo) is det.

:- pragma c_code(odbc__bind_columns(Statement0::in, Statement::out, 
		DB0::di, DB::uo), may_call_mercury,
"{ 
	int 		column_no;
	MODBC_Statement *statement;
	SQLSMALLINT 	num_columns;
	MODBC_Column	*column;
	SQLRETURN 	rc;
	SQLHSTMT 	stat_handle;

	save_transient_registers();

	statement = (MODBC_Statement *) Statement0;
	stat_handle = statement->stat_handle;

	/*
	** Retreive number of columns of statement
	*/
	rc = SQLNumResultCols(stat_handle, &num_columns);
	if (! odbc_check(odbc_env_handle, odbc_connection, stat_handle, rc)) {
		odbc_do_cleanup_statement(statement);
		odbc_throw();
		/* not reached */
	} 
	statement->num_columns = num_columns;

	/* 
	** Allocate an array of pointers to the info for each column
	*/
	statement->row = newmem((num_columns + 1)*
				sizeof(MODBC_Column *));

	/*
	** Use SQLBindCol unless there are columns with no set maximum length.
	*/
	statement->binding_type = MODBC_BIND_COL;

	/*
	** Get information about the result set columns.
	** ODBC counts columns from 1. 
	*/
	for (column_no = 1; column_no <= statement->num_columns; column_no++) {

		char		col_name[1]; 	/* Not looked at */
		SWORD		col_name_len;
		SWORD		col_type;
		UDWORD		pcbColDef;
		SWORD		pibScale;
		SWORD		pfNullable;

		column = newmem(sizeof(MODBC_Column));
		column->size = 0;
		column->data = NULL;

		/*
		** Retrieve the C type of the column.
		** (SQL type mapped to a conversion type).
		** Create an attribute object with room to store the 
		** attribute value.
		*/
			
		rc = SQLDescribeCol(stat_handle, column_no,
				(UCHAR *) col_name, sizeof(col_name), 
				&col_name_len, &col_type, &pcbColDef, 
				&pibScale, &pfNullable);

#ifdef DEBUG
		printf(""column %i: type%i length %i scale %i nullable %i\n"",
				column_no, col_type, pcbColDef, 
				pibScale, pfNullable);
#endif /* DEBUG */

		/*
		** SQL_SUCCESS_WITH_INFO means there wasn't
		** enough space for the column name, but we
		** aren't collecting the column name anyway.
		*/
		if (rc != SQL_SUCCESS_WITH_INFO && 
				! odbc_check(odbc_env_handle, odbc_connection,
					stat_handle, rc)) {
			odbc_do_cleanup_statement(statement);
			odbc_throw();
			/* not reached */
		}

		column->sql_type = col_type;
		column->size = sql_type_to_size(col_type, pcbColDef,
				pibScale, pfNullable);

		column->attr_type = sql_type_to_attribute_type(col_type);

		/* Request a conversion into one of the supported types. */
		column->conversion_type =
			attribute_type_to_sql_c_type(column->attr_type);

#ifdef DEBUG
		printf(""Column %i: size %i - sql_type %i - attr_type %i - conversion_type %i\\n"",
			column_no, column->size, column->sql_type,
			column->attr_type, column->conversion_type);
#endif /* DEBUG */
			
		statement->row[column_no] = column;

		if (is_variable_length_sql_type(col_type)) {
			statement->binding_type = MODBC_GET_DATA;
		}
		else {
			/* 
			** Do the buffer allocation once for columns which
			** have a fixed maximum length. 
			*/
			column->data = newmem(column->size);
		}
				
	} /* for */

	if (statement->binding_type == MODBC_BIND_COL) {

		for (column_no = 1; column_no <= statement->num_columns; 
				column_no++) {

#ifdef DEBUG
			printf(""Binding column %d/%d\\n"", 
					column_no, statement->num_columns);
#endif /* DEBUG */
			column = statement->row[column_no];

			rc = SQLBindCol(stat_handle, column_no,
					column->conversion_type, 
					(SQLPOINTER) column->data,
					column->size, &(column->value_info));
			if (! odbc_check(odbc_env_handle, odbc_connection, 
					stat_handle, rc)) {
				odbc_do_cleanup_statement(statement);
				odbc_throw();
				/* not reached */
			}
		}
	}

	Statement = (Word) statement;
	DB = DB0;

	restore_transient_registers();

} /* odbc__bind_columns */
").

%-----------------------------------------------------------------------------%

	% Fetch the next row of the current statement.
:- pred odbc__fetch(odbc__statement, odbc__statement,
		int, odbc__state, odbc__state).
:- mode odbc__fetch(in, out, out, di, uo) is det.


:- pragma c_code(odbc__fetch(Statement0::in, Statement::out,
		Status::out, DB0::di, DB::uo),
		may_call_mercury,
"{
	MODBC_Statement *stat;

	save_transient_registers();

	stat = (MODBC_Statement *) Statement0;

	MR_assert(stat != NULL);

#ifdef DEBUG
	if (stat->num_rows == 0 ) {
		printf(""Fetching rows...\\n"");
	}
#endif /* DEBUG */

	/* Fetching new row */
	Status = SQLFetch(stat->stat_handle);

	if (Status != SQL_NO_DATA_FOUND && 
			! odbc_check(odbc_env_handle, odbc_connection, 
				stat->stat_handle, Status)) {
		odbc_do_cleanup_statement(stat);
		odbc_throw();
		/* not reached */
	}

#ifdef DEBUG
	/* Update number of rows fetched */
	if (Status == SQL_SUCCESS) {
		stat->num_rows++;
	}

	if (Status == SQL_NO_DATA_FOUND) {
		printf(""Fetched %d rows\\n"", stat->num_rows);
	}
#endif /* DEBUG */

	Statement = (Word) stat;
	DB = DB0;

	restore_transient_registers();
}").

%-----------------------------------------------------------------------------%

:- pred odbc__get_number_of_columns(odbc__statement, int, 
		odbc__state, odbc__state).
:- mode odbc__get_number_of_columns(in, out, di, uo) is det.

:- pragma c_code(odbc__get_number_of_columns(Statement::in, NumColumns::out,
		DB0::di, DB::uo), 
		will_not_call_mercury,
"{
	MODBC_Statement * stat;

	stat = (MODBC_Statement *) Statement;

	MR_assert(stat != NULL);
		
	NumColumns = stat->num_columns;
	DB = DB0;
}").

%-----------------------------------------------------------------------------%

:- pred odbc__get_data(int, int, float, string, int, odbc__statement, 
		odbc__statement, odbc__state, odbc__state).
:- mode odbc__get_data(in, out, out, out, out, in, out, di, uo) is det.

:- pragma c_code(odbc__get_data(Column::in, Int::out, Flt::out, Str::out, 
		Type::out, Statement0::in, Statement::out, DB0::di, DB::uo),
		may_call_mercury,
"{

	MODBC_Statement *stat;
	MODBC_Column 	*col;
	SQLRETURN 	rc;
	SDWORD		column_info;

	stat = (MODBC_Statement *) Statement0;

	MR_assert(stat != NULL);
	MR_assert(stat->row != NULL);
	MR_assert(stat->row[Column] != NULL);
		

	if (stat->binding_type == MODBC_GET_DATA) {

		/* Slurp up the data for this column. */ 
		save_transient_registers();
		odbc_do_get_data(stat, Column);
		restore_transient_registers();

	}

	col = stat->row[Column];

	if (col->value_info == SQL_NULL_DATA) {
		Type = MODBC_NULL;
	} 
	else {
		Type = col->attr_type;
	}

	switch ((int) Type) {

	    case MODBC_NULL:
		break;

	    case MODBC_INT:

		Int = (Integer) *(MODBC_SQL_INT *)(col->data);
#ifdef DEBUG
			printf(""got integer %ld\\n"", Int);
#endif /* DEBUG */
		break;

	    case MODBC_FLOAT:	

		Flt = *(Float *)(col->data);

#ifdef DEBUG
			printf(""got float %f\\n"", Flt);
#endif /* DEBUG */
		break;

	    case MODBC_STRING:
	    case MODBC_TIME:

		make_aligned_string_copy(Str, (char *) col->data);
#ifdef DEBUG
		printf(""got string %s\\n"", (char *) Str);
#endif /* DEBUG */
		break;
	
	    case MODBC_VAR_STRING:
		/*
		** The data was allocated on the Mercury heap, 
		** get it then kill the pointer so it can be GC'ed.
		*/
		make_aligned_string(Str, (char *) col->data);
#ifdef DEBUG
		printf(""got var string %s\\n"", (char *) col->data);
#endif /* DEBUG */

		col->data = NULL;

		/* As far as Mercury is concerned it's an ordinary string */
		Type = MODBC_STRING;
		break;

	    default:
		fatal_error(
			""odbc.m: invalid attribute type in odbc__get_data"");
		break;
	} /* switch (Type) */

	Statement = (Word) stat;
	DB = DB0;

} /* odbc__get_data */
").

:- pragma c_code("

void
odbc_do_get_data(MODBC_Statement *stat, int column_id)
{
	MODBC_Column 	*column;
	SQLRETURN 	rc;
	SDWORD		column_info;
	char 		dummy_buffer[1]; /*
					 ** Room for the NULL termination 
					 ** byte and nothing else.
					 */

	column = stat->row[column_id];
	if (column->attr_type == MODBC_VAR_STRING) {

		/* Just get the length first time through. */
		rc = SQLGetData(stat->stat_handle, column_id,
			column->conversion_type, dummy_buffer, 1, 
			&(column->value_info));

		/*
		** SQL_SUCCESS_WITH_INFO is expected here, since
		** we didn't allocate any space for the data, so
		** don't collect the ""data truncated"" message.
		*/
		if (rc != SQL_SUCCESS_WITH_INFO &&
				! odbc_check(odbc_env_handle, 
					odbc_connection, 
					stat->stat_handle, rc)) {
			odbc_do_cleanup_statement(stat);	
			odbc_throw();
		}

		printf(""value_info: %li\n"", column->value_info);
		if (column->value_info == SQL_NULL_DATA) {
			/* 
			** The column is NULL, so there is no data to get.
			*/
			return;
		}
		else if (column->value_info == SQL_NO_TOTAL) {
			/*
			** The driver couldn't work out the length
			** in advance, so get the data in chunks of
			** some arbitrary size, and append the chunks
			** together.
			** This method must be used with MODBC_IODBC,
			** since iODBC-2.12 uses a different interpretation
			** of the ODBC standard to Microsoft, for which
			** the length returned by the first call to SQLGetData
			** above is the minimun of the buffer length and the 
			** length of the available data, rather than the 
			** total length of data available.
			*/
			odbc_get_data_in_chunks(stat, column_id);
		}
		else { 
			Word data;

			/* 
			** column->value_info == length of data 
			*/
			column->size = column->value_info + 1;
			restore_transient_registers();
			column->data = newmem(column->size);
			save_transient_registers();
			odbc_get_data_in_one_go(stat, column_id);
		}
	}
	else {	
		/* 
		** It's a fixed length column, so we can 
		** get the lot in one go.
		*/
		odbc_get_data_in_one_go(stat, column_id);
	}
}

void 
odbc_get_data_in_one_go(MODBC_Statement *stat, int column_id)
{
	MODBC_Column 	*col;
	SQLRETURN 	rc;

#ifdef DEBUG
	printf(""getting column %i in one go\n"", column_id);
#endif /* DEBUG */

	col = stat->row[column_id];

	rc = SQLGetData(stat->stat_handle, column_id, col->conversion_type, 
			(SQLPOINTER) col->data, col->size, &(col->value_info));

	if (! odbc_check(odbc_env_handle, odbc_connection, 
			stat->stat_handle, rc)) {
		odbc_do_cleanup_statement(stat);	
		odbc_throw();
	}
}

void 
odbc_get_data_in_chunks(MODBC_Statement *stat, int column_id)
{
	MODBC_Column 	*col;
	SQLRETURN 	rc;
	Word		this_bit;
	Word 		chunk_list = list_empty();
	String		result;

#ifdef DEBUG
	printf(""getting column %i in chunks\n"", column_id);
#endif /* DEBUG */

	col = stat->row[column_id];

	rc = SQL_SUCCESS_WITH_INFO;

	restore_transient_registers();
	incr_hp_atomic(this_bit, MODBC_CHUNK_SIZE / sizeof(Word));
	save_transient_registers();

		/*
		** Keep collecting chunks until we run out.
		*/
	while (rc == SQL_SUCCESS_WITH_INFO) {

		rc = SQLGetData(stat->stat_handle, column_id, 
				col->conversion_type, (SQLPOINTER) this_bit,
				MODBC_CHUNK_SIZE - 1, &(col->value_info));
	
		if (rc == SQL_NO_DATA_FOUND) {
			break;
		}

		if (rc != SQL_SUCCESS_WITH_INFO &&
				! odbc_check(odbc_env_handle, odbc_connection, 
					stat->stat_handle, rc)) {
			odbc_do_cleanup_statement(stat);	
			odbc_throw();
		}

#ifdef DEBUG
		printf(""Got chunk %s\n"", (char *) this_bit);
#endif
		restore_transient_registers();
		chunk_list = list_cons(this_bit, chunk_list);
		incr_hp_atomic(this_bit, MODBC_CHUNK_SIZE / sizeof(Word));
		save_transient_registers();
	}

	ML_odbc_condense_chunks(chunk_list, &result);
	col->data = (Word *) result;
}
").

:- pred odbc__condense_chunks(list(string), string).
:- mode odbc__condense_chunks(in, out) is det.

:- pragma export(odbc__condense_chunks(in, out), "ML_odbc_condense_chunks").

odbc__condense_chunks(RevChunks, String) :-
	list__reverse(RevChunks, Chunks),
	string__append_list(Chunks, String).

%-----------------------------------------------------------------------------%

	% The first argument should really be moded di.
:- pred odbc__cleanup_statement_check_error(odbc__statement,
		odbc__state, odbc__state).
:- mode odbc__cleanup_statement_check_error(in, di, uo) is det.

:- pragma c_code(
	odbc__cleanup_statement_check_error(Statement::in, DB0::di, DB::uo),
	may_call_mercury,
"{
	MODBC_Statement *stat;
	SQLRETURN rc;

	save_transient_registers();

	stat = (MODBC_Statement *) Statement;

	rc = odbc_do_cleanup_statement(stat);
	if (! odbc_check(odbc_env_handle, odbc_connection, 
			SQL_NULL_HSTMT, rc)) {
		odbc_throw();
	}	
	DB = DB0;

	restore_transient_registers();
}").

:- pragma c_code("

static SQLRETURN
odbc_do_cleanup_statement(MODBC_Statement *stat)
{
	int i;
	SQLRETURN rc;

	if (stat != NULL) {
#ifdef DEBUG
		printf(""cleaning up statement\\n"");
#endif /* DEBUG */
		if (stat->row != NULL) {
			for (i = 1; i <= stat->num_columns; i++) {
				if (stat->row[i] != NULL) {
					oldmem(stat->row[i]->data);
					oldmem(stat->row[i]);
				}
			}
			oldmem(stat->row);
		}
		rc = SQLFreeStmt(stat->stat_handle, SQL_DROP);
		oldmem(stat);
		return rc;
	}
	else {
		return SQL_SUCCESS;
	}
}").

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

:- pragma c_code("

/*
**  Map an ODBC SQL type to a supported attribute type.
**  Currently, supported attribute types are minimal,
**  but this function will allow us to ask ODBC to make
**  convertion from SQL types to supported types.
**  Binary types are currently converted to strings. 
*/
static MODBC_AttrType 
sql_type_to_attribute_type(SWORD sql_type)
{
	switch (sql_type) {
		case SQL_BIGINT:		return MODBC_STRING;
		case SQL_BINARY:		return MODBC_STRING;
		case SQL_BIT:			return MODBC_STRING;
		case SQL_CHAR:			return MODBC_STRING;
		case SQL_DATE:			return MODBC_TIME;
		case SQL_DECIMAL:		return MODBC_STRING; /*?*/
		case SQL_DOUBLE:		return MODBC_FLOAT;
		case SQL_FLOAT:			return MODBC_FLOAT;
		case SQL_INTEGER:		return MODBC_INT;

#ifdef MODBC_MYSQL
		case SQL_LONGVARBINARY:		return MODBC_STRING;
		case SQL_LONGVARCHAR:		return MODBC_STRING;
#else /* ! MODBC_MYSQL */
		case SQL_LONGVARBINARY:		return MODBC_VAR_STRING;
		case SQL_LONGVARCHAR:		return MODBC_VAR_STRING;
#endif /* ! MODBC_MYSQL */

		case SQL_NUMERIC:		return MODBC_STRING;
		case SQL_REAL:			return MODBC_FLOAT;
		case SQL_SMALLINT:		return MODBC_INT;
		case SQL_TIME:			return MODBC_TIME;
		case SQL_TIMESTAMP:		return MODBC_TIME;
		case SQL_TINYINT:		return MODBC_INT;
		case SQL_VARBINARY:		return MODBC_STRING;
		case SQL_VARCHAR:		return MODBC_STRING;
		default:
		    fatal_error(
		    	""odbc.m: sql_type_to_attribute_type: unknown type"");
	}
}

/*
** Return the SQL_C type corresponding to a supported attribute type.
*/
static SWORD 
attribute_type_to_sql_c_type(MODBC_AttrType AttrType)
{
	switch (AttrType) {
		case MODBC_FLOAT:		return MODBC_SQL_C_FLOAT;
		case MODBC_INT:			return SQL_C_SLONG;
		case MODBC_TIME:		return SQL_C_CHAR;
		case MODBC_STRING:		return SQL_C_CHAR;
		case MODBC_VAR_STRING:		return SQL_C_CHAR;
		default:
			/* Unsuported MODBC_xxx type */
		    fatal_error(
		    	""odbc.m: attribute_type_to_sql_c_type: unknown type"");
	}
}


/*
** Does the data have no maximum length? 
** Note: the implementation of SQLGetData for MySQL does not follow the same 
** standard as SQL Server, but from examination of the source SQLDescribeCol
** seems guaranteed to find the maximum length of a result column containing 
** variable length data. SQL_NO_TOTAL, which should be returned if the length
** cannot be determined, is not defined by the iODBC header files. So much 
** for transparent access to different databases.
*/
static bool 
is_variable_length_sql_type(SWORD sql_type) {

#ifdef MODBC_MYSQL

	return FALSE;

#else /* ! MODBC_MYSQL */

	return (
		sql_type == SQL_LONGVARBINARY ||	
		sql_type == SQL_LONGVARCHAR
	);
#endif /* !MODBC_MYSQL */
}

/*
** This function computes to total number of bytes needed
** to store an attribute value, returning -1 if there is no
** maximum size.
** [SqlType] is the ODBC SQL type of the column
** [cbColDef] is the size returned by SQLDescribeCol
** [ibScaler] is the scale returned by SQLDescribeCol
** [fNullable] is whether the column can be NULL
*/
static size_t 
sql_type_to_size(SWORD sql_type, UDWORD cbColDef, 
		SWORD ibScale, SWORD fNullable)
{
	switch (sql_type)
	{
		/*
		** 64-bit signed int converted to SQL_C_CHAR 
		*/
		case SQL_BIGINT:
			return 1 + cbColDef + 1;  /* (+ 1 == '\\0') */

		/*
		** Binary data converted to SQL_C_CHAR 
		** Each byte is converted to 2-digit Hex 
		*/
		case SQL_BINARY:
			return cbColDef * 2 + 1;  /* (+ 1 == '\\0') */

		/*
		** Bit converted to SQL_C_CHAR 
		*/
		case SQL_BIT:
			return cbColDef + 1;  /* (+ 1 == '\\0') */

		/*
		** Fixed char to SQL_C_CHAR  
		*/
		case SQL_CHAR:
			return cbColDef + 1;  /* (+ 1 == '\\0') */

		/*
		** Date YYYY-MM-DD converted to SQL_C_CHAR
		*/
		case SQL_DATE:
			return cbColDef + 1;  /* (+ 1 == '\\0') */

		/*
		** Signed decimal ddd.dd converted to SQL_C_CHAR
		*/
		case SQL_DECIMAL:
			return 1 + cbColDef + 1 + ibScale + 1; 
						/* (+ 1 == '\\0') */

		/*
		** 32-bit float converted to MODBC_SQL_C_FLOAT
		*/
		case SQL_DOUBLE:
			return sizeof(Float);

		/*
		** 32-bit float converted to MODBC_SQL_C_FLOAT
		*/
		case SQL_FLOAT:
			return sizeof(Float);

		/*
		** 32-bit integer converted to SQL_C_SLONG
		*/
		case SQL_INTEGER:
			return sizeof(MODBC_SQL_INT);

		/*
		** Any length binary convert to SQL_C_CHAR
		*/
		case SQL_LONGVARBINARY:
#ifdef MODBC_MYSQL
			return cbColDef + 1;
#else /* !MODBC_MYSQL */
			return -1;
#endif /* !MODBC_MYSQL */

		/*
		** Any length char convert to SQL_C_CHAR
		*/
		case SQL_LONGVARCHAR:
#ifdef MODBC_MYSQL
			return cbColDef + 1;
#else /* !MODBC_MYSQL */
			return -1;
#endif /* !MODBC_MYSQL */

		/*
		** Signed numeric ddd.dd converted to SQL_C_CHAR
		*/
		case SQL_NUMERIC:
			return 1 + cbColDef + 1 + ibScale + 1;
					/* (+ 1 == '\\0') */

		/*
		** 32-bit float converted to MODBC_SQL_C_FLOAT
		*/
		case SQL_REAL:
			return sizeof(Float);

		/*
		** 16-bit integer converted to SQL_C_SLONG
		*/
		case SQL_SMALLINT:
			return sizeof(MODBC_SQL_INT);

		/*
		** Time hh:mm:ss converted to SQL_C_CHAR
		*/
		case SQL_TIME:
			return cbColDef + 1;  /* (+ 1 == '\\0') */

		/*
		** Time YYYY-MM-DD hh:mm:ss converted to SQL_C_CHAR
		*/
		case SQL_TIMESTAMP:
			return cbColDef + 1;  /* (+ 1 == '\\0') */

		/*
		** 8-bit integer converted to MODBC_SQL_INT
		*/
		case SQL_TINYINT:
			return sizeof(MODBC_SQL_INT);

		/*
		** Binary data converted to SQL_C_CHAR 
		** Each byte is converted to 2-digit Hex 
		*/
		case SQL_VARBINARY:
			return cbColDef * 2 + 1;  /* (+ 1 == '\\0') */

		/*
		** Fixed char to SQL_C_CHAR  
		*/
		case SQL_VARCHAR:
			return cbColDef + 1;  /* (+ 1 == '\\0') */

		default:
		    fatal_error(""odbc.m: sql_type_to_size: unknown type"");
	}
}
").

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

	%
	% Catalog functions.
	%

odbc__data_sources(MaybeSources - Messages) -->
	odbc__sql_data_sources(RevSourceNames, RevDescs, Status, RevMessages),
	( { odbc__ok(Status) } ->
		{ list__reverse(RevMessages, Messages) },
		{ list__reverse(RevSourceNames, SourceNames) },
		{ list__reverse(RevDescs, Descs) },
		{ assoc_list__from_corresponding_lists(SourceNames, 
			Descs, SourceAL) },
		{ MakeSource = lambda([Pair::in, SourceDesc::out] is det, (
				Pair = SourceName - Desc,
				SourceDesc = odbc__source_desc(SourceName, Desc)
			)) },
		{ list__map(MakeSource, SourceAL, Sources) },
		{ MaybeSources = ok(Sources) }
	; { odbc__no_data(Status) } ->
		% iODBC 2.12 doesn't implement this function.
		{ Messages = [
			error(feature_not_implemented) - 
			"[Mercury][odbc.m]SQLDataSources not implemented by iODBC 2.12"
		] },
		{ MaybeSources = error }
	;	
		{ list__reverse(RevMessages, Messages) },
		{ MaybeSources = error }
	).
	
:- pred odbc__sql_data_sources(list(string)::out, list(string)::out, int::out, 
		list(odbc__message)::out, io__state::di, io__state::uo) is det.

:- pragma c_code(
		odbc__sql_data_sources(SourceNames::out, SourceDescs::out,
			Status::out, Messages::out, IO0::di, IO::uo),
		may_call_mercury,
"{
		/*
		** Note that iODBC-2.12 doesn't implement 
		** SQLDataSources, and always returns SQL_SUCCESS, 
		** causing an infinite loop if we call the stub.
		*/
#ifdef MODBC_IODBC
	Status = SQL_NO_DATA_FOUND;
	SourceNames = list_empty();
	SourceDescs = list_empty();
	Messages = list_empty();
#else /* !MODBC_IODBC */
	save_transient_registers();
	Status = odbc_do_get_data_sources(&SourceNames, 
			&SourceDescs, &Messages);
	restore_transient_registers();
#endif /* !MODBC_IODBC */

	IO = IO0;
}").

:- pragma c_header_code("

SQLRETURN odbc_do_get_data_sources(Word *SourceNames, 
		Word *SourceDescs, Word *Messages);
").

:- pragma c_code("

SQLRETURN
odbc_do_get_data_sources(Word *SourceNames, Word *SourceDescs, Word *Messages)
{
	char dsn[SQL_MAX_DSN_LENGTH];
	char desc[128];	/*
			** Arbitrary size, only needs to hold a 
			** descriptive string like ""SQL Server"".
			*/
	String new_dsn;
	String new_desc;
	SWORD dsn_len;
	SWORD desc_len;
	SQLRETURN rc;

	odbc_message_list = list_empty();
	SourceNames = list_empty();
	SourceDescs = list_empty();

	if (odbc_env_handle == SQL_NULL_HENV) {
		rc = SQLAllocEnv(&odbc_env_handle);
	}
	else {
		rc = SQL_SUCCESS;
	}

#ifdef DEBUG
	printf(""SQLAllocEnv status: %d\\n"", rc);
#endif /* DEBUG */

	if (odbc_check(odbc_env_handle, SQL_NULL_HDBC, 
			SQL_NULL_HSTMT, rc)) {

		rc = SQLDataSources(odbc_env_handle, SQL_FETCH_FIRST,
				dsn, SQL_MAX_DSN_LENGTH - 1,
				&dsn_len, desc, sizeof(desc), &desc_len);

			/*
			** The documentation varies on whether the driver
			** returns SQL_NO_DATA_FOUND or SQL_NO_DATA, so
			** check for both.
			*/
		while (rc != SQL_NO_DATA_FOUND && rc != SQL_NO_DATA && 
				odbc_check(odbc_env_handle, SQL_NULL_HDBC, 
					SQL_NULL_HSTMT, rc)) {

			/* 
			** Copy the new data onto the Mercury heap
			*/
			restore_transient_registers();
			make_aligned_string_copy(new_dsn, dsn);
			*SourceNames = list_cons(new_dsn, SourceNames);
			make_aligned_string_copy(new_desc, desc);
			*SourceDescs = list_cons(new_desc, SourceDescs);
			save_transient_registers();
	
			rc = SQLDataSources(odbc_env_handle,
					SQL_FETCH_NEXT, dsn,
					SQL_MAX_DSN_LENGTH - 1, &dsn_len, 
					desc, sizeof(desc), &desc_len);
		}
	}

	if (rc == SQL_NO_DATA_FOUND) {
		rc = SQL_SUCCESS;
	}

	*Messages = odbc_message_list;
	odbc_message_list = list_empty();
	return rc;

}").

%-----------------------------------------------------------------------------%

odbc__tables(Qualifier, Owner, TableName, Tables) -->
	{ odbc__convert_pattern_argument(Qualifier, QualifierStr,
		QualifierStatus) },
	{ odbc__convert_pattern_argument(Owner, OwnerStr, OwnerStatus) },
	{ odbc__convert_pattern_argument(TableName, TableStr, TableStatus) },
	odbc__get_result_set(odbc__sql_tables(QualifierStr, QualifierStatus,
		OwnerStr, OwnerStatus, TableStr, TableStatus), Results),
	list__map_foldl(odbc__convert_table_desc, Results, Tables).

:- pred odbc__convert_table_desc(odbc__row, odbc__table_desc, 
		odbc__state, odbc__state).
:- mode odbc__convert_table_desc(in, out, di, uo) is det.

odbc__convert_table_desc(Row0, Table) -->
	{ NullToEmptyStr = 
		lambda([Data0::in, Data::out] is det, (
			( Data0 = null ->
				Data = string("")
			;
				Data = Data0
			)
		)) },
	{ list__map(NullToEmptyStr, Row0, Row) },
	(
		{ Row = [string(Qualifier), string(Owner), string(Name), 
			string(Type), string(Description) | DriverColumns] } 
	->
		{ Table = odbc__table_desc(Qualifier, Owner, Name, 
			Type, Description, DriverColumns) }
	;
		odbc__add_message(error(internal_error) - 
			"[Mercury][odbc.m]Invalid results from SQLTables"),
		odbc__throw
	).

%-----------------------------------------------------------------------------%

	% odbc__convert_pattern_argument(Pattern, String, Status).
	% This is used in a fairly crude interface to C. If the Status is 0,
	% the corresponding argument to the ODBC function should be NULL,
	% meaning no constraint on the search. If the Status is 1, the
	% argument to the ODBC function should be the given string.

:- pred odbc__convert_pattern_argument(odbc__search_pattern::in, 
		string::out, int::out) is det.

odbc__convert_pattern_argument(any, "", 0).
odbc__convert_pattern_argument(pattern(Str), Str, 1).

:- pred odbc__sql_tables(string, int, string, int, string, int,
		odbc__statement, odbc__statement,
		odbc__state, odbc__state).
:- mode odbc__sql_tables(in, in, in, in, in, in, in, out, di, uo) is det.

:- pragma c_code(odbc__sql_tables(QualifierStr::in, QualifierStatus::in,
		OwnerStr::in, OwnerStatus::in, TableStr::in, TableStatus::in,
		Statement0::in, Statement::out, DB0::di, DB::uo), 
		may_call_mercury,
"{
	MODBC_Statement *statement = (MODBC_Statement *) Statement0;
	char *qualifier_str = NULL;
	char *owner_str = NULL;
	char *table_str = NULL;
	int qualifier_len = 0;
	int owner_len = 0;
	int table_len = 0;
	SQLRETURN rc;

	save_transient_registers();

	/*
	** A NULL pointer in any of the string pattern fields
	** means no constraint on the search for that field.
	*/
	if (QualifierStatus) {
		qualifier_str = (char *) QualifierStr;
		qualifier_len = strlen(qualifier_str);
	}
	if (OwnerStatus) {
		owner_str = (char *) OwnerStr;
		owner_len = strlen(owner_str);
	}
	if (TableStatus) {
		table_str = (char *) TableStr;
		table_len = strlen(table_str);	
	}

	rc = SQLTables(statement->stat_handle, qualifier_str, 
			qualifier_len, owner_str, owner_len,
			table_str, table_len, NULL, 0);
	if (! odbc_check(odbc_env_handle, odbc_connection, 
			statement->stat_handle, rc)) {
		odbc_do_cleanup_statement(statement);
		odbc_throw();
	}

	DB = DB0;
	restore_transient_registers();
	Statement = (Word) statement;
}").

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

	% 
	% Error checking.
	%

:- pred odbc__ok(int).
:- mode odbc__ok(in) is semidet.

:- pragma c_code(odbc__ok(Status::in), will_not_call_mercury,

"
SUCCESS_INDICATOR = (Status == SQL_SUCCESS || Status == SQL_SUCCESS_WITH_INFO);
").

:- pred odbc__no_data(int).
:- mode odbc__no_data(in) is semidet.

:- pragma c_code(odbc__no_data(Status::in), will_not_call_mercury,
"
SUCCESS_INDICATOR = (Status == SQL_NO_DATA_FOUND);
").

%-----------------------------------------------------------------------------%

	% Handle ODBC error codes. Refer to the ODBC API Reference 
	% provided with the ODBC SDK. The first two characters of the 
	% SQLSTATE are meant to specify an error class. Looking at the 
	% predicates below, the classes weren't terribly well chosen.
:- pred odbc__sql_state_to_message(string::in, string::in,
		odbc__message::out) is det.
:- pragma export(odbc__sql_state_to_message(in, in, out), 
		"ML_odbc_sql_state_to_message").

odbc__sql_state_to_message(SQLState, String, Message - String) :-
	string__split(SQLState, 2, Class, SubClass),
	( Class = "01" ->
		( sql_state_to_warning(SubClass, Warning) ->
			Message = warning(Warning)
		;
			Message = warning(general_warning)
		)
	;
		( sql_state_to_error(Class, SubClass, Error) ->
			Message = error(Error)
		;
			Message = error(general_error)
		)
	).

:- pred sql_state_to_warning(string::in, odbc__warning::out) is semidet.
sql_state_to_warning("000", general_warning).
sql_state_to_warning("001", general_warning).
sql_state_to_warning("002", disconnect_error).
sql_state_to_warning("003", null_value_in_set_function).
sql_state_to_warning("004", string_data_truncated).
sql_state_to_warning("006", privilege_not_revoked).
sql_state_to_warning("007", privilege_not_granted).
sql_state_to_warning("S03", general_warning).
sql_state_to_warning("S04", general_warning).

:- pred sql_state_to_error(string::in, string::in,
		odbc__error::out) is semidet.

sql_state_to_error("07", "002", execution_error(incorrect_count_field)).
sql_state_to_error("07", "005", general_error).
sql_state_to_error("07", "006", 
			execution_error(restricted_data_type_violation)).
sql_state_to_error("07", "009", general_error).
sql_state_to_error("07", "S01", internal_error).

sql_state_to_error("08", "001", connection_error(unable_to_establish)).
sql_state_to_error("08", "002", connection_error(connection_name_in_use)).
sql_state_to_error("08", "003", connection_error(nonexistent_connection)).
sql_state_to_error("08", "004", 
			connection_error(connection_rejected_by_server)).
sql_state_to_error("08", "007", connection_error(connection_failure)).
sql_state_to_error("08", "S01", connection_error(connection_failure)).


sql_state_to_error("21", "S01", execution_error(invalid_insert_value_list)).
sql_state_to_error("21", "S02", execution_error(incorrect_derived_table_arity)).

sql_state_to_error("22", "001", execution_error(string_data_truncated)).
sql_state_to_error("22", "002", execution_error(general_error)).
sql_state_to_error("22", "003", execution_error(range_error)).
sql_state_to_error("22", "007", execution_error(invalid_date_time)).
sql_state_to_error("22", "008", execution_error(overflow)).
sql_state_to_error("22", "012", execution_error(division_by_zero)).
sql_state_to_error("22", "015", execution_error(overflow)).
sql_state_to_error("22", "018", execution_error(invalid_cast_specification)).
sql_state_to_error("22", "019", execution_error(invalid_escape)).
sql_state_to_error("22", "025", execution_error(invalid_escape)).
sql_state_to_error("22", "026", execution_error(string_data_length_mismatch)).

sql_state_to_error("23", "000", 
			execution_error(integrity_constraint_violation)).

sql_state_to_error("24", "000", execution_error(general_error)).

sql_state_to_error("25", "S00", transaction_error(invalid_state)).
sql_state_to_error("25", "S01", transaction_error(invalid_state)).
sql_state_to_error("25", "S02", transaction_error(still_active)).
sql_state_to_error("25", "S03", transaction_error(rolled_back)).

sql_state_to_error("28", "000", connection_error(invalid_authorization)).

sql_state_to_error("37", "000", 
			execution_error(syntax_error_or_access_violation)).

sql_state_to_error("3C", "000", execution_error(general_error)).

sql_state_to_error("3D", "000", execution_error(general_error)).

sql_state_to_error("3F", "000", execution_error(invalid_schema_name)).

sql_state_to_error("40", "001", transaction_error(serialization_failure)).
sql_state_to_error("40", "003", execution_error(general_error)).

sql_state_to_error("42", "000", 
			execution_error(syntax_error_or_access_violation)).
sql_state_to_error("42", "S01", execution_error(table_or_view_already_exists)).
sql_state_to_error("42", "S02", execution_error(table_or_view_not_found)).
sql_state_to_error("42", "S11", execution_error(index_already_exists)).
sql_state_to_error("42", "S12", execution_error(index_not_found)).
sql_state_to_error("42", "S21", execution_error(column_already_exists)).
sql_state_to_error("42", "S22", execution_error(column_not_found)).

sql_state_to_error("44", "000", execution_error(general_error)).

sql_state_to_error("IM", _, internal_error).

sql_state_to_error("HY", SubClass, Error) :-
	( SubClass = "000" ->
		Error = general_error
	; SubClass = "109" ->
		Error = feature_not_implemented
	; SubClass = "T00" ->
		Error = timeout_expired
	; SubClass = "T01" ->
		Error = connection_error(timeout_expired)
	;
		Error = internal_error
	).

sql_state_to_error("S0", "001", execution_error(table_or_view_already_exists)).
sql_state_to_error("S0", "002", execution_error(table_or_view_not_found)).
sql_state_to_error("S0", "011", execution_error(index_already_exists)).
sql_state_to_error("S0", "012", execution_error(index_not_found)).
sql_state_to_error("S0", "021", execution_error(column_already_exists)).
sql_state_to_error("S0", "022", execution_error(column_not_found)).
sql_state_to_error("S0", "023", execution_error(no_default_for_column)).

sql_state_to_error("S1", SubClass, Error) :-
	( SubClass = "000" ->
		Error = general_error
	; SubClass = "C00" ->
		Error = feature_not_implemented
	; SubClass = "T01" ->
		Error = connection_error(timeout_expired)
	;
		Error = internal_error
	).

:- pragma c_code("

/*
** Return TRUE if the last ODBC call succeded.
** Return FALSE if the ODBC call failed.
** Add any error messages to odbc_message_list.
** This allocates heap space and calls Mercury, so be sure to call 
** save_transient_registers/restore_transient_registers around this.
*/
static bool
odbc_check(SQLHENV env_handle, SQLHDBC connection_handle, 
		SQLHSTMT statement_handle, SQLRETURN rc)
{
	SQLRETURN	status;
	SQLINTEGER	native_error;
	SQLSMALLINT	msg_len;
	UCHAR		message[SQL_MAX_MESSAGE_LENGTH];
	UCHAR		sql_state[SQL_SQLSTATE_SIZE + 1];
	String 		mercury_message;
	Word		new_message;

	MR_ASSERT_IMPLY(connection_handle == SQL_NULL_HDBC, 
			statement_handle == SQL_NULL_HSTMT);
	MR_ASSERT_IMPLY(statement_handle != SQL_NULL_HSTMT, 
			connection_handle != SQL_NULL_HDBC);

	odbc_ret_code = rc;

	/* Check type of error */
	if (rc == SQL_SUCCESS) { 
		return TRUE;
	}
	else {

#ifdef DEBUG
		printf(""getting error message for status %i\\n"", rc);
#endif /* DEBUG */

		while (1) {

			status = SQLError(env_handle, connection_handle, 
				statement_handle, sql_state, &native_error, 
				message, SQL_MAX_MESSAGE_LENGTH - 1, &msg_len);

#ifdef DEBUG
			printf(""SQLError status: %i\\n"", status);
			printf(""SQL_STATE: %s\\n"", sql_state);
			printf(""Error: %s\\n"", message);
#endif /* DEBUG */

			if (status != SQL_SUCCESS) {
				break;
			}

			/* Copy the error string to the Mercury heap. */
			make_aligned_string_copy(mercury_message, message);

			/* Convert the SQL state to an odbc__message. */
			ML_odbc_sql_state_to_message(sql_state,
				mercury_message, &new_message);

			/* Append the message onto the list. */
			odbc_message_list = 
				list_cons(new_message, odbc_message_list);
		}

		if (rc == SQL_SUCCESS_WITH_INFO) {
			return TRUE;
		}
		else {
			return FALSE;
		}
	}
}

").

:- end_module odbc.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

=======================
extras/odbc/odbc_test.m
=======================

%-----------------------------------------------------------------------------%
% Sample program for odbc.m.
%
% Assumes that there is an ODBC data source "test" containing a table
% named test.
%-----------------------------------------------------------------------------%
:- module odbc_test.

:- interface.

:- import_module io.

:- pred main(io__state::di, io__state::uo) is det.

%-----------------------------------------------------------------------------%
:- implementation.

:- import_module list, string, std_util.
:- import_module odbc.

main -->
	odbc__data_sources(SourceResult),
	( 
		{ SourceResult = ok(Sources) - SourceMessages },
		io__write_string("Available data source names:"),
		io__nl,
		io__write_list(Sources, "\n", io__write),
		io__nl
	;
		{ SourceResult = error - SourceMessages },
		io__write_string("Error getting DSNs:"),
		io__nl
	),
	io__write_list(SourceMessages, "\n", io__write),
	io__nl,
	odbc__transaction("test", "", "",
		odbc__tables(any, any, any), TableResult - TableMessages),
	(
		{ TableResult = ok(Tables) },
		io__write_string("Available tables:"),
		io__nl,
		io__write_list(Tables, "\n", io__write),
		io__nl
	;
		{ TableResult = error },
		io__write_string("Error getting tables:"),
		io__nl
	),
	io__write_list(TableMessages, "\n", io__write),
	io__nl,
	odbc__transaction("test", "", "", test_trans, 
		TransResult - TransMessages),
	( 
		{ TransResult = ok(Results) },
		io__write_string("transaction ok: "),
		{ list__length(Results, NumRows) },
		io__write_int(NumRows),
		io__write_string("result rows"),
		io__nl,
		io__write_list(Results, "\n", io__write),
		io__nl
	;
		{ TransResult = error },
		io__write_string("error in transaction:\n")
	),
	io__write_list(TransMessages, "\n", io__write),
	io__nl.

:- pred test_trans(list(odbc__row)::out,
		odbc__state::di, odbc__state::uo) is det.

test_trans(Results) -->
	{ String = "select * from test" },
	odbc__execute(String, Results).

:- pred output_results(list(odbc__row)::in,
		io__state::di, io__state::uo) is det.

output_results([]) --> [].
output_results([Row | Rows]) -->
	output_row(Row),
	io__write_string("\n"),
	output_results(Rows).

:- pred output_row(list(odbc__attribute)::in,
		io__state::di, io__state::uo) is det.

output_row([]) --> [].
output_row([Attr | Attrs]) -->
	output_attribute(Attr),
	io__write_string(" "),
	output_row(Attrs).

:- pred output_attribute(odbc__attribute::in, 
		io__state::di, io__state::uo) is det.

output_attribute(null) -->
	io__write_string("<NULL>").
output_attribute(int(Int)) -->
	io__write_int(Int).
output_attribute(string(Str)) -->
	io__write_string(Str).
output_attribute(float(Float)) -->
	io__write_float(Float).
output_attribute(time(String)) -->
	io__write_string(String).

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%



More information about the developers mailing list