mercury/runtime/io_rt.mod

/*
** Copyright (C) 1995 University of Melbourne.
** This file may only be copied under the terms of the GNU Library General
** Public License - see the file COPYING.LIB in the Mercury distribution.
*/

/*
**  File: code/io_rt.mod.
**  Main author: fjh.
** 
**  This file implements parts of the Mercury standard library
**  modules `io', `require', `std_util', `int', and `string'.
*/

#include "imp.h"
#include "io_rt.h"
#include "wrapper.h"
#include "type_info.h"

#include <string.h>

/*
** Mercury files are not quite the same as C stdio FILEs,
** because we keep track of a little bit more information.
*/

typedef struct {
	FILE *file;
	int line_number;
} MercuryFile;

MercuryFile mercury_stdin = { NULL, 0 };
MercuryFile mercury_stdout = { NULL, 0 };
MercuryFile mercury_stderr = { NULL, 0 };
MercuryFile *mercury_current_input = &mercury_stdin;
MercuryFile *mercury_current_output = &mercury_stdout;

#define initial_external_state()	0	/* some random number */
#define update_io(r_src, r_dest)	((r_dest) = (r_src))
#define final_io_state(r)		((void)0)

#define COMPARE_EQUAL 0
#define COMPARE_LESS 1
#define COMPARE_GREATER 2

void
mercury_init_io(void)
{
	mercury_stdin.file = stdin;
	mercury_stdout.file = stdout;
	mercury_stderr.file = stderr;
}

static MercuryFile*
mercury_open(const char *filename, const char *type)
{
	MercuryFile *mf;
	FILE *f;
	
	f = fopen(filename, type);
	if (!f) return NULL;
	mf = make(MercuryFile);
	mf->file = f;
	mf->line_number = 1;
	return mf;
}

static void
mercury_print_string(MercuryFile* mf, const char *s)
{
	fprintf(mf->file, "%s", s);
	while (*s) {
		if (*s++ == '\n') {
			mf->line_number++;
		}
	}
}
	
static int
mercury_getc(MercuryFile* mf)
{
	int c = getc(mf->file);
	if (c == '\n') {
		mf->line_number++;
	}
	return c;
}

static void
mercury_close(MercuryFile* mf)
{
	assert(mf != &mercury_stdin);
	assert(mf != &mercury_stdout);
	assert(mf != &mercury_stderr);
	fclose(mf->file);
	oldmem(mf);
}


/* Compare two type_info structures, using an arbitrary ordering
   (based on the addresses of the unification predicates).
*/

static int
compare_type_info(Word type_info_1, Word type_info_2)
{
	int i, num_arg_types, comp;
	Word unify_pred_1, unify_pred_2;

	/* First compare the addresses of the unify preds in the type_infos */
	unify_pred_1 = field(mktag(0), type_info_1, OFFSET_FOR_UNIFY_PRED);
	unify_pred_2 = field(mktag(0), type_info_2, OFFSET_FOR_UNIFY_PRED);
	if (unify_pred_1 < unify_pred_2) {
		return COMPARE_LESS;
	}
	if (unify_pred_1 > unify_pred_2) {
		return COMPARE_GREATER;
	}
	/* If the addresses of the unify preds are equal, we don't need to
	   compare the arity of the types - they must be the same.
	   But we need to recursively compare the argument types, if any.
	*/
	num_arg_types = field(mktag(0), type_info_1, OFFSET_FOR_COUNT);
	for (i = 0; i < num_arg_types; i++) {
		Word arg_type_info_1 = field(mktag(0), type_info_1,
					OFFSET_FOR_ARG_TYPE_INFOS + i);
		Word arg_type_info_2 = field(mktag(0), type_info_2,
					OFFSET_FOR_ARG_TYPE_INFOS + i);
		comp = compare_type_info(arg_type_info_1, arg_type_info_2);
		if (comp != COMPARE_EQUAL) return comp;
	}
	return COMPARE_EQUAL;
}

Declare_entry(mercury__io__init_state_2_0);
Declare_entry(mercury__parser__read_term_3_0);
Declare_entry(mercury__main_2_0);
Declare_entry(mercury__unify_2_0);
Declare_entry(mercury__compare_3_0);
Declare_entry(mercury__index_3_0);
Declare_entry(mercury__term_to_type_2_0);
Declare_entry(mercury__type_to_term_2_0);

BEGIN_MODULE(io_module)
BEGIN_CODE

mercury__io__run_0_0:
        mkframe("mercury__io__run_0_0", 0, ENTRY(do_fail));
	r1 = initial_external_state();
	call(ENTRY(mercury__io__init_state_2_0),
		LABEL(mercury__io__run_0_0_i1),
		LABEL(mercury__io__run_0_0));
mercury__io__run_0_0_i1:
	r1 = r2;
	call(ENTRY(mercury__main_2_0),
		LABEL(mercury__io__run_0_0_i2),
		LABEL(mercury__io__run_0_0));
mercury__io__run_0_0_i2:
	final_io_state(r2);
	succeed();

/* input predicates */

mercury__io__read_char_code_4_0:
	r2 = mercury_getc((MercuryFile*)r1);
	update_io(r3, r4);
	proceed();

mercury__io__putback_char_4_0:
	if (r2 == '\n') {
		((MercuryFile*)r1)->line_number--;
	}
	/* XXX should work even if ungetc() fails */
	if (ungetc(r2, ((MercuryFile*)r1)->file) == EOF) {
		fatal_error("io__putback_char: ungetc failed");
	}
	update_io(r3, r4);
	proceed();

/* output predicates - with output to mercury_current_output */

mercury__io__write_string_3_0:
	mercury_print_string(mercury_current_output, (char *) r1);
	update_io(r2, r3);
	proceed();

mercury__io__write_char_3_0:
		/* Note!  We cast r1 to int, not to char.
		   This is very slightly more efficient, but
		   more importantly it avoids a gcc internal
		   error for gcc-2.7.0 on i386.
		*/
	fprintf(mercury_current_output->file, "%c", (int) r1);
	update_io(r2, r3);
	proceed();

mercury__io__write_int_3_0:
	fprintf(mercury_current_output->file, "%ld", (long) (Integer) r1);
	update_io(r2, r3);
	proceed();

mercury__io__write_float_3_0:
	fprintf(mercury_current_output->file, "%f", word_to_float(r1));
	update_io(r2, r3);
	proceed();

mercury__io__flush_output_2_0:
	fflush(mercury_current_output->file);
	update_io(r1, r2);
	proceed();

/* output predicates - with output to the specified stream */

mercury__io__write_string_4_0:
	mercury_print_string((MercuryFile*)r1, (char *) r2);
	update_io(r3, r4);
	proceed();

mercury__io__write_char_4_0:
	fprintf(((MercuryFile*)r1)->file, "%c", (char) r2);
	update_io(r3, r4);
	proceed();

mercury__io__write_int_4_0:
	fprintf(((MercuryFile*)r1)->file, "%ld", (long) (Integer) r2);
	update_io(r3, r4);
	proceed();

mercury__io__write_float_4_0:
	fprintf(((MercuryFile*)r1)->file, "%f", word_to_float(r2));
	update_io(r3, r4);
	proceed();

mercury__io__flush_output_3_0:
	fflush(((MercuryFile*)r1)->file);
	update_io(r2, r3);
	proceed();

/* stream predicates */

mercury____Unify___io__stream_0_0:
	r1 = ((MercuryFile*) r2 == (MercuryFile *)r3);
	proceed();

mercury____Compare___io__stream_0_0:
	r1 = ((r2 < r3) ? COMPARE_LESS :
	      (r2 > r3) ? COMPARE_GREATER :
			  COMPARE_EQUAL);
	proceed();

mercury____Index___io__stream_0_0:
	r2 = -1;
	proceed();

mercury____Term_To_Type___io__stream_0_0:
	/* don't know what to put here. */
	fatal_error("cannot convert term to type io__stream");

mercury____Type_To_Term___io__stream_0_0:
	/* don't know what to put here. */
	fatal_error("cannot covert type io__stream to term");

mercury__io__stdin_stream_3_0:
	r1 = (Word) &mercury_stdin;
	update_io(r2, r3);
	proceed();

mercury__io__stdout_stream_3_0:
	r1 = (Word) &mercury_stdout;
	update_io(r2, r3);
	proceed();

mercury__io__stderr_stream_3_0:
	r1 = (Word) &mercury_stderr;
	update_io(r2, r3);
	proceed();

mercury__io__input_stream_3_0:
	r1 = (Word) mercury_current_input;
	update_io(r2, r3);
	proceed();

mercury__io__get_line_number_3_0:
	r1 = mercury_current_input->line_number;
	update_io(r2, r3);
	proceed();
	
mercury__io__get_line_number_4_0:
	r2 = ((MercuryFile*) r1)->line_number;
	update_io(r3, r4);
	proceed();
	
mercury__io__output_stream_3_0:
	r1 = (Word) mercury_current_output;
	update_io(r2, r3);
	proceed();

/*
:- pred io__set_input_stream(io__input_stream, io__input_stream,
                                io__state, io__state).
:- mode io__set_input_stream(in, out, di, uo) is det.
%       io__set_input_stream(NewStream, OldStream, IO0, IO1)
%               Changes the current input stream to the stream specified.
%               Returns the previous stream.
*/
mercury__io__set_input_stream_4_0:
	r2 = (Word) mercury_current_input;
	mercury_current_input = (MercuryFile*) r1;
	update_io(r3, r4);
	proceed();

mercury__io__set_output_stream_4_0:
	r2 = (Word) mercury_current_output;
	mercury_current_output = (MercuryFile*) r1;
	update_io(r3, r4);
	proceed();

/* stream open/close predicates */

/*
:- pred io__do_open_input(string, int, io__input_stream, io__state, io__state).
:- mode io__do_open_input(in, out, out, di, uo) is det.
%       io__do_open_input(File, ResultCode, Stream, IO0, IO1).
%               Attempts to open a file for input.
%               Result is 0 for success, -1 for failure.
*/
mercury__io__do_open_input_5_0:
	r3 = (Word) mercury_open((char *) r1, "r");
	r2 = (r3 ? 0 : -1);
	update_io(r4, r5);
	proceed();

/*
:- pred io__do_open_output(string, int, io__output_stream, io__state,
							io__state).
:- mode io__do_open_output(in, out, out, di, uo) is det.
%       io__do_open_output(File, ResultCode, Stream, IO0, IO1).
%               Attempts to open a file for output.
%               Result is 0 for success, -1 for failure.
*/
mercury__io__do_open_output_5_0:
	r3 = (Word) mercury_open((char *) r1, "w");
	r2 = (r3 ? 0 : -1);
	update_io(r4, r5);
	proceed();

/*
:- pred io__do_open_append(string, int, io__output_stream, io__state,
				io__state).
:- mode io__do_open_append(in, out, out, di, uo) is det.
%       io__do_open_append(File, ResultCode, Stream, IO0, IO1).
%               Attempts to open a file for appending.
%               Result is 0 for success, -1 for failure.
*/
mercury__io__do_open_append_5_0:
	r3 = (Word) mercury_open((char *) r1, "a");
	r2 = (r3 ? 0 : -1);
	update_io(r4, r5);
	proceed();

mercury__io__close_input_3_0:
	mercury_close((MercuryFile*)r1);
	update_io(r2, r3);
	proceed();

mercury__io__close_output_3_0:
	mercury_close((MercuryFile*)r1);
	update_io(r2, r3);
	proceed();

/* miscellaneous predicates */

mercury__io__progname_4_0:
	r2 = (progname ? (Word) progname : r1);
	update_io(r3, r4);
	proceed();

mercury__io__command_line_arguments_3_0:
	/* convert mercury_argv from a vector to a list */
	{ char **p = mercury_argv + mercury_argc;
	  r1 = list_empty();
	  while (--p >= mercury_argv) {
		r1 = list_cons((Word)*p, r1);
	  }
	}
	update_io(r2, r3);
	proceed();

mercury__io__get_exit_status_3_0:
	r1 = mercury_exit_status;
	update_io(r2, r3);
	proceed();

mercury__io__set_exit_status_3_0:
	mercury_exit_status = r1;
	update_io(r2, r3);
	proceed();

mercury__io__preallocate_heap_space_3_0:
	/* don't do anything - preallocate_heap_space was just a
	   hack for NU-Prolog */
	update_io(r2, r3);
	proceed();

mercury__io__call_system_code_4_0:
	r2 = system((char *)r1);
	update_io(r3, r4);
	proceed();

mercury____Unify___io__external_state_0_0:
mercury____Compare___io__external_state_0_0:
mercury____Index___io__external_state_0_0:
mercury____Term_To_Type___io__external_state_0_0:
mercury____Type_To_Term___io__external_state_0_0:
	/* the unique mode system should prevent these */
	fatal_error("cannot unify/compare/index/term_to_type/type_to_term io__external_state");

/*---------------------------------------------------------------------------*/

/* copy/2, from mercury_builtin.m
	:- pred copy(T, T).
	:- mode copy(ui, uo) is det.
	:- mode copy(in, uo) is det.
*/

mercury__copy_2_0:
mercury__copy_2_1:
	r3 = r2;
	proceed();

/*---------------------------------------------------------------------------*/

/* error/1, from require.m */

mercury__error_1_0:
	fflush(stdout);
	fprintf(stderr, "Software error: %s\n", (char *) r1);
	exit(1);
#ifndef	USE_GCC_NONLOCAL_GOTOS
	return 0;	/* suppress some dumb warnings */
#endif

/*---------------------------------------------------------------------------*/

/* io__getenv and io__putenv, from io.m */

mercury__io__getenv_2_0:
	r3 = (Word)getenv((char *)r2);
	if (!r3)
	    r1 = FALSE;
	else
	    r1 = TRUE;
	proceed();

mercury__io__putenv_1_0:
	if (!putenv((char *)r2))
	    r1 = TRUE;
	else
	    r1 = FALSE;
	proceed();

/*---------------------------------------------------------------------------*/

/* report_stats/0 and type_to_univ/2, from std_util.m */

mercury__report_stats_0_0:
	fprintf(mercury_current_output->file, 
		"[Heap: %.3fk, D Stack: %.3fk, ND Stack: %.3fk]\n",
		((char *)hp - (char *)heapmin) / 1000.0,
		((char *)sp - (char *)detstackmin) / 1000.0,
		((char *)maxfr - (char *)nondstackmin) / 1000.0
	);
	proceed();


/*
	`univ' is represented as a two word structure.
	The first word contains the address of a type_info for the type.
	The second word contains the data.
*/
#define UNIV_OFFSET_FOR_TYPEINFO 0
#define UNIV_OFFSET_FOR_DATA 1

/*
	:- pred type_to_univ(T, univ).
	:- mode type_to_univ(di, uo) is det.
	:- mode type_to_univ(in, out) is det.
	:- mode type_to_univ(out, in) is semidet.
*/
mercury__type_to_univ_2_0:
mercury__type_to_univ_2_1:
	/*
	 *  Forward mode - convert from type to univ.
	 *  On entry r1 contains type_info for type T,
	 *  and r2 contains the input argument of type T.
	 *  On exit r3 contains the output argument of type univ.
	 */
	incr_hp(r3, 2); /* allocate heap space */
	field(mktag(0), r3, UNIV_OFFSET_FOR_TYPEINFO) = r1;
		/* set the first field to contain the address of the
		   type_info for this type */
	field(mktag(0), r3, UNIV_OFFSET_FOR_DATA) = r2;
		/* store the input argument in the second field */
	proceed();

mercury__type_to_univ_2_2:
	/*
	 *  Backward mode - convert from univ to type.
	 *  On entry r2 contains type_info for type T,
	 *  and r4 contains the input argument of type univ.
	 *  On successful exit r3 contains the output argument of type T;
	 *  r1 is for the success/failure indication.
	 *
	 *  We check that type_infos compare equal.
	 */
	r1 = field(mktag(0), r4, UNIV_OFFSET_FOR_TYPEINFO);
	if (compare_type_info(r1, r2) != COMPARE_EQUAL)
	{
		r1 = FALSE;
		proceed();
	}
	r3 = field(mktag(0), r4, UNIV_OFFSET_FOR_DATA);
	r1 = TRUE;
	proceed();

mercury____Unify___univ_0_0:
	/*
	 * Unification for univ.
	 * On entry, r2 & r3 contain the `univ' values to be unified.
	 * On exit, r1 will contain the success/failure indication.
	 */

	/*
	 * First check the type_infos compare equal
	 */
	r1 = field(mktag(0), r2, UNIV_OFFSET_FOR_TYPEINFO);
	r4 = field(mktag(0), r3, UNIV_OFFSET_FOR_TYPEINFO);
	if (compare_type_info(r1, r4) != COMPARE_EQUAL)
	{
		r1 = FALSE;
		proceed();
	}

	/*
	 * Then invoke the generic unification predicate on the
	 * unwrapped args
	 */
	r4 = field(mktag(0), r3, UNIV_OFFSET_FOR_DATA);
	r3 = field(mktag(0), r2, UNIV_OFFSET_FOR_DATA);
	r2 = r1;
	tailcall(ENTRY(mercury__unify_2_0), LABEL(mercury____Unify___univ_0_0));

mercury____Compare___univ_0_0:
	/* Comparison for univ:
	 * On entry, r2 & r3 contain the `univ' values to be unified.
	 * On exit, r1 will contain the result of the comparison.
	 */

	/*
	** First compare the types
	*/
	r1 = field(mktag(0), r2, UNIV_OFFSET_FOR_TYPEINFO);
	r4 = field(mktag(0), r3, UNIV_OFFSET_FOR_TYPEINFO);
	r1 = compare_type_info(r1, r4);
	if (r1 != COMPARE_EQUAL) {
		proceed();
	}
	/*
	** If the types are the same, then invoke the generic compare/3
	** predicate on the unwrapped args.
	*/
	r1 = r4; /* set up the type_info */
	r4 = field(mktag(0), r3, UNIV_OFFSET_FOR_DATA);
	r3 = field(mktag(0), r2, UNIV_OFFSET_FOR_DATA);
	call(ENTRY(mercury__compare_3_0),
		LABEL(mercury____Compare___univ_0_0_i1),
		LABEL(mercury____Compare___univ_0_0));
mercury____Compare___univ_0_0_i1:
	/* shuffle the return value into the right register */
	r1 = r2;
	proceed();

mercury____Index___univ_0_0:
	r2 = -1;
	proceed();

mercury____Term_To_Type___univ_0_0:
	/* don't know what to put here. */
	fatal_error("cannot convert univ type to term");

mercury____Type_To_Term___univ_0_0:
	/* don't know what to put here. */
	fatal_error("cannot convert type univ to term");

/* semidet_succeed and semidet_fail, from std_util.m */

mercury__semidet_succeed_0_0:
	r1 = TRUE;
	proceed();
mercury__semidet_fail_0_0:
	r1 = FALSE;
	proceed();

/*---------------------------------------------------------------------------*/

/* from string.m */

mercury__string__float_to_string_2_0:
	{ char buf[100];
	  sprintf(buf, "%f", word_to_float(r1));
	  incr_hp_atomic(r2, (strlen(buf) + sizeof(Word)) / sizeof(Word));
	  strcpy((char *)r2, buf);
	}
	proceed();

mercury__string__to_float_2_0:
		/* mode string__to_float(in, out) is semidet */
	{ float tmp;
		/* use a temporary, since we can't take the address of a reg */
	  r1 = (sscanf((char *)r2, "%f", &tmp) == 1);
		/* r1 is TRUE if sscanf succeeds, FALSE otherwise */
	  r3 = float_to_word(tmp);
	}
	proceed();

mercury__string__to_int_list_2_0:
		/* mode (in, out) is det */
	{ char *p = (char*)r1 + strlen((char*)r1);
	  r2 = list_empty();
	  while (--p >= (char*)r1) {
		r2 = list_cons(*p, r2);
	  }
	}
	proceed();

/*-----------------------------------------------------------------------*/

mercury__string__to_int_list_2_1:
		/* mode (out, in) is det */
/*
** save int_list in r3;
*/
	r3 = r2;
/*
** loop to calculate list length + 4 in r4 using list in r2
*/
	r4 = sizeof(Word);
	GOTO_LABEL(mercury__string__to_int_list_2_1_i4);
mercury__string__to_int_list_2_1_i3:
	r2 = list_tail(r2);
	r4++;
mercury__string__to_int_list_2_1_i4:
	if (!list_is_empty(r2))
		GOTO_LABEL(mercury__string__to_int_list_2_1_i3);
/*
** allocate (length + 1) bytes of heap space for string
** i.e. (length + 4) / 4 words
*/
	incr_hp_atomic(r1, r4 / sizeof(Word));
/*
** loop to copy the characters from the int_list to the string
*/
	r4 = 0;
	GOTO_LABEL(mercury__string__to_int_list_2_1_i5);
mercury__string__to_int_list_2_1_i6:
	((char *) r1) [r4] = (char) list_head(r3);
	r4++;
	r3 = list_tail(r3);
mercury__string__to_int_list_2_1_i5:
	if (!list_is_empty(r3))
		GOTO_LABEL(mercury__string__to_int_list_2_1_i6);
/*
** null terminate the string and return
*/
	((char *) r1) [r4] = '\0';
	proceed();

/*-----------------------------------------------------------------------*/

mercury__string__to_int_list_2_2:
		/* mode (in, in) is semidet */
	incr_sp(2);
	detstackvar(1) = (Word) succip;
	detstackvar(2) = r2;
	r2 = r3;
	localcall(mercury__string__to_int_list_2_1,
		LABEL(mercury__string__to_int_list_2_2_i1),
		LABEL(mercury__string__to_int_list_2_2));
mercury__string__to_int_list_2_2_i1:
	r1 = string_equal(r1, detstackvar(2));
	LVALUE_CAST(Word,succip) = (Word) detstackvar(1);
	decr_sp(1);
	proceed();

/*-----------------------------------------------------------------------*/

mercury__builtin_strcmp_3_0:
	r1 = strcmp((char *)r2, (char *)r3);
	proceed();

/*-----------------------------------------------------------------------*/

/*
:- pred string__index(string, int, character).
:- mode string__index(in, in, out) is semidet.
*/
mercury__string__index_3_0:
	if ((Word) r3 >= strlen((char *) r2))
		GOTO_LABEL(mercury__string__index_3_0_i1);
	r1 = TRUE;
	r4 = ((char *)r2)[r3];
	proceed();
mercury__string__index_3_0_i1:
	r1 = FALSE;
	proceed();

/*-----------------------------------------------------------------------*/

/*
:- pred string__length(string, int).
:- mode string__length(in, out) is det.
*/

mercury__string__length_2_0:
	r2 = strlen((char *) r1);
	proceed();

/*-----------------------------------------------------------------------*/

/*
:- pred string__append(string, string, string).
:- mode string__append(in, in, out) is det.
:- mode string__append(in, in, in) is semidet.	% implied
:- mode string__append(in, out, in) is semidet.
:- mode string__append(out, out, in) is multidet.
*/

/*
:- mode string__append(in, in, out) is det.
*/
mercury__string__append_3_0:
	{ size_t len_1, len_2;
	  len_1 = strlen((char *)r1);
	  len_2 = strlen((char *)r2);
	  incr_hp_atomic(r3, (len_1 + len_2 + sizeof(Word)) / sizeof(Word));
	  strcpy((char *)r3, (char *)r1);
	  strcpy((char *)r3 + len_1, (char *)r2);
	}
	proceed();

/*
:- mode string__append(in, in, in) is semidet.
*/
mercury__string__append_3_1:
	{ size_t len_1;
	  len_1 = strlen((char *)r2);
	  if (strncmp((char*)r2, (char*)r4, len_1) != 0)
		GOTO_LABEL(mercury__string__append_3_1_i1);
	  if (strcmp((char*)r3, (char*)r4 + len_1) != 0)
		GOTO_LABEL(mercury__string__append_3_1_i1);
	}
	r1 = TRUE;
	proceed();
mercury__string__append_3_1_i1:
	r1 = FALSE;
	proceed();

/*
:- mode string__append(in, out, in) is semidet.
*/
mercury__string__append_3_2:
	{ size_t len_1, len_2, len_3;
	  len_1 = strlen((char *)r2);
	  if (strncmp((char*)r2, (char*)r4, len_1) != 0)
		GOTO_LABEL(mercury__string__append_3_2_i1);
	  len_3 = strlen((char *)r4);
	  len_2 = len_3 - len_1;
	  incr_hp_atomic(r3, (len_2 + sizeof(Word)) / sizeof(Word));
	  strcpy((char *)r3, (char *)r4 + len_1);
	}
	r1 = TRUE;
	proceed();
mercury__string__append_3_2_i1:
	r1 = FALSE;
	proceed();

/*
:- mode string__append(out, out, in) is multidet.
*/
mercury__string__append_3_3:
	mkframe("list__append/3", 4, LABEL(mercury__string__append_3_3_i1));
	mark_hp(framevar(0));
	framevar(1) = r3;
	framevar(2) = strlen((char *)r3);
	framevar(3) = 0;
mercury__string__append_3_3_i1:
	restore_hp(framevar(0));
	r3 = framevar(1);
	r4 = framevar(3);
	if (r4 > framevar(2)) {
		modframe(ENTRY(do_fail));
		fail();
	}
	incr_hp_atomic(r1, (r4 + sizeof(Word)) / sizeof(Word));
	memcpy((char *)r1, (char *)r3, r4);
	((char *)r1)[r4] = '\0';
	incr_hp_atomic(r2, (framevar(2) - r4 + sizeof(Word)) / sizeof(Word));
	strcpy((char *)r2, (char *)r3 + r4);
	framevar(3) = r4 + 1;
	succeed();

/*-----------------------------------------------------------------------*/

/*
:- pred string__split(string, int, string, string).
:- mode string__split(in, in, out, out) is det.
%	string__split(String, Count, LeftSubstring, RightSubstring):
%	`LeftSubstring' is the left-most `Count' characters of `String',
%	and `RightSubstring' is the remainder of `String'.
%	(If `Count' is out of the range [0, length of `String'], it is
%	treated as if it were the nearest end-point of that range.)
*/

mercury__string__split_4_0:
	{
	  char *string = (char *) r1;
	  Integer count = (Integer) r2;
	  Integer len;

	  if (count <= 0) {
		r3 = (Word) "";
		r4 = r1;
		proceed();
	  }
	  len = strlen(string);
	  if (count > len) count = len;
	  incr_hp_atomic(r3, (count + sizeof(Word)) / sizeof(Word));
	  memcpy((char *)r3, string, count);
	  ((char *)r3)[count] = '\0';
	  incr_hp_atomic(r4, (len - count + sizeof(Word)) / sizeof(Word));
	  strcpy((char *)r4, string + count);
	  proceed();
	}

/*-----------------------------------------------------------------------*/

/*
:- pred string__first_char(string, character, string).
:- mode string__first_char(in, in, in) is semidet.	% implied
:- mode string__first_char(in, out, in) is semidet.	% implied
:- mode string__first_char(in, in, out) is semidet.	% implied
:- mode string__first_char(in, out, out) is semidet.
:- mode string__first_char(out, in, in) is det.
%	string__first_char(String, Char, Rest) is true iff
%		Char is the first character of String, and Rest is the
%		remainder.
*/

/*
:- mode string__first_char(in, in, in) is semidet.	% implied
*/
mercury__string__first_char_3_0:
	{ char *string = (char *)r2;
	  char c = (char)r3;
	  char *rest = (char *)r4;
	  
	  r1 = (string[0] == c && c != 0 && strcmp(string + 1, rest) == 0);
	  proceed();
	}

/*
:- mode string__first_char(in, out, in) is semidet.	% implied
*/
mercury__string__first_char_3_1:
	{ char *string = (char *)r2;
	  char *rest = (char *)r4;
	  r3 = string[0];
	  r1 = (r3 != '\0' && strcmp(string + 1, rest) == 0);
	  proceed();
	}

/*
:- mode string__first_char(in, in, out) is semidet.	% implied
*/
mercury__string__first_char_3_2:
	{ char *string = (char *)r2;
	  char c = (char)r3;

	  if (string[0] != c || c == '\0') {
		r1 = FALSE;
		proceed();
	  }
	  string++;
	  incr_hp_atomic(r4, (strlen(string) + sizeof(Word)) / sizeof(Word));
	  strcpy((char *)r4, string);
	  r1 = TRUE;
	  proceed();
	}

/*
:- mode string__first_char(in, out, out) is semidet.
*/
mercury__string__first_char_3_3:
	{ char *string = (char *)r2;

	  r3 = string[0];
	  if (r3 == '\0') {
		r1 = FALSE;
		proceed();
	  }
	  string++;
	  incr_hp_atomic(r4, (strlen(string) + sizeof(Word)) / sizeof(Word));
	  strcpy((char *)r4, string);
	  r1 = TRUE;
	  proceed();
	}

/*
:- mode string__first_char(out, in, in) is det.
*/
mercury__string__first_char_3_4:
	{ char c = (char)r2;
	  char *rest = (char *)r3;
	  size_t len = strlen(rest) + 1;
	  char *string;

	  incr_hp_atomic(r1, (len + sizeof(Word)) / sizeof(Word));
	  ((char *)r1)[0] = c;
	  strcpy((char *)r1 + 1, rest);

	  proceed();
	}

/*-----------------------------------------------------------------------*/
/*-----------------------------------------------------------------------*/

/*
	from int.m
:- mode int__to_float(in, out) is det.
*/
mercury__int__to_float_2_0:
	{ r2 = float_to_word( (Float) (Integer) r1 );
	  proceed();
	}

/*-----------------------------------------------------------------------*/
/*-----------------------------------------------------------------------*/

mercury__term_io__read_term_3_0:
	tailcall(ENTRY(mercury__parser__read_term_3_0),
	  	LABEL(mercury__term_io__read_term_3_0));

/*-----------------------------------------------------------------------*/

/* XXX The following predicates have not yet been implemented! */

mercury__opt_debug__write_1_0:
	fatal_error("opt_debug__write/1 not implemented");

END_MODULE