#include "apl.h"
#ifdef QDOS
#include <qdos.h>
#endif

ex_dibm()
{
	int j, arg;
	struct item *p;

	/* Dyadic i-beam functions.  I-beam 63 assumes that the
	 * "empty" system call (check whether pipe empty) has been
	 * implemented in the Unix kernel.
	 */

	arg = topfix();					/* Get left argument */

	switch(topfix()) {

	default:
		error("unknown i-beam");

	case 29: 						/* Set origin, return old one */
		datum = thread.iorg;
		thread.iorg = arg;
		break;

	case 30: 						/* Set width, return old one */
		datum = thread.width;
		thread.width = arg;
		break;

	case 31: 						/* Set number of digits, return old one */
		datum = thread.digits;
		thread.digits = arg;
		break;

	case 34: 						/* "Nice" system call */
#ifdef QDOS
             datum = mt_prior(-1,arg);
#else
		datum = nice(arg);
#endif
		break;

	case 35:						/* "Sleep" system call */
		datum = sleep(arg);
		break;

	case 63:						/* "Empty" system call */
		datum = empty(arg);
		break;

	case 90:						/* Enable/disable exit with ")off" only */
		datum = offexit;
		arg = !!arg;
		offexit = arg ? isatty(0) : arg;
		break;

	case 99:						/* Buffer flush */
		/* Warning -- information is lost if an input pipe
		 * file descriptor is flushed.  No checking is
		 * made for this i-beam function!!
		 */
		datum = zero;
		break;

	}

	p = newdat(DA, 0, 1);
	p->datap[0] = datum;
	*sp++ = p;
}


int afnfree, afnused;

ex_mibm()
{
	struct tm *tp, *localtime();
	struct si *gp;
	struct item *p;
	int i;
	long tvec;
	struct {
		long proc_user_time;
		long proc_system_time;
		long child_user_time;
		long child_system_time;
	} t;

	switch(topfix()) {

	default:
		error("unknown i-beam");

	case 20:						/* time of day */
		time(&tvec);
		goto tod;

	case 21:						/* CPU time */
		times(&t);
		datum = t.proc_user_time+t.proc_system_time;
		break;

	case 22:						/* ws bytes unused */
		datum = afnfree;
		break;

	case 24:						/* starting time */
		tvec = startTime;

	tod:
		tp = localtime(&tvec);
		datum = 60.*(tp->tm_sec+60.*(tp->tm_min+60.*tp->tm_hour));
		break;

	case 25:						/* date */
		time(&tvec);
		goto dt;

	case 26:						/* current line */
		datum = (gsip ? gsip->funlc - 1 : 0);
		break;

	case 27:						/* vector of line numbers of fn activations # */
		i = 0;
		gp = gsip;
		while(gp){
			if(gp->np) i++;
			gp = gp->sip;
		}
		p = newdat(DA, 1, i);
		gp = gsip;
		i = 0;
		while(gp){
			if(gp->np); p->datap[i++] = gp->funlc - 1;
			gp = gp->sip;
		}
		*sp++ = p;
		return;

	/*
	 * non standard I functions
	 */

	case 28:						/* starting date */
		tvec = startTime;

	dt:
		tp = localtime(&tvec);
		datum = tp->tm_year+100.*(tp->tm_mday+100.*(tp->tm_mon+1));
		break;

	case 29:						/* iorg */
		datum = thread.iorg;
		break;

	case 30:						/* width */
		datum = thread.width;
		break;

	case 31:						/* digits */
		datum = thread.digits;
		break;

	case 32:						/* ws bytes in use */
		datum = afnused;
		break;

	case 36:						/* 2nd element of ib27 */
		datum = ((gsip && gsip->sip) ? gsip->sip->funlc - 1 : 0);
		break;

	case 40:						/* Total accumulated child's time */
		times(&t);
		datum = t.child_user_time+t.child_system_time;
		break;

	case 41:						/* Total accumulated user time -- including all kids */
		times(&t);
		datum = t.proc_user_time+t.child_user_time;
		break;

	case 42:						/* Total system time -- including all kids */
		times(&t);
		datum = t.proc_system_time+t.child_system_time;
		break;

	case 43:						/* User time -- parent only */
		times(&t);
		datum = t.proc_user_time;
		break;

	case 44:						/* System time -- parent only */
		times(&t);
		datum = t.proc_system_time;
		break;

	case 96:
		dstack();


	case 97:
		datum = (sp - stack) / 2;
		break;

	case 98:						/* turn off alloc/free trace */
		datum = aftrace;
		aftrace = 0;
		break;

	case 99:						/* turn on alloc/free trace */
		datum = aftrace;
		aftrace = 1;
		break;
	}
	p = newdat(DA, 0, 1);
	p->datap[0] = datum;
	*sp++ = p;
}
