/************************************************************************
*									*
*	The SB-Prolog System						*
*	Copyright SUNY at Stony Brook, 1986				*
*									*
************************************************************************/

/*-----------------------------------------------------------------
SB-Prolog is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY.  No author or distributor
accepts responsibility to anyone for the consequences of using it
or for whether it serves any particular purpose or works at all,
unless he says so in writing.  Refer to the SB-Prolog General Public
License for full details.

Everyone is granted permission to copy, modify and redistribute
SB-Prolog, but only under the conditions described in the
SB-Prolog General Public License.   A copy of this license is
supposed to have been given to you along with SB-Prolog so you
can know your rights and responsibilities.  It should be in a
file named COPYING.  Among other things, the copyright notice
and this notice must be preserved on all copies. 
------------------------------------------------------------------ */

#ifndef	lint
static	char	rcsid[] = "$Header: other.c 1.2 87/10/24 $";
#endif

/* other.c */

/* $Log:	other.c,v $
 * Revision 1.2  87/10/24  14:32:15  rbk
 * Add #ifdef sequent code in b_SYSCALL() to map 4.3bsd system call numbers
 * to Sequent DYNIX system call numbers.
 * 
 */

#include "builtin.h"
#include <errno.h>
#include <sys/types.h>
#include <netdb.h>
#include <sys/socket.h>
#include <netinet/in.h>
#include <arpa/inet.h>

extern float floatval();
extern int d_trace, d_hitrace;
extern word flags[10];
extern int errno;

typedef union {
		char *name;
		int num;
	} call_args;

static call_args call_arg[10];
static char s[256];

b_SYSTEM0()  /* r1: a list of int (string) for CShell commands */
{
    register word op1;
    register pw top;
    char s[256];

    op1 = gregc(1); deref(op1);
    namestring(get_str_psc(op1), s);
    if (!unify(makeint(system(s)), gregc(2))) {Fail0;}
}


/* rno is number of register containing list of args 
   This routine converts them into array cal_arg, and 
   returns the number of args */
getgenargs(rno) 
int rno;
{
    int i;
    register word op2, op3;
    register pw top;
    struct psc_rec *ptr;

    op2 = gregc(rno); deref(op2);
    i = 1;
    while (!(isnil(op2))) {
	untag(op2);
	op3 = follow(op2);
	deref(op3);
	if (isatom(op3)) {
	    ptr = get_str_psc(op3);
	    if ( get_etype(ptr) == T_ORDI ) {
		namestring(ptr, s);
		call_arg[i].name = s;
	    }
	    else if (get_etype(ptr) == T_BUFF) {
		    call_arg[i].name = get_name(ptr);
	    }
	} 
	else if (isinteger(op3)) call_arg[i].num = intval(op3);
	else quit("Unknown syscall argument\n");
	op2 += 4;
	deref(op2);
	i++;
    }
    return(i);
}

b_SYSCALL()  /* r1: call # ; R2: a list of parameters; R3: returned value */
{
	int n, r;
	register word op1;
	register pw top;
#ifdef	sequent
	extern syscall_map[], num_syscall_map;
#endif	sequent

	op1 = gregc(1); 
	deref(op1);
	n = intval(op1);  /* syscall number */
#ifdef	sequent
	if (n <= 0 || n >= num_syscall_map) {
		printf("Bad system call number %d\n", n);
		Fail0;
	}
	n = syscall_map[n];
#endif	sequent
	switch (getgenargs(2)) {
	case 1:	
		r = syscall(n); 
		break;
	case 2:	
		r = syscall(n, call_arg[1]); 
		break;
	case 3:	
		r = syscall(n, call_arg[1], call_arg[2]); 
		break;
	case 4:	
		r = syscall(n, call_arg[1], call_arg[2], call_arg[3]); 
		break;
	case 5:	
		r = syscall(n, call_arg[1], call_arg[2], call_arg[3],
		    call_arg[4]); 
		break;
	case 6:	
		r = syscall(n, call_arg[1], call_arg[2], call_arg[3],
		    call_arg[4], call_arg[5]); 
		break;
	case 7:	
		r = syscall(n, call_arg[1], call_arg[2], call_arg[3],
		    call_arg[4], call_arg[5], call_arg[6]); 
		break;
	default: 
		quit("Too many arguments for syscall\n");
		break;
	}
	if (!unify(gregc(3), makeint(r))) {
		Fail0;
	}
}


b_BROCALL() /*	R1: call #; 
		R2: buffer containing args in 4 byte fields;
	        R3: buffer to put return value in. */
{
    struct psc_rec *rptr;
    pw aptr;
    register word op1, op;
    register pw top;

    op1 = gregc(1); deref(op1);  /* brocall number */
    op = gregc(2); deref(op); 
    aptr = (pw)get_name(get_str_psc(op)); /* buff with args */
    op = gregc(3); deref(op); rptr = get_str_psc(op); /* buff for result */
    switch ((int)(intval(op1))) {

	case 2:	*(pw)get_name(rptr) = (word) getenv(*aptr); break;

/* Communication subsystem system calls. Have not included byteorder (ntohl,
   ntohs, htonl, htons). Each call is from manual entry 3N,  except 
   getpeername,  which is from 2.
*/

/*	case 21: *(pw)get_name(rptr) = (word) gethostent(); break;	*/
	case 22: *(pw)get_name(rptr) = (word) gethostbyname(*aptr); break;
	case 23: *(pw)get_name(rptr) = (word) gethostbyaddr(*aptr); break;
	case 24: *(pw)get_name(rptr) = (word) sethostent(*aptr); break;
	case 25: *(pw)get_name(rptr) = (word) endhostent(); break;

	case 26: *(pw)get_name(rptr) = (word) getnetent(); break;
	case 27: *(pw)get_name(rptr) = (word) getnetbyname(*aptr); break;
	case 28: *(pw)get_name(rptr) = (word) getnetbyaddr(*aptr); break;
	case 29: *(pw)get_name(rptr) = (word) setnetent(*aptr); break;
	case 30: *(pw)get_name(rptr) = (word) endnetent(); break;

	case 31: *(pw)get_name(rptr) = (word) getprotoent(); break;
	case 32: *(pw)get_name(rptr) = (word) getprotobyname(*aptr); break;
	case 33: *(pw)get_name(rptr) = (word) getprotobynumber(*aptr); break;
	case 34: *(pw)get_name(rptr) = (word) setprotoent(*aptr); break;
	case 35: *(pw)get_name(rptr) = (word) endprotoent(); break;

	case 36: *(pw)get_name(rptr) = (word) getservent(); break;
	case 37: *(pw)get_name(rptr) = (word) getservbyname(*aptr); break;
	case 38: *(pw)get_name(rptr) = (word) getservbyport(*aptr); break;
	case 39: *(pw)get_name(rptr) = (word) setservent(*aptr); break;
	case 40: *(pw)get_name(rptr) = (word) endservent(); break;

/*	case 41: *(pw)get_name(rptr) = (word) inet_addr(*aptr); break; */
	case 42: *(pw)get_name(rptr) = (word) inet_network(*aptr); break;
	case 43: *(pw)get_name(rptr) = (word) inet_ntoa(*aptr); break;
/*	case 44: *(pw)get_name(rptr) = (word) inet_makeaddr(*aptr); break; */
	case 45: *(pw)get_name(rptr) = (word) inet_lnaof(*aptr); break;
	case 46: *(pw)get_name(rptr) = (word) inet_netof(*aptr); break;

/*	case 47: *(pw)get_name(rptr) = (word) get_peername(*aptr); break; */
	case 50: *(pw)get_name(rptr) = (word) perror(*aptr); break;

	default: printf("Illegal brocall number\n"); Fail0; return;
    }
}

b_ERRNO()
{ 
    if (!unify(gregc(1), makeint(errno))) {Fail0;}
}

b_CALL()	/* R1: The predicate to be called */
{
    callv_sub();  /* since cpreg has been saved by call "call",
				should not be saved again, the same as exec */
}

b_LOAD()	/* R1: the byte code file to be loaded */
		/* R2: the return code, 0 => success */
{
    register word op1;
    register pw top;

    op1 = gregc(1); deref(op1);
    if (!unify(makeint(dyn_loader(get_str_psc(op1))), gregc(2))) {Fail0;}
}

b_STATISTICS()
{
    print_statistics();
}

b_TRACE()
{
    hitrace = 1;
}

b_PILTRACE()
{
    trace = 1;
}

b_UNTRACE()
{
    hitrace = trace = 0;
}

/* b_DETRACE()
{
    hitrace = d_hitrace;
    trace = d_trace;
} */

b_SYMTYPE()	/* R1 term, R2 type field of psc-entry of root sym of term */
{
    register word op1;
    register pw top;

    op1 = gregc(1);
    typd: switch ((int)(op1&3)) {
	case FREE:
	    nderef(op1, typd);
	case LIST:
	case NUM:
	    quit("Symtype: illegal first arg");
	case CS:
	    if (!unify(makeint(get_etype(get_str_psc(op1))), gregc(2))) 
		{Fail0;}
	}
}

b_HASHVAL()	/* R1 Arg, R2 size of hashtab, R3 hashval for this arg 	*/
{
    register word op1, op2, op3;
    register pw top;

    op1 = gregc(1);
    op2 = gregc(2); deref(op2); op2 = intval(op2);
    op3 = gregc(3); deref(op3);
    sotd0: switch((int)(op1&3)) {
	case FREE: nderef(op1, sotd0);
		   printf("Indexing for asserted predicate with var arg\n");
		   Fail0;
	case NUM:
		if (isinteger(op1))
		    op1 = intval(op1);
		else op1 = (int)(floatval(op1));
		break;
	case LIST:
		op1 = *((pw)untagged(list_str));
		break;
	case CS:
		op1 = (word)get_str_psc(op1);
		break;
    }
    if (! unify(op3, makeint(ihash(op1, op2)))) {Fail0;}
}

b_FLAGS()  /* R1 contains number of bit to get or set (must be integer);
	      R2 contains setting of 0 or 1, 
		    or is variable and setting will be returned */
{
    register word op1, op2, res;
    register pw top;

    op1 = gregc(1); deref(op1); op1 = intval(op1);
    op2 = gregc(2); deref(op2); 
    if (isnonvar(op2)) {
	if (op1>9) flags[op1-10] = op2;
	else {
	    op2 = intval(op2);
	    switch ((int)(op1)) {
		    case 0: trace = op2; break;
		    case 1: hitrace = op2; break;
		    case 2: overflow_f = op2; break;
		    case 3: trace_sta = op2; break;
	    }
	    call_intercept = hitrace | trace_sta;
	}
    }
    else {  
	    if (op1>9) res = flags[op1-10];
	    else {
		switch ((int)(op1)) {
		    case 0: res = trace; break;
		    case 1: res = hitrace; break;
		    case 2: res = overflow_f; break;
		    case 3: res = trace_sta; break;
		}
		res = makeint(res);
	    }
	    follow(op2) = res;
    }
}

print_statistics()
{
    pw lstktop;

    if (breg < ereg) lstktop = breg;
    else lstktop = ereg - *(cpreg-5);

    printf("Maximum available stack size: %d\n", maxmem);
    printf("  Local stack: %d in use, %d max used.\n", 
	local_bottom-lstktop, local_bottom-mlocaltop);
    printf("  Heap stack: %d in use, %d max used.\n", 
	hreg-heap_bottom, mheaptop-heap_bottom);

    printf("Permanent space: %d, %d in use.\n", maxpspace,
    	((int) curr_fence - (int) pspace)/4);

    printf("Trail stack: %d, %d in use, %d max used.\n", 
	maxtrail, trail_bottom-trreg, trail_bottom-mtrailtop);
}