/*
 * BASIC by Phil Cockcroft
 */
#include        "bas.h"

/*
 *      This file contains all the standard commands that are not placed
 *    anywhere else for any reason.
 */

#ifdef	__STDC__
static	void	clear_prog(void);
static	int	listl(lpoint), mypwrite(filebufp, CHAR *, int), def_fn(int, int);
static	lpoint  get_end(void);
static	STR	strpat(STR, STR, STR);
#else
static	void	clear_prog();
static	int	listl(), mypwrite(), def_fn();
static	lpoint  get_end();
static	STR	strpat();
#endif

/*
 *      The 'for' command , this is fairly straight forward , but
 *    the way that the variable is not allowed to be indexed is
 *    dependent on the layout of variables in core.
 *      Most of the fiddly bits of code are so that all the variables
 *    are of the right type (real / integer ). The code for putting
 *    a '1' in the step for default cases is not very good and could be
 *    improved.
 *      A variable is accessed by its displacement from 'earray'
 *    it is this index that speeds execution ( no need to search through
 *    the variables for a name ) and that enables the next routine to be
 *    so efficient.
 */

int
forr()
{
	register struct forst *p;
	register struct	entry	*ep;
	int	vty;
	int	dir = DIR_INC;
	value   start;
	value   iend;
	value   istep;
	value	*l;

	l= (value *)getname(0);
	vty= (int)vartype;
	ep = curentry;
	if(vartype == SVAL || ep->dimens)	/* string or array element */
		error(2);               /* variable required */
	if(getch()!='=')
		error(SYNTAX);
	eval();                         /* get the from part */
	putin(&start, vty);              /* convert and move the right type */
	if(getch()!=TO)
		error(SYNTAX);
	eval();                         /* the to part */
	putin(&iend, vty);
	if(getch()==STEP){
		eval();                 /* the step part */
		if(vartype != RVAL){
			if(res.i < 0)
				dir = DIR_DEC;
		}
		else if(res.f < ZERO)
			dir = DIR_DEC;
		putin(&istep, vty);
	}
	else {
		point--;                /* default case */
#ifndef	SOFTFP
		if(vty != RVAL)
			istep.i = 1;
		else
			istep.f = ONE;
#else
		res.i=1;
		vartype = IVAL;
		putin(&istep, vty);
#endif
	}
	check();                                /* syntax check */
				/* have we had it in a for loop before */
	for(p = estack ; p ; p = p->prev)
		if(p->fortyp == FORTYP){
			if(p->fnnm == ep)
				goto got;   /* if so then reset its limits */
		}
		else if(p->fortyp == FNTYP)
			break;

	/*
	 * grow the stack
	 */
	p = (forstp)mmalloc((ival)sizeof(struct forst));
	if((p->prev = estack) != 0)
		p->prev->next = p;
	else
		bstack = p;
	p->next = 0;
	estack = p;
	p->fnnm=ep;
	p->fortyp = FORTYP;
	p->forvty = (char)vty;

got:    p->elses=elsecount;             /* set up all information for the */
	p->stolin=stocurlin;            /* next routine */
	p->pt=point;
	p->fordir = (char)dir;
	p->final = iend;
	p->step = istep;
	*l = start;	/* set the starting value */
	normret;
}

/*
 *      the 'next' command , this does not need an argument , if there is
 *    none then the most deeply nested 'next' is accessed. If there is
 *    a list of arguments then the variable name is accessed and a search
 *    is made for it. ( next_without_for error ). Then the step is added
 *    to the varable and the result is compared to the final. If the loop
 *    is not ended then the stack is set to the end of this 'for' structure
 *    and a return is executed. Otherwise the stack is popped and a return
 *    to the required line is performed.
 */

int
next()
{
	register struct forst *p;
	register value  *l;
	register int    c;

	c=getch();
	point--;
	if(istermin(c)){                /* no argument */
		for(p = estack ; p ; p = p->prev)
			if(p->fortyp == FORTYP){
				l = &p->fnnm->_dval;
				goto got;
			}
			else if(p->fortyp == FNTYP)
				break;
		error(18);      /* no next */
	}
for(;;){
	l= (value *)getname(0);
	for(p = estack ; p ; p = p->prev)
		if(p->fortyp == FORTYP){
			if(p->fnnm == curentry)
				goto got;
		}
		else if(p->fortyp == FNTYP)
			error(51);
	error(18);                      /* next without for */
got:;
#ifdef	SOFTFP
	if( (vartype = p->forvty) != RVAL){
#else
	if(p->forvty != RVAL){
#endif
#ifdef pdp11
		foreadd(p->step.i,l);
#else
#ifdef  VAX_ASSEM                       /* if want to use assembler */
		l->i += p->step.i;
		asm("        bvc nov");         /* it is a lot faster.... */
		    error(35);
		asm("nov:");
#else
		register long   m = p->step.i;
		m += l->i;
		if(IS_OVER(l->i, p->step.i, m))
			error(35);
		else
			l->i = (itype)m;
#endif
#endif
		if(p->fordir == DIR_DEC){
			if( l->i >= p->final.i)
				goto nort;
			else goto rt;
		}
		else if( l->i <= p->final.i)
			goto nort;
	}
	else {
		fadd(&p->step, l );
#ifdef	NaN
		if(NaN(l->f))
			(*fpfunc)();
#endif
		if(p->fordir == DIR_DEC){
#ifndef SOFTFP
			if( l->f >= p->final.f)
				goto nort;
			else goto rt;
		}
		else if( l->f <= p->final.f)
			goto nort;
#else
			if(cmp(l,&p->final)>=0 )
				goto nort;
			goto rt;
		}
		else  if(cmp(l,&p->final)<= 0)
			goto nort;
#endif
	}
rt:                       /* don't loop - pop the stack */
	if((estack = p->prev) == 0)
		bstack = 0;
	else
		p->prev->next = 0;
	clr_stack(p);
	if(getch()==',')
		continue;
	point--;
	break;
nort:
	stocurlin=p->stolin;           	/* go back to the 'for' */
					/* obscure reasons */
	point = p->pt;
	elsecount=p->elses;
	if(p->next){
		clr_stack(p->next);
		p->next = 0;
		estack = p;
	}
	break;
	}
	normret;
}

/*
 *      The 'gosub' command , This uses the same structure as 'for' for
 *    the storage of data. A gosub is identified by the flag 'fr' in
 *    the 'for' structure being zero. This just gets the line on which
 *    we are on and sets up th structure. Gosubs from immeadiate mode
 *    are dealt with and this is one of the obscure reasons for the
 *    the comment and code in 'return' and 'next'.
 */

void
bld_gosub()
{
	register forstp   pt;

	pt = (forstp)mmalloc((ival)sizeof(struct forst));
	if((pt->prev = estack) != 0)
		pt->prev->next = pt;
	else
		bstack = pt;
	pt->next = 0;
	estack = pt;
	pt->fortyp = GOSTYP;
	pt->elses = elsecount;
	pt->pt = point;
	pt->stolin = stocurlin;
}

int
gosub()
{
	register lpoint l;

	l=getline();
	check();
	bld_gosub();
	stocurlin=l;
	point= l->lin;
	elsecount=0;
	return(-1);     /* return to execute the next instruction */
}

/*
 *      The 'return' command this just searches the stack for the
 *    first gosub/return it can find, pops the stack to that level
 *    and returns to the correct point. Deals with returns to
 *    immeadiate mode, as well.
 */

int
retn()
{
	register struct forst   *p;

	check();
	for(p = estack ; p ; p = p->prev)
		if(p->fortyp == GOSTYP)
			goto got;
		else if(p->fortyp == FNTYP)
			break;
	error(21);              /* return without gosub */
got:
	elsecount=p->elses;
	point=p->pt;
	stocurlin=p->stolin;
	if( (estack = p->prev) == 0)
		bstack = 0;
	else
		p->prev->next = 0;
	clr_stack(p);
	normret;
}

/*
 *      The 'run' command , run will execute a program by putting it in
 *    runmode and setting the start address to the start of the program
 *    or to the optional line number. It clears all the variables and
 *    closes all files.
 */

int
runn()
{
	register lpoint p;
	register lnumb	l;
	register int	c;
	int	rflag = 0;
	STR	st;

	c = getch();
	point--;
	p = program;
	if(istermin(c))
		goto got;
	l=getlin();
	if(l == NOLNUMB){
		if(c != ','){
			st = stringeval();
			NULL_TERMINATE(st);
			if(getch() == ','){
				if(getch() != 'r')
					error(SYNTAX);
				rflag = 1;
			}
			else
				point--;
			check();
			/*
			 * run file in str
			 */
			if((c=open( (char *)st->strval,0))== -1)
				error(15);
			FREE_STR(st);
			clear_prog();
			trap_env.e_stolin = 0;
			readfi(c, (lpoint)0, 0);
			inserted=0;   /* say we don't actually want to */
			p = program;
		}
		else {
			point++;
			if(getch() != 'r')
				error(SYNTAX);
			rflag = 1;
			check();
		}
	}
	else {
		if(getch() == ','){
			if(getch() != 'r')
				error(SYNTAX);
			rflag = 1;
		}
		else
			point--;
		check();
		p = getsline(l);
	}
got:
	clear();   /* zap the variables */
	lp_fd = -1;
	if(!rflag)
		closeall();
	if(!p)                 /* no program so return */
		reset();
	stocurlin=p;
	point=p->lin;
	elsecount=0;
	return(-1);             /* return to execute the next instruction */
}

/*
 *      The 'end' command , checks its syntax ( no parameters ) then
 *    gets out of what we were doing.
 */

int
endd()
{
	check();
	reset();
	normret;
}

/*
 *      The 'goto' command , simply gets the required line number
 *    and sets the pointers to it. If in immeadiate mode , go into
 *    runmode and zap the stack .
 */

int
gotos()
{
	register lpoint p;

	p=getline();
	check();
	if(!stocurlin){
		clr_stack(bstack);		/* zap the stack */
		bstack = estack = 0;
	}
	point=p->lin;
	stocurlin=p;
	elsecount=0;

	return(-1);
}

/*
 *      The 'print' command , The code for this routine is rather weird.
 *    It works ( well ) for all types of printing ( including files ),
 *    but it is a bit 'kludgy' and could be done better ( I don't know
 *    how ). Every expression must be followed by a comma a semicolon
 *    or the end of a statement. To get it all to work was tricky but it
 *    now does and that is all that can be said for it.
 *      The use of filedes assumes that an integer has the same size as
 *      a structure pointer. If this is not the case. This system will not
 *      work ( nor will most of the rest of the interpreter ).
 */

#ifndef	__STDC__
extern  int	write();
static	void	doprint();
#else
static	void	doprint(int, int);
#endif

int
print()
{
	doprint(0, 0);
	normret;
}

int
bwrite()
{
	doprint(0, 1);
	normret;
}

static	ival	lp_cursor;
static	int	lp_width = 80;

static	char	lp_devname[] = "bas.lpout";

int
lprint()
{
	register int	fd;

	if(lp_fd > 0){
		VOID close(lp_fd);
		lp_fd = 0;
	}
	if(lp_fd < 0)
		fd = -1;
	else
		fd = open(lp_devname, 1);
	if(fd < 0){
		fd = creat(lp_devname, 0644);
		if(fd < 0)
			error(14);
	}
	VOID lseek(fd, 0L, 2);
	lp_fd = fd;

	doprint(1, 0);

	VOID close(lp_fd);
	lp_fd = 0;

	normret;
}

#ifdef	__STDC__
/*
 * fp is a null argument
 */
/*ARGSUSED*/
static	int
mypwrite(filebufp fp, CHAR *buf, int len)
{
	fp = fp;
	return((int)write(1, (char *)buf, (unsigned)len));
}

/*ARGSUSED*/
static	int
lpwrite(filebufp fp, CHAR *buf, int len)
{
	fp = fp;
	if(write(lp_fd, (char *)buf, (unsigned)len) != len)
		c_error(60);
	return(0);
}
#else

/*
 * fp is a null argument
 */
/*ARGSUSED*/
static	int
mypwrite(fp, buf, len)
filebufp fp;
CHAR	*buf;
int	len;
{
	return((int)write(1, (char *)buf, (unsigned)len));
}

/*ARGSUSED*/
static	int
lpwrite(fp, buf, len)
filebufp fp;
CHAR	*buf;
int	len;
{
	if(write(lp_fd, (char *)buf, (unsigned)len) != len)
		c_error(60);
	return(0);
}
#endif

static  const	CHAR    spaces[]="                ";    /* 16 spaces */

static	void
doprint(islp, iswrt)
int	islp, iswrt;
{
	ival    i;
	register int     c;
#ifdef	__STDC__
	register int    (*outfunc)(filebufp, CHAR *, int);
#else
	register int    (*outfunc)();   /* pointer to the output function */
#endif
	register ival   *curcursor;     /* pointer to the current cursor */
					/* 'posn' if a file, or 'cursor' */
	int     Twidth;                 /* width of the screen or of the */
	filebufp filedes = 0;           /* file. BLOCKSIZ if a file */
	ival	tmpw;
	STR	st;
	STR	patstr = 0;
	STR	ost;
	int	is_str_pat = -1;
	struct	str_info	savpat;
	static	CHAR	comma[] = ",";
	static	CHAR	quote[] = "\"";

	c=getch();
	if(islp){
		outfunc = lpwrite;
		curcursor= &lp_cursor;
		Twidth = lp_width;
	} else if(c=='#'){
		i=evalint();
		if( (c = getch()) !=','){
			if(!istermin(c))
				error(SYNTAX);
		}
		else
			c=getch();
		filedes=getf(i,_WRITE);
		if(filedes->use & _BLOCKED)
			error(29);
		outfunc= putfile;               /* see bas6.c */
		curcursor= &filedes->posn;
		Twidth = filedes->bufsiz;
	}
	else {
		outfunc = mypwrite;
		curcursor= &cursor;
		Twidth = ter_width;
	}
	if(c == USING){
		if(iswrt)
			error(SYNTAX);
		patstr = stringeval();
		if(getch() != ';')
			error(SYNTAX);
		if(!patstr->strlen)
			error(BADFORMAT);
		c = getch();
		savpat = *patstr;
	}
	point--;

	for(;;){
		if(istermin(c)){
			VOID (*outfunc)(filedes, (CHAR *)nl, 1);
			*curcursor=0;
			break;
		}
		else if(c==TABB){                       /* tabing */
			if(patstr)
				error(SYNTAX);
			point++;
			if(*point++!='(')
				error(SYNTAX);
			i=evalint();
			if(getch()!=')')
				error(SYNTAX);

			while(!trapped && (tmpw = i - *curcursor) > 0){
				if(tmpw > sizeof(spaces) - 1)
					tmpw = sizeof(spaces) - 1;
				VOID (*outfunc)(filedes, (CHAR *)spaces, tmpw);
				*curcursor += tmpw;
			}
			*curcursor %= Twidth;
			c=getch();
		}
		else if(c==',' || c==';'){
			if(iswrt)
				error(SYNTAX);
			point++;
		}
		else {
			ost = 0;
			if(!patstr || is_str_pat < 0)
				is_str_pat = checktype();
			if(is_str_pat){
				st = stringeval();
				if(patstr){
					ost = st;
					st = strpat(ost, patstr, &savpat);
				}
				if(iswrt){
					VOID (*outfunc)(filedes, quote, 1);
					*curcursor = (*curcursor + 1) % Twidth;
				}
			}
			else {
				eval();
				if(patstr)
					st = mathpat(patstr);
				else
					st = mgcvt();
			}
			VOID (*outfunc)(filedes, st->strval, st->strlen);
			*curcursor = (*curcursor + st->strlen) % Twidth;
			FREE_STR(st);
			if(ost)
				FREE_STR(ost);
			c=getch();
			if(iswrt && is_str_pat){
				VOID (*outfunc)(filedes, quote, 1);
				*curcursor = (*curcursor + 1) % Twidth;
			}
		}
		if(c==',' ||c==';'){
			if(iswrt){
				VOID (*outfunc)(filedes, comma, 1);
				*curcursor = (*curcursor + 1) % Twidth;
			}
			if(c==',' && !patstr){
				tmpw = 16 - *curcursor % 16;
				VOID (*outfunc)(filedes, (CHAR *)spaces,tmpw);
				*curcursor = (*curcursor + tmpw) % Twidth;
			}
			c=getch();
			point--;
			if(istermin(c))
				break;
			continue;
		}
		else if(!istermin(c))
			error(SYNTAX);
		point--;
	}
	if(patstr)
		FREE_STR(patstr);
}

static	STR
strpat(st, spat, savpat)
STR	st, spat, savpat;
{
	STR	outstr;
	CHAR	*outend;
	CHAR	*outp;
	CHAR	*pat, *epat;
	ival	olen;
	ival	curpos;
	ival	flen;

	if(!spat->strlen){
		spat->strlen = savpat->strlen;
		spat->strval = savpat->strval;
	}
	if(st->strlen + spat->strlen >= MAX_STR)
		error(BADFORMAT);
	olen = st->strlen + spat->strlen;

	outstr = ALLOC_STR(olen);
	outend = outstr->strval + olen;
	outp = outstr->strval;

	for(pat = spat->strval, epat = pat + spat->strlen ; pat < epat ;){
		switch(*pat++){
		default:
			if(outp >= outend - 1){
				olen += 32;
				if(olen >= MAX_STR)
					error(9);
				curpos = outp - outstr->strval;
				RESERVE_SPACE(outstr, olen);
				outend = outstr->strval + olen;
				outp = outstr->strval + curpos;
			}
			*outp++ = *(pat - 1);
			continue;
		case '!':
			if(st->strlen >= 1)
				flen = 1;
			else
				flen = 0;
			break;
		case '\\':
			flen = 2;
			while(pat < epat && *pat == ' '){
				flen++;
				pat++;
			}
			if(pat >= epat || *pat != '\\')
				error(BADFORMAT);
			pat++;
			break;
		case '&':
			flen = st->strlen;
			break;
		}
		if(outp + flen >= outend){
			olen += 32 + flen;
			if(olen >= MAX_STR)
				error(9);
			curpos = outp - outstr->strval;
			RESERVE_SPACE(outstr, olen);
			outend = outstr->strval + olen;
			outp = outstr->strval + curpos;
		}
		if(flen <= st->strlen){
			if(flen)
				outp = strmov(outp, st->strval, flen);
		}
		else {
			outp = strmov(outp, st->strval, st->strlen);
			set_mem(outp, flen - st->strlen, ' ');
			outp += flen - st->strlen;
		}
		break;
	}
	spat->strlen -= (pat - spat->strval);
	spat->strval = pat;
	outstr->strlen = outp - outstr->strval;
	return(outstr);
}

int
matprint()
{
	ival    i;
	STR	st;
#ifdef	__STDC__
	register int    (*outfunc)(filebufp, CHAR *, int);
#else
	register int    (*outfunc)();   /* pointer to the output function */
#endif
	register ival   *curcursor;     /* pointer to the current cursor */
					/* 'posn' if a file, or 'cursor' */
	int     Twidth;                 /* width of the screen or of the */
	filebufp filedes = 0;           /* file. BLOCKSIZ if a file */
	ival	tmpw;
	struct	entry	*ep;
	ival	d1, d2;
	valp	vpp;
	ival	*ivpp;
	char	vty;

	if(getch() == '#'){
		i=evalint();
		if( getch() !=',')
			error(SYNTAX);
		filedes=getf(i,_WRITE);
		if(filedes->use & _BLOCKED)
			error(29);
		outfunc= putfile;               /* see bas6.c */
		curcursor= &filedes->posn;
		Twidth = filedes->bufsiz;
	}
	else {
		outfunc = mypwrite;
		curcursor= &cursor;
		Twidth = ter_width;
		point--;
	}

	do {
		ep = getmat(0);
		vty = vartype;
		d1 = ep->_dims[0];
		d2 = (ep->dimens == 1) ? 1 : ep->_dims[1];
		vpp = (valp)(MEMP)ep->_darr;
		if(vty != RVAL)
			ivpp = &vpp->i;
		while(d2 > 0){
			for(i = 0 ; i < d1 ; i++){
				if(vty == RVAL)
					res = *vpp++;
				else
					res.i = *ivpp++;
				st = mgcvt();

				VOID(*outfunc)(filedes, st->strval, st->strlen);
				*curcursor = (*curcursor + st->strlen) % Twidth;
				tmpw = 16 - *curcursor % 16;
				VOID (*outfunc)(filedes, (CHAR *)spaces,tmpw);
				*curcursor = (*curcursor + tmpw) % Twidth;

				FREE_STR(st);
			}
			VOID (*outfunc)(filedes, (CHAR *)nl, 1);
			*curcursor  = 0;
			d2--;
		}
	}while(getch() == ',');
	point--;
	normret;
}

/*
 *      The 'if' command , no real problems here but the 'else' part
 *    could do with a bit more checking of what it's going over.
 */

int
iff()
{
	register CHAR   *p;
	register int    c;
	register int    elsees;

	eval();
	if(getch()!=THEN)
		error(SYNTAX);
	if(!IS_ZERO(res)){
		c=getch();              /* true */
		point--;
		elsecount++;            /* say `else`s are allowed */
		if(isnumber(c))         /* if it's a number then */
			VOID gotos();        /* execute a goto */
		return(-1);             /* return to execute another ins. */
	}
	for(elsees = 0, p= point; *p ; p++) /* skip all nested 'if'-'else' */
		if(*p==(CHAR)ELSE){         /* pairs */
			if(--elsees < 0){
				p++;
				break;
			}
		}
		else if(*p==(CHAR)IF)
			elsees++;
	point = p;                      /* we are after the else or at */
	if(!*p)
		normret;
	while(*p++ == ' ');             /* end of line */
	p--;                            /* ignore the space after else */
	if(ispnumber(p))                /* if number then do a goto */
		VOID gotos();
	return(-1);
}

/*
 *      The 'on' command , this deals with everything , it has to do
 *    its own searching so that undefined lines are not accessed until
 *    a 'goto' to that line is actually required.
 *    Deals with on_gosubs from immeadiate mode.
 */

int
onn()
{
	lnumb	lnm[128];
	register lnumb	*l;
	register lpoint p;
	itype   m;
	int     k;

	if(getch()==ERROR){
		if(getch()!=GOTO)
			error(SYNTAX);
		errtrap();      /* do the trapping of errors */
		normret;
	}
	point--;
	m = evalint() - 1;
	if((k=getch())!= GOTO && k != GOSUB)
		error(SYNTAX);
	for(l=lnm;;){        /* get the line numbers */
		if( (*l++ = getlin()) == NOLNUMB)
			error(5);       /* line number required */
		if(getch()!=',')
			break;
	}
	point--;
	check();
	if(m < 0 || lnm + m >= l)	/* index is out of bounds */
		normret;                /* so return */

	p = getsline(lnm[m]);		/* find the line */

	if(k== GOSUB)
		bld_gosub();
	else {
		if(!stocurlin){		/* gotos in immeadiate mode */
			clr_stack(bstack);
			bstack = estack = 0;
		}
	}
	stocurlin = p;
	point = p->lin;
	elsecount = 0;
	return(-1);
}

/*
 *      The 'cls' command , neads to set the terminal into 'rare' mode
 *    so that there is no waiting on the page clearing ( form feed ).
 */

static	const	struct	t_info {
	const	CHAR	*t_term;
	const	CHAR	*t_clr;
} t_clr_info[] = {
	"vt100",	"\033[H\033[J$",
	"at386",	"\033[2J\033[H",
	"ansi",		"\033[H\033[J",
	"xterm",	"\033[H\033[2J",
	0, "\014",
};

int
cls()
{
	register struct	t_info	*tp;
	register const	CHAR	*p, *q;
	register char	*tvar;

	set_term();

	tvar = getenv("TERM");
	if(!tvar|| !*tvar)
		tvar = "";
	for(tp = (struct t_info  *)t_clr_info; tp->t_term ; tp++){
		for(p = tp->t_term, q = (const CHAR *)tvar ; *p ; p++, q++)
			if(*p != *q)
				break;
		if(!*p && !*q)
			break;
	}
	prints( (char *)tp->t_clr);
	rset_term(0);
	cursor = 0;
	normret;
}

/*
 *      The 'base' command , sets the start index for arrays to either
 *      '0' or '1' , simple.
 */

int
base()
{
	register itype	i;

	i=evalint();
	check();
	if(i && i!=1)
		error(28);      /* bad base value */
	baseval= (int)i;
	normret;
}

/*
 *      The 'rem' and '\'' command , ignore the rest of the line
 */

int
rem() {  return(GTO); }

/*
 *      The 'let' command , all the work is done in assign , the first
 *    getch() is to get the pointer in the right place for assign().
 */

int
lets()
{
	assign(0);
	normret;
}

/*
 *      The 'clear' command , clears all variables , and closes all files
 */

int
clearl()
{
	check();
	clear();
	closeall();
	normret;
}

/*
 *      The 'list' command , can have an optional two arguments and
 *    a dash is also used.
 *      Most of this routine is the getting of the arguments. All the
 *    actual listing is done in listl() , This routine should call write()
 *    and not clr(), but then the world is not perfect.
 */

int
list()
{
	register lnumb	l1,l2;
	register lpoint p;

	l1=getlin();
	if(l1 == NOLNUMB){
		l1=0;
		l2= NOLNUMB;
		if(getch()=='-'){
			if( (l2 = getlin()) == NOLNUMB)
				error(SYNTAX);
		}
		else
			point--;
	}
	else  {
		if(getch()!='-'){
			l2 = l1;
			point--;
		}
		else
			l2 = getlin();
	}
	check();
	p = program;
	if(l1)
		for(; p ; p = p->next)
			if(p->linnumb != CONTLNUMB && p->linnumb >= l1)
				break;
	if(!p)
		reset();
	if(l1 == l2 && l1 != p->linnumb)
		reset();
	while(p && (p->linnumb == CONTLNUMB || p->linnumb <=l2) && !trapped){
		l1=listl(p);
		line[l1++] = '\n';
		VOID write(1,line,l1);
		p = p->next;
	}
	reset();
	normret;
}

/*
 *      The routine that does the listing of a line , it searches through
 *    the table of reserved words if it find a byte with the top bit set,
 *    It should ( ha ha ) find it.
 *      This routine could run off the end of line[] since line is followed
 *    by nline[] this should not cause any problems.
 *      The result is in line[].
 */

static	int
listl(p)
lpoint p;
{
	register CHAR   *q;
	register const	struct tabl *l;
	register CHAR    *r;
	register int	t;

	/* do the linenumber */
	if(p->linnumb == CONTLNUMB)
		r = str_cpy((CHAR *)"     ", line);
	else
		r = str_cpy((CHAR *)printlin(p->linnumb), line);

	for(q= p->lin; *q && r < &line[MAXLIN]; q++){
		if(*q & (CHAR)SPECIAL){              /* reserved words */
			if((t = UC(*q)) >= EXFUNC)
				t = ((t-EXFUNC) << 8) + UC(*++q);
			for(l=table;l->chval;l++){
				if(l->chval == t){
					r=str_cpy( (CHAR *)l->string, r);
					break;
				}
			}
		}
		else if(*q<' '){                /* do special characters */
			*r++ ='\\';
			*r++ = *q+ ('a'-1);
		}
		else {
			if(*q == '\\')          /* the special character */
				*r++ = *q;
			*r++ = *q;              /* non special characters */
		}
	}
	if(r >= &line[MAXLIN])                  /* get it back a bit */
		r = &line[MAXLIN-1];
	*r=0;
	return(r-line);                 /* length of line */
}

/*
 *      The 'stop' command , prints the message that it has stopped
 *    and then exits the 'user' program.
 */

int
stop()
{
	check();
	dostop(0);
	normret;
}

/*
 *      Called if trapped is set (by control-c ) and just calls dostop
 *    with a different parameter to print a slightly different message
 */

void
dobreak()
{
	dostop(1);
}

/*
 *      prints out the 'stopped' or 'breaking' message then exits.
 *    These two functions were lumped together so that it might be
 *    possible to add a 'cont'inue command at a latter date ( not
 *    implemented yet ) - ( it is now ).
 */

void
dostop(i)
int	i;
{
	if(cursor){
		cursor=0;
		prints( (char *)nl);
	}
	prints( (i) ? "breaking" : "stopped" );
	if(stocurlin){
		prsline(" at line ", stocurlin);
		if(!intrap){            /* save environment */
			cancont=i+1;
			save_env(&cont_env);
		}
	}
	prints( (char *)nl);
	reset();
}

/*      the 'cont' command - it seems to work ?? */

int
cont()
{
	check();
	if(contpos && !stocurlin){
		ret_env(&cont_env);	/* restore environment */
		clr_stack(bstack);	/* recover the old stack */
		bstack = savbstack;
		estack = savestack;
		savestack = savbstack = 0;
		if(contpos==1){
			contpos=0;
			normret;        /* stopped */
		}
		contpos=0;              /* ctrl-c ed */
		return(-1);
	}
	contpos=0;
	error(CANTCONT);
	normret;
}

/*
 *      The 'delete' command , will only delete the required lines if it
 *    can find the two end lines. stops ' delete 1' etc. as a slip up.
 *      very slow algorithm. But who cares ??
 */

int
bdelete()
{
	register lpoint	p3;
	register lpoint p1,p2;

	p1=getline();
	if(getch()!='-')
		error(SYNTAX);
	p2=getline();
	check();
	if(p1->linnumb > p2->linnumb)
		reset();
	if(p1 == program)
		program = p2->next;
	else {
		for(p3 = program ; p3->next != p1 ; p3 = p3->next);
		p3->next = p2->next;
	}
	for(p2 = p2->next; p1 != p2 ; p1 = p3){
		p3 = p1->next;
		mfree( (MEMP)p1);
	}
	reset();
	normret;
}

/*
 *      The 'shell' command , calls the v7 shell as an entry into unix
 *    without going out of basic. Has to set the terminal in a decent
 *    mode , else 'ded' doesn't like it.
 *      Clears out all buffered file output , so that you can see what
 *    you have done so far, and sets your userid to your real-id
 *    this stops people becoming unauthorised users if basic is made
 *    setuid ( for games via runfile of the command file ).
 */

#ifdef	MSDOS
#include <process.h>

shell()
{
	register char	*s;

	check();
	flushall();

	s = getenv("COMSPEC");
	if(!s || *s == 0)
		s = "command.com";
	spawnl(P_WAIT, s, s, (char *)0);
	normret;
}

#else

int
shell()
{
	int	i;
	STR	st = 0;
	int	c;
	memp	cmd = 0;

	c = getch();
	point--;
	if(!istermin(c)){
		st = stringeval();
		if(st->strlen){
			NULL_TERMINATE(st);
			cmd = st->strval;
		}
		else {
			FREE_STR(st);
			st = 0;
		}
	}
	check();
	i = do_system((memp)cmd);
	if(i == -1 && cmd == 0)
		prints("cannot shell out\n");
	if(st)
		FREE_STR(st);
	normret;
}

int
do_system(cmd)
CHAR	*cmd;
{
	register int    i;
#ifdef	__STDC__
	register SIGFUNC (*q)(int) , (*p)(int);
#else
	register SIGFUNC (*q)() , (*p)();
#endif
	char    *s;
	char	*args[4];
	int	status;
#ifdef  SIGTSTP
#ifdef	__STDC__
	SIGFUNC	(*t)(int);
#else
	SIGFUNC	(*t)();
#endif
#endif

	flushall();
	s = getenv("SHELL");
	if(!s || !*s)
		s = "/bin/sh";
	args[0] = "sh (from basic)";
	if(cmd != 0){
		args[1] = "-c";
		args[2] = (char *)cmd;
		args[3] = (char *)0;
	}
	else
		args[1] = (char  *)0;
#ifdef  VFORK
	i = vfork();
#else
	i=fork();
#endif
	if(i==0){
		rset_term(1);
		VOID setuid(getuid());       /* stop user getting clever */
		VOID execv(s, args);
		exit(-1);                       /* problem */
	}
	if(i == -1)
		return(i);
#ifdef  SIGTSTP
	t = signal(SIGTSTP, SIG_DFL);
#endif
	p=signal(SIGINT, SIG_IGN);       /* ignore some signals */
	q=signal(SIGQUIT, SIG_IGN);
	while(i != wait(&status) && i != -1); /* wait on the 'child' */
	VOID signal(SIGINT,p);          /* resignal to what they */
	VOID signal(SIGQUIT,q);         /* were before */
#ifdef  SIGTSTP
	VOID signal(SIGTSTP, t);
#endif
	set_term();
	rset_term(0);
	return(status);
}

#endif

static	const	char	bdircmd[] = "ls -C ";
#define	BDIRCMD_LEN	(sizeof(bdircmd)-1)

static	const	char	bdirlcmd[] = "ls -l ";
#define	BDIRLCMD_LEN	(sizeof(bdirlcmd)-1)

#ifdef	__STDC__
static	void	bdircom(const char *, ival);
#else
static	void	bdircom();
#endif

int
bdir()
{
	bdircom(bdircmd, (ival)BDIRCMD_LEN);

	normret;
}

int
bdirl()
{
	bdircom(bdirlcmd, (ival)BDIRLCMD_LEN);

	normret;
}

static void
bdircom(cmd, clen)
const char *cmd;
ival	clen;
{
	register STR	stc;
	register STR	st;
	int	c;

	c = getch();
	point--;
	if(!istermin(c)){
		st = stringeval();
		if(st->strlen == 0){
			FREE_STR(st);
			st = 0;
		}
	}
	else
		st = 0;
	check();
	if(st && st->strlen + clen + 1 > MAX_STR)
		error(9);
	stc = ALLOC_STR( (ival) (clen + 1 + (st ? st->strlen : 0)) );
	stc->strlen = clen;
	VOID strmov(stc->strval, (CHAR *)cmd, stc->strlen);
	if(st){
		VOID strmov(stc->strval+stc->strlen, st->strval, st->strlen);
		stc->strlen += st->strlen;
	}
		
	NULL_TERMINATE(stc);

	flushall();

	(void) do_system(stc->strval);
	FREE_STR(stc);
	if(st)
		FREE_STR(st);
}

/*
 *      The 'edit' command , can only edit in immeadiate mode , and with the
 *    specified line ( maybe could be more friendly here , no real need to
 *    since the editor is the same as on line input.
 */

int
editl()
{
	register lpoint p, pe, pt;
	register int	i;
	register lnumb	l1, l2;
	lpoint	lastl;
	int	fd;
	char	fname_tmp[MAXLIN];
	char	*fname;
	char	*et;
	static	const char	tname[] = "/tmp/be_tmp.";
	

	if(stocurlin || noedit)
		error(13);      /* illegal edit */

	l1=getlin();
        if(l1 == NOLNUMB){
                l2= NOLNUMB;
                if(getch()=='-'){
                        if( (l2 = getlin()) == NOLNUMB)
                                error(SYNTAX);
                }
                else
                        point--;
        }
        else  {
                if(getch()!='-'){
                        l2 = l1;
                        point--;
                }
                else
                        l2 = getlin();
        }
        check();
	
	/*
	 * l1 == NOLNUMB && l2 == NOLNUMB -> Full file
	 * l1 == NOLNUMB && l2 != NOLNUMB -> from start to l2 inclusive
	 * l1 != NOLNUMB && l2 == NOLNUMB -> from l1 -> end of file
	 * l1 != NOLNUMB && l2 != NOLNUMB -> from l1 -> l2 inclusive
	 */
	p = getsline(l1);
	if(l2 == NOLNUMB)
		pe = 0;
	else
		pe = getsline(l2);
	/*
	 * Check to see that end line is > first line
	 */
	if(l1 != NOLNUMB && l2 != NOLNUMB && l1 > l2)
		error(13);
	/*
	 * p == start, pe == last line pointer or NULL of no last line
	 */
	if(p == 0)
		goto do_edit;
	if(l1 == l2 && pe && (p->next == 0 || p->next->linnumb != CONTLNUMB)){
		/*
		 * OLD edit mode.
		 */
		i=listl(p);
		VOID edit((ival)0, (ival)i, (ival)0);	/* do the edit */
		if(trapped)             /* ignore it if exited via cntrl-c */
			reset();
		i=compile(0, nline, 0);
		if(linenumber)       /* ignore it if there is no line number */
			insert(i);
		reset();                /* return to 'ready' */
		normret;
	}
	if(pe)
		while(pe->next && pe->next->linnumb == CONTLNUMB)
			pe = pe->next;
	else
		for(pe = p ; pe->next ; pe = pe->next);
	/*
	 * PE now points to the last line to be edited.
	 */
do_edit:;
	et = getenv("EDITOR");
	if(et == 0 || *et == 0)
		et = "vi";
	et = str_cpy(et, fname_tmp);
	*et++ = ' ';
	fname = et;
	et = str_cpy( (CHAR *)tname, et);
	VOID str_cpy(printlin( (lnumb)getpid()), et);
	/*
	 * Create temporary file
	 */
	fd = creat(fname, 0600);
	if(fd < 0)
		error(13);

	for(pt = p;pt;pt = pt->next){
		i = listl(pt);
		line[i++] = '\n';
		if( write(fd, (char *)line, (unsigned)i) != i)
			error(60);
		if(pt == pe)
			break;
	}
	VOID close(fd);
	i = do_system(fname_tmp);
	if(i != 0){
		/*
		 * If edit failed, give up
		 */
		VOID unlink(fname);
		reset();
	}
	/*
	 * reopen file
	 */
	fd = open(fname, O_RDONLY);
	VOID unlink(fname);
	if(fd < 0)
		error(13);
	if(p){
		/*
		 * now delete the old lines
		 */
		if(p == program){
			program = pe->next;
			lastl = 0;
		}
		else {
			for(pt = program ; pt->next != p ; pt = pt->next);
			pt->next = pe->next;
			lastl = pt;
		}
		for(pe = pe->next; p != pe ; p = pt){
			pt = p->next;
			mfree( (MEMP)p);
		}
	}
	else
		lastl = 0;

	readfi(fd, lastl, 1);
	
	reset();                /* return to 'ready' */
	normret;
}

/*
 *      The 'auto' command , allows input of lines with automatic line
 *    numbering. Most of the code is to do with getting the arguments
 *    otherwise the loop is fairly simple. There are three ways of getting
 *    out of this routine. cntrl-c will exit the routine immeadiately
 *    If there is no linenumber then it also exits. If the line typed in is
 *    terminated by an ESCAPE character the line is inserted and the routine
 *    is terminated.
 */

int
dauto()
{
	register lnumb	start, end;
	register ival	i1;
	lnumb   i2;
	long    l;
	int     c;

	i2=autoincr;
	start=getlin();
	if( start != NOLNUMB){
		if(getch()!= ','){
			point--;
			i2=autoincr;
		}
		else {
			i2=getlin();
			if(i2 == NOLNUMB)
				error(SYNTAX);
		}
	}
	else
		start=autostart;
	check();
	autoincr=i2;
	end=i2;
	for(;;){
		i1= str_cpy( (CHAR *)printlin(start), line) - line;
		line[i1++]=' ';
		c=edit((ival)0, i1, (ival)1);
		if(trapped)
			break;
		i1=compile(0, nline, 0);
		if(!linenumber)
			break;
		insert((int)i1);
		if( (l= (long)start+end) >=65530){
			autostart=10;
			autoincr=10;
			error(6);       /* undefined line number */
		}
		start+=end;
		autostart= (lnumb)l;
		if(c == ESCAPE)
			break;
	}
	reset();
	normret;
}

/*
 *      The 'save' command , saves a basic program on a file.
 *    It just lists the lines adds a newline then writes them out
 */

int
save()
{
	register lpoint p;
	register int    fp;
	register int    i;
	STR	st;

	st = stringeval();     /* get the name */
	NULL_TERMINATE(st);
	check();
	if((fp=creat( (char *)st->strval,0644))== -1)
		error(14);              /* cannot creat file */
	FREE_STR(st);
	for(p= (lpoint)program ; p ; p = p->next ){
		i=listl(p);
		line[i++]='\n';
					/* could be buffered ???? */
		if(write(fp, (char *)line,(unsigned)i) != i)
			error(60);
	}
	VOID close(fp);
	normret;
}

/*
 *      The 'old' command , loads a program from a file. The old
 *    program (if any ) is wiped.
 *      Most of the work is done in readfi, ( see also error ).
 */

int
old()
{
	register int    fp;
	register STR	st;

	st = stringeval();		/* get the file name */
	NULL_TERMINATE(st);
	check();
	if((fp=open( (char *)st->strval,0))== -1)
		error(15);              /* can't open file */
	FREE_STR(st);
	clear_prog();
	readfi(fp, (lpoint)0, 0);                     /* read the new file */
	reset();
	normret;
}

static	void
clear_prog()
{
	register lpoint	p, p1;

	for(p1 = p = program ; p ; p = p1){
		p1 = p->next;
		mfree( (MEMP)p);
	}
	program = 0;
}

/*
 *      The 'merge' command , similar to 'old' but does not zap the old
 *    program so the two files are 'merged' .
 */

int
merge()
{
	register int    fp;
	register STR	st;

	st = stringeval();
	NULL_TERMINATE(st);
	check();
	if((fp=open( (char *)st->strval,0))== -1)
		error(15);
	FREE_STR(st);
	readfi(fp, (lpoint)0, 0);
	reset();
	normret;
}

/*
 *      The routine that actually reads in a file. It sets up readfile
 *    so that if there is an error ( linenumber overflow ) , then error
 *    can pick up the pieces , else the number of file descriptors are
 *    reduced and can ( unlikely ), run out of them so stopping any file
 *    being saved or restored , ( This is the reason that all files are
 *    closed so meticulacly ( see 'chain' and its  pipes ).
 */

void
readfi(fp, lp, isedit)
int	fp;
lpoint	lp;
int	isedit;
{
	register CHAR   *p;
	int     i;
	CHAR    chblock[BLOCKSIZ];
	int     nleft=0;
	register int    special=0;
	register CHAR   *q;

	readfile=fp;
	inserted=1;     /* make certain variables are cleared */
	p=line;         /* input into line[] */
	last_ins_line = lp;
	for(;;){
		if(!nleft){
			q=chblock;
			if( (nleft=read(fp, (char *)q,BLOCKSIZ)) <= 0)
				break;
		}
		*p= *q++;
		nleft--;
		if(special){
			special=0;
			if(*p>='a' && *p<='~'){
				*p -= ('a'-1);
				continue;
			}
		}
		if(*p =='\n'){
			*p=0;
			i=compile(0, nline, 0);
			if(!linenumber){
				if(!i){
					p = line;
					continue;
				}
				if(!last_ins_line && program && !isedit)
					goto bad;
				linenumber = CONTLNUMB;
				ins_line(last_ins_line, i);
				p = line;
				continue;
			}
			insert(i);
			p=line;
			isedit = 0;
			continue;
		}
		else if(*p == '\t'){
			i = 8 - (p - line) & 7;
			while(i && p < &line[MAXLIN]){
				*p++ = ' ';
				i--;
			}
			continue;
		}
		else if(*p<' ')
			goto bad;
		else if(*p=='\\')
			special++;
		if(++p > &line[MAXLIN])
			goto bad;
	}
	if(p!=line)
		goto bad;
	VOID close(fp);
	readfile=0;
	return;

bad:    VOID close(fp);         /* come here if there is an error */
	readfile=0;             /* that readfi() has detected */
	error(57);              /* stops error() having to tidy up */
}

/*
 *      The 'new' command , This deletes any program and clears all
 *    variables , can take an extra parameter to say how many files are
 *    needed. If so then clears the number of buffers ( default 2 ).
 */

int
neww()
{
	register int    i,c;

	c=getch();
	point--;
	if(!istermin(c)){
		i=evalint();
		check();
		if(i<0 || i> MAXFILES)
			i=2;
		ncurfiles = 0;
		maxfiles = i;
	}
	else
		check();
	autostart=10;
	autoincr=10;
	baseval=1;
	drg_opt = OPT_RAD;
	closeall();             /* flush the buffers */
	clear_prog();	/* delete the program */
	clear();	/* clear the variables */
	reset();
	NO_RET;
}

/*
 *      The 'chain' command , This routine chains the program.
 *      all simple numeric variables are kept. ( max of 4 k ).
 *      all other variables are cleared.
 *      runs the loaded file
 *      files are kept open
 *
 *      error need only check pipe[0] to see if it is to be closed.
 */

int
chain()
{
	register int     fp;
	register lpoint	lp;
	register lnumb	ln = NOLNUMB;
	int	all = 0;
	STR	st;

	st = stringeval();
	NULL_TERMINATE(st);

	if(getch() == ','){
		ln = getlin();
		if(ln == NOLNUMB){
			point--;
			if(getch() != ALL)
				error(SYNTAX);
			all = 1;
		}
		else {
			if(getch() == ','){
				if(getch() != ALL)
					error(SYNTAX);
				all = 1;
			}
			else
				point--;
		}
	}
	else
		point--;
	check();
	if((fp=open( (char *)st->strval,0))== -1)
		error(15);
	FREE_STR(st);
	clear_prog();
	ch_clear(all);
	trap_env.e_stolin = 0;
	readfi(fp, (lpoint)0, 0);
	inserted=0;                     /* say we don't actually want to */
	stocurlin = program;		/* defeat getslines algorithm */
	lp = getsline(ln);
	stocurlin = lp;
	if(!lp)
		reset();
	point= lp->lin;
	elsecount=0;
	return(-1);                     /* now run the file */
}

/* define a function def fna() - can have up to 127 parameters */


int
defproc()
{
	return(def_fn(IS_MPR, 1));
}

int
bdeffn()
{
	return(def_fn(IS_MFN, 1));
}

int
deffunc()
{
	return(def_fn(IS_MFN, 0));
}

static	int
def_fn(ftyp, dftyp)
int	ftyp, dftyp;
{
	struct  deffn   fn;     /* temporary place for evaluation */
	register struct deffn *p;
	register CHAR   *l;
	register int     i=0;
	int     c;
	struct	entry	*ep;
	char	vty;
	lpoint	lp;
	struct	entry	*args[FN_MAX_ARGS];
	struct	entry	**arg, **carg;

	c = getch();
	if(!dftyp){
		if(c != FN)
			error(SYNTAX);
	}
	else
		point--;
	/*LINTED*/
	if(!ispletter(point))
		error(SYNTAX);
	ep = getnm(ISFUNC, 1);
	if(ep)
		error(REDEFFN);

	ep = newentry;
	vty = vartype;		/* save return type of function */

	fn.ncall = 0;
	arg = args;

	if(*point=='('){        /* get arguments */
		point++;
		for(;i< FN_MAX_ARGS;i++){
			VOID getname(0);	/* don't need value just entry*/
			if(curentry->dimens)
				error(VARREQD);
			if(vartype == SVAL && (curentry->flags & IS_FSTRING))
				error(VARREQD);
			for(carg = args ; carg < arg ; carg++)
				if(*carg == curentry)
					error(42);
			*arg++ = curentry;
					/* save type of arguments */
			if((c=getch())!=',')
				break;
		}
		if(c!= ')')
			error(SYNTAX);
		i++;
	}
	fn.narg = (char)i;
	fn.mline = IS_FN;
	if( (c = getch()) != '='){
		/*
		 * a multi line function
		 */
		/*
		 * make certain that this is the last command on the line
		 */
		if(c)
			error(SYNTAX);
		point--;
		if(!stocurlin)
			reset();
		for(lp = stocurlin->next ; lp ; lp = lp->next){
			for(l = lp->lin ; *l == ' ' ; l++);
			if(*l == (CHAR)FNEND)
				break;
		}
		if(!lp)
			error(42);
		lp = lp->next;
		fn.mline = (char)ftyp;
		fn.mpnt = stocurlin->next;
							  /* get the space */
		i = fn.narg * sizeof(struct entry *);
		ep->_deffn = (deffnp) mmalloc((ival)(sizeof(struct deffn) + i));
		fn.vargs = (struct entry **)(ep->_deffn + 1);
		for(arg = fn.vargs, i = 0 ; i < fn.narg ; i++, arg++)
			*arg = args[i];
		*ep->_deffn = fn;
		newentry = 0;
		ep->vtype = ISFUNC | vty;
		if(!lp)
			reset();
		stocurlin = lp;
		point = lp->lin;
		elsecount = 0;
		return(-1);
	}
	if(ftyp != IS_MFN)
		error(SYNTAX);
	l = point;
	while(*l++ == ' ');
	point = --l;
	while(!istermin(*l))    /* get rest of expression */
		l++;
	if(l==point)
		error(SYNTAX);
	c = ((l - point + 1) + WORD_MASK) & ~WORD_MASK;
	i = c + (fn.narg * sizeof(struct entry *)) + sizeof(struct deffn);
	p= (deffnp) mmalloc((ival)i);			/* get the space */
	/*LINTED*/
	fn.vargs = (struct entry **)((memp)(p + 1) + c);
	for(arg = fn.vargs, i = 0 ; i < fn.narg ; i++, arg++)
		*arg = args[i];
	newentry = 0;
	ep->vtype = ISFUNC | vty;
	*p = fn;
	*strmov(p->exp, point, (ival)(l - point)) = 0;
	point = l;
	ep->_deffn = p;
	normret;
}

/* the repeat part of the repeat - until loop */
/* now can have a construct like  'repeat until eof(1)'. */
/* It might be of use ?? it's a special case */

int
rept()
{
	register struct forst   *p;
	register CHAR   *tp;

	if(getch() == UNTIL){
		tp = point;     /* save point */
		eval();         /* calculate the value */
		check();        /* check syntax */
				/* now repeat the loop until <>0 */
		while(IS_ZERO(res) && !trapped){
			point = tp;
			eval();
		}
		if(trapped)
			return(-1);
		normret;
	}
	point--;
	check();
	p = (forstp)mmalloc((ival)sizeof(struct forst));
	if((p->prev = estack) != 0)
		p->prev->next = p;
	else
		bstack = p;
	p->next = 0;
	estack = p;
	p->pt = point;
	p->stolin = stocurlin;
	p->elses = elsecount;
	p->fortyp = REPTYP;	/* get the right type */
	normret;
}

/* the until bit of the command */

int
untilf()
{
	register struct forst   *p;
	eval();
	check();
	for(p = bstack ; p ; p = p->prev)
		if(p->fortyp != FORTYP){
			if(p->fortyp == REPTYP)
				goto got;
			error(51);
		}
	error(48);
got:
	if(IS_ZERO(res)){	/* not true so repeat loop */
		elsecount = p->elses;
		point = p->pt;
		stocurlin = p->stolin;
				/* pop all off stack up until here */
		if(p->next){
			clr_stack(p->next);
			p->next = 0;
		}
		estack = p;
	}
	else {			/* pop stack if finished here. */
		if( (estack = p->prev) == 0)
			bstack = 0;
		else
			p->prev->next = 0;
		clr_stack(p);
	}
	normret;
}

/* while part of while - wend construct. This is like repeat until unless
 * loop fails on the first time. (Yeuch - next we need syntax checking on
 * input ).
 */


int
whilef()
{
	register CHAR    *spoint = point;
	register lpoint lp;
	register struct forst   *p;

	eval();
	check();
	if(!IS_ZERO(res)){
		/* got to go through it once so make it look like a */
		/* repeat - until */
		p = (forstp)mmalloc((ival)sizeof(struct forst));
		if((p->prev = estack) != 0)
			p->prev->next = p;
		else
			bstack = p;
		p->next = 0;
		estack = p;
		p->pt = spoint;
		p->stolin = stocurlin;
		p->elses = elsecount;
		p->fortyp = WHLTYP;	/* the right type */
		normret;
	}
	lp=get_end();                   /* otherwise find a wend */
	check();
	if(stocurlin)
		stocurlin =lp;
	normret;
}

/* the end part of a while loop - wend */

int
wendf()
{
	register struct forst   *p;
	CHAR    *spoint =point;

	check();
	for(p = estack ; p ; p = p->prev)
		if(p->fortyp != FORTYP){
			if(p->fortyp == WHLTYP)
				goto got;
			error(51);
		}
	error(49);
got:
	point = p->pt;
	eval();
	if(IS_ZERO(res)){		/* failure of the loop */
		if( (estack = p->prev) == 0)
			bstack = 0;
		else
			p->prev->next = 0;
		clr_stack(p);
		point = spoint;
		normret;
	}
				/* pop stack after an iteration */
	if(p->next){
		clr_stack(p->next);
		p->next = 0;
	}
	estack = p;
	elsecount = p->elses;
	stocurlin = p->stolin;
	normret;
}

/* get_end - search from current position until found a wend statement - of
 * the correct nesting. Keeping track of elses + if's(Yeuch ).
 */

static	lpoint
get_end()
{
	register lpoint lp;
	register CHAR   *p;
	register int    c;
	int     wcount=0;
	int     rcount=0;
	int     flag=0;

	p= point;
	lp= stocurlin;
	if(getch()!=':'){
		if(!stocurlin)
			error(50);
		if( (lp = lp->next) == 0)
			error(50);
		point = lp->lin;
		elsecount=0;
	}
	for(;;){
		c=getch();
		if(c==WHILE)
			wcount++;
		else if(c==WEND){
			if(--wcount <0)
				break;  /* only get out point in loop */
		}
		else if(c==REPEAT)
			rcount++;
		else if(c==UNTIL){
			if(--rcount<0)
				error(51);      /* bad nesting */
		}
		else if(c==IF){
			flag++;
			elsecount++;
		}
		else if(c==ELSE){
			flag++;
			if(elsecount)
				elsecount--;
		}
		else if(c==REM || c==DATA || c==QUOTE){
			if(!stocurlin)
				error(50);      /* no wend */
			if( (lp = lp->next) == 0)
				error(50);      /* no wend */
			point =lp->lin;
			elsecount=0;
			flag=0;
			continue;
		}
		else for(p=point;!istermin(*p);p++)
			if(*p=='"' || *p=='`'){
				c= (int)*p++;
				while(*p && *p != (CHAR) c)
					p++;
				if(!*p)
					break;
			}
		if(!*p++){
			if(!stocurlin)
				error(50);
			if( (lp = lp->next) == 0)
				error(50);      /* no wend */
			point =lp->lin;
			elsecount=0;
			flag=0;
		}
		else
			point = p;
	}
	/* we have found it at this point - end of loop */
	if(rcount || (lp!=stocurlin && flag) )
		error(51);      /* bad nesting or wend after an if */
	return(lp);             /* not on same line */
}

/*
 * the renumber routine. It is a three pass algorithm.
 *      1) Find all line numbers that are in text.
 *         Save in table.
 *      2) Renumber all lines.
 *         Fill in table with lines that are found
 *      3) Find all line numbers and update to new values.
 *
 *      This routine eats stack space and also some code space
 *      If you don't want it don't define RENUMB.
 *      Could run out of stack if on V7 PDP-11's
 *      ( On vax's it does not matter. Also can increase MAXRLINES.)
 *      MAXRLINES can be reduced if not got split i-d. If this is
 *      the case then probarbly do not want this code anyway.
 */

struct  ta {
	lnumb	linn;
	lnumb	toli;
};

int
renumb()
{
	struct  ta      *ta, *eta;
	register struct ta *tp;
	register CHAR   *q;
	register lpoint p;
	register lpoint np;
	int	c;
	lnumb	l1,start,inc;
	int     size,pl;
	CHAR    onfl,chg,*r,*s;
	long    numb;
	int	err = 0;

	start = 10;
	inc = 10;
	l1 = getlin();
	if(l1 != NOLNUMB){              /* get start line number */
		if(l1 == 0)
			error(5);
		start = l1;
		if(getch() != ',')
			point--;
		else {
			l1 = getlin();          /* get increment */
			if(l1 == NOLNUMB || l1 == 0)
				error(5);
			inc = l1;
		}
	}
	check();                /* check rest of line */
	/*
	 * find out number of lines there are and allocate an array for them
	 */
	for(numb = 0, p=program; p ;p= p->next)
		if(p->linnumb != CONTLNUMB)
			numb++;
	/*
	 * nothing to do give up.
	 */
	if(!numb)
		reset();
	/*
	 * also check to see if we are going to overflow linenumbers
	 */
	if( (numb * inc) + start > 65530L)
		error(7);
	ta = (struct ta *)mmalloc((ival)(numb * sizeof(struct ta)));
	renstr = (MEMP)ta;

	/*
	 * now set up the renumbered line numbers
	 */
	l1 = start;           /* reset counter */
	for(tp = ta, p = program ; p ; p = p->next){
		if(p->linnumb == CONTLNUMB)
			continue;
		tp->linn = p->linnumb;
		tp->toli = l1;
		l1 += inc;
		tp++;
	}

	eta = tp;
	for(p=program; p ;p= p->next){
		onfl = 0;               /* flag to deal with on_goto */
		for(q = p->lin; *q ; q++){      /* now find keywords */
			if( ((c = UC(*q)) & SPECIAL) == 0)
				continue;
			if(c >= EXFUNC){
				q++;
				continue;
			}
			if(c == ON){            /* the on keyword */
				onfl++;                 /* set flag */
				continue;
			}               /* check items with optional numbers*/
			if(c == ELSE || c == THEN || c == RESUME || c == RESTORE
								|| c == RUNN ){
				q++;
				while(*q++ == ' ');
				q--;
				if(ispnumber(q))        /* got one ok */
					goto ok1;
			}
			if(c != GOTO && c != GOSUB)
				continue;       /* can't be anything else */
			q++;
		ok1:                            /* have a label */
			do{
				while(*q++ == ' ');
				q--;                    /* look for number */
				if( !ispnumber(q) ){
					prsline("Line number required on line ",
									p);
					prints((char *)nl);	/* missing */
					err = 1;
					goto out1;
				}
				for(l1 = 0; ispnumber(q) ; q++) /* get it */
					if(l1 >= 6553)
						error(7);
					else l1 = l1 * 10 + *q - '0';
				if(l1 == 0){
					onfl = 0;
					break;
				}
				for(tp  = ta ; tp < eta ; tp++) /* already */
					if(tp->linn == l1)      /* got it ? */
						break;
				if(tp >= eta ){        /* undefined line */
					prints("undefined line: ");
					printd(l1);
					prsline(" on line ", p);
					prints((char *)nl);  /* can't find it */
					err = 1;
					goto out1;
				}
				if(!onfl)               /* check flag */
					break;          /* get next item */
				while(*q++== ' ');      /* if ON and comma */
			}while( *(q-1) ==',');
			if(onfl)
				q--;
			onfl = 0;
			q--;
		}
	out1:   ;
	}
	/*
	 * if had an error don't do the renumbering
	 */
	if(err){
		mfree( (memp)renstr);
		renstr = 0;
		reset();
	}
	/*
	 * renumber the lines
	 */
	l1 = start;           /* reset counter */
	for(p= program ; p ;p= p->next){
		if(p->linnumb == CONTLNUMB)
			continue;
		p->linnumb = l1;
		l1 += inc;
	}
	for(np = 0, p= program ; p ;np = p, p= p->next ){
		onfl = 0;
		chg = 0;                        /* set if line changed */
		for(r = nline, q = p->lin ; *q ; *r++ = *q++){
			if(r >= &nline[MAXLIN])  /* overflow of line */
				break;
			if( ((c = UC(*q)) & SPECIAL) == 0)
				continue;
			if(c >= EXFUNC){
				*r++ = *q++;
				continue;
			}

			if(c == ON){
				onfl++;
				continue;
			}
			if(c == ELSE || c == THEN || c == RESUME || c == RESTORE
								|| c == RUNN ){
				*r++ = *q++;
				while(*q == ' ' && r < &nline[MAXLIN] )
					*r++ = *q++;
				if(ispnumber(q)) /* got optional line number*/
					goto ok2;
			}
			if(c != GOTO && c != GOSUB)
				continue;
			*r++ = *q++;
			for(;;){
				while(*q == ' ' && r < &nline[MAXLIN] )
					*r++ = *q++;
			ok2: ;
				if(r>= &nline[MAXLIN] )
					break;
				for(l1 = 0 ; ispnumber(q) ; q++) /* get numb*/
					l1 = l1 * 10 + *q - '0';

				if(l1 == 0)         /* skip if not found */
					goto out;

				for(tp = ta ; tp->linn != l1 ; tp++);

				if(tp->linn != tp->toli)
					chg++;       /* number has changed */
							/* get new number */
				s = (CHAR *)printlin(tp->toli);
				while( *s && r < &nline[MAXLIN])
					*r++ = *s++;
				if(r >= &nline[MAXLIN] )
					break;
				if(!onfl)	/* repeat if ON statement */
					break;
				while(*q == ' ' && r < &nline[MAXLIN])
					*r++ = *q++;
				if(*q != ','){
					onfl = 0;
					break;
				}
				*r++ = *q++;
			}
			onfl = 0;
			if(r >= &nline[MAXLIN])	/* line length overflow */
				error(32);
		}
		if(!chg)                /* not changed so don't put back */
			continue;
		inserted =1;            /* say we have changed it */
		*r = 0;
		size = (r - nline) + sizeof(struct olin); /* get size */
/*
		size = (size + 03) & ~03;
*/
		pl = p->linnumb;        /* save line number */
		p = (lpoint)mmalloc( (ival)size);
		p->linnumb = pl;        /* restore line number*/
		if(!np){		/* first line */
			p->next = program->next;
			mfree( (MEMP)program);
			program = p;
		}
		else {
			p->next = np->next->next;
			mfree( (MEMP) np->next);
			np->next = p;
		}
		VOID str_cpy(nline,p->lin);   /* copy back new line */
	out:    ;
	}
	mfree( (MEMP)renstr);
	renstr = 0;
	reset();
	normret;
}