/* ----------------------------------------------------------
%   (C)1992 Institute for New Generation Computer Technology
%       (Read COPYRIGHT for detailed information.)
----------------------------------------------------------- */
/*--------------------------------------------------------------------
*		cu-Prolog III (Constraint Unification Prolog)
*                  ICOT in Cooperation with SIRAI@sccs.chukyo-u.ac.jp
*		<<  main.c >>
*		88.11.23 Ver.2.00	OS command 
*               90.4.1 rewrite refute, syspred (ver.3.0) 
*               91.12  cu-Prolog III
*               92.7   ICOT Free Software Release
*               92.10.5 patch (init_status(): set globval vars)
*               92.10.29 patch (up_init(): reset termset log)
*               93.7.15 init_status()   shp  %Z(hash list)
*               93.7.30 add decode_args(),heap_alloc()
*               93.8.2  speedup        93.8.31 initialize_pointer()
*               93.9.22 gc, sample/marcus.p
*               94.5.20 PST unify, sample/hpsg.p
*               94.7.6--13  speedup, unify.c etc.
*               94.9.2  statistics (%S command)
*               94.9.27  atom_to_str/2
*               94.10.25,27  for HELIOS, debug maisub.c
--------------------------------------------------------------------*/

#include "version.h"
#define COPYRIGHT "Institute for New Generation Computer Technology (ICOT)\n\t\tTokyo, Japan 1991-94"
#define	 MAIN	1
#define HELIOS  0		/* if used as substance in Helios, 1 */

#include "include.h"
#include <signal.h>

struct itrace *newflist_save;

void main(argc,argv)
int argc;
char *argv[];
{
        void on_interrupt(),decode_args();
	int i;
	
	fp=stdin;			/* default input */
	for(argv++, i = 1; i < argc; i++, argv++)
	    decode_args(*argv);		/* decode arguments */
	prepare();		/* set flag   etc. */
	utop = &ustack[0];
    
	signal(SIGINT, on_interrupt);
	setjmp(reset);
	setjmp(unbreak_reset);

	while(1){
		f_list = NULL;
		usp = utop;
		chp = &cheap[1]; /* save constraints heap pointer */
		hp = &heap[1]; /* save user heap pointer */
		ep = &eheap[1];  /* save user stack pointer */
		newflist_save = newf_list; /* save old c.t. trace */
		prolog_execution();
		fflush(stdout);	/* for HELIOS */
	}
}

void decode_args(arg)		/* decode arguments */
char *arg;
{
    int size;

    if (arg[0] == '-') {
	size = atoi(arg+2)*1000;
	if (size > 0)
	    switch (arg[1])
	    {
	    case 'H':  HEAP_SIZE=size; break;
	    case 'S':  SHEAP_SIZE=size; break;
	    case 'E':  ESP_SIZE=size; break;  
	    case 'C':  CHEAP_SIZE=size; break;
	    case 'U':  USTACK_SIZE=size; break;
	    case 'N':  NAME_SIZE=size; break;
	    }
    }
    else if ((fp = fopen(arg,"r")) == NULL)  {
	printf("***Error*** Can't open '%s' \n",arg);
	fp = stdin;
    }
    else {
	printf(">>> open %s \n",arg);
	settimer();
    }
}

/* for statistics checking  */
void init_statistics()
{
    STAT_REFUTE=STAT_BACKTRACK_DEEP=STAT_BACKTRACK_SHAL=0;
    STAT_FOLD=STAT_UNFOLD=STAT_DEF=0;
}
void print_statistics()
{
    printf("--- statistics ----\n");
    printf("[PROLOG]   refute: %d + shallow backtrack: %d  (deep backtrack: %d)\n",
	   STAT_REFUTE, STAT_BACKTRACK_SHAL, STAT_BACKTRACK_DEEP);
    printf("[UNFOLD/FOLD]  unfold: %d    fold: %d    definition: %d\n",
	   STAT_UNFOLD, STAT_FOLD, STAT_DEF);
    init_statistics();
}

void prolog_execution()
{
#if HELIOS != 1
	if(tty && KEYIN) putcursor();		/* print cursor */
#endif
	advance;		/* read next one char into cbuf */

	switch (cbuf) {
	  case '"': {	/* read file */
	    advance;
	    settimer();	/* set timer */
	    readfile();
	    break;
	  }
	  case EOF: {	/* file end */
	    set_eof();
#if HELIOS != 1
	    printtime();	/* print execution time */
#endif
	    break;
	  }
	  case '%': {		/* flag statement */
	    next();
	    systemcommand(cbuf);
	    break;
	  }
	  case '#': {	/* os command interpreter */
	    advance;
	    oscommand();
	    break;
	  }
	  case ':':
	  case '?': {	/*  question clause */
	      init_statistics();
	    check_recursion();
	    questionclause();
	    break;
	  }
	  case '@':{		/* modularize clause */
	    advance;
	      init_statistics();
	    check_recursion();
	    trans_routine();
	    break;
	  }
	  case '$':	 /* define new predicate */
	    advance;
	    defnewfunc();
	    break;
	  case '.':
	    skipline;
	    break;
	  default :
	      init_statistics();
	    defclause(); /* definition clause */
	  }
}

/* ------------------------------------------------------------
   Error handler
------------------------------------------------------------ */
void on_interrupt()
{
  error("\nInterrupt\n");
}

void error_detail(t,e,s)
struct term *t;
struct pair *e;
char *s;
{
	if ((wfp != stdout) && (wfp != stderr)) fclose(wfp);
	wfp = stderr;
	Pterm(t,e);
	error(s);
}

void error(s)
char *s;
{
	if ((wfp != stdout) && (wfp != stderr)) {
	    if (wfp != NULL) fclose(wfp);	/* in %w command */
	    wfp = stderr;
	}
#if HELIOS == 1
	wfp = stderr;
#endif       
	if (utop != &ustack[0]) { /* restore stack  */
	    utop = &ustack[0];
	    undo(utop);
	}
	if (!KEYIN) {		/* error in reading a file */
	  while (cbuf != '\n') { next(); putc(cbuf,stderr); }
	  tprint1("\n**** error in reading file (%s) ****\n",s);
	  fclose(fp);
	  fp = stdin;
	  if ((shp -sheap) >= ((SHEAPTOP - sheap) * 0.95))
	      tprint0("\n***** Caution *****\n System heap is full! \n Restart cu-Prolog with -S option (-S xxx: system heap size)\n")
	}
	else 
	{
	    tprint1("\n%s\n", s);
	    skipline;
	    if ((shp -sheap) >= ((SHEAPTOP - sheap) * 0.95))
		garbagecollect(); /* 93.9.22  */
#if HELIOS != 1
	    printtime();	/* print execution time */
#endif
	}
	wfp = stdout;
	newf_list = newflist_save;  /* c.t. trace */
	freeheap();
	longjmp(reset, 0); /* in main() */
    }


/*------------------------------------------------
   heap allocation
------------------------------------------------*/
void system_heap_alloc()
{
    if (NULL == (sheap=(int *)malloc(SHEAP_SIZE+1)))
    {
	printf("***** No memories for system heap *****\n");
	exit(0);
    }	/* system heap */
    shp = &sheap[0];
    SHEAPTOP = &sheap[(int)(SHEAP_SIZE/SHEAP_UNIT)];
}

void user_heap_alloc()
{
    if (NULL == (heap=(int *)malloc(HEAP_SIZE+1)))
    {
	printf("***** No memories for user heap *****\n");
	exit(0);
    }	/* user heap */
    hp=Heap_Max=&heap[0];
    HEAPTOP = &heap[(int)(HEAP_SIZE/HEAP_UNIT)];
}

void cstr_heap_alloc()
{
    if (NULL == (cheap=(int *)malloc(CHEAP_SIZE+1)))
    {
	printf("***** No memories for constraint heap *****\n");
	exit(0);
    }  /* constraints/pst heap */
    chp = Cheap_Max = &cheap[0];
    CHEAPTOP = &cheap[(int)(CHEAP_SIZE/CHEAP_UNIT)];
}

void env_heap_alloc()
{
    if (NULL == (eheap = (struct pair *)malloc(ESP_SIZE+1)))
    {
	printf("***** No memories for environment heap *****\n");
	exit(0);
    }  /* environment heap */
    ep = Esp_Max = &eheap[0];
    ESPTOP = &eheap[(int)(ESP_SIZE/ESP_UNIT)];
}

void ustack_alloc()
{
    if (NULL == (ustack = (struct ustack *)malloc(USTACK_SIZE+1)))
    {
	printf("***** No memories for user stack *****\n");
	exit(0);
    } /* user stack */
    usp = Stack_Max = &ustack[0];
    STACKTOP = &ustack[(int)(USTACK_SIZE/USTACK_UNIT)];
}

void name_heap_alloc()
{
    if (NULL == (nheap = (char *)malloc(NAME_SIZE+1)))
    {
	printf("***** No memories for name string heap *****\n");
	exit(0);
    }  /* name string heap */
    nhp= &nheap[0];
    NHEAPTOP = &nheap[(int)(NAME_SIZE/NAME_UNIT)];
}

void heap_alloc()		/* allocate system/user heaps */
{
    system_heap_alloc();
    user_heap_alloc();
    cstr_heap_alloc();
    env_heap_alloc();
    ustack_alloc();
    name_heap_alloc();
}

void heap_realloc()		/* reallocate system/user heaps */
{
#if SUN4 == 1
    cfree((char *)sheap); SHEAP_SIZE=SHEAP_SIZE*1.2; system_heap_alloc();
#else
    free(heap);   HEAP_SIZE *= 1.2; 
    free(cheap);   CHEAP_SIZE *= 1.2;
    free(eheap);  ESP_SIZE *= 1.2;
    free(ustack);  USTACK_SIZE *= 1.2;
    free(nheap);   NAME_SIZE *= 1.2; 
    heap_alloc();
#endif /* SUN4 */
    init_status();
}

void initialize_pointer()		/* initialize heap pointers */
{
    shp = &sheap[0];
    SHEAPTOP = &sheap[(int)(SHEAP_SIZE/SHEAP_UNIT)];
    hp=Heap_Max=&heap[0];
    HEAPTOP = &heap[(int)(HEAP_SIZE/HEAP_UNIT)];
    chp = Cheap_Max = &cheap[0];
    CHEAPTOP = &cheap[(int)(CHEAP_SIZE/CHEAP_UNIT)];
    ep = Esp_Max = &eheap[0];
    ESPTOP = &eheap[(int)(ESP_SIZE/ESP_UNIT)];
    usp = Stack_Max = &ustack[0];
    STACKTOP = &ustack[(int)(USTACK_SIZE/USTACK_UNIT)];
    nhp= &nheap[0];
    NHEAPTOP = &nheap[(int)(NAME_SIZE/NAME_UNIT)];
}

void prepare()			/*  system preparation */
{
        tty = isatty(0);

	heap_alloc();		/* heap/stack allocation */
	init_status();		/* initialize global vars */

	/*  default status */
	wfp = stdout;			/* with echo back */
	lfp = NULL;			/* no log file  */
	ECHO_BACK = FALSE;
	Handle_Undefined = FALSE; /* fail return */
	Modular_mode;		/* solution flag */
	Notrace_mode;		/* trace flag */
	MODULARMAX = Modmax_def;
	Refcount = REFMAX;
	Print_Depth = 32;

	/* push_status(); */	/* save f_list,  etc. */
#if HELIOS != 1
	open_title();		/* opening title	*/
#endif
}

void init_status()		/* initialize global vars */
{
	int i;

	initialize_pointer();	/* 93.8.31 */
	/* initialize global vars */
	refute_node_count = -1;	/* refute node counter*/
	v_number = 0;		/* temporary var number */
	p_number = 0;
	v_list = NULL_TERM;		/* temporary var list */
	pv_list = NULL_TERM;
	f_list = (struct func *)NULL;	 /* new function list entry */
	o_list = (struct operator *)NULL;
	newf_list = (struct itrace *)NULL;	/* new function definition  */
	initialize_psttable();
	
	Def_Modified = 0;	/* user pred not modified */
	GENSYM = FNUMBER = 0;

        for(i = 0; i < HASH_SIZE; hash_list[i++] = NULL)
		;		/* initialize hash table */

	init_heap_max();	/* cf. new.c */
	init_syspred();		/* initialize system predicates */
}

void open_title()		/* opening title */
{
	printf("\n\t*******  cu - Prolog III  Ver. %s  *******\n",VERSION);
	printf("\t[COPYRIGHT] %s\n",COPYRIGHT);
/*	printf("\t%s mode",(Is_Msolvable ? "M-solvable" : "All Modular")); */
	printf("\tType '%%h' for help.\n\n");
	printf("\t[Heap=%dK System_heap=%dK Env_stack=%dK Cstr_heap=%dK\n",(int)(HEAP_SIZE/1000),(int)(SHEAP_SIZE/1000),(int)(ESP_SIZE/1000),(int)(CHEAP_SIZE/1000));
	printf("\t Ustack=%dK Name_heap=%dK]\n",(int)(USTACK_SIZE/1000),(int)(NAME_SIZE/1000));
}

void print_constant()		/* print constant list */
{
	struct func *f;
	int i;

	for (i = 0; i < HASH_SIZE; i++)
		for (f = hash_list[i]; f != NULL; f = f->f_link)
		if (f->f_arity == 0)
			tprint2("%s/%x  ",f->f_name,f);
	NL;
}

void show_hash_list()		/* for DEBUG 93.7.16*/
{
    int i;
    struct func *f;
    for (i=0; i<HASH_SIZE; i++)
    {
	if (hash_list[i] == (struct func *)NULL) continue;
	printf("<%d>:",i);
	for(f=hash_list[i];f!=(struct func *)NULL;f=f->f_link)
	    printf("%s ",f->f_name);
	printf("  |  ");
    }
    putchar('\n');
}

/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  systemcommand()
  process cu-Prolog system (%) commands
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
void systemcommand(c)   /*  % command */
int c;
{
  switch(c)
	{
        case 'C':		/* change cat() functor */
		set_category();
		break;
        case 'D':		/* maximum of print depth */
		readword(nbuf);
		Print_Depth = atoi(nbuf);
		break;
	case 'G':		/* garbage collection */
		garbagecollect();
		break;
	case 'H':		/* for debug */
		print_hash_table();
		break;
	case 'L': 		/*  list trace definition */
		tprint0("\n +-- List new predicate --<vars, terms>--+\n");
		Shownewfunc();
		break;
	case 'M':		/* maximum of variables in transformation */
		readword(nbuf);
		MODULARMAX = atoi(nbuf);
		if (MODULARMAX < 0)
		  MODULARMAX = Modmax_def;
		break;
	case 'N':		/* for debug */
		show_heap_max();
		break;
	case 'P':		/* Preprocess Constraints */
		readword(nbuf);
		preprocess_constraints(nbuf);
		break;
	case 'Q':		/* QUIT cu-prolog */
		quit_prolog();
		return;
        case 'R':		/* system reset */
		tprint0("System initialized\n");
		prepare();
		break;
        case 'S':		/* system statistics */
		print_statistics();
		break;
	case 'X':		/* print constant (for debug) */
		tprint0("+++++ print constants +++++\n");
		print_constant();
		break;
	case 'Y':		/* edit predicates (for debug) */
		tprint0("+++++ edit predicates +++++\n");
		edit_predicate();
		break;
	case 'Z':		/* show hash table (for debug) */
		tprint0("+++++ show hash table +++++\n");
		show_hash_list();
		break;
 	case 'a':		/*   all modular mode   */
		tprint0("\n  ___ all modular mode  ___\n");
		Modular_mode;
		break;
	case 'c':		/* maximum of refute counter	*/
		readword(nbuf);
		Refcount = atoi(nbuf);
		if (Refcount <= 0) Refcount = REFMAX; /* default */
		break;
	case 'd':	 		/*  list definition */
		readword(nbuf);
		showdef(nbuf);
		break;
	case 'f':			/*  free space  */
		tprint0("show the status of memory allocation\n");
		freeheap();
		break;
	case 'h':			/*  help menu */
		tprint0("** Usage:\tcuprolog [-Hxxx][-Sxxx][-Exxx][-Cxxx][-Uxxx][-Nxxx][filename]\n");
		tprint1("** %% commands (ver.%s) **",VERSION);
		tprint0(" (prompt _:normal, $:trace, >:step)\n");
		helpmenu();
		break;
	case 'l':			/*  log file */
		readword(nbuf);
		loghandle(nbuf);
		break;
	case 'n':		/* change genfunc name */
		readword(genname);
		break;
	case 'o': 	 		/*   M-Solvable mode  */
		tprint0("\n  ___ M-solvable mode ___\n");
		Msolvable_mode;
		break;
	case 'p':			/*  set/reset spy flag */
		readword(nbuf);
		spyswitch(nbuf);
		break;
	case 's':			/*  step trace on/off */
		stepswitch();
		break;
	case 't': 			/*  trace on */
		traceswitch();
		break;
	case 'u': /* undefined predicate handling */
		Handle_Undefined = (Handle_Undefined == TRUE) ?
		  FALSE : TRUE;
		tprint1("Undefined Predicates causes %s\n",
			((Handle_Undefined == TRUE) ? "ERROR" : "FAIL"));
		break;
	case 'w':			/*  write file */
		readword(nbuf);
		filewrite(nbuf); /* save program */
		break;
	default:		/* else */
		break;
	}
	skipline;		/* skip one line */
}

		
void garbagecollect()		/* garbage collection */
{
	if (fp != stdin) return; /*fclose(fp);*/
	if ((wfp != stdout) && (wfp != stderr)) fclose(wfp);
	settimer();	/* set timer */
	tprint0("====== Garbage Collection ======\n");
	strcpy(nbuf, "TEMPF.###");		/* temporary file */
	delete_tmp();			/* delete old temp file */
	tprint0("--->");
	filewrite(nbuf);	/* save program to nbuf */
	init_status();		/* initialize shp, f_list, etc. */
	tprint0("--->");
	set_inputfile(nbuf);
	/* wfp = NULL; no echo back */
}
		
void edit_predicate()		/* edit predicate */
{
	tprint0("++++++++ Garbage Collection +++++++++\n");
	strcpy(nbuf, "TEMPF.prd");		/* temporary file */
	system("rm -f TEMPF.prd");       	/* delete old temp file */
	tprint0("++++++++ Step 1: write file \n");
	filewrite(nbuf);	/* save program */
/*	pop_status();	*/ /* initialize shp, f_list, etc. */
	system("$EDITOR TEMPF.prd"); /* edit */
	tprint0("++++++++ Step 2: read file \n");
	set_inputfile(nbuf);
}

void trans_routine()	/* modular translation routine (@ C1,C2,...,Cn.) */
{
	register struct term *t;
	struct clause *c;

	if (Is_Steptrace && isspy(MODULAR_P)) CTstep;
	else if (Is_Normaltrace && isspy(MODULAR_P)) CTnormal;
	else CTnotrace;
	up_init();			/* reset termset log (92/10/29) */
	v_number = 0; v_list = NULL;
	p_number = 0; pv_list = NULL;
	reread = FALSE;
	clear_psttable();

	t = Rterm(1200,TEMPORAL);          /* read constraints */
	if (tokentype != FULLSTOP) error("Syntax error --- . missing");
	skipline;
	NL;
	settimer();	/* set timer */
	if (is_clause(t))
		c = (struct clause *)t;
	else 
		c = Nclause(t, NULL_CL, TEMPORAL);
	modular(c,v_list,v_number+p_number);
#if HELIOS != 1
	if (fp == stdin) printtime();	/* print execution time */
#endif
	undo(utop);	/* pop user stack  ( u : static var ) */
}


void questionclause()	/*  ?-g1,g2,...gm;c1,c2...cn.	*/
{
  register struct term *q;
  struct eclause *co;
  struct pair *e;
  struct node *Last_Node, *Initial_Goal;
  struct term *initial_vlist;
  struct clause *c;
  int Status, refute();

  if (Is_Steptrace && isspy(MODULAR_P)) CTstep;
  else if (Is_Normaltrace && isspy(MODULAR_P)) CTnormal;
  else CTnotrace;
  up_init();			/* reset termset log (92/10/29) */
  v_number = 0;	v_list = NULL;
  p_number = 0; pv_list = NULL;
  clear_psttable();

  reread = FALSE;
  q  = Rterm(1200,TEMPORAL);	        /* read goal */
  if (tokentype!=FULLSTOP) error("Syntax error --- . expected");
  skipline;		/* skip CR */
  
  renum_pvars((struct pstvar *)pv_list,v_number);
  e = Nenv(v_number+p_number);	/* initial environments */

  settimer();
  if ((Pred(q) == CONSTRAINT_P) || (Pred(q) == CONSTRAINT2_P)) {
    c = (is_clause(Arg2(q))) ? (struct clause *)Arg2(q) :
      Nclause(Arg2(q),NULL_CL,TEMPORAL);
    co = transform(NULL_ECL,c,e);
    if (co == (struct eclause *)MFAIL)
    {
      tprint0("no (unsatisfied constraints)\n");
#if HELIOS != 1
      if (fp == stdin) printtime();
#endif
      refute_node_count = -1;
      undo(utop);
      return;
    }
    q = Arg1(q);
  }
  else {
     co = NULL_ECL;
  }
  if ((Pred(q) != QUERY1_P) && (Pred(q) != QUERY2_P))
    error("Syntax error --- Query Predicate was expected");
  f_list = NULL;		/* temp. pred list */
  c = (is_clause(Arg1(q))) ? (struct clause *)Arg1(q) :
      Nclause(Arg1(q),NULL_CL,TEMPORAL);
  Initial_Goal = Last_Node 
    = Newnode(c,co,e,NULL_NODE,NULL_NODE);
  Last_BT = NULL; Last_SKIP = NULL;
  Status = DOWN;
  initial_vlist = v_list;

  /* refutation */
  while (1) {
    if (refute(Initial_Goal,Last_Node,Status) == FALSE){ 
#if HELIOS==1
	printf("result:");
#endif
	tprint0("no.\n"); 
	break; 
    }
    else if (initial_vlist == NULL) { 
#if HELIOS==1
	printf("result:");
#endif
	tprint0("true.\n"); 
	break; 
    }
    else {
#if HELIOS==1
	printf("result:");
	Pclause(Initial_Goal->n_clause, Initial_Goal->n_env);
	printf("\n");
	break;
#endif
	if ((fp != stdin) ||
	    (Panswer(Initial_Goal,initial_vlist) == FALSE)) break;
    }
    Status = BACKTRACK;
    Last_BT = Last_Node = backtrack_node(Last_BT);
  }
#if HELIOS != 1
  if (fp == stdin) printtime();
#endif
/*  freeheap(); */
/*  newf_list=index_newflist(newf_list,newflist_save); register itrace list */
/*  index_funclist(f_list);     tmp. pred -> hash */
  refute_node_count = -1;	/* refute node counter */
  undo(utop);		/* pop user stack ( u : static var ) */
}


void defclause()	/* definition clause read & set */
{
  register struct term *t;
  register struct clause *c, *cstr;

  v_number = 0; v_list = NULL;
  p_number = 0; pv_list = NULL;
  up_init();			/* reset termset log (92/10/29) */

  reread = FALSE;
  t = Rterm(1200,STINGY);
  if (tokentype != FULLSTOP) error("Syntax error --- . was expected");
  skipline;
  if (isvar(t)) error("Syntax error --- Variables cannot be asserted");
  rename_var_names((struct var *)v_list); /* STINGY -> ETERNAL */
  if ((Pred(t) == CONSTRAINT_P) || (Pred(t) == CONSTRAINT2_P)) {
    cstr = (is_clause(Arg2(t))) ? (struct clause *)Arg2(t) :
           Nclause(Arg2(t),NULL_CL,ETERNAL);
    t = Arg1(t);
  }
  else  cstr = NULL;
  if (Pred(t) == DEF_P) {
    if (isvar(Arg1(t))) {
      tprint0(">>>>> ");
      Pterm(t,NULL_ENV);
      tprint0(" <<<<<");
      error("Syntax error --- Variables cannot be asserted");
    }
    if (is_clause(Arg2(t)))
      c = Nclause(Arg1(t),(struct clause *)Arg2(t),ETERNAL);
    else
      c = Nclause(Arg1(t), 
		  Nclause(Arg2(t),NULL_CL,ETERNAL), ETERNAL);
  }
  else if (is_functor(t))
    c = Nclause(t,NULL_CL,ETERNAL);
  else error("Illegal definition");

  if (p_number != 0) {
    renum_pvars((struct pstvar *)pv_list,v_number);
  }
  index_set(c, cstr, 'z');
}

void rename_var_names(v)
struct var *v;
{
  while (v != (struct var *)NULL) {
    truncate_varname(v->v_name,nbuf);
    v->v_name = nalloc(nbuf,ETERNAL);
    v = v->v_link;
  }
}

void truncate_varname(n,nbuf)
char n[], nbuf[];
{
  register int i = 0;
  while ((n[i] != '\0') && (i < 7)) {
    if (n[i] == '_') break;
    nbuf[i] = n[i];
    i++;
  }
  nbuf[i] = '\0';
}

void renum_pvars(pvs,vnum)
struct pstvar *pvs;
int vnum;
{
  while (pvs != (struct pstvar *)NULL) {
    pvs->v_number += vnum;
    pvs = (struct pstvar *)pvs->v_link;
   }
}

void defnewfunc()	/* definition clause read & set */
{
  register struct term *t;
  register struct itrace *it;
  struct clause *c;

  v_number = 0; v_list = NULL;
  p_number = 0; pv_list = NULL;
  up_init();			/* reset termset log (92/10/29) */

  reread = FALSE;
  t = Rterm(1200,STINGY);
  if (tokentype != FULLSTOP) error("Syntax error --- . was expected");
  skipline;
  if (Pred(t) != EQSIGN_P) error("Illegal itrace definition");

  rename_var_names((struct var *)v_list); /* STINGY -> ETERNAL */  

  c =  (is_clause(Arg2(t))) ? (struct clause *)Arg2(t) :
    Nclause(Arg2(t),NULL_CL,ETERNAL);

  it = snew(itrace);
  it->it_clause = Nclause(Arg1(t),c,ETERNAL);
  it->it_anumber = v_number+p_number;
  it->it_cnumber = literalnumber(c);
  it->it_link = newf_list;
  newf_list = it;
  Pred(Arg1(t))->f_integ = it;
}