firebird-mirror/src/gpre/ada.cpp

//____________________________________________________________
//  
//		PROGRAM:	ADA preprocesser
//		MODULE:		ada.cpp
//		DESCRIPTION:	Inserted text generator for ADA
//  
//  The contents of this file are subject to the Interbase Public
//  License Version 1.0 (the "License"); you may not use this file
//  except in compliance with the License. You may obtain a copy
//  of the License at http://www.Inprise.com/IPL.html
//  
//  Software distributed under the License is distributed on an
//  "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express
//  or implied. See the License for the specific language governing
//  rights and limitations under the License.
//  
//  The Original Code was created by Inprise Corporation
//  and its predecessors. Portions created by Inprise Corporation are
//  Copyright (C) Inprise Corporation.
//  
//  All Rights Reserved.
//  Contributor(s): ______________________________________.
//  
//
//____________________________________________________________
//
//	$Id: ada.cpp,v 1.36 2004-01-28 07:50:26 robocop Exp $
//

#include "firebird.h"

#ifdef HAVE_STRING_H
#include <string.h>
#endif

#include "../jrd/ib_stdio.h"
#include "../jrd/common.h"
#include <stdarg.h>
#include "../jrd/y_ref.h"
#include "../jrd/ibase.h"
#include "../gpre/gpre.h"
#include "../gpre/pat.h"
#include "../gpre/cmp_proto.h"
#include "../gpre/gpre_proto.h"
#include "../gpre/lang_proto.h"
#include "../gpre/pat_proto.h"
#include "../gpre/prett_proto.h"
#include "../jrd/gds_proto.h"

static void	align (int);
static void	asgn_from (const act*, REF, int);
static void	asgn_to (const act*, REF, int);
static void	asgn_to_proc (REF, int);
static void	gen_any (const act*, int);
static void	gen_at_end (const act*, int);
static void	gen_based (const act*, int);
static void	gen_blob_close (const act*, USHORT);
static void	gen_blob_end (const act*, USHORT);
static void	gen_blob_for (const act*, USHORT);
static void	gen_blob_open (const act*, USHORT);
static void	gen_blr (void*, SSHORT, const char*);
static void	gen_clear_handles (const act*, int);
static void	gen_compile (const act*, int);
static void	gen_create_database (const act*, int);
static int	gen_cursor_close (const act*, gpre_req*, int);
static void	gen_cursor_init (const act*, int);
static void	gen_database (const act*, int);
static void	gen_ddl (const act*, int);
static void	gen_drop_database (const act*, int);
static void	gen_dyn_close (const act*, int);
static void	gen_dyn_declare (const act*, int);
static void	gen_dyn_describe(const act*, int, bool);
static void	gen_dyn_execute (const act*, int);
static void	gen_dyn_fetch (const act*, int);
static void	gen_dyn_immediate (const act*, int);
static void	gen_dyn_insert (const act*, int);
static void	gen_dyn_open (const act*, int);
static void	gen_dyn_prepare (const act*, int);
static void	gen_emodify (const act*, int);
static void	gen_estore (const act*, int);
static void	gen_endfor (const act*, int);
static void	gen_erase (const act*, int);
static SSHORT	gen_event_block (const act*);
static void	gen_event_init (const act*, int);
static void	gen_event_wait (const act*, int);
static void	gen_fetch (const act*, int);
static void	gen_finish (const act*, int);
static void	gen_for (const act*, int);
static void	gen_function (const act*, int);
static void	gen_get_or_put_slice(const act*, REF, bool, int);
static void	gen_get_segment (const act*, int);
static void	gen_loop (const act*, int);
static TEXT* gen_name(TEXT*, const ref*, bool);
static void	gen_on_error (const act*, USHORT);
static void	gen_procedure (const act*, int);
static void	gen_put_segment (const act*, int);
static void	gen_raw (const UCHAR *, enum req_t, const int, int);
static void	gen_ready (const act*, int);
static void	gen_receive (const act*, int, gpre_port*);
static void	gen_release (const act*, int);
static void	gen_request (gpre_req*, int);
static void	gen_return_value (const act*, int);
static void	gen_routine (const act*, int);
static void	gen_s_end (const act*, int);
static void	gen_s_fetch (const act*, int);
static void	gen_s_start (const act*, int);
static void	gen_segment (const act*, int);
static void	gen_select (const act*, int);
static void	gen_send (const act*, gpre_port*, int);
static void	gen_slice (const act*, int);
static void	gen_start (const act*, gpre_port*, int);
static void	gen_store (const act*, int);
static void	gen_t_start (const act*, int);
static void	gen_tpb (const tpb*, int);
static void	gen_trans (const act*, int);
static void	gen_type (const act*, int);
static void	gen_update (const act*, int);
static void	gen_variable (const act*, int);
static void	gen_whenever (const swe*, int);
static void	make_array_declaration (REF, int);
static void	make_cursor_open_test (enum act_t, gpre_req*, int);
static TEXT* make_name (TEXT*, gpre_sym*);
static void	make_ok_test (const act*, gpre_req*, int);
static void	make_port (const gpre_port*, int);
static void	make_ready (const dbb*, const TEXT*, const TEXT*, USHORT, gpre_req*);
static void	printa (int, const TEXT*, ...);
static const TEXT* request_trans (const act*, const gpre_req*);
static const TEXT* status_vector (const act*);
static void	t_start_auto (const act*, const gpre_req*, const TEXT*, int, bool);

static TEXT output_buffer[512];
static bool first_flag = false;

static const char* const COMMENT = "--- ";
const int INDENT	= 3;

static const char* const BYTE_DCL			= "interbase.isc_byte";
static const char* const BYTE_VECTOR_DCL	= "interbase.isc_vector_byte";
static const char* const SHORT_DCL		= "interbase.isc_short";
static const char* const USHORT_DCL		= "interbase.isc_ushort";
static const char* const LONG_DCL			= "interbase.isc_long";
static const char* const LONG_VECTOR_DCL	= "interbase.isc_vector_long";
static const char* const EVENT_LIST_DCL	= "interbase.event_list";
static const char* const REAL_DCL			= "interbase.isc_float";
static const char* const DOUBLE_DCL		= "interbase.isc_double";

static inline void endif(const int column)
{
	printa(column, "end if;");
}

static inline void begin(const int column)
{
	printa(column, "begin");
}

static inline void endp(const int column)
{
	printa(column, "end");
}

static inline void set_sqlcode(const act* action, const int column)
{
	if (action->act_flags & ACT_sql)
		printa(column, "SQLCODE := interbase.sqlcode(isc_status);");
}

//____________________________________________________________
//  
//		Code generator for ADA.  Not to be confused with
//  
//  

void ADA_action( const act* action, int column)
{

	switch (action->act_type) {
	case ACT_alter_database:
	case ACT_alter_domain:
	case ACT_alter_table:
	case ACT_alter_index:
	case ACT_create_domain:
	case ACT_create_generator:
	case ACT_create_index:
	case ACT_create_shadow:
	case ACT_create_table:
	case ACT_create_view:
	case ACT_declare_filter:
	case ACT_declare_udf:
	case ACT_drop_domain:
	case ACT_drop_filter:
	case ACT_drop_index:
	case ACT_drop_shadow:
	case ACT_drop_table:
	case ACT_drop_udf:
	case ACT_statistics:
	case ACT_drop_view:
		gen_ddl(action, column);
		break;
	case ACT_any:
		gen_any(action, column);
		return;
	case ACT_at_end:
		gen_at_end(action, column);
		return;
	case ACT_commit:
		gen_trans(action, column);
		break;
	case ACT_commit_retain_context:
		gen_trans(action, column);
		break;
	case ACT_b_declare:
		gen_database(action, column);
		gen_routine(action, column);
		return;
	case ACT_basedon:
		gen_based(action, column);
		return;
	case ACT_blob_cancel:
		gen_blob_close(action, column);
		return;
	case ACT_blob_close:
		gen_blob_close(action, column);
		return;
	case ACT_blob_create:
		gen_blob_open(action, column);
		return;
	case ACT_blob_for:
		gen_blob_for(action, column);
		return;
	case ACT_blob_handle:
		gen_segment(action, column);
		return;
	case ACT_blob_open:
		gen_blob_open(action, column);
		return;
	case ACT_clear_handles:
		gen_clear_handles(action, column);
		break;
	case ACT_close:
		gen_s_end(action, column);
		break;
	case ACT_create_database:
		gen_create_database(action, column);
		break;
	case ACT_cursor:
		gen_cursor_init(action, column);
		return;
	case ACT_database:
		gen_database(action, column);
		return;
	case ACT_disconnect:
		gen_finish(action, column);
		break;
	case ACT_drop_database:
		gen_drop_database(action, column);
		break;
	case ACT_dyn_close:
		gen_dyn_close(action, column);
		break;
	case ACT_dyn_cursor:
		gen_dyn_declare(action, column);
		break;
	case ACT_dyn_describe:
		gen_dyn_describe(action, column, false);
		break;
	case ACT_dyn_describe_input:
		gen_dyn_describe(action, column, true);
		break;
	case ACT_dyn_execute:
		gen_dyn_execute(action, column);
		break;
	case ACT_dyn_fetch:
		gen_dyn_fetch(action, column);
		break;
	case ACT_dyn_grant:
		gen_ddl(action, column);
		break;
	case ACT_dyn_immediate:
		gen_dyn_immediate(action, column);
		break;
	case ACT_dyn_insert:
		gen_dyn_insert(action, column);
		break;
	case ACT_dyn_open:
		gen_dyn_open(action, column);
		break;
	case ACT_dyn_prepare:
		gen_dyn_prepare(action, column);
		break;
	case ACT_procedure:
		gen_procedure(action, column);
		break;
	case ACT_dyn_revoke:
		gen_ddl(action, column);
		break;
	case ACT_endblob:
		gen_blob_end(action, column);
		return;
	case ACT_enderror:
		endif(column);
		break;
	case ACT_endfor:
		gen_endfor(action, column);
		break;
	case ACT_endmodify:
		gen_emodify(action, column);
		break;
	case ACT_endstore:
		gen_estore(action, column);
		break;
	case ACT_erase:
		gen_erase(action, column);
		return;
	case ACT_event_init:
		gen_event_init(action, column);
		break;
	case ACT_event_wait:
		gen_event_wait(action, column);
		break;
	case ACT_fetch:
		gen_fetch(action, column);
		break;
	case ACT_finish:
		gen_finish(action, column);
		break;
	case ACT_for:
		gen_for(action, column);
		return;
	case ACT_function:
		gen_function(action, column);
		return;
	case ACT_get_segment:
		gen_get_segment(action, column);
		return;
	case ACT_get_slice:
		gen_slice(action, column);
		return;
	case ACT_hctef:
		endif(column);
		break;
	case ACT_insert:
		gen_s_start(action, column);
		break;
	case ACT_loop:
		gen_loop(action, column);
		break;
	case ACT_open:
		gen_s_start(action, column);
		break;
	case ACT_on_error:
		gen_on_error(action, column);
		return;
	case ACT_ready:
		gen_ready(action, column);
		break;
	case ACT_prepare:
		gen_trans(action, column);
		break;
	case ACT_put_segment:
		gen_put_segment(action, column);
		return;
	case ACT_put_slice:
		gen_slice(action, column);
		return;
	case ACT_release:
		gen_release(action, column);
		break;
	case ACT_rfinish:
		gen_finish(action, column);
		break;
	case ACT_rollback:
		gen_trans(action, column);
		break;
	case ACT_routine:
		gen_routine(action, column);
		return;
	case ACT_s_end:
		gen_s_end(action, column);
		return;
	case ACT_s_fetch:
		gen_s_fetch(action, column);
		return;
	case ACT_s_start:
		gen_s_start(action, column);
		break;
	case ACT_select:
		gen_select(action, column);
		break;
	case ACT_segment_length:
		gen_segment(action, column);
		return;
	case ACT_segment:
		gen_segment(action, column);
		return;
	case ACT_sql_dialect:
		sw_sql_dialect = ((SDT) action->act_object)->sdt_dialect;
		return;
	case ACT_start:
		gen_t_start(action, column);
		break;
	case ACT_store:
		gen_store(action, column);
		return;
	case ACT_store2:
		gen_return_value(action, column);
		return;
	case ACT_type_number:
		gen_type(action, column);
		return;
	case ACT_update:
		gen_update(action, column);
		break;
	case ACT_variable:
		gen_variable(action, column);
		return;
	default:
		return;
	}

//  Put in a trailing brace for those actions still with us 

	if (action->act_flags & ACT_sql)
		gen_whenever(action->act_whenever, column);
}


//____________________________________________________________
//  
//		Print a statment, breaking it into
//       reasonable 120 character hunks.
//  

void ADA_print_buffer( TEXT* output_buffer, const int column)
{
	TEXT s[121];
	int i;
	bool multiline = false;

	TEXT* p = s;

	for (const TEXT* q = output_buffer; *q; q++) {
		*p++ = *q;
		if (((p - s) + column) > 119) {
			for (p--; (*p != ',') && (*p != ' '); p--)
				q--;
			*++p = 0;

			if (multiline) {
				for (i = column / 8; i; --i)
					ib_putc('\t', out_file);

				for (i = column % 8; i; --i)
					ib_putc(' ', out_file);
			}
			ib_fprintf(out_file, "%s\n", s);
			s[0] = 0;
			p = s;
			multiline = true;
		}
	}
	*p = 0;
	if (multiline) {
		for (i = column / 8; i; --i)
			ib_putc('\t', out_file);
		for (i = column % 8; i; --i)
			ib_putc(' ', out_file);
	}
	ib_fprintf(out_file, "%s", s);
	output_buffer[0] = 0;
}


//____________________________________________________________
//  
//		Align output to a specific column for output.
//  

static void align( int column)
{
	if (column < 0)
		return;

	ib_putc('\n', out_file);

	int i;
	for (i = column / 8; i; --i)
		ib_putc('\t', out_file);

	for (i = column % 8; i; --i)
		ib_putc(' ', out_file);
}


//____________________________________________________________
//  
//		Build an assignment from a host language variable to
//		a port variable.
//  

static void asgn_from( const act* action, REF reference, int column)
{
	TEXT name[64], variable[20], temp[20];

	for (; reference; reference = reference->ref_next) {
		const gpre_fld* field = reference->ref_field;
		if (field->fld_array_info)
			if (!(reference->ref_flags & REF_array_elem)) {
				printa(column, "%s := interbase.null_blob;",
					   gen_name(name, reference, true));
				gen_get_or_put_slice(action, reference, false, column);
				continue;
			}

		if (!reference->ref_source && !reference->ref_value)
			continue;
		gen_name(variable, reference, true);
		const TEXT* value;
		if (reference->ref_source)
			value = gen_name(temp, reference->ref_source, true);
		else
			value = reference->ref_value;

		if (!reference->ref_master)
			printa(column, "%s := %s;", variable, value);
		else {
			printa(column, "if %s < 0 then", value);
			printa(column + INDENT, "%s := -1;", variable);
			printa(column, "else");
			printa(column + INDENT, "%s := 0;", variable);
			endif(column);
		}
	}
}

//____________________________________________________________
//  
//		Build an assignment to a host language variable from
//		a port variable.
//  

static void asgn_to( const act* action, REF reference, int column)
{
	REF source = reference->ref_friend;
	const gpre_fld* field = source->ref_field;

	if (field->fld_array_info) {
		source->ref_value = reference->ref_value;
		gen_get_or_put_slice(action, source, true, column);
		return;
	}
//  
//if (field && (field->fld_flags & FLD_text))
//   printa (column, "interbase.isc_ftof (%s, %d, %s, sizeof (%s));", 
// gen_name (s, source, true),
// field->fld_length,
// reference->ref_value,
// reference->ref_value);
//else
//  
	TEXT s[20];
	printa(column, "%s := %s;", reference->ref_value,
		   gen_name(s, source, true));

//  Pick up NULL value if one is there 
	if (reference = reference->ref_null)
		printa(column, "%s := %s;", reference->ref_value,
			   gen_name(s, reference, true));
}


//____________________________________________________________
//  
//		Build an assignment to a host language variable from
//		a port variable.
//  

static void asgn_to_proc( REF reference, int column)
{
	SCHAR s[64];

	for (; reference; reference = reference->ref_next) {
		if (!reference->ref_value)
			continue;
		printa(column, "%s := %s;",
			   reference->ref_value, gen_name(s, reference, true));
	}
}


//____________________________________________________________
//  
//       Generate a function call for free standing ANY.  Somebody else
//       will need to generate the actual function.
//  

static void gen_any( const act* action, int column)
{
	align(column);
	const gpre_req* request = action->act_request;

	ib_fprintf(out_file, "%s_r (&%s, &%s",
			   request->req_handle, request->req_handle, request->req_trans);

	const gpre_port* port = request->req_vport;
	if (port) {
		for (const ref* reference = port->por_references; reference;
			 reference = reference->ref_next)
		{
				ib_fprintf(out_file, ", %s", reference->ref_value);
		}
	}

	ib_fprintf(out_file, ")");
}


//____________________________________________________________
//  
//       Generate code for AT END clause of FETCH.
//  

static void gen_at_end( const act* action, int column)
{
	SCHAR s[20];

	const gpre_req* request = action->act_request;
	printa(column, "if %s = 0 then", gen_name(s, request->req_eof, true));
}


//____________________________________________________________
//  
//		Substitute for a BASED ON <field name> clause.
//  

static void gen_based( const act* action, int column)
{
	SSHORT datatype, i;
	SCHAR s[512], s2[128];

	bas* based_on = (bas*) action->act_object;
	gpre_fld* field = based_on->bas_field;
	TEXT* q = s;
	const TEXT* p;

	if (field->fld_array_info) {
		datatype = field->fld_array->fld_dtype;
		sprintf(s, "array (");
		for (q = s; *q; q++);

		//  Print out the dimension part of the declaration  
		const dim* dimension = field->fld_array_info->ary_dimension;
		for (i = 1; i < field->fld_array_info->ary_dimension_count;
			 dimension = dimension->dim_next, i++) 
		{
			sprintf(s2, "%s range %"SLONGFORMAT"..%"SLONGFORMAT
					",\n                            ",
					LONG_DCL, dimension->dim_lower, dimension->dim_upper);
			for (p = s2; *p; p++, q++)
				*q = *p;
		}

		sprintf(s2, "%s range %"SLONGFORMAT"..%"SLONGFORMAT") of ",
				LONG_DCL, dimension->dim_lower, dimension->dim_upper);
		for (p = s2; *p; p++, q++)
			*q = *p;
	}
	else
		datatype = field->fld_dtype;

	SSHORT length;

	switch (datatype) {
	case dtype_short:
		sprintf(s2, "%s", SHORT_DCL);
		break;

	case dtype_long:
		sprintf(s2, "%s", LONG_DCL);
		break;

	case dtype_date:
	case dtype_blob:
	case dtype_quad:
		sprintf(s2, "interbase.quad");
		break;

	case dtype_text:
		length =
			(field->fld_array_info) ? field->fld_array->fld_length : field->
			fld_length;
		if (field->fld_sub_type == 1) {
			if (length == 1)
				sprintf(s2, "%s", BYTE_DCL);
			else
				sprintf(s2, "%s (1..%d)", BYTE_VECTOR_DCL, length);
		}
		else if (length == 1)
			sprintf(s2, "interbase.isc_character");
		else
			sprintf(s2, "string (1..%d)", length);
		break;

	case dtype_real:
		sprintf(s2, "%s", REAL_DCL);
		break;

	case dtype_double:
		sprintf(s2, "%s", DOUBLE_DCL);
		break;

	default:
		sprintf(s2, "datatype %d unknown\n", field->fld_dtype);
		return ;
	}
	for (p = s2; *p; p++, q++)
		*q = *p;
	if (!strcmp(based_on->bas_terminator, ";"))
		*q++ = ';';
	*q = 0;
	printa(column, s);
}


//____________________________________________________________
//  
//		Make a blob FOR loop.
//  

static void gen_blob_close( const act* action, USHORT column)
{
	blb* blob;

	if (action->act_flags & ACT_sql) {
		column = gen_cursor_close(action, action->act_request, column);
		blob = (blb*) action->act_request->req_blobs;
	}
	else
		blob = (blb*) action->act_object;

	const TEXT* command = (action->act_type == ACT_blob_cancel) ? "CANCEL" :
                                                                  "CLOSE";
	printa(column, "interbase.%s_BLOB (%s isc_%d);",
		   command, status_vector(action), blob->blb_ident);

	if (action->act_flags & ACT_sql) {
		endif(column);
		column -= INDENT;
	}

	set_sqlcode(action, column);
}


//____________________________________________________________
//  
//		End a blob FOR loop.
//  

static void gen_blob_end( const act* action, USHORT column)
{
	const blb* blob = (blb*) action->act_object;
	printa(column, "end loop;");

	if (action->act_error)
		printa(column, "interbase.CLOSE_BLOB (isc_status2, isc_%d);",
			   blob->blb_ident);
	else
		printa(column, "interbase.CLOSE_BLOB (%s isc_%d);",
			   status_vector(0), blob->blb_ident);
}


//____________________________________________________________
//  
//		Make a blob FOR loop.
//  

static void gen_blob_for( const act* action, USHORT column)
{

	gen_blob_open(action, column);
	if (action->act_error)
		printa(column, "if (isc_status(1) = 0) then");
	printa(column, "loop");
	gen_get_segment(action, column + INDENT);
	printa(column + INDENT,
		   "exit when (isc_status(1) /= 0 and isc_status(1) /= interbase.isc_segment);");
}


#ifdef NOT_USED_OR_REPLACED
//  This is the V4.0 version of the function prior to 18-January-95.
//  for unknown reasons it contains a core dump.  The V3.3 version of
//  this function appears to work fine, so we are using it instead.
//  Ravi Kumar
//  
//____________________________________________________________
//  
//		Generate the call to open (or create) a blob.
//  

static gen_blob_open( const act* action, USHORT column)
{
	TEXT s[20];
	const TEXT* pattern1 =
		"interbase.%IFCREATE%ELOPEN%EN_BLOB2 (%V1 %RF%DH, %RF%RT, %RF%BH, %RF%FR, %N1, %I1);";
	const TEXT* pattern2 =
		"interbase.%IFCREATE%ELOPEN%EN_BLOB2 (%V1 %RF%DH, %RF%RT, %RF%BH, %RF%FR, 0, isc_null_bpb);";

	REF reference = 0;
	blb* blob;
	if (action->act_flags & ACT_sql) {
		column = gen_cursor_open(action, action->act_request, column);
		blob = (blb*) action->act_request->req_blobs;
		reference = ((open_cursor*) action->act_object)->opn_using;
		gen_name(s, reference, true);
	}
	else
		blob = (blb*) action->act_object;

	PAT args;
	args.pat_condition = (action->act_type == ACT_blob_create);	//  open or create blob
	args.pat_vector1 = status_vector(action);	//  status vector
	args.pat_database = blob->blb_request->req_database;	//  database handle
	args.pat_request = blob->blb_request;	// transaction handle
	args.pat_blob = blob;		// blob handle
	args.pat_reference = reference;	//  blob identifier
	args.pat_ident1 = blob->blb_bpb_ident;

	if ((action->act_flags & ACT_sql) && action->act_type == ACT_blob_open)
		printa(column, "%s := %s;", s, reference->ref_value);

	if (args.pat_value1 = blob->blb_bpb_length)
		PATTERN_expand(column, pattern1, &args);
	else
		PATTERN_expand(column, pattern2, &args);

	if (action->act_flags & ACT_sql) {
		endif(column);
		column -= INDENT;
		endif(column);
		column -= INDENT;
		set_sqlcode(action, column);
		if (action->act_type == ACT_blob_create) {
			printa(column, "if SQLCODE = 0 then");
			printa(column + INDENT, "%s := %s;", reference->ref_value, s);
			endif(column);
		}
		endif(column);
	}
}
#else
//  This is the version 3.3 of this routine - the original V4.0 version
//  has a core drop.
//  Ravi Kumar
// CVC: no surprise, since "reference" was left uninitialized in one execution path!
//  
//____________________________________________________________
//  
//       Generate the call to open (or create) a blob.
//  

static void gen_blob_open( const act* action, USHORT column)
{
	const TEXT* pattern1 =
		"interbase.%IFCREATE%ELOPEN%EN_BLOB2 (%V1 %RF%DH, %RF%RT, %RF%BH, %RF%FR, %N1, %I1);";
	const TEXT* pattern2 =
		"interbase.%IFCREATE%ELOPEN%EN_BLOB2 (%V1 %RF%DH, %RF%RT, %RF%BH, %RF%FR, 0, isc_null_bpb);";

	blb* blob = (blb*) action->act_object;
	PAT args;
	args.pat_condition = (action->act_type == ACT_blob_create);	// open or create blob
	args.pat_vector1 = status_vector(action);	// status vector
	args.pat_database = blob->blb_request->req_database;	// database handle
	args.pat_request = blob->blb_request;	// transaction handle
	args.pat_blob = blob;		// blob handle
	args.pat_reference = blob->blb_reference;	// blob identifier
	args.pat_ident1 = blob->blb_bpb_ident;

	if (args.pat_value1 = blob->blb_bpb_length)
		PATTERN_expand(column, pattern1, &args);
	else
		PATTERN_expand(column, pattern2, &args);
}
#endif


//____________________________________________________________
//  
//		Callback routine for BLR pretty printer.
//  

static void gen_blr(void* user_arg, SSHORT offset, const char* string)
{
	const int c_len = strlen(COMMENT);
	const int len = strlen(string);
	int from = 0;
	int to = 120 - c_len;

	while (from < len) {
		if (to < len) {
			char buffer[121];
			strncpy(buffer, string + from, 120 - c_len);
			buffer[120 - c_len] = 0;
			ib_fprintf(out_file, "%s%s\n", COMMENT, buffer);
		}
		else
			ib_fprintf(out_file, "%s%s\n", COMMENT, string + from);
		from = to;
		to = to + 120 - c_len;
	}
}


//____________________________________________________________
//  
//       Zap all know handles.
//  

static void gen_clear_handles( const act* action, int column)
{
	for (const gpre_req* request = requests; request; request = request->req_next) {
		if (!(request->req_flags & REQ_exp_hand))
			printa(column, "%s = 0;", request->req_handle);
	}
}


#ifdef NOT_USED_OR_REPLACED
//____________________________________________________________
//  
//       Generate a symbol to ease compatibility with V3.
//  

static void gen_compatibility_symbol(
									 const TEXT* symbol,
									 const TEXT* v4_prefix, const TEXT* trailer)
{
	const TEXT* v3_prefix = (isLangCpp(sw_language)) ? "gds_" : "gds__";

	ib_fprintf(out_file, "#define %s%s\t%s%s%s\n", v3_prefix, symbol,
			   v4_prefix, symbol, trailer);
}
#endif


//____________________________________________________________
//  
//		Generate text to compile a request.
//  

static void gen_compile( const act* action, int column)
{
	const gpre_req* request = action->act_request;
	column += INDENT;
	DBB db = request->req_database;
	gpre_sym* symbol = db->dbb_name;

	if (sw_auto)
		t_start_auto(action, request, status_vector(action), column, true);

	if ((action->act_error || (action->act_flags & ACT_sql)) && sw_auto)
		printa(column, "if (%s = 0) and (%s%s /= 0) then", request->req_handle,
				ada_package, request_trans(action, request));
	else
		printa(column, "if %s = 0 then", request->req_handle);

	column += INDENT;
#ifdef NOT_USED_OR_REPLACED
	printa(column, "interbase.COMPILE_REQUEST%s (%s %s%s, %s%s, %d, isc_%d);",
		   (request->req_flags & REQ_exp_hand) ? "" : "2",
		   status_vector(action),
		   ada_package, symbol->sym_string,
		   request_trans(action, request),
		   (request->req_flags & REQ_exp_hand) ? "" : "'address",
		   request->req_length, request->req_ident);
#endif
	printa(column, "interbase.COMPILE_REQUEST%s (%s %s%s, %s%s, %d, isc_%d);",
		   (request->req_flags & REQ_exp_hand) ? "" : "2",
		   status_vector(action),
		   ada_package, symbol->sym_string,
		   request->req_handle,
		   (request->req_flags & REQ_exp_hand) ? "" : "'address",
		   request->req_length, request->req_ident);

	set_sqlcode(action, column);
	column -= INDENT;
	endif(column);

	const blb* blob = request->req_blobs;
	if (blob)
		for (; blob; blob = blob->blb_next)
			printa(column - INDENT, "isc_%d := 0;", blob->blb_ident);
}


//____________________________________________________________
//  
//		Generate a call to create a database.
//  

static void gen_create_database( const act* action, int column)
{
	TEXT s1[32], s2[32];

	gpre_req* request = ((mdbb*) action->act_object)->mdbb_dpb_request;
	DBB db = (DBB) request->req_database;

	sprintf(s1, "isc_%dl", request->req_ident);

	if (request->req_flags & REQ_extend_dpb) {
		sprintf(s2, "isc_%dp", request->req_ident);
		if (request->req_length)
			printa(column, "%s = isc_to_dpb_ptr (isc_%d'address);", s2,
				   request->req_ident);
		if (db->dbb_r_user)
			printa(column,
				   "interbase.MODIFY_DPB (%s, %s, interbase.isc_dpb_user_name, %s, %d);\n",
				   s2, s1, db->dbb_r_user, (strlen(db->dbb_r_user) - 2));
		if (db->dbb_r_password)
			printa(column,
				   "interbase.MODIFY_DPB (%s, %s, interbase.isc_dpb_password, %s, %d);\n",
				   s2, s1, db->dbb_r_password,
				   (strlen(db->dbb_r_password) - 2));
		/*
		   ** ===========================================================
		   ** ==
		   ** ==   Process Role Name
		   ** ==
		   ** ===========================================================
		 */
		if (db->dbb_r_sql_role)
			printa(column,
				   "interbase.MODIFY_DPB (%s, %s, interbase.isc_dpb_sql_role_name, %s, %d);\n",
				   s2, s1, db->dbb_r_sql_role,
				   (strlen(db->dbb_r_sql_role) - 2));

		if (db->dbb_r_lc_messages)
			printa(column,
				   "interbase.MODIFY_DPB (%s, %s, interbase.isc_dpb_lc_messages, %s, %d);\n",
				   s2, s1, db->dbb_r_lc_messages,
				   (strlen(db->dbb_r_lc_messages) - 2));
		if (db->dbb_r_lc_ctype)
			printa(column,
				   "interbase.MODIFY_DPB (%s, %s, interbase.isc_dpb_lc_ctype, %s, %d);\n",
				   s2, s1, db->dbb_r_lc_ctype,
				   (strlen(db->dbb_r_lc_ctype) - 2));

	}
	else
		sprintf(s2, "isc_to_dpb_ptr (isc_%d'address)", request->req_ident);

	if (request->req_length)
		printa(column,
			   "interbase.CREATE_DATABASE (%s %d, \"%s\", %s%s, %s, %s, 0);",
			   status_vector(action),
			   strlen(db->dbb_filename),
			   db->dbb_filename,
			   ada_package, db->dbb_name->sym_string, s1, s2);
	else
		printa(column,
			   "interbase.CREATE_DATABASE (%s %d, \"%s\", %s%s, 0, interbase.null_dpb, 0);",
			   status_vector(action),
			   strlen(db->dbb_filename),
			   db->dbb_filename, ada_package, db->dbb_name->sym_string);

	if (request && request->req_flags & REQ_extend_dpb) {
		if (request->req_length)
			printa(column, "if (%s != isc_%d)", s2, request->req_ident);
		printa(column + (request->req_length ? 4 : 0),
			   "interbase.FREE (%s);", s2);

		// reset the length of the dpb 
		if (request->req_length)
			printa(column, "%s = %d;", s1, request->req_length);
	}

	printa(column, "if %sisc_status(1) = 0 then", ada_package);
	column += INDENT;
	const bool save_sw_auto = sw_auto;
	sw_auto = true;
	gen_ddl(action, column);
	sw_auto = save_sw_auto;
	column -= INDENT;
	printa(column, "else");
	column += INDENT;
	set_sqlcode(action, column);
	column -= INDENT;
	endif(column);
}


//____________________________________________________________
//  
//		Generate substitution text for END_STREAM.
//  

static int gen_cursor_close( const act* action, gpre_req* request, int column)
{

	return column;
}


//____________________________________________________________
//  
//		Generate text to initialize a cursor.
//  

static void gen_cursor_init( const act* action, int column)
{

//  If blobs are present, zero out all of the blob handles.  After this
//int, the handles are the user's responsibility 

	if (action->act_request->
		req_flags & (REQ_sql_blob_open | REQ_sql_blob_create))
	{
		printa(column, "gds_%d := 0;", 
			action->act_request->req_blobs->blb_ident);
	}
}

#ifdef NOT_USED_OR_REPLACED
//____________________________________________________________
//  
//		Generate text to open an embedded SQL cursor.
//  

static int gen_cursor_open( const act* action, gpre_req* request, int column)
{

	return column;
}
#endif

//____________________________________________________________
//  
//		Generate insertion text for the database statement,
//		including the definitions of all requests, and blob
//		and port declarations for requests in the main routine.
//  

static void gen_database( const act* action, int column)
{
	if (first_flag)
		return;
	first_flag = true;

	ib_fprintf(out_file, "\n----- GPRE Preprocessor Definitions -----\n");

	gpre_req* request;
	for (request = requests; request; request = request->req_next) {
		if (request->req_flags & REQ_local)
			continue;
		for (const gpre_port* port = request->req_ports; port; port = port->por_next)
			make_port(port, column);
	}
	ib_fprintf(out_file, "\n");
	for (request = requests; request; request = request->req_routine) {
		if (request->req_flags & REQ_local)
			continue;
		for (const gpre_port* port = request->req_ports; port; port = port->por_next)
			printa(column, "isc_%d\t: isc_%dt;\t\t\t-- message --",
				   port->por_ident, port->por_ident);

		for (const blb* blob = request->req_blobs; blob; blob = blob->blb_next) {
			printa(column,
				   "isc_%d\t: interbase.blob_handle;\t-- blob handle --",
				   blob->blb_ident);
			SSHORT blob_subtype = blob->blb_const_to_type;
			if (!blob_subtype)
			{
				const ref* reference = blob->blb_reference;
				if (reference)
				{
					const gpre_fld* field = reference->ref_field;
					if (field)
						blob_subtype = field->fld_sub_type;
				}
			}
			if (blob_subtype != 0 && blob_subtype != 1)
				printa(column,
					   "isc_%d\t: %s (1 .. %d);\t\t-- blob segment --",
					   blob->blb_buff_ident, BYTE_VECTOR_DCL,
					   blob->blb_seg_length);
			else
				printa(column,
					   "isc_%d\t: string (1 .. %d);\t\t-- blob segment --",
					   blob->blb_buff_ident, blob->blb_seg_length);
			printa(column, "isc_%d\t: %s;\t\t-- segment length --",
				   blob->blb_len_ident, USHORT_DCL);
		}
	}

//  generate event parameter block for each event in module 

	USHORT max_count = 0;
	for (LLS stack_ptr = events; stack_ptr; stack_ptr = stack_ptr->lls_next) {
		const USHORT event_count = gen_event_block((const act*) stack_ptr->lls_object);
		max_count = MAX(event_count, max_count);
	}

	if (max_count)
		printa(column, "isc_events: %s(1..%d);\t-- event vector --",
			   EVENT_LIST_DCL, max_count);

	bool array_flag = false;
	for (request = requests; request; request = request->req_next) {
		gen_request(request, column);

		//  Array declarations  
		const gpre_port* port = request->req_primary;
		if (port)
			for (REF reference = port->por_references; reference;
				 reference = reference->ref_next)
			{
				if (reference->ref_flags & REF_fetch_array) {
					make_array_declaration(reference, column);
					array_flag = true;
				}
			}
	}
	if (array_flag) {
		printa(column, "isc_array_length\t: %s;\t-- slice return value --",
			   LONG_DCL);
		printa(column,
			   "isc_null_vector_l\t: %s (1..1);\t-- null long vector --",
			   LONG_VECTOR_DCL);
	}

	printa(column,
		   "isc_null_bpb\t: interbase.blr (1..1);\t-- null blob parameter block --");

	if (!ada_package[0])
		printa(column,
			   "gds_trans\t: interbase.transaction_handle := 0;\t-- default transaction --");
	printa(column,
		   "isc_status\t: interbase.status_vector;\t-- status vector --");
	printa(column,
		   "isc_status2\t: interbase.status_vector;\t-- status vector --");
	printa(column, "SQLCODE\t: %s := 0;\t\t\t-- SQL status code --",
		   LONG_DCL);
	if (!ada_package[0]) {
		for (const dbb* db = isc_databases; db; db = db->dbb_next)
			printa(column,
				   "%s\t\t: interbase.database_handle%s;-- database handle --",
				   db->dbb_name->sym_string,
				   (db->dbb_scope == DBB_EXTERN) ? "" : " := 0");
	}

	printa(column, " ");

	USHORT count = 0;
	for (const dbb* db = isc_databases; db; db = db->dbb_next) {
		++count;
		for (const tpb* tpb_val = db->dbb_tpbs; tpb_val; tpb_val = tpb_val->tpb_dbb_next)
			gen_tpb(tpb_val, column + INDENT);
	}

	printa(column,
		   "isc_teb\t: array (1..%d) of interbase.isc_teb_t;\t-- transaction vector ",
		   count);

	printa(column, "----- end of GPRE definitions ");
}


//____________________________________________________________
//  
//		Generate a call to update metadata.
//  

static void gen_ddl( const act* action, int column)
{
//  Set up command type for call to RDB$DDL 

	const gpre_req* request = action->act_request;

//  Generate a call to RDB$DDL to perform action 

	if (sw_auto) {
		t_start_auto(action, 0, status_vector(action), column, true);
		printa(column, "if %sgds_trans /= 0 then", ada_package);
		column += INDENT;
	}

	printa(column, "interbase.DDL (%s %s%s, %s%s, %d, isc_%d'address);",
		   status_vector(action),
		   ada_package, request->req_database->dbb_name->sym_string,
		   ada_package, request->req_trans,
		   request->req_length, request->req_ident);

	if (sw_auto) {
		printa(column, "if %sisc_status(1) = 0 then", ada_package);
		printa(column + INDENT,
			   "interbase.commit_TRANSACTION (%s %sgds_trans);",
			   status_vector(action), ada_package);
		printa(column, "else", ada_package);
		printa(column + INDENT,
			   "interbase.rollback_TRANSACTION (%sgds_trans);", ada_package);
		endif(column);
		column -= INDENT;
		endif(column);
	}

	set_sqlcode(action, column);
}


//____________________________________________________________
//  
//		Generate a call to create a database.
//  

static void gen_drop_database( const act* action, int column)
{
	DBB db = (DBB) action->act_object;
	gpre_req* request = action->act_request;

	printa(column,
		   "interbase.DROP_DATABASE (%s %d, \"%s\", RDBK_DB_TYPE_GDS);",
		   status_vector(action), strlen(db->dbb_filename), db->dbb_filename);

	set_sqlcode(action, column);
}


//____________________________________________________________
//  
//		Generate a dynamic SQL statement.
//  

static void gen_dyn_close( const act* action, int column)
{
	TEXT s[64];

	const dyn* statement = (DYN) action->act_object;
	printa(column,
		   "interbase.embed_dsql_close (%s %s);",
		   status_vector(action), make_name(s, statement->dyn_cursor_name));
	set_sqlcode(action, column);
}


//____________________________________________________________
//  
//		Generate a dynamic SQL statement.
//  

static void gen_dyn_declare( const act* action, int column)
{
	TEXT s1[64], s2[64];

	const dyn* statement = (DYN) action->act_object;
	printa(column,
		   "interbase.embed_dsql_declare (%s %s, %s);",
		   status_vector(action),
		   make_name(s1, statement->dyn_statement_name),
		   make_name(s2, statement->dyn_cursor_name));
	set_sqlcode(action, column);
}


//____________________________________________________________
//  
//		Generate a dynamic SQL statement.
//  

static void gen_dyn_describe(const act* action,
							 int column,
							 bool input_flag)
{
	TEXT s[64];

	const dyn* statement = (DYN) action->act_object;
	printa(column,
		   "interbase.embed_dsql_describe%s (%s %s, %d, %s'address);",
		   input_flag ? "_bind" : "",
		   status_vector(action),
		   make_name(s, statement->dyn_statement_name),
		   sw_sql_dialect, statement->dyn_sqlda);
	set_sqlcode(action, column);
}


//____________________________________________________________
//  
//		Generate a dynamic SQL statement.
//  

static void gen_dyn_execute( const act* action, int column)
{
	TEXT s[64];
	gpre_req* request;
	gpre_req req_const;

	DYN statement = (DYN) action->act_object;
	const TEXT* transaction;
	if (statement->dyn_trans) {
		transaction = statement->dyn_trans;
		request = &req_const;
		request->req_trans = transaction;
	}
	else {
		transaction = "gds_trans";
		request = NULL;
	}

	if (sw_auto) {
		t_start_auto(action, request, status_vector(action), column, true);
		printa(column, "if %s%s /= 0 then", ada_package, transaction);
		column += INDENT;
	}

	if (statement->dyn_sqlda2)
		printa(column,
			   "interbase.embed_dsql_execute2 (isc_status, %s%s, %s, %d, %s'address);",
			   ada_package, transaction,
			   make_name(s, statement->dyn_statement_name),
			   sw_sql_dialect,
			   (statement->dyn_sqlda) ? ada_null_address : statement->
			   dyn_sqlda, statement->dyn_sqlda2);
	else if (statement->dyn_sqlda)
		printa(column,
			   "interbase.embed_dsql_execute (isc_status, %s%s, %s, %d, %s'address);",
			   ada_package, transaction, make_name(s,
												   statement->
												   dyn_statement_name),
			   sw_sql_dialect, statement->dyn_sqlda);
	else
		printa(column,
			   "interbase.embed_dsql_execute (isc_status, %s%s, %s, %d);",
			   ada_package, transaction, make_name(s,
												   statement->
												   dyn_statement_name),
			   sw_sql_dialect);

	if (sw_auto) {
		column -= INDENT;
		endif(column);
	}

	set_sqlcode(action, column);
}


//____________________________________________________________
//  
//		Generate a dynamic SQL statement.
//  

static void gen_dyn_fetch( const act* action, int column)
{
	TEXT s[64];

	const dyn* statement = (DYN) action->act_object;
	if (statement->dyn_sqlda)
		printa(column,
			   "interbase.embed_dsql_fetch (isc_status, SQLCODE, %s, %d, %s'address);",
			   make_name(s, statement->dyn_cursor_name),
			   sw_sql_dialect, statement->dyn_sqlda);
	else
		printa(column,
			   "interbase.embed_dsql_fetch (isc_status, SQLCODE, %s, %d);",
			   make_name(s, statement->dyn_cursor_name), sw_sql_dialect);

	printa(column, "if SQLCODE /= 100 then");
	printa(column + INDENT, "SQLCODE := interbase.sqlcode (isc_status);");
	endif(column);
}


//____________________________________________________________
//  
//		Generate code for an EXECUTE IMMEDIATE dynamic SQL statement.
//  

static void gen_dyn_immediate( const act* action, int column)
{
	gpre_req* request;
	gpre_req req_const;

	DYN statement = (DYN) action->act_object;
	const TEXT* transaction;
	if (statement->dyn_trans) {
		transaction = statement->dyn_trans;
		request = &req_const;
		request->req_trans = transaction;
	}
	else {
		transaction = "gds_trans";
		request = NULL;
	}

	DBB database = statement->dyn_database;

	if (sw_auto) {
		t_start_auto(action, request, status_vector(action), column, true);
		printa(column, "if %s%s /= 0 then", ada_package, transaction);
		column += INDENT;
	}

	printa(column,
		   "interbase.embed_dsql_execute_immed (isc_status, %s%s, %s%s, %s'length(1), %s, %d);",
		   ada_package, database->dbb_name->sym_string,
		   ada_package, transaction,
		   statement->dyn_string, statement->dyn_string, sw_sql_dialect);

	if (sw_auto) {
		column -= INDENT;
		endif(column);
	}

	set_sqlcode(action, column);
}


//____________________________________________________________
//  
//		Generate a dynamic SQL statement.
//  

static void gen_dyn_insert( const act* action, int column)
{
	TEXT s[64];

	const dyn* statement = (DYN) action->act_object;
	if (statement->dyn_sqlda)
		printa(column,
			   "interbase.embed_dsql_insert (isc_status, %s, %d, %s'address);",
			   make_name(s, statement->dyn_cursor_name),
			   sw_sql_dialect, statement->dyn_sqlda);
	else
		printa(column,
			   "interbase.embed_dsql_insert (isc_status, %s, %d);",
			   make_name(s, statement->dyn_cursor_name), sw_sql_dialect);

	set_sqlcode(action, column);
}


//____________________________________________________________
//  
//		Generate a dynamic SQL statement.
//  

static void gen_dyn_open( const act* action, int column)
{
	TEXT s[64];
	gpre_req* request;
	gpre_req req_const;

	DYN statement = (DYN) action->act_object;
	const TEXT* transaction;
	if (statement->dyn_trans) {
		transaction = statement->dyn_trans;
		request = &req_const;
		request->req_trans = transaction;
	}
	else {
		transaction = "gds_trans";
		request = NULL;
	}

	make_name(s, statement->dyn_cursor_name);

	if (sw_auto) {
		t_start_auto(action, request, status_vector(action), column, true);
		printa(column, "if %s%s /= 0 then", ada_package, transaction);
		column += INDENT;
	}

	if (statement->dyn_sqlda)
		printa(column,
			   "interbase.embed_dsql_open (isc_status, %s%s, %s, %d, %s'address);",
			   ada_package, transaction,
			   s, sw_sql_dialect, statement->dyn_sqlda);
	else
		printa(column,
			   "interbase.embed_dsql_open (isc_status, %s%s, %s, %d);",
			   ada_package, transaction, s, sw_sql_dialect);

	if (sw_auto) {
		column -= INDENT;
		endif(column);
	}

	set_sqlcode(action, column);
}


//____________________________________________________________
//  
//		Generate a dynamic SQL statement.
//  

static void gen_dyn_prepare( const act* action, int column)
{
	TEXT s[64];
	gpre_req* request;
	gpre_req req_const;

	DYN statement = (DYN) action->act_object;
	const dbb* database = statement->dyn_database;

	const TEXT* transaction;
	if (statement->dyn_trans) {
		transaction = statement->dyn_trans;
		request = &req_const;
		request->req_trans = transaction;
	}
	else {
		transaction = "gds_trans";
		request = NULL;
	}

	if (sw_auto) {
		t_start_auto(action, request, status_vector(action), column, true);
		printa(column, "if %s%s /= 0 then", ada_package, transaction);
		column += INDENT;
	}

	if (statement->dyn_sqlda)
		printa(column,
			   "interbase.embed_dsql_prepare (isc_status, %s%s, %s%s, %s, %s'length(1), %s, %d, %s'address);",
			   ada_package, database->dbb_name->sym_string, ada_package,
			   transaction, make_name(s, statement->dyn_statement_name),
			   statement->dyn_string, statement->dyn_string, sw_sql_dialect,
			   statement->dyn_sqlda);
	else
		printa(column,
			   "interbase.embed_dsql_prepare (isc_status, %s%s, %s%s, %s, %s'length(1), %s, %d);",
			   ada_package, database->dbb_name->sym_string, ada_package,
			   transaction, make_name(s, statement->dyn_statement_name),
			   statement->dyn_string, statement->dyn_string, sw_sql_dialect);

	if (sw_auto) {
		column -= INDENT;
		endif(column);
	}

	set_sqlcode(action, column);
}


//____________________________________________________________
//  
//		Generate substitution text for END_MODIFY.
//  

static void gen_emodify( const act* action, int column)
{
	TEXT s1[20], s2[20];

	upd* modify = (upd*) action->act_object;

	for (REF reference = modify->upd_port->por_references; reference;
		 reference = reference->ref_next) 
	{
		REF source = reference->ref_source;
		if (!source)
			continue;
		const gpre_fld* field = reference->ref_field;
		printa(column, "%s := %s;",
			   gen_name(s1, reference, true), gen_name(s2, source, true));
		if (field->fld_array_info)
			gen_get_or_put_slice(action, reference, false, column);
	}

	gen_send(action, modify->upd_port, column);
}


//____________________________________________________________
//  
//		Generate substitution text for END_STORE.
//  

static void gen_estore( const act* action, int column)
{
	gpre_req* request = action->act_request;

//  if we did a store ... returning_values aka store2
//  just wrap up any dangling error handling 
	if (request->req_type == REQ_store2) {
		if (action->act_error)
			endif(column);
		return;
	}

	gen_start(action, request->req_primary, column);
	if (action->act_error)
		endif(column);
}


//____________________________________________________________
//  
//		Generate definitions associated with a single request.
//  

static void gen_endfor( const act* action, int column)
{
	gpre_req* request = action->act_request;

	if (request->req_sync)
		gen_send(action, request->req_sync, column + INDENT);

	printa(column, "end loop;");

	if (action->act_error || (action->act_flags & ACT_sql))
		endif(column);
}


//____________________________________________________________
//  
//		Generate substitution text for ERASE.
//  

static void gen_erase( const act* action, int column)
{
	upd* erase = (upd*) action->act_object;
	gen_send(action, erase->upd_port, column);
}


//____________________________________________________________
//  
//		Generate event parameter blocks for use
//		with a particular call to isc_event_wait.
//		For languages too dim to deal with variable
//		arg lists, set up a vector for the event names.
//  

static SSHORT gen_event_block( const act* action)
{
	GPRE_NOD init = (GPRE_NOD) action->act_object;
	gpre_sym* event_name = (gpre_sym*) init->nod_arg[0];

	const int ident = CMP_next_ident();
	init->nod_arg[2] = (GPRE_NOD) ident;
	const gpre_nod* list = init->nod_arg[1];

	printa(0, "isc_%da\t\t: system.address;\t\t-- event parameter block --\n",
		   ident);
	printa(0,
		   "isc_%db\t\t: system.address;\t\t-- result parameter block --\n",
		   ident);
	printa(0, "isc_%dc\t\t: %s;\t\t-- count of events --\n", ident,
		   USHORT_DCL);
	printa(0, "isc_%dl\t\t: %s;\t\t-- length of event parameter block --\n",
		   ident, USHORT_DCL);
	printa(0,
		   "isc_%dv\t\t: interbase.isc_el_t (1..%d);\t\t-- vector for initialization --\n",
		   ident, list->nod_count);

	return list->nod_count;
}


//____________________________________________________________
//  
//		Generate substitution text for EVENT_INIT.
//  

static void gen_event_init( const act* action, int column)
{
	const TEXT* pattern1 =
		"isc_%N1l := interbase.event_block (%RFisc_%N1a'address, %RFisc_%N1b'address, isc_%N1c, %RFisc_%N1v);";
	const TEXT *pattern2 =
		"interbase.event_wait (%V1 %RF%DH, isc_%N1l, isc_%N1a, isc_%N1b);";
	const TEXT* pattern3 =
		"interbase.event_counts (isc_events, isc_%N1l, isc_%N1a, isc_%N1b);";

	if (action->act_error)
		begin(column);
	begin(column);

	GPRE_NOD init = (GPRE_NOD) action->act_object;
	GPRE_NOD event_list = init->nod_arg[1];

	PAT args;
	args.pat_database = (DBB) init->nod_arg[3];
	args.pat_vector1 = status_vector(action);
	args.pat_value1 = (int) init->nod_arg[2];

//  generate call to dynamically generate event blocks 

	TEXT variable[32];
	USHORT count = 0;
	GPRE_NOD* ptr = event_list->nod_arg;
	for (GPRE_NOD* const end = ptr + event_list->nod_count; ptr < end; ++ptr)
	{
		count++;
		const gpre_nod* node = *ptr;
		if (node->nod_type == nod_field) {
			const ref* reference = (REF) node->nod_arg[0];
			gen_name(variable, reference, true);
			printa(column, "isc_%dv(%d) := %s'address;",
				   args.pat_value1, count, variable);
		}
		else
			printa(column, "isc_%dv(%d) := %s'address;",
				   args.pat_value1, count, node->nod_arg[0]);
	}

	printa(column, "isc_%dc := %d;", args.pat_value1,
		   (int) event_list->nod_count);
	PATTERN_expand(column, pattern1, &args);

//  generate actual call to event_wait 

	PATTERN_expand(column, pattern2, &args);

//  get change in event counts, copying event parameter block for reuse 

	PATTERN_expand(column, pattern3, &args);

	endp(column);
	set_sqlcode(action, column);
}


//____________________________________________________________
//  
//		Generate substitution text for EVENT_WAIT.
//  

static void gen_event_wait( const act* action, int column)
{
	const TEXT* pattern1 =
		"interbase.event_wait (%V1 %RF%DH, isc_%N1l, isc_%N1a, isc_%N1b);";
	const TEXT* pattern2 =
		"interbase.event_counts (isc_events, isc_%N1l, isc_%N1a, isc_%N1b);";

	if (action->act_error)
		begin(column);
	begin(column);

	gpre_sym* event_name = (gpre_sym*) action->act_object;

//  go through the stack of events, checking to see if the
//  event has been initialized and getting the event identifier 

	int ident = -1;
	DBB database;
	for (LLS stack_ptr = events; stack_ptr; stack_ptr = stack_ptr->lls_next) {
		const act* event_action = (const act*) stack_ptr->lls_object;
		GPRE_NOD event_init = (GPRE_NOD) event_action->act_object;
		gpre_sym* stack_name = (gpre_sym*) event_init->nod_arg[0];
		if (!strcmp(event_name->sym_string, stack_name->sym_string)) {
			ident = (int) event_init->nod_arg[2];
			database = (DBB) event_init->nod_arg[3];
		}
	}

	if (ident < 0) {
		TEXT s[64];
		sprintf(s, "event handle \"%s\" not found", event_name->sym_string);
		CPR_error(s);
		return;
	}

	PAT args;
	args.pat_database = database;
	args.pat_vector1 = status_vector(action);
	args.pat_value1 = (int) ident;

//  generate calls to wait on the event and to fill out the events array 

	PATTERN_expand(column, pattern1, &args);
	PATTERN_expand(column, pattern2, &args);

	endp(column);
	set_sqlcode(action, column);
}



//____________________________________________________________
//  
//		Generate replacement text for the SQL FETCH statement.  The
//		epilog FETCH statement is handled by GEN_S_FETCH (generate
//		stream fetch).
//  

static void gen_fetch( const act* action, int column)
{
	gpre_req* request = action->act_request;

#ifdef SCROLLABLE_CURSORS
	gpre_port* port = request->req_aport;
	if (port) {
		/* set up the reference to point to the correct value 
		   in the linked list of values, and prepare for the 
		   next FETCH statement if applicable */

		REF reference;
		for (reference = port->por_references; reference;
			 reference = reference->ref_next) 
		{
			VAL value = reference->ref_values;
			reference->ref_value = value->val_value;
			reference->ref_values = value->val_next;
		}

		// find the direction and offset parameters 

		reference = port->por_references;
		const TEXT* offset = reference->ref_value;
		reference = reference->ref_next;
		const TEXT* direction = reference->ref_value;

		/* the direction in which the engine will scroll is sticky, so check to see 
		   the last direction passed to the engine; if the direction is the same and 
		   the offset is 1, then there is no need to pass the message; this prevents 
		   extra packets and allows for batch fetches in either direction */

		printa(column, "if isc_%ddirection MOD 2 /= %s or %s /= 1 then",
			   request->req_ident, direction, offset);
		column += INDENT;

		/* assign the direction and offset parameters to the appropriate message, 
		   then send the message to the engine */

		asgn_from(action, port->por_references, column);
		gen_send(action, port, column);
		printa(column, "isc_%ddirection := %s;", request->req_ident,
			   direction);
		column -= INDENT;
		endif(column);

		printa(column, "if SQLCODE = 0 then");
		column += INDENT;
	}
#endif

	if (request->req_sync) {
		gen_send(action, request->req_sync, column);
		printa(column, "if SQLCODE = 0 then");
		column += INDENT;
	}

	gen_receive(action, column, request->req_primary);
	printa(column, "if SQLCODE = 0 then");
	column += INDENT;

	SCHAR s[20];
	printa(column, "if %s /= 0 then", gen_name(s, request->req_eof, true));
	column += INDENT;

	GPRE_NOD var_list = (GPRE_NOD) action->act_object;
	if (var_list) {
		for (int i = 0; i < var_list->nod_count; i++)
			asgn_to(action, (REF) var_list->nod_arg[i], column);
	}
	else {						/*  No WITH clause on the FETCH, so no assignments generated;  fix
								   for bug#940.  mao 6/20/89  */
		printa(column, "NULL;");
	}

	column -= INDENT;
	printa(column, "else");
	printa(column + INDENT, "SQLCODE := 100;");
	endif(column);
	column -= INDENT;
	endif(column);
	column -= INDENT;

	if (request->req_sync)
		endif(column);

#ifdef SCROLLABLE_CURSORS
	if (port) {
		column -= INDENT;
		endif(column);
	}
#endif
}


//____________________________________________________________
//  
//		Generate substitution text for FINISH.
//  

static void gen_finish( const act* action, int column)
{
	DBB db = NULL;

	if (sw_auto || ((action->act_flags & ACT_sql) &&
					(action->act_type != ACT_disconnect))) 
	{
		printa(column, "if %sgds_trans /= 0 then", ada_package);
		printa(column + INDENT, "interbase.%s_TRANSACTION (%s %sgds_trans);",
			   (action->act_type != ACT_rfinish) ? "COMMIT" : "ROLLBACK",
			   status_vector(action), ada_package);
		endif(column);
	}

//  the user supplied one or more db_handles 

	for (rdy* ready = (rdy*) action->act_object; ready; ready = ready->rdy_next) {
		db = ready->rdy_database;
		if (action->act_error || (action->act_flags & ACT_sql))
			printa(column, "if %s%s /= 0 then", ada_package,
				   db->dbb_name->sym_string);
		printa(column, "interbase.DETACH_DATABASE (%s %s%s);",
			   status_vector(action), ada_package, db->dbb_name->sym_string);
		if (action->act_error || (action->act_flags & ACT_sql))
			endif(column);
	}

//  no hanbdles, so we finish all known databases 

	if (!db) {
		if (action->act_error || (action->act_flags & ACT_sql))
			printa(column, "if %sgds_trans = 0 then", ada_package);
		for (db = isc_databases; db; db = db->dbb_next) {
			if ((action->act_error || (action->act_flags & ACT_sql))
				&& (db != isc_databases)) printa(column,
												 "if %s%s /= 0 and isc_status(1) = 0 then",
												 ada_package,
												 db->dbb_name->sym_string);
			else
				printa(column, "if %s%s /= 0 then", ada_package,
					   db->dbb_name->sym_string);
			column += INDENT;
			printa(column, "interbase.DETACH_DATABASE (%s %s%s);",
				   status_vector(action),
				   ada_package, db->dbb_name->sym_string);
			for (gpre_req* request = requests; request;
				request = request->req_next)
			{
				if (!(request->req_flags & REQ_exp_hand) &&
					request->req_type != REQ_slice &&
					request->req_type != REQ_procedure &&
					request->req_database == db)
				{
					printa(column, "%s := 0;", request->req_handle);
				}
			}
			column -= INDENT;
			endif(column);
		}
		if (action->act_error || (action->act_flags & ACT_sql))
			endif(column);
	}

	set_sqlcode(action, column);
}


//____________________________________________________________
//  
//		Generate substitution text for FOR statement.
//  

static void gen_for( const act* action, int column)
{
	gen_s_start(action, column);
	gpre_req* request = action->act_request;

	if (action->act_error || (action->act_flags & ACT_sql))
		printa(column, "if isc_status(1) = 0 then");

	printa(column, "loop");
	column += INDENT;
	gen_receive(action, column, request->req_primary);

	TEXT s[20];
	if (action->act_error || (action->act_flags & ACT_sql))
		printa(column, "exit when (%s = 0) or (isc_status(1) /= 0);",
			   gen_name(s, request->req_eof, true));
	else
		printa(column, "exit when %s = 0;",
			   gen_name(s, request->req_eof, true));

	gpre_port* port = action->act_request->req_primary;
	if (port) {
		for (REF reference = port->por_references; reference;
			 reference = reference->ref_next)
		{
			if (reference->ref_field->fld_array_info)
				gen_get_or_put_slice(action, reference, true, column);
		}
	}
}


//____________________________________________________________
//  
//       Generate a function for free standing ANY or statistical.
//  

static void gen_function( const act* function, int column)
{
	const act* action = (const act*) function->act_object;

	if (action->act_type != ACT_any) {
		CPR_error("can't generate function");
		return;
	}

	gpre_req* request = action->act_request;

	ib_fprintf(out_file, "static %s_r (request, transaction", request->req_handle);

	TEXT s[64];
	const gpre_port* port = request->req_vport;
	if (port) {
		for (REF reference = port->por_references; reference;
			 reference = reference->ref_next)
		{
				ib_fprintf(out_file, ", %s",
						   gen_name(s, reference->ref_source, true));
		}
	}
	ib_fprintf(out_file,
			   ")\n    isc_req_handle\trequest;\n    isc_tr_handle\ttransaction;\n");

	if (port) {
		for (REF reference = port->por_references; reference;
			 reference = reference->ref_next) 
		{
			const gpre_fld* field = reference->ref_field;
			const TEXT* dtype;

			switch (field->fld_dtype) {
			case dtype_short:
				dtype = "short";
				break;

			case dtype_long:
				dtype = "long";
				break;

			case dtype_cstring:
			case dtype_text:
				dtype = "char*";
				break;

			case dtype_quad:
				dtype = "long";
				break;

			case dtype_date:
			case dtype_blob:
				dtype = "ISC_QUAD";
				break;

			case dtype_real:
				dtype = "float";
				break;

			case dtype_double:
				dtype = "double";
				break;

			default:
				CPR_error("gen_function: unsupported datatype");
				return;
			}
			ib_fprintf(out_file, "    %s\t%s;\n", dtype,
					   gen_name(s, reference->ref_source, true));
		}
	}

	ib_fprintf(out_file, "{\n");
	for (port = request->req_ports; port; port = port->por_next)
		make_port(port, column);

	ib_fprintf(out_file, "\n\n");
	gen_s_start(action, 0);
	gen_receive(action, column, request->req_primary);

	for (port = request->req_ports; port; port = port->por_next) {
		for (REF reference = port->por_references; reference;
			 reference = reference->ref_next)
		{
			if (reference->ref_field->fld_array_info)
				gen_get_or_put_slice(action, reference, true, column);
		}
	}

	port = request->req_primary;
	ib_fprintf(out_file, "\nreturn %s;\n}\n",
			   gen_name(s, port->por_references, true)
		);
}

//____________________________________________________________
//  
//		Generate a call to isc_get_slice
//       or isc_put_slice for an array.
//  

static void gen_get_or_put_slice(const act* action,
								 REF reference,
								 bool get,
								 int column)
{
	const TEXT* pattern1 =
		"interbase.GET_SLICE (%V1 %RF%DH%RE, %RF%S1%RE, %S2, %N1, %S3, %N2, %S4, %L1, %S5, %S6);";
	const TEXT* pattern2 =
		"interbase.PUT_SLICE (%V1 %RF%DH%RE, %RF%S1%RE, %S2, %N1, %S3, %N2, %S4, %L1, %S5);";

	if (!(reference->ref_flags & REF_fetch_array))
		return;

	PAT args;
	args.pat_vector1 = status_vector(action);	// status vector 
	args.pat_database = action->act_request->req_database;	// database handle 
	args.pat_string1 = action->act_request->req_trans;	// transaction handle 

	TEXT s1[25];
	gen_name(s1, reference, true);	// blob handle
	args.pat_string2 = s1;

	args.pat_value1 = reference->ref_sdl_length;	// slice descr. length 

	TEXT s2[25];
	sprintf(s2, "isc_%d", reference->ref_sdl_ident);	// slice description 
	args.pat_string3 = s2;

	args.pat_value2 = 0;		// parameter length 

	TEXT s3[25];
	sprintf(s3, "isc_null_vector_l");	// parameter block init 
	args.pat_string4 = s3;

	args.pat_long1 = reference->ref_field->fld_array_info->ary_size;
	//  slice size 
	TEXT s4[25];
	if (action->act_flags & ACT_sql) {
		sprintf(s4, "%s'address", reference->ref_value);
	}
	else {
		sprintf(s4, "isc_%d'address",
				reference->ref_field->fld_array_info->ary_ident);

	}
	args.pat_string5 = s4;		// array name 

	args.pat_string6 = "isc_array_length";	// return length 

	if (get)
		PATTERN_expand(column, pattern1, &args);
	else
		PATTERN_expand(column, pattern2, &args);
}


//____________________________________________________________
//  
//		Generate the code to do a get segment.
//  

static void gen_get_segment( const act* action, int column)
{
	blb* blob;
	if (action->act_flags & ACT_sql)
		blob = (blb*) action->act_request->req_blobs;
	else
		blob = (blb*) action->act_object;

	if (action->act_error || (action->act_flags & ACT_sql))
		printa(column,
			   "interbase.ISC_GET_SEGMENT (isc_status, isc_%d, isc_%d, %d, isc_%d'address);",
			   blob->blb_ident,
			   blob->blb_len_ident,
			   blob->blb_seg_length, blob->blb_buff_ident);
	else
		printa(column,
			   "interbase.ISC_GET_SEGMENT (isc_status(1), isc_%d, isc_%d, %d, isc_%d'address);",
			   blob->blb_ident,
			   blob->blb_len_ident,
			   blob->blb_seg_length, blob->blb_buff_ident);

	if (action->act_flags & ACT_sql) {
		const ref* into = action->act_object;
		set_sqlcode(action, column);
		printa(column, "if (SQLCODE = 0) or (SQLCODE = 101) then");
		printa(column + INDENT, "%s := isc_%d;",
			   into->ref_value, blob->blb_buff_ident);
		if (into->ref_null_value)
			printa(column + INDENT, "%s := isc_%d;",
				   into->ref_null_value, blob->blb_len_ident);
		endif(column);
	}
}


//____________________________________________________________
//  
//		Generate code to drive a mass update.  Just start a request
//		and get the result.
//  

static void gen_loop( const act* action, int column)
{
	gen_s_start(action, column);
	gpre_req* request = action->act_request;
	gpre_port* port = request->req_primary;
	printa(column, "if SQLCODE = 0 then");
	column += INDENT;
	gen_receive(action, column, port);

	TEXT name[20];
	gen_name(name, port->por_references, true);
	printa(column, "if (SQLCODE = 0) and (%s = 0) then", name);
	printa(column + INDENT, "SQLCODE := 100;");
	endif(column);
	column -= INDENT;
	endif(column);
}


//____________________________________________________________
//  
//		Generate a name for a reference.  Name is constructed from
//		port and parameter idents.
//  

static TEXT* gen_name(TEXT* string,
					  const ref* reference,
					  bool as_blob)
{

	if (reference->ref_field->fld_array_info && !as_blob)
		sprintf(string, "isc_%d",
				reference->ref_field->fld_array_info->ary_ident);
	else
		sprintf(string, "isc_%d.isc_%d",
				reference->ref_port->por_ident, reference->ref_ident);

	return string;
}


//____________________________________________________________
//  
//		Generate a block to handle errors.
//  

static void gen_on_error( const act* action, USHORT column)
{
	const act* err_action = (const act*) action->act_object;
	if ((err_action->act_type == ACT_get_segment) ||
		(err_action->act_type == ACT_put_segment) ||
		(err_action->act_type == ACT_endblob))
	{
			printa(column,
				   "if (isc_status (1) /= 0) and (isc_status(1) /= interbase.isc_segment) and (isc_status(1) /= interbase.isc_segstr_eof) then");
	}
	else
		printa(column, "if (isc_status (1) /= 0) then");
}


//____________________________________________________________
//  
//		Generate code for an EXECUTE PROCEDURE.
//  

static void gen_procedure( const act* action, int column)
{
	gpre_req* request = action->act_request;
	gpre_port* in_port = request->req_vport;
	gpre_port* out_port = request->req_primary;

	const dbb* database = request->req_database;
	PAT args;
	args.pat_database = database;
	args.pat_request = action->act_request;
	args.pat_vector1 = status_vector(action);
	args.pat_string2 = ada_null_address;
	args.pat_request = request;
	args.pat_port = in_port;
	args.pat_port2 = out_port;

	const TEXT* pattern;
	if (in_port && in_port->por_length)
		pattern =
			"interbase.gds_transact_request (%V1 %RF%DH%RE, %RF%RT%RE, %VF%RS%VE, %RF%RI%RE, %VF%PL%VE, %PI'address, %VF%QL%VE, %QI'address);\n";
	else
		pattern =
			"interbase.gds_transact_request (%V1 %RF%DH%RE, %RF%RT%RE, %VF%RS%VE, %RF%RI%RE, %VF0%VE, %S2, %VF%QL%VE, %QI'address);\n";


//  Get database attach and transaction started 

	if (sw_auto)
		t_start_auto(action, 0, status_vector(action), column, true);

//  Move in input values 

	asgn_from(action, request->req_values, column);

//  Execute the procedure 

	PATTERN_expand(column, pattern, &args);

	set_sqlcode(action, column);

	printa(column, "if SQLCODE = 0 then");

//  Move out output values 

	asgn_to_proc(request->req_references, column);
	endif(column);
}


//____________________________________________________________
//  
//		Generate the code to do a put segment.
//  

static void gen_put_segment( const act* action, int column)
{
	const blb* blob;
	if (action->act_flags & ACT_sql) {
		blob = (blb*) action->act_request->req_blobs;
		const ref* from = action->act_object;
		printa(column, "isc_%d := %s;",
			   blob->blb_len_ident, from->ref_null_value);
		printa(column, "isc_%d := %s;",
			   blob->blb_buff_ident, from->ref_value);
	}
	else
		blob = (blb*) action->act_object;

	printa(column,
		   "interbase.ISC_PUT_SEGMENT (%s isc_%d, isc_%d, isc_%d'address);",
		   status_vector(action),
		   blob->blb_ident, blob->blb_len_ident, blob->blb_buff_ident);

	set_sqlcode(action, column);
}


//____________________________________________________________
//  
//		Generate BLR in raw, numeric form.  Ugly but dense.
//  

static void gen_raw(
			   const UCHAR* blr,
			   enum req_t request_type, const int request_length, int column)
{
	TEXT buffer[80];

	TEXT* p = buffer;
	const TEXT* const limit = buffer + 60;

	for (const UCHAR* const end = blr + request_length - 1; blr <= end; ++blr) 
	{
		const UCHAR c = *blr;
		sprintf(p, "%d", c);
		while (*p)
			p++;
		if (blr != end)
			*p++ = ',';
		if (p < limit)
			continue;
		*p = 0;
		printa(INDENT, buffer);
		p = buffer;
	}

	*p = 0;
	printa(INDENT, buffer);
}


//____________________________________________________________
//  
//		Generate substitution text for READY
//  

static void gen_ready( const act* action, int column)
{
	const TEXT* vector = status_vector(action);

	for (rdy* ready = (rdy*) action->act_object; ready; ready = ready->rdy_next) {
		const dbb* db = ready->rdy_database;
		const TEXT* filename = ready->rdy_filename;
		if (!filename)
			filename = db->dbb_runtime;
		if ((action->act_error || (action->act_flags & ACT_sql)) &&
			ready != (rdy*) action->act_object)
		{
			printa(column, "if isc_status(1) = 0 then");
		}
		make_ready(db, filename, vector, column, ready->rdy_request);
		if ((action->act_error || (action->act_flags & ACT_sql)) &&
			ready != (rdy*) action->act_object)
		{
			endif(column);
		}
	}
	set_sqlcode(action, column);
}


//____________________________________________________________
//  
//		Generate receive call for a port.
//  

static void gen_receive( const act* action, int column, gpre_port* port)
{
	const gpre_req* request = action->act_request;
	printa(column, "interbase.RECEIVE (%s %s, %d, %d, isc_%d'address, %s);",
		   status_vector(action),
		   request->req_handle,
		   port->por_msg_number,
		   port->por_length, port->por_ident, request->req_request_level);

	set_sqlcode(action, column);
}


//____________________________________________________________
//  
//		Generate substitution text for RELEASE_REQUESTS
//       For active databases, call isc_release_request.
//       for all others, just zero the handle.  For the
//       release request calls, ignore error returns, which
//       are likely if the request was compiled on a database
//       which has been released and re-readied.  If there is
//       a serious error, it will be caught on the next statement.
//  

static void gen_release( const act* action, int column)
{
	const dbb* exp_db = (DBB) action->act_object;

	for (const gpre_req* request = requests; request; request = request->req_next) {
		const dbb* db = request->req_database;
		if (exp_db && db != exp_db)
			continue;
		if (!(request->req_flags & REQ_exp_hand)) {
			printa(column, "if %s%s /= 0 then", ada_package,
				   db->dbb_name->sym_string);
			printa(column + INDENT,
				   "interbase.release_request (isc_status, %s);",
				   request->req_handle);
			endif(column);
			printa(column, "%s := 0;", request->req_handle);
		}
	}
}


//____________________________________________________________
//  
//		Generate definitions associated with a single request.
//  

static void gen_request( gpre_req* request, int column)
{
//  generate request handle, blob handles, and ports 

	if (!(request->req_flags &
		  (REQ_exp_hand  | REQ_sql_blob_open | REQ_sql_blob_create)) &&
		request->req_type != REQ_slice && request->req_type != REQ_procedure) 
	{
		printa(column, "%s\t: interbase.request_handle := 0;-- request handle --",
			   request->req_handle);
	}

	if (request->req_flags & (REQ_sql_blob_open | REQ_sql_blob_create))
		printa(column, "isc_%do\t: %s;\t\t-- SQL CURSOR FLAG --",
			   request->req_ident, SHORT_DCL);

//  check the case where we need to extend the dpb dynamically at runtime,
//  in which case we need dpb length and a pointer to be defined even if 
//  there is no static dpb defined 

	if (request->req_flags & REQ_extend_dpb) {
		printa(column,
			   "isc_%dp\t: interbase.dpb_ptr := 0;\t-- db parameter block --",
			   request->req_ident);
		if (!request->req_length)
			printa(column,
				   "isc_%dl\t: interbase.isc_ushort := 0;\t-- db parameter block --",
				   request->req_ident);
	}

//  generate actual BLR string 

	if (request->req_length) {
		const SSHORT length = request->req_length;
		switch (request->req_type) {
		case REQ_create_database:
			if (ada_flags & ADA_create_database) {
				printa(column,
					   "function isc_to_dpb_ptr is new unchecked_conversion (system.address, interbase.dpb_ptr);");
				ada_flags &= ~ADA_create_database;
			}
			// fall into ... 
		case REQ_ready:
			printa(column,
				   "isc_%dl\t: interbase.isc_ushort := %d;\t-- db parameter block --",
				   request->req_ident, length);
			printa(column, "isc_%d\t: CONSTANT interbase.dpb (1..%d) := (",
				   request->req_ident, length);
			break;

		default:
			if (request->req_flags & REQ_sql_cursor)
				printa(column, "isc_%do\t: %s;\t\t-- SQL CURSOR FLAG --",
					   request->req_ident, SHORT_DCL);
#ifdef SCROLLABLE_CURSORS
			if (request->req_flags & REQ_scroll)
				printa(column,
					   "isc_%ddirection\t: interbase.isc_ushort := 0;\t-- last direction sent to engine --",
					   request->req_ident);
#endif
			printa(column, "isc_%d\t: CONSTANT interbase.blr (1..%d) := (",
				   request->req_ident, length);
		}
		gen_raw(request->req_blr, request->req_type, request->req_length,
				column);
		printa(column, ");\n");
		const TEXT* string_type;
		if (!sw_raw) {
			printa(column, "---");
			printa(column, "--- FORMATTED REQUEST BLR FOR GDS_%d = \n",
				   request->req_ident);

			switch (request->req_type) {
			case REQ_create_database:
			case REQ_ready:
				string_type = "DPB";
				if (PRETTY_print_cdb(request->req_blr,
									 gen_blr, 0, 0))
					CPR_error("internal error during parameter generation");
				break;

			case REQ_ddl:
				string_type = "DYN";
				if (PRETTY_print_dyn(request->req_blr,
									 gen_blr, 0, 0))
					CPR_error("internal error during dynamic DDL generation");
				break;
			case REQ_slice:
				string_type = "SDL";
				if (PRETTY_print_sdl(request->req_blr,
									 gen_blr, 0, 0))
					CPR_error("internal error during SDL generation");
				break;

			default:
				string_type = "BLR";
				if (gds__print_blr(request->req_blr,
								   gen_blr, 0, 0))
					CPR_error("internal error during BLR generation");
			}
		}
		else {
			switch (request->req_type) {
			case REQ_create_database:
			case REQ_ready:
				string_type = "DPB";
				break;
			case REQ_ddl:
				string_type = "DYN";
				break;
			case REQ_slice:
				string_type = "SDL";
				break;

			default:
				string_type = "BLR";
			}
		}
		printa(column, "\t-- end of %s string for request isc_%d --\n",
			   string_type, request->req_ident, request->req_length);
	}

//   Print out slice description language if there are arrays associated with request  
	for (const gpre_port* port = request->req_ports; port; port = port->por_next)
		for (const ref* reference = port->por_references; reference;
			 reference = reference->ref_next)
		{
			if (reference->ref_sdl) {
				printa(column,
					   "isc_%d\t: CONSTANT interbase.blr (1..%d) := (",
					   reference->ref_sdl_ident, reference->ref_sdl_length);
				gen_raw(reference->ref_sdl, REQ_slice,
						reference->ref_sdl_length, column);
				printa(column, "); \t--- end of SDL string for isc_%d\n",
					   reference->ref_sdl_ident);
				if (!sw_raw) {
					printa(column, "---");
					printa(column,
						   "--- FORMATTED REQUEST SDL FOR GDS_%d = \n",
						   reference->ref_sdl_ident);
					if (PRETTY_print_sdl(reference->ref_sdl,
										 gen_blr, 0, 1))
						CPR_error("internal error during SDL generation");
				}
			}
		}

//  Print out any blob parameter blocks required 

	for (const blb* blob = request->req_blobs; blob; blob = blob->blb_next)
		if (blob->blb_bpb_length) {
			printa(column, "isc_%d\t: CONSTANT interbase.blr (1..%d) := (",
				   blob->blb_bpb_ident, blob->blb_bpb_length);
			gen_raw(blob->blb_bpb, request->req_type, blob->blb_bpb_length,
					column);
			printa(INDENT, ");\n");
		}

//  If this is a GET_SLICE/PUT_slice, allocate some variables 

	if (request->req_type == REQ_slice) {
		printa(INDENT, "isc_%ds\t: %s;\t\t", request->req_ident, LONG_DCL);
		printa(INDENT, "isc_%dv: %s (1..%d);", request->req_ident,
			   LONG_VECTOR_DCL, MAX(request->req_slice->slc_parameters, 1));
	}
}


//____________________________________________________________
//  
//		Generate receive call for a port
//		in a store2 statement.
//  

static void gen_return_value( const act* action, int column)
{
	gpre_req* request = action->act_request;
	if (action->act_pair->act_error)
		column += INDENT;
	align(column);

	gen_start(action, request->req_primary, column);
	upd* update = (upd*) action->act_object;
	REF reference = update->upd_references;
	gen_receive(action, column, reference->ref_port);
}


//____________________________________________________________
//  
//		Process routine head.  If there are requests in the
//		routine, insert local definitions.
//  

static void gen_routine( const act* action, int column)
{
	column += INDENT;

	for (gpre_req* request = (gpre_req*) action->act_object; request;
		 request = request->req_routine) 
	{
		gpre_port* port;
		for (port = request->req_ports; port; port = port->por_next)
			make_port(port, column);
		for (port = request->req_ports; port; port = port->por_next)
			printa(column, "isc_%d\t: isc_%dt;\t\t\t-- message --",
				   port->por_ident, port->por_ident);

		for (const blb* blob = request->req_blobs; blob; blob = blob->blb_next) {
			printa(column,
				   "isc_%d\t: interbase.blob_handle;\t-- blob handle --",
				   blob->blb_ident);
			SSHORT blob_subtype = blob->blb_const_to_type;
			if (!(blob_subtype)) {
				const ref* reference = blob->blb_reference;
				if (reference) {
					const gpre_fld* field = reference->ref_field;
					if (field)
						blob_subtype = field->fld_sub_type;
				}
			}
			if (blob_subtype != 0 && blob_subtype != 1)
				printa(column, "isc_%d\t: %s (1..%d);\t-- blob segment --",
					   blob->blb_buff_ident, BYTE_VECTOR_DCL,
					   blob->blb_seg_length);
			else
				printa(column,
					   "isc_%d\t: string (1..%d);\t-- blob segment --",
					   blob->blb_buff_ident, blob->blb_seg_length);
			printa(column, "isc_%d\t: %s;\t\t\t-- segment length --",
				   blob->blb_len_ident, USHORT_DCL);
		}
	}
	column -= INDENT;
}


//____________________________________________________________
//  
//		Generate substitution text for END_STREAM.
//  

static void gen_s_end( const act* action, int column)
{
	gpre_req* request = action->act_request;

	if (action->act_type == ACT_close) {
		make_cursor_open_test(ACT_close, request, column);
		column += INDENT;
	}

	printa(column, "interbase.UNWIND_REQUEST (%s %s, %s);",
		   status_vector(action),
		   request->req_handle, request->req_request_level);

	set_sqlcode(action, column);

	if (action->act_type == ACT_close) {
		printa(column, "if (SQLCODE = 0) then");
		printa(column + INDENT, "isc_%do := 0;", request->req_ident);
		endif(column);
		column -= INDENT;
		endif(column);
	}
}


//____________________________________________________________
//  
//		Generate substitution text for FETCH.
//  

static void gen_s_fetch( const act* action, int column)
{
	gpre_req* request = action->act_request;
	if (request->req_sync)
		gen_send(action, request->req_sync, column);

	gen_receive(action, column, request->req_primary);
}


//____________________________________________________________
//  
//		Generate text to compile and start a stream.  This is
//		used both by START_STREAM and FOR
//  

static void gen_s_start( const act* action, int column)
{
	gpre_req* request = action->act_request;

	if ((action->act_type == ACT_open)) {
		make_cursor_open_test(ACT_open, request, column);
		column += INDENT;
	}

	gen_compile(action, column);

	gpre_port* port = request->req_vport;
	if (port)
		asgn_from(action, port->por_references, column);

	if (action->act_error || (action->act_flags & ACT_sql)) {
		make_ok_test(action, request, column);
		gen_start(action, port, column + INDENT);
		endif(column);
	}
	else
		gen_start(action, port, column);

	if (action->act_type == ACT_open) {
		printa(column, "if (SQLCODE = 0) then");
		printa(column + INDENT, "isc_%do := 1;", request->req_ident);
		endif(column);
		column -= INDENT;
		endif(column);
	}
}


//____________________________________________________________
//  
//		Substitute for a segment, segment length, or blob handle.
//  

static void gen_segment( const act* action, int column)
{
	const blb* blob = (blb*) action->act_object;

	printa(column, "isc_%d",
		   (action->act_type == ACT_segment) ? blob->blb_buff_ident :
		   (action->act_type == ACT_segment_length) ? blob->blb_len_ident :
		   blob->blb_ident);
}


//____________________________________________________________
//  
//		Generate code for standalone SELECT statement.
//  

static void gen_select( const act* action, int column)
{
	gpre_req* request = action->act_request;
	gpre_port* port = request->req_primary;
	TEXT name[20];
	gen_name(name, request->req_eof, true);

	gen_s_start(action, column);
	gen_receive(action, column, port);
	printa(column, "if SQLCODE = 0 then", name);
	column += INDENT;
	printa(column, "if %s /= 0 then", name);
	column += INDENT;

	GPRE_NOD var_list = (GPRE_NOD) action->act_object;
	if (var_list) {
		for (int i = 0; i < var_list->nod_count; i++)
			asgn_to(action, (REF) var_list->nod_arg[i], column);
	}
	if (request->req_database->dbb_flags & DBB_v3) {
		gen_receive(action, column, port);
		printa(column, "if (SQLCODE = 0) AND (%s /= 0) then", name);
		printa(column + INDENT, "SQLCODE := -1;");
		endif(column);
	}

	printa(column - INDENT, "else");
	printa(column, "SQLCODE := 100;");
	column -= INDENT;
	endif(column);
	column -= INDENT;
	endif(column);
}


//____________________________________________________________
//  
//		Generate a send or receive call for a port.
//  

static void gen_send( const act* action, gpre_port* port, int column)
{
	const gpre_req* request = action->act_request;
	printa(column, "interbase.SEND (%s %s, %d, %d, isc_%d'address, %s);",
		   status_vector(action),
		   request->req_handle,
		   port->por_msg_number,
		   port->por_length, port->por_ident, request->req_request_level);

	set_sqlcode(action, column);
}


//____________________________________________________________
//  
//		Generate support for get/put slice statement.
//  

static void gen_slice( const act* action, int column)
{
	const TEXT* pattern1 =
		"interbase.GET_SLICE (%V1 %RF%DH%RE, %RF%RT%RE, %RF%FR%RE, %N1, \
%I1, %N2, %I1v, %I1s, %RF%S5'address%RE, %RF%S6%RE);";
	const TEXT* pattern2 =
		"interbase.PUT_SLICE (%V1 %RF%DH%RE, %RF%RT%RE, %RF%FR%RE, %N1, \
%I1, %N2, %I1v, %I1s, %RF%S5'address%RE);";

	gpre_req* request = action->act_request;
	slc* slice = (slc*) action->act_object;
	gpre_req* parent_request = slice->slc_parent_request;

//  Compute array size 

	printa(column, "isc_%ds := %d", request->req_ident,
		   slice->slc_field->fld_array->fld_length);

	slc::slc_repeat* tail = slice->slc_rpt;
	for (const slc::slc_repeat* const end = tail + slice->slc_dimensions;
		 tail < end; ++tail)
	{
		if (tail->slc_upper != tail->slc_lower) {
			const ref* lower = (REF) tail->slc_lower->nod_arg[0];
			const ref* upper = (REF) tail->slc_upper->nod_arg[0];
			if (lower->ref_value)
				ib_fprintf(out_file, " * ( %s - %s + 1)", upper->ref_value,
						   lower->ref_value);
			else
				ib_fprintf(out_file, " * ( %s + 1)", upper->ref_value);
		}
	}

	ib_fprintf(out_file, ";");

//  Make assignments to variable vector 

	REF reference;
	for (reference = request->req_values; reference;
		 reference = reference->ref_next)
	{
		printa(column, "isc_%dv (%d) := %s;", request->req_ident, 
			reference->ref_id + 1, reference->ref_value);
	}

	PAT args;
	args.pat_reference = slice->slc_field_ref;
	args.pat_request = parent_request;	// blob id request 
	args.pat_vector1 = status_vector(action);	// status vector 
	args.pat_database = parent_request->req_database;	// database handle 
	args.pat_value1 = request->req_length;	// slice descr. length 
	args.pat_ident1 = request->req_ident;	// request name 
	args.pat_value2 = slice->slc_parameters * sizeof(SLONG);	// parameter length 

	reference = (REF) slice->slc_array->nod_arg[0];
	args.pat_string5 = reference->ref_value;	// array name 
	args.pat_string6 = "isc_array_length";

	PATTERN_expand(column,
				   (action->act_type == ACT_get_slice) ? pattern1 : pattern2,
				   &args);
}


//____________________________________________________________
//  
//		Generate either a START or START_AND_SEND depending
//		on whether or a not a port is present.
//  

static void gen_start( const act* action, gpre_port* port, int column)
{
	gpre_req* request = action->act_request;
	const TEXT* vector = status_vector(action);
	column += INDENT;

	if (port) {
		for (REF reference = port->por_references; reference;
			 reference = reference->ref_next)
		{
			if (reference->ref_field->fld_array_info)
					gen_get_or_put_slice(action, reference, false, column);
		}

		printa(column,
			   "interbase.START_AND_SEND (%s %s, %s%s, %d, %d, isc_%d'address, %s);",
			   vector, request->req_handle, ada_package, request_trans(action,
																	   request),
			   port->por_msg_number, port->por_length, port->por_ident,
			   request->req_request_level);
	}
	else
		printa(column, "interbase.START_REQUEST (%s %s, %s%s, %s);",
			   vector,
			   request->req_handle,
			   ada_package, request_trans(action, request),
			   request->req_request_level);

	set_sqlcode(action, column);
}


//____________________________________________________________
//  
//		Generate text for STORE statement.  This includes the compile
//		call and any variable initialization required.
//  

static void gen_store( const act* action, int column)
{
	TEXT name[64];

	gpre_req* request = action->act_request;
	gen_compile(action, column);
	if (action->act_error || (action->act_flags & ACT_sql))
		make_ok_test(action, request, column);

//  Initialize any blob fields 

	const gpre_port* port = request->req_primary;
	for (const ref* reference = port->por_references; reference;
		 reference = reference->ref_next) 
	{
		const gpre_fld* field = reference->ref_field;
		if (field->fld_flags & FLD_blob)
			printa(column, "%s := interbase.null_blob;",
				   gen_name(name, reference, true));
	}
}


//____________________________________________________________
//  
//		Generate substitution text for START_TRANSACTION.
//  

static void gen_t_start( const act* action, int column)
{
//  for automatically generated transactions, and transactions that are
//  explicitly started, but don't have any arguments so don't get a TPB,
//  generate something plausible. 

	const gpre_tra* trans;
	if (!action || !(trans = (gpre_tra*) action->act_object)) {
		t_start_auto(action, 0, status_vector(action), column, false);
		return;
	}

//  build a complete statement, including tpb's.
//  first generate any appropriate ready statements,
//  and fill in the tpb vector (aka TEB). 

	int count = 0;
	for (const tpb* tpb_iterator = trans->tra_tpb; tpb_iterator;
		 tpb_iterator = tpb_iterator->tpb_tra_next)
	{
		count++;
		const dbb* db = tpb_iterator->tpb_database;
		if (sw_auto) {
			const TEXT* filename = db->dbb_runtime;
			if (filename || !(db->dbb_flags & DBB_sqlca)) {
				printa(column, "if (%s%s = 0) then", ada_package,
					   db->dbb_name->sym_string);
				align(column + INDENT);
				make_ready(db, filename, status_vector(action),
						   column + INDENT, 0);
				endif(column);
			}
		}

		printa(column, "isc_teb(%d).tpb_len := %d;", count, tpb_iterator->tpb_length);
		printa(column, "isc_teb(%d).tpb_ptr := isc_tpb_%d'address;",
			   count, tpb_iterator->tpb_ident);
		printa(column, "isc_teb(%d).dbb_ptr := %s%s'address;",
			   count, ada_package, db->dbb_name->sym_string);
	}

	printa(column, "interbase.start_multiple (%s %s%s, %d, isc_teb'address);",
		   status_vector(action),
		   ada_package,
		   (trans->tra_handle) ? (SCHAR *) trans->tra_handle : "gds_trans",
		   trans->tra_db_count);

	set_sqlcode(action, column);
}


//____________________________________________________________
//  
//		Generate a TPB in the output file
//  

static void gen_tpb(const tpb* tpb_buffer, int column)
{
	printa(column, "isc_tpb_%d\t: CONSTANT interbase.tpb (1..%d) := (",
		   tpb_buffer->tpb_ident, tpb_buffer->tpb_length);

	int length = tpb_buffer->tpb_length;
	const TEXT* text = (TEXT*) tpb_buffer->tpb_string;
	TEXT buffer[80];
	TEXT* p = buffer;

	while (--length) {
		const TEXT c = *text++;
		sprintf(p, "%d, ", c);
		while (*p)
			p++;
		if (p - buffer > 60) {
			printa(column + INDENT, " %s", buffer);
			p = buffer;
			*p = 0;
		}
	}

//  handle the last character 

	const TEXT c = *text++;
	sprintf(p, "%d", c);
	printa(column + INDENT, "%s", buffer);
	printa(column, ");");
}


//____________________________________________________________
//  
//		Generate substitution text for COMMIT, ROLLBACK, PREPARE, and SAVE
//  

static void gen_trans( const act* action, int column)
{

	if (action->act_type == ACT_commit_retain_context)
		printa(column, "interbase.COMMIT_RETAINING (%s %s%s);",
			   status_vector(action),
			   ada_package,
			   (action->act_object) ? (TEXT *) action->
			   act_object : "gds_trans");
	else
		printa(column, "interbase.%s_TRANSACTION (%s %s%s);",
			   (action->act_type ==
				ACT_commit) ? "COMMIT" : (action->act_type ==
										  ACT_rollback) ? "ROLLBACK" :
			   "PREPARE", status_vector(action), ada_package,
			   (action->act_object) ? (TEXT *) action->
			   act_object : "gds_trans");

	set_sqlcode(action, column);
}



//____________________________________________________________
//  
//       Substitute for a variable reference.
//  

static void gen_type( const act* action, int column)
{

	printa(column, "%ld", action->act_object);
}



//____________________________________________________________
//  
//		Generate substitution text for UPDATE ... WHERE CURRENT OF ...
//  

static void gen_update( const act* action, int column)
{
	upd* modify = (upd*) action->act_object;
	gpre_port* port = modify->upd_port;
	asgn_from(action, port->por_references, column);
	gen_send(action, port, column);
}


//____________________________________________________________
//  
//		Substitute for a variable reference.
//  

static void gen_variable( const act* action, int column)
{
	TEXT s[20];

	printa(column, gen_name(s, (REF) action->act_object, false));
}


//____________________________________________________________
//  
//		Generate tests for any WHENEVER clauses that may have been declared.
//  

static void gen_whenever(const swe* label, int column)
{
	while (label) {
		const TEXT* condition;

		switch (label->swe_condition) {
		case SWE_error:
			condition = "SQLCODE < 0";
			break;

		case SWE_warning:
			condition = "(SQLCODE > 0) AND (SQLCODE /= 100)";
			break;

		case SWE_not_found:
			condition = "SQLCODE = 100";
			break;
		}
		printa(column, "if %s then goto %s; end if;", condition,
			   label->swe_label);
		label = label->swe_next;
	}
}


//____________________________________________________________
//  
//		Generate a declaration of an array in the
//       output file.
//  

static void make_array_declaration( REF reference, int column)
{
	gpre_fld* field = reference->ref_field;
	const TEXT* name = field->fld_symbol->sym_string;

//  Don't generate multiple declarations for the array.  V3 Bug 569.  

	if (field->fld_array_info->ary_declared)
		return;

	field->fld_array_info->ary_declared = true;

	if ((field->fld_array->fld_dtype <= dtype_varying)
		&& (field->fld_array->fld_length != 1)) 
	{
		if (field->fld_array->fld_sub_type == 1)
			ib_fprintf(out_file, "subtype isc_%d_byte is %s(1..%d);\n",
					   field->fld_array_info->ary_ident, BYTE_VECTOR_DCL,
					   field->fld_array->fld_length);
		else
			ib_fprintf(out_file, "subtype isc_%d_string is string(1..%d);\n",
					   field->fld_array_info->ary_ident,
					   field->fld_array->fld_length);
	}

	ib_fprintf(out_file, "type isc_%dt is array (",
			   field->fld_array_info->ary_ident);

//   Print out the dimension part of the declaration  
	const dim* dimension = field->fld_array_info->ary_dimension;
	for (int i = 1;
		 i < field->fld_array_info->ary_dimension_count;
		 dimension = dimension->dim_next, ++i)
	{
		ib_fprintf(out_file, "%s range %"SLONGFORMAT"..%"SLONGFORMAT
				   ",\n                        ",
				   LONG_DCL, dimension->dim_lower, dimension->dim_upper);
	}

	ib_fprintf(out_file, "%s range %"SLONGFORMAT"..%"SLONGFORMAT") of ",
			   LONG_DCL, dimension->dim_lower, dimension->dim_upper);

	switch (field->fld_array_info->ary_dtype) {
	case dtype_short:
		ib_fprintf(out_file, "%s", SHORT_DCL);
		break;

	case dtype_long:
		ib_fprintf(out_file, "%s", LONG_DCL);
		break;

	case dtype_cstring:
	case dtype_text:
	case dtype_varying:
		if (field->fld_array->fld_length == 1) {
			if (field->fld_array->fld_sub_type == 1)
				ib_fprintf(out_file, BYTE_DCL);
			else
				ib_fprintf(out_file, "interbase.isc_character");
		}
		else {
			if (field->fld_array->fld_sub_type == 1)
				ib_fprintf(out_file, "isc_%d_byte",
						   field->fld_array_info->ary_ident);
			else
				ib_fprintf(out_file, "isc_%d_string",
						   field->fld_array_info->ary_ident);
		}
		break;

	case dtype_date:
	case dtype_quad:
		ib_fprintf(out_file, "interbase.quad");
		break;

	case dtype_real:
		ib_fprintf(out_file, "%s", REAL_DCL);
		break;

	case dtype_double:
		ib_fprintf(out_file, "%s", DOUBLE_DCL);
		break;

	default:
		printa(column, "datatype %d unknown for field %s",
			   field->fld_array_info->ary_dtype, name);
		return;
	}

	ib_fprintf(out_file, ";\n");

//   Print out the database field  

	ib_fprintf(out_file, "isc_%d : isc_%dt;\t--- %s\n\n",
			   field->fld_array_info->ary_ident,
			   field->fld_array_info->ary_ident, name);
}


//____________________________________________________________
//  
//     Generate code to test existence 
//     of open cursor and do the right thing:
//     if type == ACT_open && isc_nl, error
//     if type == ACT_close && !isc_nl, error
//  

static void make_cursor_open_test( enum act_t type, gpre_req* request, int column)
{
	if (type == ACT_open) {
		printa(column, "if (isc_%do = 1) then", request->req_ident);
		printa(column + INDENT, "SQLCODE := -502;");
	}
	else if (type == ACT_close) {
		printa(column, "if (isc_%do = 0) then", request->req_ident);
		printa(column + INDENT, "SQLCODE := -501;");
	}

	printa(column, "else");
}


//____________________________________________________________
//  
//		Turn a symbol into a varying string.
//  

static TEXT* make_name(TEXT* string, gpre_sym* symbol)
{
	sprintf(string, "\"%s \"", symbol->sym_string);

	return string;
}


//____________________________________________________________
//  
//		Generate code to test existence of
//		compiled request with active transaction.
//  

static void make_ok_test( const act* action, gpre_req* request, int column)
{
	if (sw_auto)
		printa(column, "if (%s%s /= 0) and (%s /= 0) then",
			   ada_package, request_trans(action, request),
			   request->req_handle);
	else
		printa(column, "if (%s /= 0) then", request->req_handle);
}


//____________________________________________________________
//  
//		Insert a port record description in output.
//  

static void make_port( const gpre_port* port, int column)
{
	printa(column, "type isc_%dt is record", port->por_ident);

	const ref* reference;

	for (reference = port->por_references; reference;
		 reference = reference->ref_next) 
	{
		const gpre_fld* field = reference->ref_field;
		const TEXT* name;
		const gpre_sym* symbol = field->fld_symbol;
		if (symbol)
			name = symbol->sym_string;
		else
			name = "<expression>";
		if (reference->ref_value && (reference->ref_flags & REF_array_elem))
			field = field->fld_array;

		switch (field->fld_dtype) {
		case dtype_real:
			printa(column + INDENT, "isc_%d\t: %s;\t-- %s --",
				   reference->ref_ident, REAL_DCL, name);
			break;

		case dtype_double:
			printa(column + INDENT, "isc_%d\t: %s;\t-- %s --",
				   reference->ref_ident, DOUBLE_DCL, name);
			break;

		case dtype_short:
			printa(column + INDENT, "isc_%d\t: %s;\t-- %s --",
				   reference->ref_ident, SHORT_DCL, name);
			break;

		case dtype_long:
			printa(column + INDENT, "isc_%d\t: %s;\t-- %s --",
				   reference->ref_ident, LONG_DCL, name);
			break;

		case dtype_date:
		case dtype_quad:
		case dtype_blob:
			printa(column + INDENT, "isc_%d\t: interbase.quad;\t-- %s --",
				   reference->ref_ident, name);
			break;

		case dtype_text:
			if (strcmp(name, "isc_slack")) {
				if (field->fld_sub_type == 1) {
					if (field->fld_length == 1)
						printa(column + INDENT, "isc_%d\t: %s;\t-- %s --",
							   reference->ref_ident, BYTE_DCL, name);
					else
						printa(column + INDENT,
							   "isc_%d\t: %s (1..%d);\t-- %s --",
							   reference->ref_ident, BYTE_VECTOR_DCL,
							   field->fld_length, name);
				}
				else {
					if (field->fld_length == 1)
						printa(column + INDENT,
							   "isc_%d\t: interbase.isc_character;\t-- %s --",
							   reference->ref_ident, name);
					else
						printa(column + INDENT,
							   "isc_%d\t: string (1..%d);\t-- %s --",
							   reference->ref_ident, field->fld_length, name);
				}
			}
			break;

		default:
			{
				TEXT s[80];
				sprintf(s, "datatype %d unknown for field %s, msg %d",
					field->fld_dtype, name, port->por_msg_number);
				CPR_error(s);
				return;
			}
		}
	}

	printa(column, "end record;");

	printa(column, "for isc_%dt use record at mod 4;", port->por_ident);

	int pos = 0;
	for (reference = port->por_references; reference;
		 reference = reference->ref_next) 
	{
		const gpre_fld* field = reference->ref_field;
		if (reference->ref_value && field->fld_array_info)
			field = field->fld_array;
		printa(column + INDENT, "isc_%d at %d range 0..%d;",
			   reference->ref_ident, pos, 8 * field->fld_length - 1);
		pos += field->fld_length;
	}

	printa(column, "end record;");
}


//____________________________________________________________
//  
//		Generate the actual insertion text for a
//       ready;
//  

static void make_ready(const dbb* db,
					   const TEXT* filename,
					   const TEXT* vector,
					   USHORT column,
					   gpre_req* request)
{
	TEXT s1[32], s2[32];

	if (request) {
		sprintf(s1, "isc_%dl", request->req_ident);
		sprintf(s2, "isc_%d", request->req_ident);

		/* if the dpb needs to be extended at runtime to include items
		   in host variables, do so here; this assumes that there is 
		   always a request generated for runtime variables */

		if (request->req_flags & REQ_extend_dpb) {
			sprintf(s2, "isc_%dp", request->req_ident);
			if (request->req_length)
				printa(column, "%s = isc_%d;", s2, request->req_ident);
			if (db->dbb_r_user)
				printa(column,
					   "interbase.MODIFY_DPB (%s, %s, interbase.isc_dpb_user_name, %s, %d);\n",
					   s2, s1, db->dbb_r_user, (strlen(db->dbb_r_user) - 2));
			if (db->dbb_r_password)
				printa(column,
					   "interbase.MODIFY_DPB (%s, %s, interbase.isc_dpb_password, %s, %d);\n",
					   s2, s1, db->dbb_r_password,
					   (strlen(db->dbb_r_password) - 2));
			/*
			   ** ===========================================================
			   ** ==
			   ** ==   Process Role Name
			   ** ==
			   ** ===========================================================
			 */
			if (db->dbb_r_sql_role)
				printa(column,
					   "interbase.MODIFY_DPB (%s, %s, interbase.isc_dpb_sql_role_name, %s, %d);\n",
					   s2, s1, db->dbb_r_sql_role,
					   (strlen(db->dbb_r_sql_role) - 2));

			if (db->dbb_r_lc_messages)
				printa(column,
					   "interbase.MODIFY_DPB (%s, %s, interbase.isc_dpb_lc_messages, %s, %d);\n",
					   s2, s1, db->dbb_r_lc_messages,
					   (strlen(db->dbb_r_lc_messages) - 2));
			if (db->dbb_r_lc_ctype)
				printa(column,
					   "interbase.MODIFY_DPB (%s, %s, interbase.isc_dpb_lc_ctype, %s, %d);\n",
					   s2, s1, db->dbb_r_lc_ctype,
					   (strlen(db->dbb_r_lc_ctype) - 2));
		}
	}

	if (filename)
		if (*filename == '"')
			printa(column,
				   "interbase.ATTACH_DATABASE (%s %d, %s, %s%s, %s, %s);",
				   vector, strlen(filename) - 2, filename, ada_package,
				   db->dbb_name->sym_string, (request ? s1 : "0"),
				   (request ? s2 : "interbase.null_dpb"));
		else
			printa(column,
				   "interbase.ATTACH_DATABASE (%s %s'length(1), %s, %s%s, %s, %s);",
				   vector, filename, filename, ada_package,
				   db->dbb_name->sym_string, (request ? s1 : "0"),
				   (request ? s2 : "interbase.null_dpb"));
	else
		printa(column,
			   "interbase.ATTACH_DATABASE (%s %d, \"%s\", %s%s, %s, %s);",
			   vector, strlen(db->dbb_filename), db->dbb_filename,
			   ada_package, db->dbb_name->sym_string, (request ? s1 : "0"),
			   (request ? s2 : "interbase.null_dpb"));

	if (request && request->req_flags & REQ_extend_dpb) {
		if (request->req_length)
			printa(column, "if (%s != isc_%d)", s2, request->req_ident);
		printa(column + (request->req_length ? 4 : 0),
			   "interbase.FREE (%s);", s2);

		// reset the length of the dpb 
		if (request->req_length)
			printa(column, "%s = %d;", s1, request->req_length);
	}
}


//____________________________________________________________
//  
//		Print a fixed string at a particular column.
//  

static void printa( int column, const TEXT* string, ...)
{
	va_list ptr;

	VA_START(ptr, string);
	align(column);
	vsprintf(output_buffer, string, ptr);
	ADA_print_buffer(output_buffer, column);
}


//____________________________________________________________
//  
//		Generate the appropriate transaction handle.
//  

static const TEXT* request_trans( const act* action, const gpre_req* request)
{
	if (action->act_type == ACT_open) {
		const TEXT* trname = ((open_cursor*) action->act_object)->opn_trans;
		if (!trname)
			trname = "gds_trans";
		return trname;
	}
	else
		return (request) ? request->req_trans : (TEXT*) "gds_trans";
}


//____________________________________________________________
//  
//		Generate the appropriate status vector parameter for a gds
//		call depending on where or not the action has an error clause.
//  

static const TEXT* status_vector( const act* action)
{
	if (action && (action->act_error || (action->act_flags & ACT_sql)))
		return "isc_status,";

	return "";
}


//____________________________________________________________
//  
//		Generate substitution text for START_TRANSACTION.
//  

static void t_start_auto(const act* action,
						 const gpre_req* request,
						 const TEXT* vector,
						 int column,
						 bool test)
{
	const TEXT* trname = request_trans(action, request);
	const int stat = !strcmp(vector, "isc_status");

	begin(column);

	if (sw_auto) {
		TEXT buffer[256], temp[40];
		buffer[0] = 0;
		for (const dbb* db = isc_databases; db; db = db->dbb_next) {
			const TEXT* filename = db->dbb_runtime;
			if (filename || !(db->dbb_flags & DBB_sqlca)) {
				align(column);
				ib_fprintf(out_file, "if (%s%s = 0", ada_package,
						   db->dbb_name->sym_string);
				if (stat && buffer[0])
					ib_fprintf(out_file, "and %s(1) = 0", vector);
				ib_fprintf(out_file, ") then");
				make_ready(db, filename, vector, column + INDENT, 0);
				endif(column);
				if (buffer[0])
					strcat(buffer, ") and (");
				sprintf(temp, "%s%s /= 0", ada_package,
						db->dbb_name->sym_string);
				strcat(buffer, temp);
			}
		}
		if (!buffer[0])
			strcpy(buffer, "True");
		if (test)
			printa(column, "if (%s) and (%s%s = 0) then", buffer, ada_package,
				   trname);
		else
			printa(column, "if (%s) then", buffer);
		column += INDENT;
	}

	int count = 0;
	for (const dbb* db = isc_databases; db; db = db->dbb_next) {
		count++;
		printa(column, "isc_teb(%d).tpb_len:= 0;", count);
		printa(column, "isc_teb(%d).tpb_ptr := interbase.null_tpb'address;",
			   count);
		printa(column, "isc_teb(%d).dbb_ptr := %s%s'address;", count,
			   ada_package, db->dbb_name->sym_string);
	}

	printa(column, "interbase.start_multiple (%s %s%s, %d, isc_teb'address);",
		   vector, ada_package, trname, count);

	if (sw_auto) {
		endif(column);
		column -= INDENT;
	}

	endp(column);
}