/************************************************************************
*									*
*		   C Prolog	evalp.c					*
*		   ========	-------					*
*									*
*  By Fernando Pereira, July 1982.					*
*  EdCAAD, Dept. of Architecture, University of Edinburgh.		*
*									*
*  Based on the Prolog system written in IMP by Luis Damas for ICL 2900	*
*  computers, with some contributions by Lawrence Byrd.  Stricter types	*
*  and several extensions by Richard O'Keefe, also BACKWARDS support.	*
*									*
*  Copyright (C) 1982 Fernando Pereira, Luis Damas and Lawrence Byrd.	*
*  Copyright (C) 1984 F.Pereira, L.Damas, L.Byrd and R.A.O'Keefe.	*
*									*
************************************************************************/

/*----------------------------------------------------------------------+
|									|
|			Evaluable Predicates				|
|									|
|   This file contains the definitions of the evaluable predicates.  A	|
|   table of the numbers assigned to them may be found in evalp.h, and	|
|   the numbers assigned to the predicates  in  pl/init  must  be  the	|
|   same.   There are two sorts of evaluable predicates, ones which do	|
|   not have a stack frame built for them -- defined by $sysp(P,N)  --	|
|   and those which do have a frame -- defined by P:-N -- and most are	|
|   the latter sort.  The predicates fall into 6 major groups:		|
|       group 1: control predicates					|
|       group 2: arithmetic predicates					|
|       group 3: metalogical predicates					|
|       group 4: data base predicates					|
|       group 5: input/output and other file-system access		|
|       group 6: flags of various sorts					|
|   As part of an effort to make C Prolog faster, I have put  as  many	|
|   of  the  local  variables  as  possible into registers below.  The	|
|   Prolog X register is used so often  that  it  seemed  worth  while	|
|   making  it  into  a C register as well.  A number of other changes	|
|   were made as well, so I am not sure what the effect of this change	|
|   is on its own.  heap0 and glb0 are kept in registers all the time.	|
|									|
+----------------------------------------------------------------------*/

    {
	register FRAME *rX = X;
#	define constarg(v,c) unifyarg(Addr(rX->v), c, NullP)

#ifdef	COUNTING
	instrct[PredNo]++;
#endif	COUNTING
	switch (PredNo) {


/*----------------------------------------------------------------------+
|									|
|		Group 1: control predicates				|
|									|
+----------------------------------------------------------------------*/

	case _and_:		/* conjunction: A,B */
	    {
		register PTR conjunct = arg(SkelP(g)->Arg2, x1);
		register PTR t = v1;

		MolP(t)->Sk = Addr(HiddenCall->gtoffe),
		MolP(t)->Env= t+2,
		*CellP(t+2) = conjunct,
		conjunct = t, t += 3;
		if (c != NullP) {
		    SkelP(t)->Fn   = commatag,
		    SkelP(t)->Arg1 = conjunct,
		    SkelP(t)->Arg2 = c,
		    c = t, t += 3;
		} else {
		    c = conjunct;
		}
		v1 = t;
	    }
	    /* there is no break between this case and the next */

	case _hidden_call_:	/* $hidden_call(Goal) */
	    {
		register PTR goal = arg(SkelP(g)->Arg1, x1);

		if (IsPrim(goal)) goto FAIL;
		if (IsUnbound(goal)) {
		    ErrorMess = "! unbound goal";
		    goto ERROR;
		}
		pg = goal;
		goto CALL;
	    }

	case _user_call_:	/* revive tracing (for setof, etc.) */
	    usermode = TRUE, lev++;
	    /* there is no break between this case and the next */

	case _call_:		/* call(Goal) */
	    {
		register PTR goal = rX->v1ofcf;
		
		if (IsPrim(goal)) goto FAIL;
		if (IsUnbound(goal)) {
		    ErrorMess = "! call/1: unbound goal";
		    goto ERROR;
		}
		pg = goal;
		goto CALL;
	    }

	case _user_exec_:	/* $user_exec(CommandOrQuestion) */
	    {
		register PTR goals = rX->v1ofcf;

		if (IsPrim(goals)) goto FAIL;
		if (IsUnbound(goals)) {
		    ErrorMess = "! unbound goal";
		    goto ERROR;
		}
		c = goals;
		GrowLocal(1);	/* argument was temporary */
		sklev = 0, lev = 1, invokno = 0, usermode = TRUE;
		info = (1<<LEVEL_WIDTH)|1|FRM0;
		/*  This is a quick patch, not a principled correction  */
		if (debug) {
		    spy = SPY_ME;
		    if (dotrace) sklev = NEVER_SKIP, dotrace = FALSE;
		}
		goto EXIT;
	    }

	case _call1_:		/*  $call(Goal) */
	    {
		register PTR goal = arg(SkelP(g)->Arg1, x1);

		c = rX->cofcf, X = rX->gfofcf;
		if (IsPrim(goal)) goto FAIL;
		if (IsUnbound(goal)) {
		    ErrorMess = "! $call/1: unbound goal";
		    goto ERROR;
		}
		pg = goal;
		goto CALL;
	    }

	case _cut_:		/* cut: ! */
	    if (rX > VV) goto EXIT;	/* determinate already */
	    VV = rX->lcpofcf;
	    vv1 = VV->gsofcf,
	    V = FrameP((PTR)rX + szofcf + ClauseP((PTR)(rX->altofcf)-
		(Addr(NullC->altofcl)-NullP))->ltofcl);
	    /*  All this dodging around is because X->altofcf points not
		to the current clause, but to the successor  pointer  of
		the  current  clause.   So  we  have to subtract off the
		offset to get back to the current clause before  we  can
		find out how many local variables we had.
	    */
	    if (rX->trofcf != tr) {
		register PTR *old_tr = CellP(rX->trofcf);
		register PTR *new_tr = old_tr;
		register PTR tr_entry;
		while (old_tr != CellP(tr)) {
		    tr_entry = *old_tr++;
#ifdef	BACKWARDS
		    if (!IsaRef(tr_entry) || tr_entry < vv1
		    || tr_entry >= lcl0 && tr_entry < vv)
			*new_tr++ = tr_entry;
#else  ~BACKWARDS
		    /* This is an optimised version of the test above */
		    if (SC(tr_entry,<,vv1) || tr_entry >= lcl0 && tr_entry < vv)
			*new_tr++ = tr_entry;
#endif	BACKWARDS
		}
		tr = (PTR)new_tr;
	    }
	    if (c == NullP) {
		c = rX->cofcf, pg = rX->gofcf,
		X = rX->gfofcf, info = rX->infofcf;
		lev = info&LEVEL, usermode = IsVisible(info);
		goto neckfoot;
	    }
	    goto EXIT;

	case _repeat_:		/* repeat */
	    VV = rX, vv1 = x1, *fl = d;
	    goto EXIT;

	case _abort_:		/* abort */
	    goto aborting;

	case _fail_:		/* fail */
	    goto FAIL;
	    /*  Once upon a time this had no definition, and thus failed.
	    /*  However, when the unknown/2 flag was introduced, it used
	    /*  to turn up all the time as an undefined predicate.  This
	    /*  also gives us a chance to collect statistics on its use.
	    */

	case _halt_:		/* halt */
	    Halt(0);		/* does not return */

	case _yes_:		/* top level success in bootstrap */
	    ResetTrail();
	    goto BootLoop;

	case _no_:		/* top level failure in bootstrap */
	    PutString("no\n");
	    goto BootLoop;

	case _break_:		/* $break(Goal) */
	    {
/*---		This is called in just three places in pl/init.  In each
		place it is an atom or compound term, so there is no need
		to check.  If you change C-Prolog so that that no longer
		holds, reinstate the following tests.

		register PTR goal = arg(SkelP(g)->Arg1, x1);

		if (IsPrim(goal)) goto FAIL;
		if (IsUnbound(goal)) {
		    ErrorMess = "! $break/1: unbound goal";
		    goto ERROR;
		}
		k = goal;
/*---*/
		k = arg(SkelP(g)->Arg1, x1);
		brtn = 1; savevars(); pg = k;
		dotrace = debug = spy = FALSE;
		goto CALL;
	    }

	case _break_start_:	/* $break_start */
	    fprintf(stderr, "[ Break (level %d) ]\n", brklev);
	    goto EXIT;

	case _break_end_:	/* $break_end */
	    fprintf(stderr, "[ End break (level %d) ]\n", brklev);
	    goto EXIT;

	case _exit_break_:	/* $exit_break */
	    restvars();
	    switch (brtn) {
		case 1: goto EXIT;
		case 2: goto message;
		case 3: goto CALL;
	    }
	    abort();

	case _repply_:		/* $repply */
	    Put(' ');		/*  the (Prolog) caller has to set Output  */
	    for (;;) switch (ToEOL()) {
		case '?':
		case 'h':
			fprintf(stderr, "t switches tracing on, n switches it off\n");
			fprintf(stderr, "Type ; or y for next answer: ");
			continue;
		case 't':
			debug = dotrace = TRUE;
			goto FAIL;
		case 'n':
			debug = dotrace = FALSE;
			goto FAIL;
		case ';':
		case 'y':
			goto FAIL;
		default:
			goto EXIT;
	    }


/*----------------------------------------------------------------------+
|									|
|		Group 2: arithmetic predicates				|
|									|
+----------------------------------------------------------------------*/

	case _ncompare_+EQ:	/*  Lhs =:= Rhs  */
	case _ncompare_+NE:	/*  Lhs =/= Rhs  */
	case _ncompare_+LT:	/*  Lhs  <  Rhs  */
	case _ncompare_+GT:	/*  Lhs  >  Rhs  */
	case _ncompare_+LE:	/*  Lhs =<  Rhs  */
	case _ncompare_+GE:	/*  Lhs  >= Rhs  */
	    TRY(numcompare(PredNo-_ncompare_, Addr(rX->v1ofcf), Addr(rX->v2ofcf)));

	case _lseq_:		/*  lseq(Lhs, Rhs) */
	    {
		register PTR lhs = rX->v1ofcf;
		register PTR rhs = rX->v2ofcf;

		if (IsaRef(lhs) && IsUnbound(lhs) ?
		    IsaRef(rhs) && IsUnbound(rhs) || IsInt(rhs)
		  : IsaRef(rhs) && IsUnbound(rhs) && IsInt(lhs)) {
		    ErrorMess = "! lseq/2: instantiation fault";
		    goto ERROR;
		}
		TRY(IsInt(lhs) && IsInt(rhs) && XtrInt(lhs) <= XtrInt(rhs));
	    }

	case _succ_:		/*  succ(Pred,Succ)  */
	    {
		register PTR argone = rX->v1ofcf;
		register PTR argtwo = rX->v2ofcf;

		if (IsPosInt(argone)) {
		    register Sint succ = XtrPosInt(argone)+1;
		    TRY(constarg(v2ofcf, ConsInt(succ)));
		} else
		if (IsPosInt(argtwo)) {
		    register Sint pred = XtrPosInt(argtwo)-1;
		    if (pred >= 0) { k = ConsInt(pred); goto unifyatom; }
		}
		if (IsaRef(argone) && IsUnbound(argone)
		&&  IsaRef(argtwo) && IsUnbound(argtwo)) {
		    ErrorMess = "! succ/2: instantiation fault";
		    goto ERROR;
		}
		goto FAIL;
	    }

	case _is_:		/*  Var is Expr */
	    k = numeval(Addr(rX->v2ofcf));
unifyatom:			/* unify atom k with arg in v1ofcf */
	    {
		register PTR argone = rX->v1ofcf;

		if (IsaRef(argone) && IsUnbound(argone)) {
		    VarVal(argone) = k;
		    TrailReg(argone);
		    goto EXIT;
		}
		TRY(argone == k);
	    }

	case _is_+1:		/*  is(Var,Op,Rhs)  */
	case _is_+2:		/*  is(Var,Op,Lhs,Rhs)  */
	    {
		register PTR op = rX->v2ofcf;
		if (IsPrim(op) || !IsAtomic(op)) {
		    ErrorMess = "! is/3-4: arg 2 not an atom";
		    goto ERROR;
		}
		MolP(v1)->Sk  = Addr(fentry(AtomP(op), PredNo-_is_)->gtoffe);
		MolP(v1)->Env = Addr(rX->v3ofcf);
		k = numeval(Addr(v1));
		goto unifyatom;
	    }

	case _plus_:		/* plus(Addend,Augend,Sum) */
#	    define getintarg(a,f) a = rX->f;\
		   if (IsaAtomic(a)) {if (!IsInt(a)) goto FAIL;}\
		   else {if (!IsUnbound(a)) goto FAIL; n++;}
#	    define tryintarg(f,b,op,c)\
		    constarg(f, ConsInt(XtrInt(b) op XtrInt(c)))
	    {
		register PTR p, q, r;
		n = -1;
		getintarg(p, v1ofcf)
		getintarg(q, v2ofcf)
		getintarg(r, v3ofcf)
		if (n > 0) {	/* two or more variables */
		    ErrorMess = "! plus/3: instantiation fault";
		    goto ERROR;
		}
		TRY(IsaRef(p) ? tryintarg(v1ofcf, r,-,q)
		  : IsaRef(q) ? tryintarg(v2ofcf, r,-,p)
		  :		tryintarg(v3ofcf, p,+,q) );
	    }


/*----------------------------------------------------------------------+
|									|
|		Group 3: meta-logical predicates			|
|		Subgroups: type tests, comparison, name, term hacking	|
|									|
+----------------------------------------------------------------------*/

	/*	Group 3.1: type tests	*/

	case _var_:		/* var(Var) */
	    {	register PTR argone = rX->v1ofcf;
		TRY( (IsaRef(argone) && IsUnbound(argone)) );
	    }

	case _nonvar_:		/* nonvar(Var) */
	    {	register PTR argone = rX->v1ofcf;
		TRY(!(IsaRef(argone) && IsUnbound(argone)) );
	    }

	case _integer_:		/* integer(Var) */
	    TRY(IsInt(rX->v1ofcf));

	case _number_:		/* number(Var) */
	    TRY(IsNumber(rX->v1ofcf));

	case _primitive_:	/* primitive(Var) */
	    TRY(IsPrim(rX->v1ofcf));

	case _db_reference_:	/* db_reference(Var) */
	    TRY(IsDBRef(rX->v1ofcf));

	case _atomic_:		/* atomic(Var) */
	    TRY(IsaAtomic(rX->v1ofcf));

	case _atom_:		/* atom(Var) */
	    {	register PTR argone = rX->v1ofcf;
		TRY(!IsPrim(argone) && IsaAtomic(argone));
	    }

	/*	Group 3.2: comparison	*/

	case _kcompare_:	/* $compare(R, T1, T2, N) */
	    /*  This is a hack for the sorting routines.  It lets us
		compare corresponding arguments of two terms without
		taking the terms apart by pattern matching.  We save
		two things: time and global stack space, both vital.
	    */
	    {
		register PTR a, b;
		int WhichArg;

		a = rX->v4ofcf;	/* argument number */
		if (!IsPosInt(a)) goto FAIL;
		if ((WhichArg = XtrPosInt(a)) == 0) {
		    k = (PTR)acompare();
		    goto unifyatom;
		}
		b = rX->v3ofcf;	/* second term */
		if (!IsaRef(b) || IsUnbound(b)) goto FAIL;
		a = rX->v2ofcf;	/* first term */
		if (!IsaRef(a) || IsUnbound(a)) goto FAIL;
		b = (PTR)kcompare(MolP(a)->Sk, MolP(a)->Env,
				  MolP(b)->Sk, MolP(b)->Env, WhichArg);
		TRY(b != NullP && constarg(v1ofcf, b));
	    }

	case _compare_:		/* compare(Op,T1,T2) */
	    k = (PTR)acompare();
	    goto unifyatom;

	case _tcompare_+EQ:	/* T1 == T2 */
	    TRY(icompare() == 0);

	case _tcompare_+NE:	/* T1 \== T2 */
	    TRY(icompare() != 0);

	case _tcompare_+LT:	/* T1 @< T2 */
	    TRY(icompare() < 0);
	
	case _tcompare_+GT:	/* T1 @> T2 */
	    TRY(icompare() > 0);

	case _tcompare_+LE:	/* T1 @=< T2 */
	    TRY(icompare() <= 0);
	
	case _tcompare_+GE:	/* T1 @>= T2 */
	    TRY(icompare() >= 0);

	/*	Group 3.3: name	*/

	case _name_:		/*  name(Atom, String) */
	    k = rX->v1ofcf;
	    if (!IsaAtomic(k)) {
		if (!IsUnbound(k)) goto FAIL;
		if (!list_to_string(rX->v2ofcf, OutBuf, 255)) {
		    ErrorMess = "! name/2: argument 2 is not a string";
		    goto ERROR;
		}
		bn = OutBuf;
		if (!NumberString(&bn, &k, FALSE)) k = (PTR)lookup(OutBuf);
		goto unifyatom;
	    }
	    {
		register PTR  list = v+2;
		register PTR *cons = CellP(list);
		register char *str;

		if (!IsPrim(k)) {	/* atom */
		    str = AtomP(k)->stofae;
		} else
		if (IsNumber(k)) {	/* integer or float */
		    str = num2chars(k);
		} else {		/* data base reference */
		    goto FAIL;
		}
		while (*str) *cons++ = ConsInt(*str++);
		if (cons == CellP(list)) {
		    list = atomnil;
		} else {
		    *cons++ = atomnil;
		    list = makelist(cons-CellP(list), CellP(list)), v1 -= 2;
		}
		TRY(unifyarg(Addr(rX->v2ofcf), MolP(list)->Sk, MolP(list)->Env));
	    }

	/*	Group 3.4: term hacking	*/

	case _functor_:		/* functor(Term, Functor, Arity) */
	    {	register PTR term = rX->v1ofcf;
		if (IsaAtomic(term)) {
		    TRY(constarg(v2ofcf, term)
		    &&  constarg(v3ofcf, ConsInt(0)) );
		}
		if (!IsUnbound(term)) {
		    register FUNCTORP fn = SkelFuncP(MolP(term)->Sk);
		    TRY(constarg(v2ofcf, (PTR)(fn->atoffe))
		    &&  constarg(v3ofcf, ConsInt(fn->arityoffe)) );
		}
	    }
	    /*  Term is a variable  */
	    ErrorMess = "! functor/3: instantiation fault";
	    {   register PTR fsymbol = rX->v2ofcf;
		if (IsaRef(fsymbol)) {
		    if (IsUnbound(fsymbol)) goto ERROR;
		    goto FAIL;
		}
		if (IsPrim(fsymbol)) {
		    TRY(constarg(v1ofcf, fsymbol)
		    &&  constarg(v3ofcf, ConsInt(0)) );
		}
	    }
	    /*  Term is a variable and Functor is an atom  */
	    {   register PTR aritint = rX->v3ofcf;
		register int arity;
		PTR frame;

		if (IsaRef(aritint) && IsUnbound(aritint)) goto ERROR;;
		if (!IsPosInt(aritint)) goto FAIL;
		arity = XtrPosInt(aritint);
		if (arity == 0) {
		    k = rX->v2ofcf;
		    goto unifyatom;
		}
		if (arity > MaxArity) {
		    ErrorMess = "! functor/3: arity > 200 unsupported";
		    goto ERROR;
		}
		InitGlobal(arity, frame);
		TRY(unifyarg(Addr(rX->v1ofcf),
		    Addr(fentry(AtomP(rX->v2ofcf), arity)->gtoffe), frame));
	    }

	case _arg_:		/* arg(ArgNo, Term, Arg) */
	    {
		register int argno;
		register PTR term;
		PTR frame;		/* &frame used, so may not be reg */

		ErrorMess = "! arg/3: instantiation fault";
		term = rX->v1ofcf;	/* arg 1 is the argument number */
		if (IsaRef(term) && IsUnbound(term)) goto ERROR;
		if ((unsigned)(term) <= (unsigned)ConsInt(0)
		 || (unsigned)(term) >  (unsigned)ConsInt(MaxArity))
		    goto FAIL;		/* not an integer 1..MaxArity */
		argno = XtrPosInt(term);
		term = rX->v2ofcf;	/* arg 2 is the term to take apart */
		if (!IsaRef(term)) goto FAIL;
		if (IsUnbound(term)) goto ERROR;
		frame = MolP(term)->Env, term = MolP(term)->Sk;
		if (argno > SkelFuncP(term)->arityoffe) goto FAIL;
		term = argv((PTR)(term[argno]), frame, &frame);
		TRY(unifyarg(Addr(rX->v3ofcf), term, frame));
	    }

	case _univ_:		/*  Term =.. List */
	    {
		register PTR term = rX->v1ofcf;
		register PTR cons = v+1;
		register int arity;
		PTR env;

		if (IsaRef(term) && IsUnbound(term)) {
		    /* construct a new term from a given list */

		    term = rX->v2ofcf, arity = -1;
		    if (!IsaRef(term) || IsUnbound(term)) goto FAIL;
		    env = MolP(term)->Env, term = MolP(term)->Sk;
		    while (term != atomnil) {
			if (IsaAtomic(term) || IsVar(term) || SkelFuncP(term) != listfunc)
			    goto FAIL;
			if (++arity > MaxArity) {
			    ErrorMess = "! =../2: list too long";
			    goto ERROR;
			}
			NextArg(cons) = arg(SkelP(term)->Arg1, env);
			term = argv(SkelP(term)->Arg2, env, &env);
		    }
		    term = *CellP(v+2);
		    if (!IsaAtomic(term)) goto FAIL;
		    if (arity == 0) TRY(constarg(v1ofcf, term));
		    if (IsPrim(term)) goto FAIL;
		    term = apply(AtomP(term), arity, CellP(v+3));
		    v1 -= 2;
		    TRY(unifyarg(Addr(rX->v1ofcf), MolP(term)->Sk, MolP(term)->Env));
		} else {
		    /* form a list from a given term */
		    Sint nElems = 2;
		    if (IsaRef(term)) {
			env = MolP(term)->Env, term = MolP(term)->Sk;
			NextArg(cons) = (PTR)SkelAtomP(term);
			arity = SkelFuncP(term)->arityoffe;
			nElems += arity;
			while (--arity >= 0)
			    NextArg(cons) = arg(NextArg(term), env);
		    } else {
			NextArg(cons) = term;
		    }
		    NextArg(cons) = atomnil;
		    term = makelist(nElems, CellP(v+2));
		    v1 -= 2;
		    TRY(unifyarg(Addr(rX->v2ofcf), MolP(term)->Sk, MolP(term)->Env));
		}
	    }


/*----------------------------------------------------------------------+
|									|
|		Group 4: data base access				|
|									|
+----------------------------------------------------------------------*/

	case _z1_assert_:	/* assertz(C), assert(C) */
	    TEST(record(CLAUSE, rX->v1ofcf, NullP, FALSE), EXIT, ERROR);

	case _a1_assert_:	/* asserta(C) */
	    TEST(record(CLAUSE, rX->v1ofcf, NullP, TRUE),  EXIT, ERROR);

	case _z2_assert_:	/* assertz(C,Ref), assert(C,Ref) */
	case _a2_assert_:	/* asserta(C,Ref) =z2assert+1*/
	    {
		register PTR ref =
		    record(CLAUSE, rX->v1ofcf, NullP, PredNo-_z2_assert_);
		if (ref == NullP) goto ERROR;
		XtraDB(ref)->infofcl |= IN_USE;
		TrailPtr(ref);	/* Trail the clause so it will not vanish */
		TRY(constarg(v2ofcf, ref));
	    }

	case _recordz_:		/* recordz(K,T,Ref) */
	case _recorda_:		/* recorda(K,T,Ref) =recordz+1 */
	    {
		register PTR ref =
		    record(RECORD, rX->v2ofcf, rX->v1ofcf, PredNo-_recordz_);
		if (ref == NullP) goto ERROR;
		XtraDB(ref)->infofcl |= IN_USE;
		TrailPtr(ref);	/* Trail the clause so it will not vanish */
		TRY(constarg(v3ofcf, ref));
	    }

	case _assertr_:		/* $assertr(Clause) */
	    /*  This predicate should ONLY be called from $assertr.	 */
	    /*  It has been tweaked to give just the right error action  */
	    /*  for that particular case, and requires the rest of that  */
	    /*  Prolog definition to finish the error message.		 */
	    if (record(CLAUSE, rX->v1ofcf, (PTR)recons, FALSE)) goto EXIT;
	    fprintf(stderr, "\n%s\n", ErrorMess);
	    goto FAIL;

	case _instance_:	/* instance(Ref,T) */
	    {	register int ans = instance(rX->v1ofcf, Addr(rX->v2ofcf));
		if (ans < 0) {
		    ErrorMess = "! instance/2: 1st argument must be a dbref";
		    goto ERROR;
		}
		TRY(ans);
	    }

	case _erase_:		/* erase(Ref) */
	    TEST(erase(rX->v1ofcf), EXIT, ERROR);

	case _erased_:		/* erased(Ref) */
	    {	register int ans = erased(rX->v1ofcf);
		if (ans < 0) goto ERROR;
		TRY(ans);
	    }

	case _clause_:		/* $clause(P,Ref,_) */
	    {	register PTR key = rX->v3ofcf;
		if (IsaRef(key)) key = MolP(key)->Sk;
		if (SkelFuncP(key)->flgsoffe & RESERVED) goto cutfail;
		rX->v4ofcf = Addr(SkelFuncP(key)->defsoffe);
	    }			/* fall into next clause */
	    FailToSelf;		/* which is its own successor */
	case _clause_+1:
	    k = recorded(CLAUSE);
	    if (k == NullP) goto cutfail;
	    TRY(instance(k, Addr(rX->v1ofcf)));

	case _recorded_:	/* $recorded(T,Ref,K) */
	    {	register PTR key = rX->v3ofcf;
		if (IsaRef(key)) key = MolP(key)->Sk;
		rX->v4ofcf = Addr(SkelFuncP(key)->dboffe);
	    }			/* fall into next clause */
	    FailToSelf;		/* which is its own successor */
	case _recorded_+1:
	    TEST(recorded(RECORD) == NullP, cutfail, EXIT);

	case _catom_:		/* current_atom(Atom) */
	    /* this is called with arg1 unbound */
	    rX->v2ofcf = ConsInt(HashSize), rX->v3ofcf = NullP;
	    FailToSelf;
	case _catom_+1:
	    GrowLocal(3);	/* arguments were classified as temporary */
	    {
		register int slot;	/* which chain to scan */
		register PTR atom;	/* where in chain */

		for ( atom = rX->v3ofcf, slot = XtrInt(rX->v2ofcf)
		    ; atom == NullP
		    ; atom = *CellP(hasha + slot) )
		    if (--slot < 0) goto cutfail;
		rX->v2ofcf = ConsInt(slot),
		rX->v3ofcf = (PTR)(AtomP(atom)->nxtofae);
		Ignore constarg(v1ofcf, atom);	/* MUST succeed */
		goto EXIT;
	    }

	case _cfunctor_:	/*  $current_functor(+A,?N,+Key,+Mask) */
	    rX->v5ofcf = rX->v1ofcf;
	    FailToSelf;
	case _cfunctor_+1:
	    GrowLocal(5);	/* arguments were classified as temporary */
	    {
		auto     int proc = Signed(rX->v3ofcf)&256;	/* pred wanted? */
		register int flgs = XtrByte(rX->v3ofcf);	/* flags wanted */
		register int mask = XtrByte(rX->v4ofcf);	/* mask given */
		register FUNCTORP func = FunctorP(rX->v5ofcf);

		if (func == FunctorP(0)) goto cutfail;
		while ((func->flgsoffe & mask) != flgs
		    || proc && func->defsoffe == NullC
		    || !constarg(v2ofcf, ConsInt(func->arityoffe))
		) {
		    func = func->nxtoffe;
		    if (func == FunctorP(0)) goto cutfail;
		}
		rX->v5ofcf = (PTR)(func->nxtoffe);
		goto EXIT;
	    }

	case _abolish_:		/* abolish(Functor, Arity) */
	    if (!IsaAtomic(rX->v1ofcf) || IsPrim(rX->v1ofcf)) {
		ErrorMess = "! abolish/2: arg 1 not an atom";
		goto ERROR;
	    }
	    if (!IsPosInt(rX->v2ofcf)) {
		ErrorMess = "! abolish/2: arg 2 not a non-negative integer";
		goto ERROR;
	    }
	    abolish(fentry(AtomP(rX->v1ofcf), (int)XtrPosInt(rX->v2ofcf)), TRUE);
	    goto EXIT;


/*----------------------------------------------------------------------+
|									|
|		Group 5: input/output and other file system access	|
|		Subgroups: opening/closing, input, output, other, flags	|
|									|
+----------------------------------------------------------------------*/

	/*	Group 5.1: opening and closing files	*/

	case _see_:		/* see(File) */
	    See(AtomP(rX->v1ofcf));
	    goto EXIT;

	case _seeing_:		/* seeing(File) */
	    k = (PTR)Seeing();
	    goto unifyatom;

	case _2seeing_:		/* seeing(OldFile, NewFile) */
	    k = (PTR)Seeing();
	    if (!constarg(v1ofcf, k)) goto cutfail;
	    GrowLocal(3);	/* add a new argument not reset on failure */
	    rX->v3ofcf = k;	/* remember the old file name */
	    See(AtomP(vvalue(Addr(rX->v2ofcf), &k)));
	    goto EXIT;
	case _3seeing_:		/* what to do on backtracking */
	    See(AtomP(rX->v3ofcf));
	    goto FAIL;

	case _seen_:		/* seen */
	    Seen();
	    goto EXIT;

	case _tell_:		/* tell(File) */
	case _append_:		/* append(File) */
	    Tell(AtomP(rX->v1ofcf), PredNo-_tell_);
	    goto EXIT;

	case _telling_:		/* telling(File) */
	    k = (PTR)Telling();
	    goto unifyatom;

	case _2telling_:	/* telling(OldFile, NewFile) */
	    k = (PTR)Telling();
	    if (!constarg(v1ofcf, k)) goto cutfail;
	    GrowLocal(3);	/* add a new argument not reset on failure */
	    rX->v3ofcf = k;	/* remember the old file name */
	    Tell(AtomP(vvalue(Addr(rX->v2ofcf), &k)), FALSE);
	    goto EXIT;
	case _3telling_:	/* what to do on backtracking */
	    Tell(AtomP(rX->v3ofcf), FALSE);
	    goto FAIL;

	case _told_:		/* told */
	    Told();
	    goto EXIT;

	case _close_:		/* close(File) */
	    PClose(AtomP(rX->v1ofcf));
	    goto EXIT;

	case _ttyflush_:	/* ttyflush(File) */
	    Flush(rX->v1ofcf);	/* 0 means all tty files */
	    goto EXIT;

	/*	Group 5.2: input	*/

	case _read_:		/*  read(Term) */
	case _read2_:		/*  read(Term,Vars) */
	    {
		static PTR vars;

		reading = TRUE, vars = atomnil;
		k = pread(PredNo == _read_ ? CellP(0) : &vars);
resumeread:
	    /*  Come back here when end of file is trapped.  Because end of
		file is handled so badly, we end up jumping into a block! I
		think it is a bit disgusting of C to let us get away with a
		dubious dodge like that.  The upshot is that we have to use
		X instead of rX.  I found this out the hard way!  If we can
		get rid of this jump it would be a good thing.
	    */
		reading = FALSE;
		if (k == NullP) goto FAIL;
		TRY( (PredNo==_read_ || unifyarg(Addr(X->v2ofcf),vars,NullP))
		   && unifyarg(Addr(X->v1ofcf), k, NullP));
	    }

	case _get0_:		/* get0(Char) */
	    k = ConsInt(Get());
	    goto unifyatom;

	case _get_:		/* get(Char) */
	    {	register int ch;

		do ch = Get(); while (ch <= ' ' && ch != CtrlZ || ch >= 127);
		k = ConsInt(ch);
	    }
	    goto unifyatom;

	case _skip_:		/* skip(Char) */
	    {	register int ch = intval(Addr(rX->v1ofcf));
		while (Get() != ch) ;	/* end of file is trapped in Get */
	    }
	    goto EXIT;

	case _curlineno_:	/* current_line_number(File, LineNo) */
	    {
		register int L = CurLineNo(AtomP(rX->v1ofcf));
		TRY(L > 0 && constarg(v2ofcf, ConsInt(L)) );
	    }

	/*	Group 5.3: output	*/

	case _display_:		/* display(Term) */
	case _write_:		/* write(Term) */
	case _writeq_:		/* writeq(Term) */
	    quoteia = PredNo-_write_;
	    pwrite(rX->v1ofcf, x1, 1200);
	    goto EXIT;

	case _nl_:		/* nl */
	    Put('\n');
	    goto EXIT;

	case _put_:		/* put(Char) */
	    Put((int)(intval(Addr(rX->v1ofcf))&127));
	    goto EXIT;

	case _tab_:		/* tab(N) */
	    {	register int spaces;

		spaces = intval(Addr(rX->v1ofcf));
		while (--spaces >= 0) Put(' ');
	    }
	    goto EXIT;

	case _xprompt_:		/* $prompt(PromptAtom) */
	    if (Input == STDIN && Output == STDOUT) {
		char *prompt = AtomP(rX->v1ofcf)->stofae;

		if (brklev != 0) {
		    Ignore sprintf(OutBuf, "[%d] %s", brklev, prompt);
		    prompt = OutBuf;
		}
		PromptIfUser(prompt);
	    }
	    goto EXIT;

	/*	Group 5.4: other file system access	*/

	case _expfilename_:	/* expand_file_name(Short, Full) */
	    {
#ifdef	unix
		extern char *expand_file();
		register PTR p = rX->v1ofcf;

		if (!IsaAtomic(p) || IsPrim(p)) {
		    ErrorMess = "! expand_file_name/2: arg 1 not an atom";
		    goto ERROR;
		}
		TRY(constarg(v2ofcf,
		    (PTR)(lookup(expand_file(AtomP(p)->stofae))) ));
#else  !unix
		ErrorMess = "! expand_file_name/2 not defined for this OS";
		goto ERROR;
#endif	unix
	    }

	case _exists_:		/* exists(File) */
	    TRY(Exists(AtomToFile(AtomP(rX->v1ofcf))));

	case _rename_:		/* rename(OldFile, NewFile) */
	    if (rX->v2ofcf == atomnil) {
		Remove(AtomToFile(AtomP(rX->v1ofcf)));
	    } else {
		Ignore strcpy(OutBuf, AtomToFile(AtomP(rX->v1ofcf)));
		Rename(OutBuf, AtomToFile(AtomP(rX->v2ofcf)));
	    }
	    goto EXIT;

	case _chdir_:		/* cd(Dir) */
	    TRY(ChDir(AtomToFile(AtomP(rX->v1ofcf))));

	case _sh_:		/* sh */
	    TRY(!CallShell(NullS));

	case _shell_:		/* shell(_) */
	    TRY(list_to_string(rX->v1ofcf, OutBuf, 255)
		&& !CallShell(OutBuf));

	case _save_:		/* save(File, ResumeFlag) */
	    fprintf(stderr, "\n[ closing all files ]\n");
	    CloseFiles();
	    save();		/* will signal IO_ERROR on failure */
	    TRY(constarg(v2ofcf, ConsInt(0)));

	/*	Group 5.5: input/output flags	*/

	case _fileerrors_:	/* fileerrors */
	    fileerrors = FALSE;
	    goto EXIT;

	case _nofileerrors_:	/* nofileerrors */
	    fileerrors = TRUE;
	    goto EXIT;

	case _NOLC_:		/* 'NOLC' */
	    lc = FALSE;
	    goto EXIT;

	case _LC_:		/* 'LC' */
	    lc = TRUE;
	    goto EXIT;

	case _change_chtype_:	/* chtype(Char,Old,New) */
	    n = intval(Addr(rX->v1ofcf));
	    if ((i = GetChType(n)) < 0) goto ERROR;
	    if (!constarg(v2ofcf, ConsInt(i))) goto FAIL;
	    i = intval(Addr(rX->v3ofcf));
	    if (SetChType(n, i)) goto ERROR;
	    goto EXIT;

	case _op_:		/* $op(Prio, Type, Atom) */
	    TRY(op(rX->v1ofcf, rX->v2ofcf, Addr(rX->v3ofcf)));

	case _is_op_:		/* $is_op(+Atom, +Type, ?Prio, ?Left, ?Right) */
	    {
		int p, lp, rp;
		TRY( isop(AtomP(rX->v1ofcf),(int)XtrPosInt(rX->v2ofcf),&p,&lp,&rp)
		&& constarg(v3ofcf, ConsInt(p ))
		&& constarg(v4ofcf, ConsInt(lp))
		&& constarg(v5ofcf, ConsInt(rp))  );
	    }

	case _prompt_:		/* prompt(OldPrompt, NewPrompt) */
	    {	register PTR newprompt;
		if (!constarg(v1ofcf, atprompt)) goto FAIL;
		newprompt = vvalue(Addr(rX->v2ofcf), &k);
		if (IsPrim(newprompt) || !IsaAtomic(newprompt)) goto FAIL;
		SetPlPrompt(AtomP(newprompt)->stofae);
		atprompt = newprompt;
	    }
	    goto EXIT;


/*----------------------------------------------------------------------+
|									|
|		Group 6: other flags					|
|									|
+----------------------------------------------------------------------*/

	case _trace_:		/* trace */
	    debug = dotrace = TRUE;
	    goto EXIT;

	case _leash_:		/* $leash(Old, New) */
	    if (!constarg(v1ofcf, ConsInt(leash))) goto FAIL;
	    leash = intval(Addr(rX->v2ofcf));
	    goto EXIT;

	case _debug_:		/*  $debug(Old, New) */
	    if (!constarg(v1ofcf, ConsInt(debug))) goto FAIL;
	    debug = intval(Addr(rX->v2ofcf));
	    goto EXIT;

	case _flags_:		/*  $flags(p,old,new) */
	    {
		register byte *p = &(SkelFuncP(MolP(rX->v1ofcf)->Sk)->flgsoffe);
		if (!constarg(v2ofcf, ConsInt(*p))) goto FAIL;
		*p = (byte)intval(Addr(rX->v3ofcf));
	    }
	    goto EXIT;

	case _all_float_:	/* $all_float(Old, New) */
	    if (!constarg(v1ofcf, ConsInt(AllFloat))) goto FAIL;
	    AllFloat = intval(Addr(rX->v2ofcf));
	    goto EXIT;

	case _sysp_:		/*  $sysp(Functor,Pred#) */
	    if (rX->v2ofcf == ConsInt(0)) {
		/*  "not unknown" empty predicates  */
		SkelFuncP(MolP(rX->v1ofcf)->Sk)->moreflgs = 1;
	    } else {
		SkelFuncP(MolP(rX->v1ofcf)->Sk)->defsoffe =
		    ClauseP(XtrByte(rX->v2ofcf));
	    }
	    goto EXIT;

	case _sysflgs_:		/*  $sysflgs(Functor,Flags) */
	    SkelFuncP(MolP(rX->v1ofcf)->Sk)->flgsoffe =
		(byte)(XtrByte(rX->v2ofcf));
	    goto EXIT;

	case _recons_:		/* $recons(_) */
	    recons = rX->v1ofcf != ConsInt(0);
	    goto EXIT;

	case _carith_:		/*  $carith(Old, New) */
	    if (!constarg(v1ofcf, ConsInt(carith))) goto FAIL;
	    carith = intval(Addr(rX->v2ofcf));
	    goto EXIT;

	case _unknown_:		/*  unknown(Old, New) */
	    if (!constarg(v1ofcf, ConsInt(unknown))) goto FAIL;
	    unknown = intval(Addr(rX->v2ofcf));
	    goto EXIT;

	case _statistics_:	/*  statistics  */
	    Statistics();
	    goto EXIT;

	case _set_:		/* $SET$(ArgNo, Term, Old, New) */
	    {
		register int argno;
		register PTR term, frame;

		ErrorMess = "$SET$ botch";
		term = rX->v1ofcf;	/* arg 1 is the argument number */
		if (!IsPosInt(term)) goto ERROR;
		argno = XtrPosInt(term);
		term = rX->v2ofcf;	/* arg 2 is the term to take apart */
		if (!IsaRef(term) || IsUnbound(term)) goto ERROR;
		frame = MolP(term)->Env, term = MolP(term)->Sk;
		if (argno > SkelFuncP(term)->arityoffe) goto ERROR;
		term += argno;
		if (IsaVar(*term)) term = FrameGlo(*term, frame);
		if (Undef(frame = VarVal(term))) frame = ConsInt(0);
		else if (!IsInt(frame)) goto ERROR;
		if (!constarg(v3ofcf, frame)) goto FAIL;
		VarVal(term) = ConsInt(intval(Addr(rX->v4ofcf)));
		goto EXIT;
	    }

	default:
	    Ignore sprintf(ErrorMess = OutBuf,
		"\n! Undefined built-in predicate : %d\n", PredNo);
	    goto ERROR;
	}
    }