[unix-history] / usr / src / cmd / apl / a6.c

#include "apl.h"

ex_red0()
{

	fetch1();
	red0(0);
}

ex_red()
{
	register struct item *p;

	p = fetch1();
	red0(p->rank-1);
}

ex_redk()
{
	register i;

	i = topfix() - thread.iorg;
	fetch1();
	red0(i);
}

red0(k)
{
	register struct item *p, *q;
	int param[3], red1();

	p = fetch1();
	if(p->type != DA)
		error("red T");
	bidx(p);
	colapse(k);
	if(idx.dimk == 0) {
/*
 *  reduction identities - ets/jrl 5/76
 */
		q = newdat(DA,0,1);
		q->dim[0] = 1;
		switch(*pcp++) {
	case ADD:
	case SUB:
	case OR:
			q->datap[0] = 0;
			break;
	case AND:
	case MUL:
	case DIV:
			q->datap[0] = 1;
			break;
	case MIN:
			q->datap[0] = 1.0e38;
			break;
	case MAX:
			q->datap[0] = -1.0e38;
			break;
	default:
			error("reduce identity");
		}
		pop();
		push(q);
		return;
	}
	q = newdat(idx.type, idx.rank, idx.size);
	copy(IN, idx.dim, q->dim, idx.rank);
	param[0] = p->datap;
	param[1] = q;
	param[2] = exop[*pcp++];
	forloop(red1, param);
	pop();
	push(q);
}

red1(param)
int param[];
{
	register i;
	register data *dp;
	data d, (*f)();

	dp = param[0];
	dp =+ access() + (idx.dimk-1) * idx.delk;
	f = param[2];
	d = *dp;
	for(i=1; i<idx.dimk; i++) {
		dp =- idx.delk;
		d = (*f)(*dp, d);
	}
	putdat(param[1], d);
}
Commit	Line	Data
957bb13d BJ	1	#include "apl.h"
	2
	3	ex_red0()
	4	{
	5
	6	fetch1();
	7	red0(0);
	8	}
	9
	10	ex_red()
	11	{
	12	register struct item *p;
	13
	14	p = fetch1();
	15	red0(p->rank-1);
	16	}
	17
	18	ex_redk()
	19	{
	20	register i;
	21
	22	i = topfix() - thread.iorg;
	23	fetch1();
	24	red0(i);
	25	}
	26
	27	red0(k)
	28	{
	29	register struct item p, q;
	30	int param[3], red1();
	31
	32	p = fetch1();
	33	if(p->type != DA)
	34	error("red T");
	35	bidx(p);
	36	colapse(k);
	37	if(idx.dimk == 0) {
	38	/*
	39	* reduction identities - ets/jrl 5/76
	40	*/
	41	q = newdat(DA,0,1);
	42	q->dim[0] = 1;
	43	switch(*pcp++) {
	44	case ADD:
	45	case SUB:
	46	case OR:
	47	q->datap[0] = 0;
	48	break;
	49	case AND:
	50	case MUL:
	51	case DIV:
	52	q->datap[0] = 1;
	53	break;
	54	case MIN:
	55	q->datap[0] = 1.0e38;
	56	break;
	57	case MAX:
	58	q->datap[0] = -1.0e38;
	59	break;
	60	default:
	61	error("reduce identity");
	62	}
	63	pop();
	64	push(q);
65	return;
66	}
67	q = newdat(idx.type, idx.rank, idx.size);
68	copy(IN, idx.dim, q->dim, idx.rank);
69	param[0] = p->datap;
70	param[1] = q;
71	param[2] = exop[*pcp++];
72	forloop(red1, param);
73	pop();
74	push(q);
75	}
76
77	red1(param)
78	int param[];
79	{
80	register i;
81	register data *dp;
82	data d, (*f)();
83
84	dp = param[0];
85	dp =+ access() + (idx.dimk-1) * idx.delk;
86	f = param[2];
87	d = *dp;
88	for(i=1; i<idx.dimk; i++) {
89	dp =- idx.delk;
90	d = (f)(dp, d);
91	}
92	putdat(param[1], d);
93	}