/*
 * parallel process program copyright (C) 2009 - 2013 H.Niwa
 */


/*
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2, or (at your option)
 * any later version.

 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.

 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 * 02110-1301, USA.
 */

#include "config.h"

#include <stdio.h>
#include <stdlib.h>
#include <unistd.h>

#include <errno.h>
#include <setjmp.h>
#include <sys/time.h>
#include <math.h>
#include <libgen.h>
#include <setjmp.h>
#include <string.h>
#include <signal.h>

#ifndef __CYGWIN__
#ifndef __MINGW32__ 
#include <wait.h>
#endif /* __MINGW32__ */
#endif /* __CYGWIN__ */
#ifndef __MINGW32__ 
#include <sys/wait.h>
#endif /* __MINGW32__ */


#include <string>
#include <complex>

#include "syserr.h"

#include "bin_node.h"
#include "gc.h"
#include "var.h"
#include "pred.h"
#include "context.h"
#include "unify.h"
#include "builtin.h"
#include "sysmodule.h"
#include "expression.h"
#include "let.h"
#include "func.h"
#include "token.h"
#include "module.h"
#include "code.h"
#include "timeout.h"
#include "help.h"
#include "ncurlib.h"
#include "compiler.h"
#include "lib_include.h"
#include "opcall.h"
#include "server.h"
#include "client.h"
#include "proc.h"

// Parallel CPU limit
int MAXCORE = 64;
int ncore = 0;

int ProcFlag = 0;

int NewProc(Context* cx, Node* goalscar, List* module);
int EachProc(Context* cx, Node* goalscar, List* module);
int FirstNewProc(Context* cx, Node* goalscar, List* module);
int FirstEachProc(Context* cx, Node* goalscar, List* module);

extern int DoFor(Context* cx, Node* goalscar, List* module);
extern int DoForeach(Context* cx, Node* goalscar, List* module);
extern int DoFirstFor(Context* cx, Node* goalscar, List* module);
extern int DoFirstForeach(Context* cx, Node* goalscar, List* module);


extern FILE* MksTemp(char* templ);

int PROCN = 1;
int setprocn(int n) 
{
	if (n < 1) {
		n = 1;
	}
	
	if (n > MAXCORE) {
		PROCN = MAXCORE;
	} else {
		PROCN = n;
	}
}


#define MAXPATHLEN 4096

#if !defined(__MINGW32__) 
int NewProc(Context* cx, Node* goalscar, List* module)
{
	if (ProcFlag || TraceFlag) {
		return DoFor(cx, goalscar, module);
	}

	GC_FORCE();

	int i;
	
	if (ListLength(goalscar) < 2) {
		syserr("usage : <newproc [VAR] (VAR LOOP-COUNT) PRED> or <newproc [VAR] (VAR FROM TO) PRED>\n");
		return 0;
	}

	Node*	nresult = goalscar->Cdr()->Car();
	
 	int rn;
	
	if ((rn = FuncArg(cx, nresult, goalscar, module)) <= 0) {
		syserr("newproc: failed in the evaluation of the argument. \n");
		return 0;
	}

	Node*	gl = Nil;
	Node*	glargs = Nil;
	if (nresult->kind() == UNDEF) {
		gl = goalscar->Cdr()->Cdr()->Cdr();
		glargs = goalscar->Cdr()->Cdr()->Car();
	} else {
		gl = goalscar->Cdr()->Cdr();
		glargs = nresult;
		nresult = Nil;
	}

	if ((rn = FuncArg(cx, glargs, goalscar, module)) <= 0) {
		syserr("newproc: failed in the evaluation of the argument. \n");
		return 0;
	}

	int nc = ListLength(glargs);
	if (!((nc == 2) || (nc == 3)) ) {
		syserr("usage : <newproc VAR (VAR LOOP-COUNT) PRED> or <newproc (VAR FROM TO) PRED>\n");
		return 0;
	}
		
	Node* nvar = glargs->Car()->Val();

	if (nvar->kind() != UNDEF) {
		return 0;
	}

	glargs = glargs->Cdr();

	Node* nto_val;
	long long init_val = 0;
	long long to_val;
	if (nc == 2) {
		init_val = 0;
		nto_val = glargs->Car()->Val();
		if (nto_val->kind() != ATOM) {
			syserr("usage : <newproc [VAR] (VAR LOOP-COUNT) PRED> or <newproc [VAR] (VAR FROM TO) PRED>\n");
			return 0;
		}
		if (!((Atom*)nto_val)->toInt(to_val)) {
			syserr("usage : <newproc [VAR] (VAR LOOP-COUNT) PRED> or <newproc [VAR] (VAR FROM TO) PRED>\n");
			return 0;
		}
		to_val--;
	} else {
		Node* ninitval = glargs->Car()->Val();
		if (ninitval->kind() != ATOM) {
			syserr("usage : <newproc [VAR] (VAR LOOP-COUNT) PRED> or <newproc [VAR] (VAR FROM TO) PRED>\n");
			return 0;
		}
		if (!((Atom*)ninitval)->toInt(init_val)) {
			syserr("usage : <newproc [VAR] (VAR LOOP-COUNT) PRED> or <newproc [VAR] (VAR FROM TO) PRED>\n");
			return 0;
		}
		
		nto_val = glargs->Cdr()->Car()->Val();
		if (nto_val->kind() != ATOM) {
			syserr("usage : <newproc [VAR] (VAR LOOP-COUNT) PRED> or <newproc [VAR] (VAR FROM TO) PRED>\n");
			return 0;
		}
		if (!((Atom*)nto_val)->toInt(to_val)) {
			syserr("usage : <newproc [VAR] (VAR LOOP-COUNT) PRED> or <newproc [VAR] (VAR FROM TO) PRED>\n");
			return 0;
		}
	}

	char tmpfilename[MAXPATHLEN];
	if (nresult != Nil) {
		strncpy(tmpfilename, tmppath, MAXPATHLEN);
		strncat(tmpfilename, "/sockXXXXXX", MAXPATHLEN-strlen(tmppath)-1);
		FILE* fd = MksTemp(tmpfilename);
		if (fd == NULL) {
			fprintf(stderr, "tmpfile : cannot open tmp file \n");
			return 0;
		}
		fclose(fd);
		unlink(tmpfilename);
	}
	

	fflush(cx->ioin);
	fflush(cx->ioout);

	pid_t spid = fork();
	if (spid < 0) {
		syserr("newproc fork error \n");
		return 0;
	} 
	if (spid > 0) {
		Node* val = Nil;
		int pidno = to_val-init_val+1;

		if (nresult != Nil) {
			ProcServer(val, pidno, tmpfilename);

			if (nresult->kind() == UNDEF) {
				Node* env = Nil->Cons(Nil);

				SetEnv(env, nresult);
				((Undef*)(nresult->Val()))->Set(val);

				PushStack(cx, Nil, Nil, env);
			}
		}

		int status = 0;
		waitpid(spid, &status, 0);

		setprocn(1);
		return 1;
	}

	pid_t pid = 1;
	pid_t pidno=0;
	setprocn(to_val-init_val+1);
	pid_t savepid[to_val-init_val+1];
	Node* env = Nil->Cons(Nil);
	Context *cx2;
	for (i = init_val, pidno = 0; i <= to_val; ) {
		if (pid != 0) {
			if (ncore < MAXCORE) {
				pid = fork();
				if (pid < 0) {
					syserr("newproc error \n");
					return 0;
				}
				ncore++;
				if (pid == 0) {
					ProcFlag = 1;
#ifdef __MINGW32__
					struct timeval tv;
					gettimeofday(&tv, NULL);
					srand(tv.tv_usec);
#else
					struct timeval tv;
					gettimeofday(&tv, NULL);
					srandom(tv.tv_usec);
#endif /* __MINGW32__ */

				} else if (pid != 0) {
//					int nc = nice(20);
					savepid[pidno] = pid;
					int j;
					for (j = 0; j <= pidno; j++) {
						if (savepid[j] != 0) {
							int status = 0;
							if (waitpid(savepid[j], &status, 
							    WNOHANG) == savepid[j]) {
								savepid[j] = 0;
								ncore--;
							}
						}
					}
					usleep(1);
					
					i++;
					pidno++;
					continue;
				}
			} else {
				int j;
//				int nc = nice(20);
				for (j = 0; j < pidno; j++) {
					if (savepid[j] != 0) {
						int status = 0;
						if (waitpid(savepid[j], &status, 
						    WNOHANG) == savepid[j]) {
							savepid[j] = 0;
							ncore--;
						}
					}
				}
				usleep(1);
				continue;
			}
		}

		cx2 = new Context(module, cx->modulename);
		cx2->selfname = cx->selfname;
		cx2->ioin = cx->ioin;
		cx2->ioout = cx->ioout;
		cx2->tokenflag = cx->tokenflag;
		cx2->token = cx->token;

		cx2->ode = cx->ode;
		cx2->integral = cx->integral;
		
		env = Nil->Cons(Nil);
		SetEnv(env, nvar);
		((Undef*)nvar)->Set(mka((long long)i));

		cxpush(cx2, gl);
		cxpush(cx2, glargs);
		cxpush(cx2, env);
		cxpush(cx2, nvar);
		cxpush(cx2, goalscar);
		cxpush(cx2, nresult);
				
		int r = Unify(cx2, gl, module);

		if (r == 1) {
			if (cx->tokenflag) cx->token = cx2->token;
		}
		
		if (nresult != Nil) {
		   if (r == 1) {
			Node*	res;
			if (gl->Car()->Car()->Eq(mka("unify"))
					|| gl->Car()->Car()->Eq(mka("obj"))) {
				res = gl->Car()->Cdr()->Cdr()->Car()->Cdr()->Car()->Val();
			} else {
				res = gl->Car()->Cdr()->Car()->Val();
			}
			
			if (res->kind() == ATOM) {
				ProcClient(res, pidno, r, tmpfilename);
			} else {
				ProcClient(Nil, pidno, r, tmpfilename);
			}
		   } else {
			ProcClient(Nil, pidno, r, tmpfilename);
		   }
		}

		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		
		cx2->Clear();
		
		UnsetEnv(env);
		
		delete cx2;
		cx2 = 0;

		if (pid == 0) {
			exit(r);
		}
	}		
	if (pid != 0) {
		int	i;
		int	flg = 0;
		int	n = pidno;
		
//		int nc = nice(20);
		for (;;) {
			flg = 0;
			for (i = 0; i < pidno; i++) {
				if (savepid[i] != 0) {
					int status = 0;
					if (waitpid(savepid[i], &status, 
							WNOHANG) == savepid[i]) {
						savepid[i] = 0;
						ncore--;
					} else {
						flg++;
					}
				} else {
					n--;
				}
			}
			if (!flg) { 
				break;
			}
			if (n <= 0) {
				break;
			}
			usleep(1);
		}
		usleep(1);
	}
	exit(1);
}

int EachProc(Context* cx, Node* goalscar, List* module)
{
	if (ProcFlag || TraceFlag) {
		return DoForeach(cx, goalscar, module);
	}

	GC_FORCE();

	int i;

	Node*	nresult = goalscar->Cdr()->Car();
	
 	int rn;
	
	if ((rn = FuncArg(cx, nresult, goalscar, module)) <= 0) {
		syserr("eachproc: failed in the evaluation of the argument. \n");
		return 0;
	}

	Node*	gl = Nil;
	Node*	glargs = Nil;
	if (nresult->kind() == UNDEF) {
		gl = goalscar->Cdr()->Cdr()->Cdr();
		glargs = goalscar->Cdr()->Cdr()->Car();
	} else {
		gl = goalscar->Cdr()->Cdr();
		glargs = nresult;
		nresult = Nil;
	}

	if ((rn = FuncArg(cx, glargs, goalscar, module)) <= 0) {
		syserr("eachproc: failed in the evaluation of the argument. \n");
		return 0;
	}

	int narg = ListLength(glargs);
	if (narg < 2) {
		syserr("usage : <eachproc [VAR] (VAR LIST) PRED>\n");
		return 0;
	}

	Node* nvar = glargs->Car()->Val();
	
	if ((rn = FuncArg(cx, nvar, goalscar, module)) <= 0) {
		syserr("eachproc: failed in the evaluation of the argument. \n");
		return 0;
	}

	if (nvar->kind() != UNDEF) {
		return 0;
	}

	glargs = glargs->Cdr();

	Node* nlist = glargs->Car()->Val();
	if ((nlist->kind() != LIST) && (nlist != Nil)) {
		return 0;
	}

	char tmpfilename[MAXPATHLEN];
	if (nresult != Nil) {
		strncpy(tmpfilename, tmppath, MAXPATHLEN);
		strncat(tmpfilename, "/sockXXXXXX", MAXPATHLEN-strlen(tmppath)-1);
		FILE* fd = MksTemp(tmpfilename);
		if (fd == NULL) {
			fprintf(stderr, "tmpfile : cannot open tmp file \n");
			return 0;
		}
		fclose(fd);
		unlink(tmpfilename);
	}
		
	fflush(cx->ioin);
	fflush(cx->ioout);

	pid_t spid = fork();
	if (spid < 0) {
		syserr("eachproc fork error \n");
		return 0;
	} 
	if (spid > 0) {

		Node* val = Nil;
		int pidno = ListLength(nlist);

		if (nresult != Nil) {
			ProcServer(val, pidno, tmpfilename);
			if (nresult->kind() == UNDEF) {
				Node* env = Nil->Cons(Nil);

				SetEnv(env, nresult);
				((Undef*)(nresult->Val()))->Set(val);

				PushStack(cx, Nil, Nil, env);
			}
		}

		int status = 0;
		waitpid(spid, &status, 0);
		
		setprocn(1);

		return 1;
	}

	Node* val = Nil;

	pid_t pid = 1;
	pid_t pidno=0;
	setprocn(ListLength(nlist));
	pid_t savepid[ListLength(nlist)];
	for (pidno = 0 ; nlist->kind() != ATOM; ) {
		if (pid != 0) {
			if (ncore < MAXCORE) {
				pid = fork();
				if (pid < 0) {
					syserr("eachproc error \n");
					return 0;
				}
				ncore++;
				if (pid == 0) {
					ProcFlag = 1;
#ifdef __MINGW32__
					struct timeval tv;
					gettimeofday(&tv, NULL);
					srand(tv.tv_usec);
#else
					struct timeval tv;
					gettimeofday(&tv, NULL);
					srandom(tv.tv_usec);
#endif /* __MINGW32__ */
				} else if (pid != 0) {
					savepid[pidno] = pid;
					int j;
//					int nc = nice(20);
					for (j = 0; j <= pidno; j++) {
						if (savepid[j] != 0) {
							int status = 0;
							if (waitpid(savepid[j], &status, 
							    WNOHANG) == savepid[j]) {
								savepid[j] = 0;
								ncore--;
							}
						}
					}
					usleep(1);

					nlist=nlist->Cdr();
					pidno++;
					continue;
				}
			} else {
				int j;
//				int nc = nice(20);
				for (j = 0; j < pidno; j++) {
					if (savepid[j] != 0) {
						int status = 0;
						if (waitpid(savepid[j], &status, 
						    WNOHANG) == savepid[j]) {
							savepid[j] = 0;
							ncore--;
						}
					}
				}
				usleep(1);
				continue;
			}
				
		}

		Context *cx2 = new Context(module, cx->modulename);
		cx2->selfname = cx->selfname;
		cx2->ioin = cx->ioin;
		cx2->ioout = cx->ioout;
		cx2->tokenflag = cx->tokenflag;
		cx2->token = cx->token;

		cx2->ode = cx->ode;
		cx2->integral = cx->integral;

		Node* env = Nil->Cons(Nil);
		SetEnv(env, nvar);
		((Undef*)nvar)->Set(nlist->Car());

		cxpush(cx2, gl);
		cxpush(cx2, glargs);
		cxpush(cx2, module);
		cxpush(cx2, env);
		cxpush(cx2, nvar);
		cxpush(cx2, goalscar);
		cxpush(cx2, nlist);
		cxpush(cx2, nresult);
				
		rn = Unify(cx2, gl, module);

		if (rn == 1) {
			if (cx->tokenflag) cx->token = cx2->token;
		}
		
		if (nresult != Nil) {
		   if (rn == 1) {
			Node*	res;
			if (gl->Car()->Car()->Eq(mka("unify"))
					|| gl->Car()->Car()->Eq(mka("obj"))) {
				res = gl->Car()->Cdr()->Cdr()->Car()->Cdr()->Car()->Val();
			} else {
				res = gl->Car()->Cdr()->Car()->Val();
			}
			
			if (res->kind() == ATOM) {
				ProcClient(res, pidno, rn, tmpfilename);
			} else {
				ProcClient(Nil, pidno, rn, tmpfilename);
			}
		   } else {
			ProcClient(Nil, pidno, rn, tmpfilename);
		   }
		}
		
		cx2->Clear();

		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		
		UnsetEnv(env);
		
		delete cx2;
		cx2 = 0;

		if (pid == 0) {
			exit(rn);
		}
	}		
	if (pid != 0) {
		int	i;
		int	flg = 0;
		int	n = pidno;
		
		Node* val = Nil;
//		int nc = nice(20);

		for (;;) {
			flg = 0;
			for (i = 0; i < pidno; i++) {
				if (savepid[i] != 0) {
					int status = 0;
					if (waitpid(savepid[i], &status, 
							WNOHANG) == savepid[i]) {
						savepid[i] = 0;
						ncore--;
					} else {
						flg++;
					}
				} else {
					n--;
				}
			}
			if (!flg) { 
				break;
			}
			if (n <= 0) {
				break;
			}
			usleep(1);
		}
		usleep(1);
	}
	exit(1);
}

int FirstNewProc(Context* cx, Node* goalscar, List* module)
{
	if (ProcFlag || TraceFlag) {
		return DoFirstFor(cx, goalscar, module);
	}

	GC_FORCE();

	int	flg = 0;
	int	i;

	if (ListLength(goalscar) < 2) {
		syserr("usage : <firstnewproc [VAR] (VAR LOOP-COUNT) PRED> or <firstnewproc [VAR] (VAR FROM TO) PRED>\n");
		return 0;
	}

	Node*	nresult = goalscar->Cdr()->Car();
	
 	int rn;
	
	if ((rn = FuncArg(cx, nresult, goalscar, module)) <= 0) {
		syserr("firstnewproc: failed in the evaluation of the argument. \n");
		return 0;
	}

	Node*	gl = Nil;
	Node*	glargs = Nil;
	if (nresult->kind() == UNDEF) {
		gl = goalscar->Cdr()->Cdr()->Cdr();
		glargs = goalscar->Cdr()->Cdr()->Car();
	} else {
		gl = goalscar->Cdr()->Cdr();
		glargs = nresult;
		nresult = Nil;
	}

	if ((rn = FuncArg(cx, glargs, goalscar, module)) <= 0) {
		syserr("firstnewproc: failed in the evaluation of the argument. \n");
		return 0;
	}

	int nc = ListLength(glargs);
	if (!((nc == 2) || (nc == 3)) ) {
		syserr("usage : <firstnewproc VAR (VAR LOOP-COUNT) PRED> or <firstnewproc (VAR FROM TO) PRED>\n");
		return 0;
	}
		
	Node* nvar = glargs->Car()->Val();

	if (nvar->kind() != UNDEF) {
		return 0;
	}

	glargs = glargs->Cdr();

	Node* nto_val;
	long long init_val = 0;
	long long to_val;
	if (nc == 2) {
		init_val = 0;
		nto_val = glargs->Car()->Val();
		if (nto_val->kind() != ATOM) {
			syserr("usage : <firstnewproc [VAR] (VAR LOOP-COUNT) PRED> or <firstnewproc [VAR] (VAR FROM TO) PRED>\n");
			return 0;
		}
		if (!((Atom*)nto_val)->toInt(to_val)) {
			syserr("usage : <firstnewproc [VAR] (VAR LOOP-COUNT) PRED> or <firstnewproc [VAR] (VAR FROM TO) PRED>\n");
			return 0;
		}
	} else {
		Node* ninitval = glargs->Car()->Val();
		if (ninitval->kind() != ATOM) {
			syserr("usage : <firstnewproc [VAR] (VAR LOOP-COUNT) PRED> or <firstnewproc [VAR] (VAR FROM TO) PRED>\n");
			return 0;
		}
		if (!((Atom*)ninitval)->toInt(init_val)) {
			syserr("usage : <firstnewproc [VAR] (VAR LOOP-COUNT) PRED> or <firstnewproc [VAR] (VAR FROM TO) PRED>\n");
			return 0;
		}
		
		nto_val = glargs->Cdr()->Car()->Val();
		if (nto_val->kind() != ATOM) {
			syserr("usage : <firstnewproc [VAR] (VAR LOOP-COUNT) PRED> or <firstnewproc [VAR] (VAR FROM TO) PRED>\n");
			return 0;
		}
		if (!((Atom*)nto_val)->toInt(to_val)) {
			syserr("usage : <firstnewproc [VAR] (VAR LOOP-COUNT) PRED> or <firstnewproc [VAR] (VAR FROM TO) PRED>\n");
			return 0;
		}
	}

	char tmpfilename[MAXPATHLEN];
	if (nresult != Nil) {
		strncpy(tmpfilename, tmppath, MAXPATHLEN);
		strncat(tmpfilename, "/sockXXXXXX", MAXPATHLEN-strlen(tmppath)-1);
		FILE* fd = MksTemp(tmpfilename);
		if (fd == NULL) {
			fprintf(stderr, "tmpfile : cannot open tmp file \n");
			return 0;
		}
		fclose(fd);
		unlink(tmpfilename);
	}
	
	fflush(cx->ioin);
	fflush(cx->ioout);

	pid_t spid = fork();
	if (spid < 0) {
		syserr("firstnewproc fork error \n");
		return 0;
	} 
	if (spid > 0) {

		Node* val = Nil;
		int pidno = to_val-init_val+1;

		if (nresult != Nil) {
			FirstProcServer(val, pidno, tmpfilename);

			if (nresult->kind() == UNDEF) {
				Node* env = Nil->Cons(Nil);

				SetEnv(env, nresult);
				((Undef*)(nresult->Val()))->Set(val);

				PushStack(cx, Nil, Nil, env);
			}
		}

		int status = 0;
		waitpid(spid, &status, 0);

		setprocn(1);

		return 1;
	}

	pid_t pid = 1;
	pid_t pidno=0;
	setprocn(to_val-init_val+1);
	pid_t savepid[to_val-init_val+1];
	Node* env = Nil->Cons(Nil);
	Context *cx2;
	for (i = init_val, pidno = 0; i <= to_val; ) {
		int f = 0;
		if (pid != 0) {
			if (ncore < MAXCORE) {
				pid = fork();
				if (pid < 0) {
					syserr("firstnewproc error \n");
					return 0;
				}
				ncore++;
				if (pid == 0) {
					ProcFlag = 1;
#ifdef __MINGW32__
					struct timeval tv;
					gettimeofday(&tv, NULL);
					srand(tv.tv_usec);
#else
					struct timeval tv;
					gettimeofday(&tv, NULL);
					srandom(tv.tv_usec);
#endif /* __MINGW32__ */
				} else if (pid != 0) {
					savepid[pidno] = pid;
					int j;
//					int nc = nice(20);
					for (j = 0; j <= pidno; j++) {
						if (savepid[j] != 0) {
						   int status = 0;
						   if (waitpid(savepid[j], &status, 
						       WNOHANG) == savepid[j]) {
						         savepid[j] = 0;
							 ncore--;

							 int k;
							 for (k = 0; k <= pidno; k++) {
							    if (savepid[k]) {
							       kill(savepid[k], SIGKILL);
							    }
							 }
							 for (k = 0; k <= pidno; k++) {
							    if (savepid[k]) {
							       int status = 0;
							       waitpid(savepid[k], &status, 0);
							       savepid[k] = 0;
							       ncore--;
							    }
							 }

							 exit(1);
						   }
						}
					}
					usleep(1);

					i++;
					pidno++;
					continue;
				}
			} else {
				int j;
//				int nc = nice(20);
				for (j = 0; j < pidno; j++) {
					if (savepid[j] != 0) {
					   int status = 0;
					   if (waitpid(savepid[j], &status, 
					       WNOHANG) == savepid[j]) {
					          savepid[j] = 0;
						  ncore--;

						   int k;
						   for (k = 0; k <= pidno; k++) {
						      if (savepid[k]) {
						         kill(savepid[k], SIGKILL);
						      }
						   }
						   for (k = 0; k <= pidno; k++) {
						      if (savepid[k]) {
						      	 int status = 0;
						         waitpid(savepid[k], &status, 0);
						         savepid[k] = 0;
						         ncore--;
						      }
						   }

						   exit(1);
					   }
					}
				}
				usleep(1);
				continue;
			}
		}
	
		cx2 = new Context(module, cx->modulename);
		cx2->selfname = cx->selfname;
		cx2->ioin = cx->ioin;
		cx2->ioout = cx->ioout;
		cx2->tokenflag = cx->tokenflag;
		cx2->token = cx->token;

		cx2->ode = cx->ode;
		cx2->integral = cx->integral;

		env = Nil->Cons(Nil);
		SetEnv(env, nvar);
		((Undef*)nvar)->Set(mka((long long)i));

		cxpush(cx2, gl);
		cxpush(cx2, glargs);
		cxpush(cx2, env);
		cxpush(cx2, nvar);
		cxpush(cx2, goalscar);
		cxpush(cx2, nresult);
				
		int r = Unify(cx2, gl, module);

		if (r == 1) {
			if (cx->tokenflag) cx->token = cx2->token;
		}
		
		if (nresult != Nil) {
		  if (r == 1) {
			Node*	res;
			if (gl->Car()->Car()->Eq(mka("unify"))
					|| gl->Car()->Car()->Eq(mka("obj"))) {
				res = gl->Car()->Cdr()->Cdr()->Car()->Cdr()->Car()->Val();
			} else {
				res = gl->Car()->Cdr()->Car()->Val();
			}
			if (res->kind() == ATOM) {
				ProcClient(res, pidno, r, tmpfilename);
			} else {
				ProcClient(Nil, pidno, r, tmpfilename);
			}
		  } else {
			ProcClient(Nil, pidno, r, tmpfilename);
		  }
		}
		
		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		
		cx2->Clear();
		
		UnsetEnv(env);
		
		delete cx2;
		cx2 = 0;

		/* exit */
		exit(rn);
	}		

	if (pid != 0) {
//	  int nc = nice(20);
	  for (;;) {
		flg = 0;
		for (i = 0; i < pidno; i++) {
			if (savepid[i] != 0) {
				flg++;

				int st;
				int rw = waitpid(savepid[i], &st, WNOHANG);
				if (rw <= 0) {
					continue;
				}
				if ((savepid[i] == rw) && 
						   (WIFEXITED(st) != 0)) {

					savepid[i] = 0;
					int j;
					for (j = 0; j < pidno; j++) {
						if (savepid[j]) {
							kill(savepid[j], SIGKILL);
						}
					}
					for (j = 0; j < pidno; j++) {
						if (savepid[j]) {
							int status = 0;
							waitpid(savepid[j], &status, 0);
							savepid[j] = 0;
							ncore--;
						}
					}
					exit(1);
				}
			}
		}
		usleep(1);
	  }
	}
	exit(1);
}

int FirstEachProc(Context* cx, Node* goalscar, List* module)
{
	if (ProcFlag || TraceFlag) {
		return DoFirstForeach(cx, goalscar, module);
	}

	GC_FORCE();

	int	flg = 0;
	int	i;

	Node*	nresult = goalscar->Cdr()->Car();
	
 	int rn;
	
	if ((rn = FuncArg(cx, nresult, goalscar, module)) <= 0) {
		syserr("firsteachproc: failed in the evaluation of the argument. \n");
		return 0;
	}

	Node*	gl = Nil;
	Node*	glargs = Nil;
	if (nresult->kind() == UNDEF) {
		gl = goalscar->Cdr()->Cdr()->Cdr();
		glargs = goalscar->Cdr()->Cdr()->Car();
	} else {
		gl = goalscar->Cdr()->Cdr();
		glargs = nresult;
		nresult = Nil;
	}

	if ((rn = FuncArg(cx, glargs, goalscar, module)) <= 0) {
		syserr("firsteachproc: failed in the evaluation of the argument. \n");
		return 0;
	}

	int narg = ListLength(glargs);
	if (narg < 2) {
		syserr("usage : <firsteachproc [VAR] (VAR LIST) PRED>\n");
		return 0;
	}

	Node* nvar = glargs->Car()->Val();
	
	if ((rn = FuncArg(cx, nvar, goalscar, module)) <= 0) {
		syserr("firsteachproc: failed in the evaluation of the argument. \n");
		return 0;
	}

	if (nvar->kind() != UNDEF) {
		return 0;
	}

	glargs = glargs->Cdr();

	Node* nlist = glargs->Car()->Val();
	if ((nlist->kind() != LIST) && (nlist != Nil)) {
		return 0;
	}

	char tmpfilename[MAXPATHLEN];
	if (nresult != Nil) {
		strncpy(tmpfilename, tmppath, MAXPATHLEN);
		strncat(tmpfilename, "/sockXXXXXX", MAXPATHLEN-strlen(tmppath));
		FILE* fd = MksTemp(tmpfilename);
		if (fd == NULL) {
			fprintf(stderr, "tmpfile : cannot open tmp file \n");
			return 0;
		}
		fclose(fd);
		unlink(tmpfilename);
	}
	
	fflush(cx->ioin);
	fflush(cx->ioout);

	pid_t spid = fork();
	if (spid < 0) {
		syserr("firsteachproc fork error \n");
		return 0;
	} 
	if (spid > 0) {

		Node* val = Nil;
		int pidno = ListLength(nlist);

		if (nresult != Nil) {
			FirstProcServer(val, pidno, tmpfilename);
			if (nresult->kind() == UNDEF) {
				Node* env = Nil->Cons(Nil);

				SetEnv(env, nresult);
				((Undef*)(nresult->Val()))->Set(val);

				PushStack(cx, Nil, Nil, env);
			}
		}

		int status = 0;
		waitpid(spid, &status, 0);
		
		setprocn(1);

		return 1;
	}

	pid_t pid = 1;
	pid_t pidno=0;
	setprocn(ListLength(nlist));
	pid_t savepid[ListLength(nlist)];
	for (pidno = 0 ; nlist->kind() != ATOM; ) {
		int f = 0;
		if (pid != 0) {
			if (ncore < MAXCORE) {
				pid = fork();
				if (pid < 0) {
					syserr("firsteachproc error \n");
					return 0;
				}
				ncore++;
				if (pid == 0) {
					ProcFlag = 1;
#ifdef __MINGW32__
					struct timeval tv;
					gettimeofday(&tv, NULL);
					srand(tv.tv_usec);
#else
					struct timeval tv;
					gettimeofday(&tv, NULL);
					srandom(tv.tv_usec);
#endif /* __MINGW32__ */
				} else if (pid != 0) {
					savepid[pidno] = pid;
					int j;
//					int nc = nice(20);
					for (j = 0; j <= pidno; j++) {
						if (savepid[j] != 0) {
						   int status = 0;
						   if (waitpid(savepid[j], &status, 
						       WNOHANG) == savepid[j]) {
						         savepid[j] = 0;
							 ncore--;

							 int k;
							 for (k = 0; k <= pidno; k++) {
							    if (savepid[k]) {
							       kill(savepid[k], SIGKILL);
							    }
							 }
							 for (k = 0; k <= pidno; k++) {
							    if (savepid[k]) {
							       int status = 0;
							       waitpid(savepid[k], &status, 0);
							       savepid[k] = 0;
							       ncore--;
							    }
							 }

							 exit(1);
						   }
						}
					}
					usleep(1);

					nlist=nlist->Cdr();
					pidno++;
					continue;
				}
			} else {
				int j;
//				int nc = nice(20);
				for (j = 0; j < pidno; j++) {
					if (savepid[j] != 0) {
					   int status = 0;
					   if (waitpid(savepid[j], &status, 
					       WNOHANG) == savepid[j]) {
					          savepid[j] = 0;
						  ncore--;

						   int k;
						   for (k = 0; k <= pidno; k++) {
						      if (savepid[k]) {
						         kill(savepid[k], SIGKILL);
						      }
						   }
						   for (k = 0; k <= pidno; k++) {
						      if (savepid[k]) {
						      	 int status = 0;
						         waitpid(savepid[k], &status, 0);
						         savepid[k] = 0;
						         ncore--;
						      }
						   }

						   exit(1);
					   }
					}
				}
				usleep(1);
				continue;
			}
		}

		Context *cx2 = new Context(module, cx->modulename);
		cx2->selfname = cx->selfname;
		cx2->ioin = cx->ioin;
		cx2->ioout = cx->ioout;
		cx2->tokenflag = cx->tokenflag;
		cx2->token = cx->token;

		cx2->ode = cx->ode;
		cx2->integral = cx->integral;

		Node* env = Nil->Cons(Nil);
		SetEnv(env, nvar);
		((Undef*)nvar)->Set(nlist->Car());

		cxpush(cx2, gl);
		cxpush(cx2, glargs);
		cxpush(cx2, module);
		cxpush(cx2, env);
		cxpush(cx2, nvar);
		cxpush(cx2, goalscar);
		cxpush(cx2, nlist);
		cxpush(cx2, nresult);
				
		rn = Unify(cx2, gl, module);

		if (rn == 1) {
			if (cx->tokenflag) cx->token = cx2->token;
		}

		if (nresult != Nil) {
		   if (rn == 1) {
			if (cx->tokenflag) cx->token = cx2->token;

			Node*	res;
			if (gl->Car()->Car()->Eq(mka("unify"))
					|| gl->Car()->Car()->Eq(mka("obj"))) {
				res = gl->Car()->Cdr()->Cdr()->Car()->Cdr()->Car()->Val();
			} else {
				res = gl->Car()->Cdr()->Car()->Val();
			}
			
			if (res->kind() == ATOM) {
				ProcClient(res, pidno, rn, tmpfilename);
			} else {
				ProcClient(Nil, pidno, rn, tmpfilename);
			}
		   } else {
			ProcClient(Nil, pidno, rn, tmpfilename);
		   }
		}
		
		cx2->Clear();

		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		
		UnsetEnv(env);
		
		delete cx2;
		cx2 = 0;

		/* exit */
		exit(rn);
	}		

	if (pid != 0) {
//	  int nc = nice(20);
	  for (;;) {
		flg = 0;
		for (i = 0; i < pidno; i++) {
			if (savepid[i] != 0) {
				flg++;

				int st;
				int rw = waitpid(savepid[i], &st, WNOHANG);
				if (rw <= 0) {
					continue;
				}
				if ((savepid[i] == rw) && 
						(WIFEXITED(st) != 0)) {
					
					savepid[i] = 0;
					int j;
					for (j = 0; j < pidno; j++) {
						if (savepid[j]) {
							kill(savepid[j], SIGKILL);
						}
					}
					for (j = 0; j < pidno; j++) {
						if (savepid[j]) {
							int status = 0;
							waitpid(savepid[j], &status, 0);
							savepid[j] = 0;
							ncore--;
						}
					}
					exit(1);
				}
			}
		}
		usleep(1);
	  }
	  usleep(1);
	}
	exit(1);
}


#else  /* !defined(__MINGW32__) */

extern int BreakFlag;

int NewProc(Context* cx, Node* goalscar, List* module)
{
	long long i;

	if (ListLength(goalscar) < 2) {
		syserr("usage : <newproc [VAR] (VAR LOOP-COUNT) PRED> or <newproc [VAR] (VAR FROM TO) PRED>\n");
		return 0;
	}

	Node*	nresult = goalscar->Cdr()->Car();
	
 	int rn;
	
	if ((rn = FuncArg(cx, nresult, goalscar, module)) <= 0) {
		syserr("newproc: failed in the evaluation of the argument. \n");
		return 0;
	}

	Node*	gl = Nil;
	Node*	glargs = Nil;
	if (nresult->kind() == UNDEF) {
		gl = goalscar->Cdr()->Cdr()->Cdr();
		glargs = goalscar->Cdr()->Cdr()->Car();
	} else {
		gl = goalscar->Cdr()->Cdr();
		glargs = nresult;
		nresult = Nil;
	}

	if ((rn = FuncArg(cx, glargs, goalscar, module)) <= 0) {
		syserr("newproc: failed in the evaluation of the argument. \n");
		return 0;
	}

	int nc = ListLength(glargs);
	if (!((nc == 2) || (nc == 3)) ) {
		syserr("usage : <newproc [VAR] (VAR LOOP-COUNT) PRED> or <newproc [VAR] (VAR FROM TO) PRED>\n");
		return 0;
	}
		
	Node* nvar = glargs->Car()->Val();

	if (nvar->kind() != UNDEF) {
		syserr("usage : <newproc [VAR] (VAR LOOP-COUNT) PRED> or <newproc [VAR] (VAR FROM TO) PRED>\n");
		return 0;
	}

	glargs = glargs->Cdr();

	Node* nto_val;
	long long init_val = 0;
	long long to_val;
	if (nc == 2) {
		init_val = 0;
		nto_val = glargs->Car()->Val();
		if (nto_val->kind() != ATOM) {
			syserr("usage : <newproc [VAR] (VAR LOOP-COUNT) PRED> or <newproc [VAR] (VAR FROM TO) PRED>\n");
			return 0;
		}
		if (!((Atom*)nto_val)->toInt(to_val)) {
			syserr("usage : <newproc [VAR] (VAR LOOP-COUNT) PRED> or <newproc [VAR] (VAR FROM TO) PRED>\n");
			return 0;
		}
		to_val--;
	} else {
		Node* ninitval = glargs->Car()->Val();
		if (ninitval->kind() != ATOM) {
			syserr("usage : <newproc [VAR] (VAR LOOP-COUNT) PRED> or <newproc [VAR] (VAR FROM TO) PRED>\n");
			return 0;
		}
		if (!((Atom*)ninitval)->toInt(init_val)) {
			syserr("usage : <newproc [VAR] (VAR LOOP-COUNT) PRED> or <newproc [VAR] (VAR FROM TO) PRED>\n");
			return 0;
		}
		
		nto_val = glargs->Cdr()->Car()->Val();
		if (nto_val->kind() != ATOM) {
			syserr("usage : <newproc [VAR] (VAR LOOP-COUNT) PRED> or <newproc [VAR] (VAR FROM TO) PRED>\n");
			return 0;
		}
		if (!((Atom*)nto_val)->toInt(to_val)) {
			syserr("usage : <newproc [VAR] (VAR LOOP-COUNT) PRED> or <newproc [VAR] (VAR FROM TO) PRED>\n");
			return 0;
		}
	}
	
	Node* val = Nil;

	Node* env = Nil->Cons(Nil);
	Context *cx2;
	for (i = init_val; i <= to_val; i++) {
		cx2 = new Context(module, cx->modulename);
		cx2->selfname = cx->selfname;
		cx2->ioin = cx->ioin;
		cx2->ioout = cx->ioout;
		cx2->tokenflag = cx->tokenflag;
		cx2->token = cx->token;

		cx2->ode = cx->ode;
		cx2->integral = cx->integral;

		env = Nil->Cons(Nil);
		SetEnv(env, nvar);
		((Undef*)nvar)->Set(mka(i));

		cxpush(cx2, gl);
		cxpush(cx2, glargs);
		cxpush(cx2, env);
		cxpush(cx2, nvar);
		cxpush(cx2, goalscar);
		cxpush(cx2, val);
		cxpush(cx2, nresult);
				
		int r = Unify(cx2, gl, module);

		if (r == 1) {
			if (cx->tokenflag) cx->token = cx2->token;

			Node*	res;
			if (gl->Car()->Car()->Eq(mka("unify"))
					|| gl->Car()->Car()->Eq(mka("obj"))) {
				res = gl->Car()->Cdr()->Cdr()->Car()->Cdr()->Car()->Val();
			} else {
				res = gl->Car()->Cdr()->Car()->Val();
			}
			
			val = Append(val, MkList(res));
		}

		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		
		cx2->Clear();
		
		UnsetEnv(env);
		
		delete cx2;
		cx2 = 0;

		BreakFlag = 0;

		if (r != 1) {
			return r;
		}
	}		

	if (nresult->kind() == UNDEF) {
		Node* env = Nil->Cons(Nil);

		SetEnv(env, nresult);
		((Undef*)(nresult->Val()))->Set(val);

		PushStack(cx, Nil, Nil, env);
	}
			
	return 1;
}

int EachProc(Context* cx, Node* goalscar, List* module)
{
	int i;
	
	Node*	nresult = goalscar->Cdr()->Car();
	
 	int rn;
	
	if ((rn = FuncArg(cx, nresult, goalscar, module)) <= 0) {
		syserr("usage : <eachproc [VAR] (VAR LIST) PRED> \n");
		return 0;
	}

	Node*	gl = Nil;
	Node*	glargs = Nil;
	if (nresult->kind() == UNDEF) {
		gl = goalscar->Cdr()->Cdr()->Cdr();
		glargs = goalscar->Cdr()->Cdr()->Car();
	} else {
		gl = goalscar->Cdr()->Cdr();
		glargs = nresult;
		nresult = Nil;
	}

	if ((rn = FuncArg(cx, glargs, goalscar, module)) <= 0) {
		syserr("eachproc: failed in the evaluation of the argument. \n");
		return 0;
	}

	int narg = ListLength(glargs);
	if (narg < 2) {
		syserr("usage : <eachproc [VAR] (VAR LIST) PRED>\n");
		return 0;
	}

	Node* nvar = glargs->Car()->Val();
	
	if ((rn = FuncArg(cx, nvar, goalscar, module)) <= 0) {
		syserr("eachproc: failed in the evaluation of the argument. \n");
		return 0;
	}

	if (nvar->kind() != UNDEF) {
		syserr("usage : <eachproc [VAR] (VAR LIST) PRED> \n");
		return 0;
	}

	glargs = glargs->Cdr();

	Node* nlist = glargs->Car()->Val();
	if ((nlist->kind() != LIST) && (nlist != Nil)) {
		syserr("usage : <eachproc [VAR] (VAR LIST) PRED> \n");
		return 0;
	}

	Node* val = Nil;

	for ( ; nlist->kind() != ATOM; nlist=nlist->Cdr()) {
		Context *cx2 = new Context(module, cx->modulename);
		cx2->selfname = cx->selfname;
		cx2->ioin = cx->ioin;
		cx2->ioout = cx->ioout;
		cx2->tokenflag = cx->tokenflag;
		cx2->token = cx->token;

		cx2->ode = cx->ode;
		cx2->integral = cx->integral;

		Node* env = Nil->Cons(Nil);
		SetEnv(env, nvar);
		((Undef*)nvar)->Set(nlist->Car());

		cxpush(cx2, gl);
		cxpush(cx2, glargs);
		cxpush(cx2, val);
		cxpush(cx2, module);
		cxpush(cx2, env);
		cxpush(cx2, nvar);
		cxpush(cx2, goalscar);
		cxpush(cx2, nlist);
		cxpush(cx2, nresult);
				
		rn = Unify(cx2, gl, module);

		if (rn == 1) {
			if (cx->tokenflag) cx->token = cx2->token;

			Node*	res;
			if (gl->Car()->Car()->Eq(mka("unify"))
					|| gl->Car()->Car()->Eq(mka("obj"))) {
				res = gl->Car()->Cdr()->Cdr()->Car()->Cdr()->Car()->Val();
			} else {
				res = gl->Car()->Cdr()->Car()->Val();
			}
			
			val = Append(val, MkList(res));
		}
		
		cx2->Clear();

		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		
		UnsetEnv(env);
		
		delete cx2;
		cx2 = 0;

		BreakFlag = 0;

/*
		if (rn != 1) {
			return rn;
		}
*/
	}		

	if (nresult->kind() == UNDEF) {
		Node* env = Nil->Cons(Nil);

		SetEnv(env, nresult);
		((Undef*)(nresult->Val()))->Set(val);

		PushStack(cx, Nil, Nil, env);
	}

	return 1;
}


int FirstNewProc(Context* cx, Node* goalscar, List* module)
{
	long long i;

	if (ListLength(goalscar) < 2) {
		syserr("usage : <firstnewproc [VAR] (VAR LOOP-COUNT) PRED> or <firstnewproc [VAR] (VAR FROM TO) PRED>\n");
		return 0;
	}

	Node*	nresult = goalscar->Cdr()->Car();
	
 	int rn;
	
	if ((rn = FuncArg(cx, nresult, goalscar, module)) <= 0) {
		syserr("firstnewproc: failed in the evaluation of the argument. \n");
		return 0;
	}

	Node*	gl = Nil;
	Node*	glargs = Nil;
	if (nresult->kind() == UNDEF) {
		gl = goalscar->Cdr()->Cdr()->Cdr();
		glargs = goalscar->Cdr()->Cdr()->Car();
	} else {
		gl = goalscar->Cdr()->Cdr();
		glargs = nresult;
		nresult = Nil;
	}

	if ((rn = FuncArg(cx, glargs, goalscar, module)) <= 0) {
		syserr("firstnewproc: failed in the evaluation of the argument. \n");
		return 0;
	}

	int nc = ListLength(glargs);
	if (!((nc == 2) || (nc == 3)) ) {
		syserr("usage : <firstnewproc [VAR] (VAR LOOP-COUNT) PRED> or <firstnewproc [VAR] (VAR FROM TO) PRED>\n");
		return 0;
	}
		
	Node* nvar = glargs->Car()->Val();

	if (nvar->kind() != UNDEF) {
		syserr("usage : <firstnewproc [VAR] (VAR LOOP-COUNT) PRED> or <firstnewproc [VAR] (VAR FROM TO) PRED>\n");
		return 0;
	}

	glargs = glargs->Cdr();

	Node* nto_val;
	long long init_val = 0;
	long long to_val;
	if (nc == 2) {
		init_val = 0;
		nto_val = glargs->Car()->Val();
		if (nto_val->kind() != ATOM) {
			syserr("usage : <firstnewproc [VAR] (VAR LOOP-COUNT) PRED> or <firstnewproc [VAR] (VAR FROM TO) PRED>\n");
			return 0;
		}
		if (!((Atom*)nto_val)->toInt(to_val)) {
			syserr("usage : <firstnewproc [VAR] (VAR LOOP-COUNT) PRED> or <firstnewproc [VAR] (VAR FROM TO) PRED>\n");
			return 0;
		}
		to_val--;
	} else {
		Node* ninitval = glargs->Car()->Val();
		if (ninitval->kind() != ATOM) {
			syserr("usage : <firstnewproc [VAR] (VAR LOOP-COUNT) PRED> or <firstnewproc [VAR] (VAR FROM TO) PRED>\n");
			return 0;
		}
		if (!((Atom*)ninitval)->toInt(init_val)) {
			syserr("usage : <firstnewproc [VAR] (VAR LOOP-COUNT) PRED> or <firstnewproc [VAR] (VAR FROM TO) PRED>\n");
			return 0;
		}
		
		nto_val = glargs->Cdr()->Car()->Val();
		if (nto_val->kind() != ATOM) {
			syserr("usage : <firstnewproc [VAR] (VAR LOOP-COUNT) PRED> or <firstnewproc [VAR] (VAR FROM TO) PRED>\n");
			return 0;
		}
		if (!((Atom*)nto_val)->toInt(to_val)) {
			syserr("usage : <firstnewproc [VAR] (VAR LOOP-COUNT) PRED> or <firstnewproc [VAR] (VAR FROM TO) PRED>\n");
			return 0;
		}
	}
	
	Node* val = Nil;

	Node* env = Nil->Cons(Nil);
	Context *cx2;
	for (i = init_val; i <= to_val; i++) {
		cx2 = new Context(module, cx->modulename);
		cx2->selfname = cx->selfname;
		cx2->ioin = cx->ioin;
		cx2->ioout = cx->ioout;
		cx2->tokenflag = cx->tokenflag;
		cx2->token = cx->token;

		cx2->ode = cx->ode;
		cx2->integral = cx->integral;

		env = Nil->Cons(Nil);
		SetEnv(env, nvar);
		((Undef*)nvar)->Set(mka(i));

		cxpush(cx2, gl);
		cxpush(cx2, glargs);
		cxpush(cx2, env);
		cxpush(cx2, nvar);
		cxpush(cx2, goalscar);
		cxpush(cx2, val);
		cxpush(cx2, nresult);
				
		int r = Unify(cx2, gl, module);

		if (r == 1) {
			if (cx->tokenflag) cx->token = cx2->token;

			Node*	res;
			if (gl->Car()->Car()->Eq(mka("unify"))
					|| gl->Car()->Car()->Eq(mka("obj"))) {
				res = gl->Car()->Cdr()->Cdr()->Car()->Cdr()->Car()->Val();
			} else {
				res = gl->Car()->Cdr()->Car()->Val();
			}
			
			val = res;

		}

		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		
		cx2->Clear();
		
		UnsetEnv(env);
		
		delete cx2;
		cx2 = 0;

		BreakFlag = 0;

		if (r == 1) {
			break;
		}
	}		

	if (nresult->kind() == UNDEF) {
		Node* env = Nil->Cons(Nil);

		SetEnv(env, nresult);
		((Undef*)(nresult->Val()))->Set(val);

		PushStack(cx, Nil, Nil, env);
	}
			
	return 1;
}

int FirstEachProc(Context* cx, Node* goalscar, List* module)
{
	int i;
	
	Node*	nresult = goalscar->Cdr()->Car();
	
 	int rn;
	
	if ((rn = FuncArg(cx, nresult, goalscar, module)) <= 0) {
		syserr("usage : <firsteachproc [VAR] (VAR LIST) PRED> \n");
		return 0;
	}

	Node*	gl = Nil;
	Node*	glargs = Nil;
	if (nresult->kind() == UNDEF) {
		gl = goalscar->Cdr()->Cdr()->Cdr();
		glargs = goalscar->Cdr()->Cdr()->Car();
	} else {
		gl = goalscar->Cdr()->Cdr();
		glargs = nresult;
		nresult = Nil;
	}

	if ((rn = FuncArg(cx, glargs, goalscar, module)) <= 0) {
		syserr("firsteachproc: failed in the evaluation of the argument. \n");
		return 0;
	}

	int narg = ListLength(glargs);
	if (narg < 2) {
		syserr("usage : <firsteachproc [VAR] (VAR LIST) PRED>\n");
		return 0;
	}

	Node* nvar = glargs->Car()->Val();
	
	if ((rn = FuncArg(cx, nvar, goalscar, module)) <= 0) {
		syserr("firsteachproc: failed in the evaluation of the argument. \n");
		return 0;
	}

	if (nvar->kind() != UNDEF) {
		syserr("usage : <firsteachproc [VAR] (VAR LIST) PRED> \n");
		return 0;
	}

	glargs = glargs->Cdr();

	Node* nlist = glargs->Car()->Val();
	if ((nlist->kind() != LIST) && (nlist != Nil)) {
		syserr("usage : <firsteachproc [VAR] (VAR LIST) PRED> \n");
		return 0;
	}

	Node* val = Nil;

	for ( ; nlist->kind() != ATOM; nlist=nlist->Cdr()) {
		Context *cx2 = new Context(module, cx->modulename);
		cx2->selfname = cx->selfname;
		cx2->ioin = cx->ioin;
		cx2->ioout = cx->ioout;
		cx2->tokenflag = cx->tokenflag;
		cx2->token = cx->token;

		cx2->ode = cx->ode;
		cx2->integral = cx->integral;

		Node* env = Nil->Cons(Nil);
		SetEnv(env, nvar);
		((Undef*)nvar)->Set(nlist->Car());

		cxpush(cx2, gl);
		cxpush(cx2, glargs);
		cxpush(cx2, val);
		cxpush(cx2, module);
		cxpush(cx2, env);
		cxpush(cx2, nvar);
		cxpush(cx2, goalscar);
		cxpush(cx2, nlist);
		cxpush(cx2, nresult);
				
		rn = Unify(cx2, gl, module);

		if (rn == 1) {
			if (cx->tokenflag) cx->token = cx2->token;

			Node*	res;
			if (gl->Car()->Car()->Eq(mka("unify"))
					|| gl->Car()->Car()->Eq(mka("obj"))) {
				res = gl->Car()->Cdr()->Cdr()->Car()->Cdr()->Car()->Val();
			} else {
				res = gl->Car()->Cdr()->Car()->Val();
			}
			
			val = res;
		}
		
		cx2->Clear();

		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		
		UnsetEnv(env);
		
		delete cx2;
		cx2 = 0;

		BreakFlag = 0;

		if (rn == 1) {
			break;
		}

	}		

	if (nresult->kind() == UNDEF) {
		Node* env = Nil->Cons(Nil);

		SetEnv(env, nresult);
		((Undef*)(nresult->Val()))->Set(val);

		PushStack(cx, Nil, Nil, env);
	}

	return 1;
}



#endif  /* !defined(__MINGW32__) */


