/*	UGENS2.C Modified by Robin Whittle 28 August 1995 . . . 
 *
 * !    Bug fixed 1 February 1996:
 * !
 * !	The offset was not being used.  Identical bugs fixed in:
 * !	ftkrch() and ftkrchk()
 *
 *   	
 *
 * NOTE - this code will only operate with a new version of fgens.c (for
 *	a perf time table finder), a modified prototyp.h (which declares it)
 *	and with a changed version of entry.c.
 *	See notes below.
 *
 * Alterations to table and tablei code to:
 *-----------------------------------------
 *
 * 1 - 	Alter non-wrap behavior at the end of the table in non-interpolated
 * 	read.  
 *
 * 2 - 	Alter non-wrap mode below 0 and above table length in interpolated 
 * 	read.
 *
 *	Non-wrap is now known as limit mode.
 * 	The purpose of these is to make the output of the table read "stick" 
 *	or "limit" to the values read for the lowest (0) and highest index 
 *	values, when (in non-wrap mode) the final index exceeds the limit 
 *	of the table.
 *
 * 3 - 	Fix a bug which produced idiosyncratic (and almost certainly useless)
 *	results with interpolated table read when the ixoff pointed 
 *	to somewhere between the integer index values which point to the 
 *	elements in the table.  This happened in wrap and non-wrap modes.
 *
 *	tablei p4, p5, 0, 2	OK, the offset points to location 2.
 *	tablei p4, p5, 0, 2.3	Bad.
 *	tablei p4, p5, 1, 0.5	OK, the offset points to the middle location.
 *	tablei p4, p5, 1, 0.501	Bad, the offset points just beyond the middle.
 *
 * 4 -	Fixed a problem in non-interpolated, wrap mode for negative final 
 *	indexes - the -1 to -0.0001 range was being converted to address 0
 *	when it should have been converted to -1.  In wrap mode, this meant
 * 	The entire negative index response was addressing one too high in 
 *	the table.
 *
 *	Changes have been made to the following functions:
 *
 *	tblchk()
 *	ktable()
 *  	table()
 *	ktablei()
 *	tablei()
 *
 *	Because of the number of changes, they have not been marked.
 *
 * 5 -	Provided for the possiblity of a k rate variable controlling the 
 *	table number.  Previously only an i rate variable could be used.
 *
 *	This is achieved with two new ugens:
 *
 *	tablekt and tableikt
 *
 * 	See "opodlst etc." below for changes required in entry.c.
 *
 * 6 -	ugens2.h has been modified to comment the data structures.  It is 
 * 	much the same as before, except I have changed the name of *indx to 
 *	*xndx and *ifn to *xfn and to add a new variable pfn for the previous
 *	function table number.
 *
 * This file written with tabstops every 8 columns.
 */		


/* opcodlst etc. - notes on changes to be made to entry.c
 * =============   --------------------------------------
 *
 * The opcoslst in entry.c is the central control for parsing ugens and 
 * deciding which functions to call.
 *
 * Previously the table and tablei ugens had the following entries:
 *
 * opcode   length of 	thread	output	input	functions to call at:
 *	    data space		args	args	i time	k rate	a rate

{ "itable", S(TABLE),	1,	"i",	"iiooo",itable	 		},
{ "itablei", S(TABLE),	1,	"i",	"iiooo",itabli	 		},

{ "table",  S(TABLE),	7,	"s",	"xiooo",tblset,	ktable,	table	},
{ "tablei", S(TABLE),	7,	"s",	"xiooo",tblset,	ktabli,	tabli	},

 * Although the ugen name is "table" or "tablei", special code in rdorch.c 
 * looks for these opcodes, and can decide to prepend i to them if certain
 * conditions are met.  The code will then find "itable" or "itablei" in 
 * the opcodlst, and work from there.
 *
 * These four lines remain.  However we need different code to handle 
 * table numbers which could change at k rate. This means we need
 * new lines in opcodlst to match the new ugen names with the new functions:

{ "tablekt",  S(TABLE),	7,	"s",  "xkooo",tblsetkt,	ktablekt, tablekt },
{ "tableikt", S(TABLE),	7,	"s",  "xkooo",tblsetkt,	ktablikt, tablikt },

 * Also we need to add function prototypes for these five new functions to
 * the first section of entry.c:

void tblsetkt(void*), ktablekt(void*), tablekt(void*), ktablikt(void*), tablikt(void*);

 */


/* Discussion on coping with various combinations of parameter type
 * ----------------------------------------------------------------
 *
 * Since there are three types of variable (i, k and a) and since the 
 * table read operation may well depend on the types of variable for output
 * and two input variables, there are 27 possiblilities - many of which we
 * want to disallow.  There really needs to be a better way of specifying
 * in opcodlst which sorts of parameters we expect, and what the thread and
 * functions will be.  This can be done with multiple names for similar
 * unit generators - but this is messy.  It is the technique usually adopted 
 * - for intance ilinrand, klinrand and alinrand.
 *
 * A better approach would be for certain opcodes (listed specifically on some
 * list) to have their names expanded according to the argument types on the
 * line in which they are called.  Then a search of opcodlst would proceed.
 *
 * For instance "kblah table kzot, 3" would cause "table" to be expanded to 
 * "table_k/kc" for types k, k and constant.  An appropriate line in opcodlist
 * could have this and all would be well.  There are probably better approaches
 * than this.
 *
 * I do not want to attempt such basic changes to Csound, so to get the 
 * table read opcodes working with either k or i rate variables, I decided to 
 * creat two new ugen names.
 */

/*****************************************************************************/
 
#include "cs.h"			/*			UGENS2.C	*/
#include "ugens2.h"
#include <math.h>

static float	fzero = 0., fone = 1.;

void phsset(PHSOR *p)
{
register float	phs;
register long  longphs;
	if ((phs = *p->iphs) >= fzero) {
		if ((longphs = phs))
			warning("init phase truncation");
		p->curphs = phs - longphs;
	}
}

void kphsor(PHSOR *p)
{
register float	phs;
	*p->sr = phs = p->curphs;
	if ((phs += *p->xcps * onedkr) >= fone)
		phs -= fone;
	else if (phs < fzero)
		phs += fone;
	p->curphs = phs;
}

void phsor(PHSOR *p)
{
register int	nsmps = ksmps;
register float	*rs, phase, incr;

	rs = p->sr;
	phase = p->curphs;
	if (p->XINCODE) {
		register float *cps = p->xcps;
		do {
			incr = *cps++ / esr;
			*rs++ = phase;
			phase += incr;
			if (phase >= fone)
				phase -= fone;
			else if (phase < fzero)
				phase += fone;
		} while (--nsmps);
	}
	else {
		incr = *p->xcps / esr;
		do {
			*rs++ = phase;
			phase += incr;
			if (phase >= fone)
				phase -= fone;
			else if (phase < fzero)
				phase += fone;
		} while (--nsmps);
	}
	p->curphs = phase;
}

/*****************************************************************************/
/*****************************************************************************/

					/* Table read code - see TABLE 
					 * data structure in ugens2.h.
					 */


					/*************************************/

					/* itblchk() 
					 *
				 	 * This is called at init time
					 * by tblset() to set up the TABLE
					 * data structure for subsequent
					 * k and a rate operations.
					 *
					 * It is also called at init time by
					 * itable() and itablei() prior to 
					 * them calling ktable() and ktabli()
					 * respectively to produce a single
					 * result at init time.
					 *
					 * Here we need to find the table and
					 * set up variables in TABLE.  We need
					 * to generate errors in a way suitable
					 * for init time.
					 *
					 * A similar function - ptblchk() 
					 * does the same job, but reports 
					 * errors in a way suitable for 
					 * performance time.
					 */

					/* If the specified table number can
					 * be found, then the purpose is to 
					 * read the three i rate input 
					 * variables and the function table 
					 * number input variable - (which
					 * we can assume here is also i rate)
					 * to set up the TABLE data structure 
					 * ready for the k and a rate 
					 * functions.
					 */
int itblchk(TABLE *p)
{
					/* No need to check for a 0 or negative
					 * table number - ftfind will do that.
					 */

					/* Get pointer to the function table
					 * data structure of the table number
					 * specified in xfn. Return 0 if
					 * it cannot be found.
					 *
					 * ftfind() generates an error message 
					 * if the table cannot be found. This
				 	 * works OK at init time.
					 */

	if ((p->ftp = ftfind(p->xfn)) == NULL)
		return(NULL);

					/* Table number is valid.
					 *
					 * Although TABLE has an integer
					 * variable for the table number
					 * (p->pfn) we do not need to 
					 * write it.  We know that
					 * the k and a rate functions which
					 * will follow will not be expecting
					 * a changed table number.
					 *
					 * p->pfn exists only for checking
					 * table number changes for functions
					 * which are expecting a k rate
					 * table number.
					 */

					/* Set denormalisation factor to 1 or 
					 * table length, depending on the 
					 * state of ixmode.
					 * 1L means a 32 bit 1.
					 */
	if (*p->ixmode)
		p->xbmul = p->ftp->flen;

	else	p->xbmul = 1L;

					/* Multiply the ixoff value by the 
					 * xbmul denormalisation factor and 
					 * then check it is between 0 and the
					 * table length.
					 *
  					 * Bug fix: was p->offset * *p->ixoff
					 */

	if (    ( p->offset = p->xbmul * *p->ixoff) < 0. 
	     || p->offset > p->ftp->flen
           )
	{
		sprintf(errmsg, "Offset %f < 0 or > tablelength", p->offset);
		initerror(errmsg);
		return(NULL);
	}

	p->wrap   = *p->iwrap;

					/* Return 1 to say everything is OK
					 */	
	return(1);
}

					/*************************************/

					/* ptblchk() 
					 *
				 	 * This is called at init time
					 * by tblsetkt() to set up the TABLE
					 * data structure for subsequent
					 * k and a rate operations which are
					 * expecting the table number to 
					 * change at k rate.
					 *
					 * tblsetkt() does very little - 
					 * just setting up the wrap variable
					 * in TABLE. All the other variables
					 * depend on the table number. This
					 * is not available at init time,
					 * so the following 4 functions must
					 * look for the changed table number
					 * and set up the variables accordingly
					 * - generating error messages in a 
					 * way which works at performance time.
					 *
					 * k rate   a rate
					 *
					 * ktablekt tablekt   Non interpolated
					 * ktablikt tablikt   Interpolated
					 * 
					 */
ptblchk(TABLE *p)
{
					/* TABLE has an integer variable for 
					 * the previous table number (p->pfn).
					 *
					 * Now (at init time) we do not 
					 * know the function table number 
					 * which will be provided at perf
					 * time, so set p->pfn to 0, so that
					 * the k or a rate code will recognise
					 * that the first table number is
					 * different from the "previous" one.
					 */
	p->pfn = 0;

					/* The only other thing to do is
					 * write the wrap value into the 
					 * immediate copy of it in TABLE.
					 */
	p->wrap   = *p->iwrap;
}



/*---------------------------------------------------------------------------*/
				
					/* tblset() 
					 *
					 * This is called at init time 
					 * to set up TABLE for the a and k
					 * rate table read functions which
					 * are expecting the table number to
					 * be fixed at i time. 
					 *
					 * Call the itblchk() function to 
					 * do the work.
					 */ 	
void tblset(TABLE *p)
{
	itblchk(p);
}
					
					/* tblsetkt() 
					 *
					 * This is called at init time 
					 * to set up TABLE for the a and k
					 * rate table read functions which
					 * are expecting the table number to
					 * be a k rate variable. 
					 *
					 * Call the ptblchk() function to 
					 * do the work.
					 */ 	
void tblsetkt(TABLE *p)
{
	ptblchk(p);
}

					/*************************************/

					/* Special functions to use when
					 * the output value is an init time 
					 * variable.
					 *
					 * These are called by the opodlst
					 * lines for itable and itablei 
					 * ugens.
					 *
					 * They call itblchk() and if the 
					 * table was found, they call the
					 * k rate function just once.
					 *
					 * If the table was not found, an
					 * error will result from ftfind.
					 */
void itable(TABLE *p)
{
void ktable();

	if (itblchk(p))
		ktable(p);
}
 
void itabli(TABLE *p)
{
void ktabli();

	if (itblchk(p))
		ktabli(p);
}

/*---------------------------------------------------------------------------*/

					/* Functions which read the table.
					 *
					 * First we have the four basic
					 * functions for a and k rate, 
					 * non interpolated and interpolated
					 * reading.  These all assume that
					 * the TABLE data structure has been
					 * correctly set up - they are not
					 * expecting the table number to 
					 * change at k rate.
					 *
					 * These are:
					 *
					 * k rate  a rate
					 *
					 * ktable  table   Non interpolated
					 * ktabli  tabli   Interpolated
					 * 
					 *
					 * Then we have	four more functions
					 * which are expecting the table 
					 * number to change at k rate.
					 * They deal with this, and then
					 * call one of the above functions
					 * to do the reading.
					 *
					 * These are:
					 *
					 * k rate   a rate
					 *
					 * ktablekt tablekt   Non interpolated
					 * ktablikt tablikt   Interpolated
					 * 
					 */

					/* ktable() and ktabli()
					 * ---------------------
					 *
					 * These both read a single value from 
					 * the table. ktabli() does it with
					 * interpolation.
					 *
					 * This is typically used for k rate
					 * reading - where they are called as
					 * a result of being listed in a line
					 * in opcodlst.  They are also called
					 * by two functions which after they 
					 * have coped with any change in
					 * the k rate function table number.
					 *
					 * ktablekt() and ktablikt().
					 *
					 * In addition, they can be called 
					 * by the init time functions:
					 * itable() and itabli().	
					 *
					 *
					 * table() and tabli()
					 * -------------------
					 *
					 * These do the reading at a rate
					 * with an a rate index.
					 *
					 * They are called directly via their
					 * entries in opcodlst, and also by
					 * two functions which call them after
					 * they have coped with any change in
					 * the k rate function table number.
					 *
					 * tablekt() and tablikt().
					 *
					 *	
					 */ 

					/*************************************/

					/* ktable()
					 */

void ktable(TABLE  *p)
{
					/* Local variables . . .
					 *
					 * Pointer to function table data 
					 * structure.
					 */
FUNC 	*ftp;
					
					/* 32 bit integers for pointing into
					 * table and for the table length - 
					 * which is always a power of 2. 
					 * The table must actually be one 
					 * more longer than this if it has a
					 * guard point.
					 */
register long	indx, length;

					/* Float for calculating where we are
					 * going to read from.
					 */
register float 	ndx;
			
					/*-----------------------------------*/

					/* Assume that TABLE variables have
					 * been set so everything is ready to 
					 * go!
					 */
		
					/* Set up local variables.
					 */				
	ftp    = p->ftp;
	ndx    = *p->xndx;
	length = ftp->flen;
					/* Multiply ndx by denormalisation 
					 * factor.  and add in the offset -
					 * already denormalised - by tblchk().  
					 *
					 * xbmul = 1 or table length depending
					 * on state of ixmode.
					 */

	ndx = ( ndx * p->xbmul) + p->offset;		

					/* ndx now includes the offset and is
					 * ready to address the table.  
					 *
					 * The original code was:
					 *
					 *  indx = (long) (ndx + p->offset);
					 *
					 * This is a problem, because 
					 * converting a float to a long integer
					 * in this way, (at least with the 
					 * MSDOS GNU DJGPP compiler) causes
					 * problems with negative numbers.
					 *
					 * We want anything between -1.0 and 
					 * just below zero to be converted
					 * to -1. But they are converted to 0.
					 * Then -2.0 to -1.0001 is converted
					 * to -1, when we want -2.
					 *
					 * Negative indexes are an issue with
					 * wrap mode, so we have to convert
					 * the way we want.
					 * 
					 * ANSI C library function floor
				 	 * finds the next most negative integer
					 * - returning it as a float.
					 *
					 * There may be faster ways of doing
					 * it, but the results would be
					 * machine dependant. 
					 */
	indx = (long) floor(ndx);

					/* Now for "limit mode" - the "non-wrap" 
					 * function, depending on iwrap.
					 *
					 * The following section of code 
					 * limits the final index to 0 and
					 * the last location in the table.
					 * 
					 * It is only used when wrap is OFF. 
					 * The wrapping is acheived by code 
					 * after this - when this code is
					 * not run.
 					 */ 
	if (!p->wrap) {
					/* Previously this code limited the 
					 * upper range of the indx to the 
					 * table length - for instance 8.
					 * Then the result was ANDed with
					 * a mask (for instance 7).
					 *
					 * This meant that when the input 
					 * index was 8 or above, it got
					 * reduced to 0.  What we want is for
					 * it to stick at the index which reads
					 * the last value from the table - in
					 * this example from location 7.
					 *
					 * So instead of limiting to the 
					 * table length, we limit to 
					 * (table length - 1).
					 */
		if (indx > length - 1)
			indx = length - 1;

					/* Now limit negative values to zero.
					 * 0L is a macro for a long zero.  
					 * Why is this used?
					 */
		else if (indx < 0L)
			indx = 0L;
	}
					/* The following code uses an AND with
					 * an integer like 0000 0111 to 
					 * wrap the current index within the
					 * range of the table.
					 * In the original version, this
					 * code always ran, but with the new
					 * (length - 1) code above, it would
					 * have no effect, so it is now an else
					 * operation - running only when
					 * iwrap = 1.  This may save half a 
					 * usec or so. 
					 */
	else	indx &= ftp->lenmask;

					/* Now find the address of the start
					 * of the table, add it to the index,
					 * read the value from there and 
					 * write it to the destination.
					 */
	*p->rslt = *(ftp->ftable + indx);
}

					/*************************************/

						
					/* table()
					 */

					/* table() is similar to ktable() 
					 * above, except that it processes
					 * an array of input indexes, to 
					 * send results to another array.
					 * These arrays are ksmps long.
					 */
void table(TABLE  *p)
{
					/* Local variables . . .
					 *
					 * Pointer to function table data 
					 * structure.
					 */
register FUNC 	*ftp;

					/* Pointers to floats:
					 *
					 * *rslt	Array where the results
					 *		will be written.
					 *
					 * *pxndx	Array of input index
					 *		values.
					 *
					 * *tab		Pointer to start of 
					 * 		the table we will read.
					 */
register float 	*rslt, *pxndx, *tab;

					/* 32 bit integers:
					 *
					 * indx		Used to read table.
					 *		
					 * mask		ANDed with indx to 
					 * 		make it wrap within
					 *		table.
					 *
					 * length	Length of table - 
					 *		always a power of two, 
					 * 		even if the table has
					 *		a guard point.
					 *
					 * For instance length = 8, mask = 
					 * 0000 0111, normal locations in table
					 * are 0 to 7.  Location 8 is the 
					 * guard point.  table() does not read 
					 * the guard point - tabli() does.
					 */
register long	indx, mask, length;

					/* nsmps is the counter for the loop 
					 * which processes the data.
					 * declare it as an integer, and 
					 * intialize it to the global variable
					 * ksmps.
					 */
register int	nsmps = ksmps;

					/* Float local variables.
					 *
					 * ndx		Index.
					 *	
					 * xbmul	Normalisation factor
					 * 		to adjust for ndx 
					 * 		having a 0 to 1 range.
					 *		Equal to 1 or length
					 * 		depending on ixmode.
					 * 		
					 * offset	Offset to add to ndx.
					 *		Already denormalised.
					 */
float	ndx, xbmul, offset;

					/*-----------------------------------*/

					/* Assume that TABLE variables have
					 * been set so everything is ready to 
					 * go!
					 */
		
					/* Set up local variables.
					 */
	ftp    = p->ftp;
	rslt   = p->rslt;
	length = ftp->flen;
	pxndx  = p->xndx;
	xbmul  = p->xbmul;
	offset = p->offset;
	mask   = ftp->lenmask;
	tab    = ftp->ftable;
					/* Main loop - for the number of a
					 * samples in a k cycle.
					 */
	do {
					/* Read in the next raw index and 
					 * increment the pointer ready for
					 * the next cycle.
					 *
					 * Then multiply the ndx by the 
					 * denormalising factor and add in
					 * the offset.
					 */ 

		ndx = (*pxndx++ * xbmul) + offset;

					/* See notes in ktable() about this
					 * conversion to a 32 bit integer.
					 */
		indx = (long) floor(ndx);

					/* Limit = non-wrap.  Limits to 0 and
					 * (length - 1), or does the wrap 
					 * code.  See notes above in ktable().
					 */ 
		if (!p->wrap) {
			if (indx > length - 1)  
				indx = length - 1;
			else if (indx < 0L)  
				indx = 0L;
		}
					/* Now do the wrap code only if we are
					 * not doing the non-wrap code.
					 */			
		else	indx &= mask;
					/* Add add the index to the table 
					 * starting address, read the value
					 * and write it to the result array.
					 */
		*rslt++ = *(tab + indx);
	} 
	while(--nsmps);
}


					/*************************************/


					/* ktabli()
					 */
		
					/* ktabli() is similar to ktable() 
					 * above, except that it uses the
					 * fractional part of the final index 
					 * to interpolate between one value in
					 * the table and the next.
					 * 
					 * This means that it may read the
					 * guard point.  In a table of 
					 * "length" 8, the guardpoint is
					 * at locaton 8. The normal part of the
					 * table is locations 0 to 7.
					 *
					 * Previously this code did not cope
					 * properly with non wrap mode.
					 * Outside the 0 to 7.99 range (in
					 * the example of a table length 8),
					 * it repeated the outputs of the 
					 * 0 to 0.99 range of the table.
					 *
					 * Also there was a bug when the 
					 * offset did not point exactly to 
					 * an entry in the table.
					 *
					 * In non-wrap mode, when the final
					 * index is negative, the output
					 * should be the value in location 0.
					 * 
					 * In non-wrap mode, when the final 
					 * index is >= length, then the output 
					 * should be the value in the guard 
 					 * point location.
					 */
void ktabli(TABLE  *p)
{
					/* Local variables . . .
					 *
					 * Pointer to function table data 
					 * structure.
					 */
register FUNC 	*ftp;

					/* 32 bit integers for pointing into
					 * table and for the table length - 
					 * which is always a power of 2. 
					 * The table must actually be one 
					 * more longer than this if it has a
					 * guard point.
					 */
register long	indx, length;

					/* Variables for reading from two
					 * locations, and interpolating
					 * between them.
					 */
register float 	v1, v2, fract, ndx;

					/*-----------------------------------*/

					/* Assume that TABLE variables have
					 * been set so everything is ready to 
					 * go!
					 */
					
					/* Set up local variables.
					 */
	ftp    = p->ftp;
	ndx    = *p->xndx;
	length = ftp->flen;
					/* Multiply ndx by denormalisation 
					 * factor.  
					 * 
					 * xbmul is 1 or table length depending
					 * on state of ixmode.
					 *
					 * Add in the offset, which has already
					 * been denormalised by tblchk().  
					 */

	ndx    = (ndx * p->xbmul) + p->offset;

					/* See notes in ktable() about this
					 * conversion to a 32 bit integer.
					 */
	indx = (long) floor(ndx);

					/* We need to generate a fraction - 
					 * How much above indx is ndx?
					 * It will be between 0 and just
					 * below 1.0.
					 */
	fract = ndx - indx;
			
					/* Start of changes to fix non-
					 * wrap bug.
					 *
					 * There are two changes here:
					 *
					 * 1 - We only run the wrap code
					 * if iwrap = 1. Previously it was
					 * always run.
					 *
					 * 2 - The other change is similar in 
					 * concept to limiting the index to 
					 * (length - 1) when in non-wrap
					 * mode.
					 *
					 * This would be fine - the 
					 * fractional code would enable us
					 * to interpolate using an index
					 * value which is almost as high as
					 * the length of the table.  This
					 * would be good for 7.99999 etc.
					 * However, to be a little pedantic,
					 * what we want is for any index of
					 * 8 or more to produce a result 
					 * exactly equal to the value at the 
					 * guard point.
					 *
					 * We will let all (non negative) 
					 * values which are less than length
					 * pass through. This deals with all
					 * cases 0 to 7.9999 . . . 
					 *
					 * However we will look for final
					 * indexes of length (8) and above and 
					 * take the following steps:
					 * 
					 * fract = 1	
					 * indx = length - 1
					 * 
					 * We then continue with the rest of 
					 * code.  This causes the result to be
					 * the value read from the guard point
					 * - which is what we want.
					 *
					 * Likewise, if the final index is
					 * negative, set both fract and indx
					 * to 0.	
					 */
	if (!p->wrap) 
	{
		if (ndx > length) {
			indx  = length - 1;
			fract = 1;
		}

		else if (ndx < 0) {
			indx  = 0L;
			fract = 0;
		}	
	}
					/* We are in wrap mode, so do the 
					 * wrap function.
				  	 */	
	else	indx &= ftp->lenmask;

					/* Now read the value at indx and the
					 * one beyond.  Code slightly tweaked
					 * for speed by auto incrementing
					 * indx to the next location, rather
					 * than adding one to it.  
					 */
	v1 = *(ftp->ftable + indx++);
	v2 = *(ftp->ftable + indx); 
					/* Calculate the interpolated value and
					 * write it to the result destination.
					 */

	*p->rslt = v1 + (v2 - v1) * fract;
}


					/*************************************/
					
					/* tabli()
					 */

					/* tabli() is similar to ktabli() 
					 * above, except that it processes
					 * an array of input indexes, to 
					 * send results to another array.
					 *
					 * See the notes on ktablei() for 
					 * details of how it works.  Only 
					 * array specific things are 
					 * commented here.
					 */
					 
void tabli(TABLE  *p)
{
					/* Local variables as for ktabli, 
					 * with the following addtions:
					 *
					 * mask		Local 32 bit integer
					 *		to save time in the 
					 *		loop, instead of
					 *		accessing it from
					 *		structure FUNC.
					 */

register FUNC 	*ftp;
register long	indx, mask, length;
register int	nsmps = ksmps;
					/* Three pointers to floats as in 
					 * table() above.
					 */
register float 	*rslt, *pxndx, *tab;
					/* Four floats as per ktabli().
				  	 */
register float 	v1, v2, fract, ndx;
					
					/* Two floats as per table(). These
					 * are for speed - better to have them
					 * local than via a structure.
					 */	
register float	xbmul, offset;
					/*-----------------------------------*/

					/* Assume that TABLE variables have
					 * been set so everything is ready to 
					 * go!
					 */
	
					/* Set up local variables 
					 */
	ftp    = p->ftp;
	rslt   = p->rslt;
	length = ftp->flen;
	pxndx  = p->xndx;
	xbmul  = p->xbmul;
	offset = p->offset;
	mask   = ftp->lenmask;
	tab    = ftp->ftable;
					/* Loop for ksmps cycles.
					 */

	do {
					/* Read in the next raw index and 
					 * increment the pointer ready for
					 * the next cycle.
					 *
					 * Then multiply the ndx by the 
					 * denormalising factor and add in
					 * the offset.
					 */ 

		ndx = (*pxndx++ * xbmul) + offset;

					/* See notes in ktable() about this
					 * conversion to a 32 bit integer.
					 */
		indx = (long) floor(ndx);

					/* We need to generate a fraction - 
					 * How much above indx is ndx?
					 * It will be between 0 and just
					 * below 1.0.
					 */
		fract = ndx - indx;
					/* As for ktabli() code to handle
					 * non wrap mode, and wrap mode.
					 */
		if (!p->wrap) {
			if (ndx > length) {
				indx  = length - 1;
				fract = 1;

			}

			else if (ndx < 0) {
 
				indx  = 0L;
				fract = 0;	
			}
		}
	
		else	indx &= mask;

					/* As for ktabli(), read two values
					 * and interpolate between them.
					 */
		v1 = *(tab + indx++);
		v2 = *(tab + indx);

		*rslt++ = v1 + (v2 - v1)*fract;
	} 
	while(--nsmps);
}

					/*************************************/
					
					/* Four functions to call the above
					 * four, after handling the k rate
					 * table number variable.
					 *
					 * Prior to these running, we can
					 * assume that tblsetkt() has been
					 * run at init time.
					 *
					 * tblsetkt() does very little - 
					 * just setting up the wrap variable
					 * in TABLE. All the other variables
					 * depend on the table number. This
					 * is not available at init time,
					 * so the following 4 functions must
					 * look for the changed table number
					 * and set up the variables accordingly
					 * - generating error messages in a 
					 * way which works at performance time.
					 *
					 * k rate   a rate
					 *
					 * ktablekt tablekt   Non interpolated
					 * ktablikt tablikt   Interpolated
					 * 
					 * Since these perform identical 
					 * operations, apart from the 
					 * function they call, create a
					 * common function to do this work:
					 *
					 * ftkrchk()
					 */
	
int ftkrchk(TABLE *p)
{
					/* Check the table number is >= 1.
					 * Print error and deactivate 
					 * if it is not.
					 * Return 0 to tell calling function
					 * not to proceed with a or k rate
					 * operations.
					 *
					 * We must do this to catch the 
					 * situation where the first call
					 * has a table number of 0, and since
					 * that equals pfn, we would otherwise
					 * proceed without checking the
					 * table number - and none of the
					 * pointers would have been set up.
					 */
	if (*p->xfn < 1) 
	{		
		sprintf(errmsg, "k rate function table no. %f < 1", *p->xfn);
		perferror(errmsg);
		return (NULL);
	}
					/* Check to see if table number 
					 * has changed from previous value.
					 *
					 * On the first run through, the 
					 * previous value will be 0.
					 */


	if (p->pfn != (long)*p->xfn)
	{
					/* If it is different, check to see
					 * if the table exists.
					 *
					 * If it doesn't, an error message
					 * should be produced by ftfindp()
					 * which should also deactivate 
					 * the instrument.
					 *
					 * Return 0 to tell calling function
					 * not to proceed with a or k rate
					 * operations.
					 *
					 * ftfindp is in a new version of 
					 * fgens.c. A prototype for it
					 * should be added to prototype.h.
					 */

		if ( (p->ftp = ftfindp(p->xfn) ) == NULL) 
		{
			return (0);
		}	

					/* p->ftp now points to the FUNC
					 * data structure of the newly 
					 * selected table.
					 * 
					 * Now we set up some variables in 
					 * TABLE ready for the k or a rate
					 * functions which follow.
					 */

					/* Write the integer version of the
					 * table number into pfn so we
					 * can later decide whether subsequent
					 * calls to the k and a rate functions
					 * occur with a table number value 
					 * which points to a different table. 
					 *
					 * p->pfn is an integer.
					 */
		p->pfn = *p->xfn;

					/* Set denormalisation factor to 1 or 
					 * table length, depending on the 
					 * state of ixmode.
					 * 1L means a 32 bit 1.
					 */
		if (*p->ixmode)
			p->xbmul = p->ftp->flen;
	
		else	p->xbmul = 1L;

					/* Multiply the ixoff value by the 
					 * xbmul denormalisation factor and 
					 * then check it is between 0 and the
					 * table length.
					 */

		if (    (p->offset = p->xbmul * *p->ixoff) < 0. 
		     || p->offset > p->ftp->flen
  	   	   ) 
		{
			sprintf(errmsg, "Offset %f < 0 or > tablelength", p->offset);
			perferror(errmsg);
			return(NULL);
		}
					/* If all is well, return 1 to 
					 * tell calling function to proceed
					 * with a or k rate operations.
					 */
		return(1);
	}
}

					/* Now for the four functions, which
					 * are called as a result of being
					 * listed in opcodlst in entry.c
					 */

void	ktablekt(TABLE *p)
{
	if ( ftkrchk(p) ) ktable(p);
}

void	tablekt(TABLE *p)
{
	if ( ftkrchk(p) ) table(p);
}

void	ktablikt(TABLE *p)
{
	if ( ftkrchk(p) ) ktabli(p);
}

void	tablikt(TABLE *p)
{
	if ( ftkrchk(p) ) tabli(p);
}

					/* Re-entering comment free zone . . .
					 */

/*****************************************************************************/

void ko1set(OSCIL1 *p)
{
register FUNC	*ftp;

	if ((ftp = ftfind(p->ifn)) == NULL)
		return;
	if (*p->idur <= fzero)
		warning("duration < zero");
	p->ftp = ftp;
	p->phs = 0;
	p->dcnt = *p->idel * ekr;
	p->kinc = (long) (kicvt / *p->idur);
}

void kosc1(OSCIL1 *p)
{
register FUNC *ftp;
register long  phs, dcnt;

	ftp = p->ftp;
	phs = p->phs;
	*p->rslt = *(ftp->ftable + (phs >> ftp->lobits)) * *p->kamp;
	if ((dcnt = p->dcnt) > 0L)
		dcnt--;
	else if (dcnt == 0L) {
		phs += p->kinc;
		if (phs >= MAXLEN) {
			phs = MAXLEN;
			dcnt--;
		}
		p->phs = phs;
	}
	p->dcnt = dcnt;
}

void kosc1i(OSCIL1  *p)
{
register FUNC	*ftp;
register float	fract, v1, *ftab;
register long	phs, dcnt;

	ftp = p->ftp;
	phs = p->phs;
	fract = PFRAC(phs); 	
	ftab = ftp->ftable + (phs >> ftp->lobits);
	v1 = *ftab++;
	*p->rslt = (v1 + (*ftab - v1) * fract) * *p->kamp;
	if ((dcnt = p->dcnt) > 0L) {
		dcnt--;
		p->dcnt = dcnt;
	}
	else if (dcnt == 0L) {
		phs += p->kinc;
		if (phs >= MAXLEN) {
			phs = MAXLEN;
			dcnt--;
			p->dcnt = dcnt;
		}
		p->phs = phs;
	}
}

void oscset(OSC *p)
{
register FUNC	*ftp;

	if ((ftp = ftfind(p->ifn)) != NULL) {
		p->ftp = ftp;
		if (*p->iphs >= 0)
			p->lphs = ((long)(*p->iphs * fmaxlen)) & PMASK;
	}
}

void koscil(OSC *p)
{
register FUNC	*ftp;
register long	phs, inc;

	ftp = p->ftp;
	phs = p->lphs;
	inc = *p->xcps * kicvt;
	*p->sr = *(ftp->ftable + (phs >> ftp->lobits)) * *p->xamp;
	phs += inc;
	phs &= PMASK;
	p->lphs = phs;
}

void osckk(OSC *p)
{
register FUNC	*ftp;
register float	amp, *ar, *ftbl;
register long	phs, inc, lobits;
register int	nsmps = ksmps;

	ftp = p->ftp;
	ftbl = ftp->ftable;
	phs = p->lphs;
	inc = *p->xcps * sicvt;
	lobits = ftp->lobits;
	amp = *p->xamp;
	ar = p->sr;
	do {
		*ar++ = *(ftbl + (phs >> lobits)) * amp;
		phs += inc;
		phs &= PMASK;
	}
	while (--nsmps);
	p->lphs = phs;
}

void oscka(OSC *p)
{
register FUNC	*ftp;
register float	*ar, amp, *cpsp, *ftbl;
register long	phs, lobits;
register int	nsmps = ksmps;

	ftp = p->ftp;
	ftbl = ftp->ftable;
	lobits = ftp->lobits;
	amp = *p->xamp;
	cpsp = p->xcps;
	phs = p->lphs;
	ar = p->sr;
	do {
		register long inc;
		inc = *cpsp++ * sicvt;
		*ar++ = *(ftbl + (phs >> lobits)) * amp;
		phs += inc;
		phs &= PMASK;
	}
	while (--nsmps);
	p->lphs = phs;
}

void oscak(OSC *p)
{
register FUNC	*ftp;
register float	*ar, *ampp, *ftbl;
register long	phs, inc, lobits;
register int	nsmps = ksmps;

	ftp = p->ftp;
	ftbl = ftp->ftable;
	lobits = ftp->lobits;
	phs = p->lphs;
	inc = *p->xcps * sicvt;
	ampp = p->xamp;
	ar = p->sr;
	do {
		*ar++ = *(ftbl + (phs >>lobits)) * *ampp++;
		phs += inc;
		phs &= PMASK;
	}
	while (--nsmps);
	p->lphs = phs;
}

void oscaa(OSC *p)
{
register FUNC	*ftp;
register float	*ar, *ampp, *cpsp, *ftbl;
register long	phs, lobits;
register int	nsmps = ksmps;

	ftp = p->ftp;
	ftbl = ftp->ftable;
	lobits = ftp->lobits;
	phs = p->lphs;
	ampp = p->xamp;
	cpsp = p->xcps;
	ar = p->sr;
	do {
		register long inc;
		inc = *cpsp++ * sicvt;
		*ar++ = *(ftbl + (phs >>lobits)) * *ampp++;
		phs += inc;
		phs &= PMASK;
	}
	while (--nsmps);
	p->lphs = phs;
}

void koscli(OSC  *p)
{
register FUNC	*ftp;
register long	phs, inc;
register float  *ftab, fract, v1;

	phs = p->lphs;
	ftp = p->ftp;
	fract = PFRAC(phs);
	ftab = ftp->ftable + (phs >> ftp->lobits);
	v1 = *ftab++;
	*p->sr = (v1 + (*ftab - v1) * fract) * *p->xamp;
	inc = *p->xcps * kicvt;
	phs += inc;
	phs &= PMASK;
	p->lphs = phs;
}

void osckki(OSC  *p)
{
register FUNC	*ftp;
register float	fract, v1, amp, *ar, *ftab;
register long	phs, inc, lobits;
register int	nsmps = ksmps;

	ftp = p->ftp;
	lobits = ftp->lobits;
	phs = p->lphs;
	inc = *p->xcps * sicvt;
	amp = *p->xamp;
	ar = p->sr;
	do {
		fract = PFRAC(phs);
		ftab = ftp->ftable + (phs >> lobits);
		v1 = *ftab++;
		*ar++ = (v1 + (*ftab - v1) * fract) * amp;
		phs += inc;
		phs &= PMASK;
	}
	while (--nsmps);
	p->lphs = phs;
}

void osckai(OSC  *p)
{
register FUNC	*ftp;
register float	*ar, amp, *cpsp, fract, v1, *ftab;
register long	phs, lobits;
register int	nsmps = ksmps;

	ftp = p->ftp;
	lobits = ftp->lobits;
	amp = *p->xamp;
	cpsp = p->xcps;
	phs = p->lphs;
	ar = p->sr;
	do {
		register long inc;
		inc = *cpsp++ * sicvt;
		fract = PFRAC(phs);
		ftab = ftp->ftable + (phs >> lobits);
		v1 = *ftab++;
		*ar++ = (v1 + (*ftab - v1) * fract) * amp;
		phs += inc;
		phs &= PMASK;
	}
	while (--nsmps);
	p->lphs = phs;
}

void oscaki(OSC  *p)
{
register FUNC	*ftp;
register float	v1, fract, *ar, *ampp, *ftab;
register long	phs, inc, lobits;
register int	nsmps = ksmps;

	ftp = p->ftp;
	ftab = ftp->ftable;
	lobits = ftp->lobits;
	phs = p->lphs;
	inc = *p->xcps * sicvt;
	ampp = p->xamp;
	ar = p->sr;
	do {
		fract = PFRAC(phs);
		ftab = ftp->ftable + (phs >> lobits);
		v1 = *ftab++;
		*ar++ = (v1 + (*ftab - v1) * fract) * *ampp++;
		phs += inc;
		phs &= PMASK;
	}
	while (--nsmps);
	p->lphs = phs;
}

void oscaai(OSC  *p)
{
register FUNC	*ftp;
register float	v1, fract, *ar, *ampp, *cpsp, *ftab;
register long	phs, lobits;
register int	nsmps = ksmps;

	ftp = p->ftp;
	ftab = ftp->ftable;
	lobits = ftp->lobits;
	phs = p->lphs;
	ampp = p->xamp;
	cpsp = p->xcps;
	ar = p->sr;
	do {
		register long inc;
		inc = *cpsp++ * sicvt;
		fract = PFRAC(phs);
		ftab = ftp->ftable + (phs >> lobits);
		v1 = *ftab++;
		*ar++ = (v1 + (*ftab - v1) * fract) * *ampp++;
		phs += inc;
		phs &= PMASK;
	}
	while (--nsmps);
	p->lphs = phs;
}