/******************************************************************************

			UNSW Prolog (version 4)

			Written by Claude Sammut
		     Department of Computer Science
		     University of New South Wales
		   (and St. Joseph's U., Philadelphia)

		   Copyright (c)  1983 - Claude Sammut

******************************************************************************/





/*		built-in predicates for I/O			*/


#include "pred.h"
#include "in.h"

#define MAXFILES _NFILE - 3	/* _NFILES is in stdio.h */
#define UNUSED	0
#define I_MODE	1
#define O_MODE	2


extern pval new();
extern compterm *record();
extern int bind(), unbind(), isbound(), prin(), _prin();

extern pval _input, _output;
extern FILE *prog_file, *output;
extern chartype chtype[];
extern integer *stack_int;

static
struct
{
	pval sname;
	FILE *file;
	char mode;
} stream [MAXFILES];

static short num_open = -1, onum = -1, inum = -1;
static pval ifile, ofile;

FILE *piport, *poport;


set_files()
{
	register i;

	for (i = 0; i < MAXFILES; i++)
		stream[i].mode = UNUSED;
	num_open = -1;
	piport = stdin;
	poport = stdout;
}


static
int get_stream()
{
	register i;

	for (i = 0; i <= num_open; i++)
		if (stream[i].mode == UNUSED) return(i);
	if (++num_open == MAXFILES) return(-1);
	else return(num_open);
}


int find_stream(name)
pval name;
{
	register i;

	for (i = 0; i <= num_open; i++)
		if (stream[i].sname == name) return(i);
	return(-1);
}


static
see PREDICATE
{
	register i;

	if (! isatom(arg[0]))
		fail("See - argument must be atomic")
	if ((i = find_stream(arg[0])) != -1)
	{
		if (stream[i].mode == O_MODE)
			fail("See - file already opened for output")
		if (i == inum) return(TRUE);
		input = piport = stream[i].file;
		inum = i;
		ifile = stream[i].sname;
		return(TRUE);
	}
	if ((i = get_stream()) == -1)
		fail("See - Too many open files")
	if ((piport = fopen(NAME(arg[0]), "r")) == NULL)
		fail("See - cannot open file")
	stream[i].sname = arg[0];
	stream[i].file = piport;
	stream[i].mode = I_MODE;
	inum = i;
	ifile = arg[0];
	input = piport;
	return(TRUE);
}


static
read_in PREDICATE
{
	input = piport = prog_file;
}


static
ptell PREDICATE
{
	register i;

	if (! isatom(arg[0]))
		fail("Tell - argument must be atomic")
	if ((i = find_stream(arg[0])) != -1)
	{
		if (stream[i].mode == I_MODE)
			fail("Tell - file already opened for input")
		if (i == onum) return(TRUE);
		output = poport = stream[i].file;
		onum = i;
		ofile = stream[i].sname;
		return(TRUE);
	}
	if ((i = get_stream()) == -1)
		fail("Tell - Too many open files")
	if ((poport = fopen(NAME(arg[0]), "w")) == NULL)
		fail("Tell - cannot open file")
	stream[i].sname = arg[0];
	stream[i].file = poport;
	stream[i].mode = O_MODE;
	onum = i;
	ofile = arg[0];
	output = poport;
	return(TRUE);
}


p_close PREDICATE
{
	register i;

	if (! isatom(arg[0]))
		fail("Close - argument must be atomic")
	if ((i = find_stream(arg[0])) == -1)
		fail("Close - file not open")
	if (stream[i].mode == I_MODE)
	{
		piport = input = prog_file;
		inum = -1;
		ifile = _input;
	}
	else {
		poport = output = stdout;
		onum = -1;
		ofile = _output;
	}
	fclose(stream[i].file);
	stream[i].mode = UNUSED;
	stream[i].sname = 0;
	return(TRUE);
}


static
seen PREDICATE
{
	if (inum == -1)
		fail("Seen - cannot close standard input")
	fclose(stream[inum].file);
	stream[inum].mode = UNUSED;
	stream[inum].sname = 0;
	piport = input = prog_file;
	inum = -1;
	ifile = _input;
	return(TRUE);
}


static
told PREDICATE
{
	if (onum == -1)
		fail("Told - cannot close standard output")
	fclose(stream[onum].file);
	stream[onum].mode = UNUSED;
	poport = output = stdout;
	onum = -1;
	ofile = _output;
	return(TRUE);
}


static
seeing PREDICATE
{
	if (isvariable(arg[0]))
	{
		if (inum == -1)
			bind(arg[0], frame[0], _input, 0);
		else bind(arg[0], frame[0], stream[inum].sname, 0);
		return(TRUE);
	}
	else fail("Seeing - argument must be unbound variable")
}


static
telling PREDICATE
{
	if (isvariable(arg[0]))
	{
		if (inum == -1)
			bind(arg[0], frame[0], _output, 0);
		else bind(arg[0], frame[0], stream[onum].sname, 0);
		return(TRUE);
	}
	else fail("Telling - argument must be unbound variable")
}


static
p_eof PREDICATE
{
	return(feof(input));
}



static
save PREDICATE
{
	FILE *old_output;
	extern FILE *output;

	if (isatom(arg[0]))
	{
		old_output = output;
		if ((output = fopen(NAME(arg[0]), "w")) == NULL)
			fail("Save - open failure")
		listing();
		fclose(output);
		output = old_output;
		return(TRUE);
	}
	else fail("Save - invalid file name")
}


infile(file_name, pname)
char *file_name;
char *pname;
{
	char old_interp;
	FILE *old_input;

	extern char interpret, *cur_file;
	extern FILE *input;
	extern int linen;
	
	old_input = input;
	if ((input = fopen(file_name, "r")) == NULL)
		fail("Consult - cannot open file")
	old_interp = interpret;
	interpret = isatty(fileno(input));
	linen = 1;
	if (pname == 0) cur_file = file_name;
	else cur_file = pname;
	prog_file = input;
	evloop();

	fclose(input);
	input = piport = old_input;
	interpret = old_interp;
	return(TRUE);
}


static
consult PREDICATE
{
	extern pval proc_list;
	extern atom *nil;
	pval prev_proc_list;

	prev_proc_list = proc_list;
	proc_list = (pval) nil;
	if (! isatom(arg[0]))
		fail("Consult - first argument must be an atom")
	else if (infile(NAME(arg[0]), 0))
	{
		add_file(arg[0], proc_list);
		proc_list = prev_proc_list;
		return(TRUE);
	}
	return(FALSE);
}




atom_table p_files =
{
	SET_PRED(FX, 700, 1, "save", save),
	SET_PRED(NONOP, 0, 1, "consult", consult),
	SET_PRED(NONOP, 0, 1, "see", see),
	SET_PRED(NONOP, 0, 0, "read_from_this_file", read_in),
	SET_PRED(NONOP, 0, 0, "eof", p_eof),
	SET_PRED(NONOP, 0, 1, "tell", ptell),
	SET_PRED(NONOP, 0, 1, "seeing", seeing),
	SET_PRED(NONOP, 0, 1, "telling", telling),
	SET_PRED(NONOP, 0, 0, "seen", seen),
	SET_PRED(NONOP, 0, 0, "told", told),
	SET_PRED(NONOP, 0, 1, "close", p_close),
	END_MARK
};