/* xlisp.c - a small implementation of lisp with object-oriented programming */
/*		Copyright (c) 1987, by David Michael Betz
		All Rights Reserved
		Permission is granted for unrestricted non-commercial use		*/

#include "xlisp.h"
#include <stdlib.h>

/* define the banner line string */
#ifdef STRUCTS
#define BANNER	"XLISP version 2.1, Copyright (c) 1988, by David Betz\n\
As modified by Thomas Almy, compiled for Atari ST 30:04:91"
#else
#define BANNER	"XLISP version 2.0, Copyright (c) 1988, by David Betz\n\
As modified by Thomas Almy"
#endif

/* global variables */
jmp_buf top_level;

/* external variables */
extern LVAL s_stdin,s_evalhook,s_applyhook;
extern LVAL s_1plus,s_2plus,s_3plus,s_1star,s_2star,s_3star,s_minus;
extern int xltrcindent;
extern int xldebug;
extern LVAL true;
extern char buf[];
extern FILE *tfp;

/* external routines */
extern FILE *osaopen();

#ifdef MSC6
/* no optimization which interferes with setjmp */
#pragma optimize("elg",off)
#endif

/* usage - print command line usage, then quit */
VOID usage() {
	fprintf(stderr,"Valid Arguments:\n\t-?\tThis help\n\
\t-tfname\tOpen transcript (dribble) file fname\n\
\t-v\tLoad verbosely\n\
\t-w\tDon't restore from xlisp.wks\n\
\tfname\tLoad file fname\n");
	exit(1);
}

/* main - the main routine */
VOID main(argc,argv)
  int argc; char *argv[];
{
	char *transcript;
	CONTEXT cntxt;
	int verbose,nores,i;
	LVAL expr;

#ifdef PROFILES
	prof_start(argv[0]);
#endif

	/* setup default argument values */
	transcript = NULL;
	verbose = FALSE;
	nores = FALSE;

	/* parse the argument list switches */
#ifndef LSC
	for (i = 1; i < argc; ++i)
		if (argv[i][0] == '-')
			switch(tolower(argv[i][1])) {
			case '?':	/* TAA MOD: added help */
				usage();
			case 't':
				transcript = &argv[i][2];
				break;
			case 'v':
				verbose = TRUE;
				break;
			case 'w':
				nores = TRUE;
				break;
			default: /* Added to print bad switch message */
				fprintf(stderr,"Bad switch: %s\n",argv[i]);
				usage();
			}
#endif

	/* initialize and print the banner line */
	osinit(BANNER);

	/* setup initialization error handler */
	xlbegin(&cntxt,CF_TOPLEVEL|CF_CLEANUP|CF_BRKLEVEL,(LVAL)1);
	if (setjmp(cntxt.c_jmpbuf))
		xlfatal("fatal initialization error");
	if (setjmp(top_level))
		xlfatal("RESTORE not allowed during initialization");

	/* initialize xlisp */
	i = xlinit(nores);
	xlend(&cntxt);

	/* reset the error handler */
	xlbegin(&cntxt,CF_TOPLEVEL|CF_CLEANUP|CF_BRKLEVEL,true);

	/* open the transcript file */
	if (transcript && (tfp = osaopen(transcript,"w")) == NULL) {
		/* TAA Mod -- quote name so "-t foo" will indicate no file name */
		sprintf(buf,"error: can't open transcript file: \"%s\"",transcript);
		stdputstr(buf);
	}

	/* load "init.lsp" */
	if (i && (setjmp(cntxt.c_jmpbuf) == 0))
		xlload("init.lsp",TRUE,FALSE);

	/* load any files mentioned on the command line */
	if (setjmp(cntxt.c_jmpbuf) == 0)
		for (i = 1; i < argc; i++)
			if (argv[i][0] != '-' && !xlload(argv[i],TRUE,verbose))
				xlerror("can't load file",cvstring(argv[i]));

	/* target for restore */
	if (setjmp(top_level))
		xlbegin(&cntxt,CF_TOPLEVEL|CF_CLEANUP|CF_BRKLEVEL,true);

	/* protect some pointers */
	xlsave1(expr);

	/* main command processing loop */
	for (;;) {

		/* setup the error return */
		if (setjmp(cntxt.c_jmpbuf)) {
			setvalue(s_evalhook,NIL);
			setvalue(s_applyhook,NIL);
			xltrcindent = 0;
			xldebug = 0;
			xlflush();
		}

		/* print a prompt */
		stdputstr("> ");

		/* read an expression */
		if (!xlread(getvalue(s_stdin),&expr))
			break;

		/* save the input expression */
		xlrdsave(expr);

		/* evaluate the expression */
		expr = xleval(expr);

		/* save the result */
		xlevsave(expr);

		/* print it */
		stdprint(expr);
	}
	xlend(&cntxt);

	/* clean up */
	wrapup();
}

#ifdef MSC6
#pragma optimize("",on)
#endif

/* xlrdsave - save the last expression returned by the reader */
VOID xlrdsave(expr)
  LVAL expr;
{
	setvalue(s_3plus,getvalue(s_2plus));
	setvalue(s_2plus,getvalue(s_1plus));
	setvalue(s_1plus,getvalue(s_minus));
	setvalue(s_minus,expr);
}

/* xlevsave - save the last expression returned by the evaluator */
VOID xlevsave(expr)
  LVAL expr;
{
	setvalue(s_3star,getvalue(s_2star));
	setvalue(s_2star,getvalue(s_1star));
	setvalue(s_1star,expr);
}

/* xlfatal - print a fatal error message and exit */
VOID xlfatal(msg)
  char *msg;
{
	oserror(msg);
	wrapup();
}

/* wrapup - clean up and exit to the operating system */
VOID wrapup()
{
	if (tfp)
		osclose(tfp);
	osfinish();
	exit(0);
}