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

#include "apl.h"

ex_immed()
{
	register i;
	register struct item *p;
	register struct nlist *n;
	double f;

	i = *pcp++;
	switch(i) {

	default:
		error("immed B");
	
	case APL:
		setterm(0);
		return;

	case ASCII:
		setterm(1);
		return;

	case DEBUG:
		debug = ~debug;
		return;

	case DIGITS:
		i = topfix();
		if(i < 1 || i > 20)
			error("digits D");
		aprintf("was %d\n",thread.digits);
		thread.digits = i;
		return;

	case ED_IT:
		funedit(EDIT_ED);
		return;

	case EX_IT:
		funedit(EDIT_EX);
		return;

	case EX_VI:
		funedit(EDIT_VI);
		return;
	
	case FUZZ:
		i = topfix();
		if(i <= 0) {
			thread.fuzz = 0.;
			return;
		}
		f = i;
		thread.fuzz = exp(-f*2.3025851);
		return;

	case ORIGIN:
		aprintf("was %d\n",thread.iorg);
		thread.iorg = topfix();
		return;

	case WIDTH:
		i = topfix();
		if(i < 1)
			error("width D");
		aprintf("was %d\n",thread.width);
		thread.width = i;
		return;

	case READ:
		funload(0);
		return;

	case ERASE:
		p = sp[-1];
		sp--;
		erase(p);
		return;

	case CONTIN:
		if((i=creat("continue",0644)) < 0)
			error("cannot create");
		wssave(i);
		aprintf(" continue");

	case OFF:
		term();

	case VARS:
		for(n=nlist; n->namep; n++)
			if(n->itemp && n->use == DA) {
				if(column+8 >= thread.width)
					aprintf("\n\t");
				aprintf(n->namep);
				aputchar('\t');
			}
		aputchar('\n');
		return;

/*#ifdef SOMED*/
	case SYMBOLS:
	    {
	      int typkey, ii;
		for(n=nlist; n->namep; n++) {
			aputchar('\n'); aprintf(n->namep); aprintf(">\n  use>\t");
			prtype(n->use);
			aprintf("  type>\t");
			prtype(n->type);
			aprintf("  labl>\t%d\n", n->label);
			aprintf("  rank>\t%d\n", n->itemp->rank);
			aprintf("  type>\t"); prtype(n->itemp->type);
			aprintf("  size>\t%d\n", n->itemp->size);
			aprintf("  indx>\t%d\n", n->itemp->index);
			if(n->itemp->datap)
				aprintf("  ival>\t%d\n", (int)*n->itemp->datap);
			aprintf("  dims>\n");
			for(ii=0; ii<n->itemp->rank; ++ii)
				aprintf("   ;%d'>\t%d\n",ii,n->itemp->dim[ii]);
		}
	    }
/*#endif*/

	case FNS:
		for(n=nlist; n->namep; n++)
			if(n->use == DF || n->use == MF || n->use == NF) {
				if(column+8 >= thread.width)
					aprintf("\n\t");
				aprintf(n->namep);
				aputchar('\t');
			}
		aputchar('\n');
		return;

	case CLEAR:
		clear();
		aprintf("clear ws\n");
		break;

	case LIB:
		listdir();
		return;

	case LOAD:
		funload(2);
		break;

	case COPY:
		funload(1);
		return;

	case DROPC:
		i = 1;
		goto drcom;

	case SAVE:
		i = 0;
drcom:
		n = sp[-1];
		sp--;
		if(n->type != LV)
			error("save B");
		if(i) {
			unlink(n->namep);
			return;
		}
		i = creat(n->namep,0644);
		if(i < 0)
			error("cannot create");
		wssave(i);
		aputchar('\n');
		return;
	}
	/* special return for after clear */
	sp = stack;
	reset();
}

/*#ifdef SOMED*/

prtype(type)
{
int	typkey;

#define TYPCASE(type,print) case type: typkey = print; break;

	switch(type) {
	    default:
		aprintf("%d\n", type);
		return;
	    TYPCASE(DA,'da')
	    TYPCASE(CH,'dh')
	    TYPCASE(LV,'lv')
	    TYPCASE(QD,'qd')
	    TYPCASE(QQ,'qq')
	    TYPCASE(IN,'in')
	    TYPCASE(EL,'el')
	    TYPCASE(NF,'nf')
	    TYPCASE(MF,'mf')
	    TYPCASE(DF,'df')
	    TYPCASE(QC,'qc')
	}
	aputchar(typkey.c[0]); aputchar(typkey.c[1]); aputchar('\n');
	return;
}

/*#endif*/
Commit	Line	Data
b5a92627 KT	1	#include "apl.h"
	2
	3	ex_immed()
	4	{
	5	register i;
	6	register struct item *p;
	7	register struct nlist *n;
	8	double f;
	9
	10	i = *pcp++;
	11	switch(i) {
	12
	13	default:
	14	error("immed B");
	15
	16	case APL:
	17	setterm(0);
	18	return;
	19
	20	case ASCII:
	21	setterm(1);
	22	return;
	23
	24	case DEBUG:
	25	debug = ~debug;
	26	return;
	27
	28	case DIGITS:
	29	i = topfix();
	30	if(i < 1 \|\| i > 20)
	31	error("digits D");
	32	aprintf("was %d\n",thread.digits);
	33	thread.digits = i;
	34	return;
	35
	36	case ED_IT:
	37	funedit(EDIT_ED);
	38	return;
	39
	40	case EX_IT:
	41	funedit(EDIT_EX);
	42	return;
	43
	44	case EX_VI:
	45	funedit(EDIT_VI);
	46	return;
	47
	48	case FUZZ:
	49	i = topfix();
	50	if(i <= 0) {
	51	thread.fuzz = 0.;
	52	return;
	53	}
	54	f = i;
	55	thread.fuzz = exp(-f*2.3025851);
	56	return;
	57
	58	case ORIGIN:
	59	aprintf("was %d\n",thread.iorg);
	60	thread.iorg = topfix();
	61	return;
	62
	63	case WIDTH:
	64	i = topfix();
65	if(i < 1)
66	error("width D");
67	aprintf("was %d\n",thread.width);
68	thread.width = i;
69	return;
70
71	case READ:
72	funload(0);
73	return;
74
75	case ERASE:
76	p = sp[-1];
77	sp--;
78	erase(p);
79	return;
80
81	case CONTIN:
82	if((i=creat("continue",0644)) < 0)
83	error("cannot create");
84	wssave(i);
85	aprintf(" continue");
86
87	case OFF:
88	term();
89
90	case VARS:
91	for(n=nlist; n->namep; n++)
92	if(n->itemp && n->use == DA) {
93	if(column+8 >= thread.width)
94	aprintf("\n\t");
95	aprintf(n->namep);
96	aputchar('\t');
97	}
98	aputchar('\n');
99	return;
100
101	/#ifdef SOMED/
102	case SYMBOLS:
103	{
104	int typkey, ii;
105	for(n=nlist; n->namep; n++) {
106	aputchar('\n'); aprintf(n->namep); aprintf(">\n use>\t");
107	prtype(n->use);
108	aprintf(" type>\t");
109	prtype(n->type);
110	aprintf(" labl>\t%d\n", n->label);
111	aprintf(" rank>\t%d\n", n->itemp->rank);
112	aprintf(" type>\t"); prtype(n->itemp->type);
113	aprintf(" size>\t%d\n", n->itemp->size);
114	aprintf(" indx>\t%d\n", n->itemp->index);
115	if(n->itemp->datap)
116	aprintf(" ival>\t%d\n", (int)*n->itemp->datap);
117	aprintf(" dims>\n");
118	for(ii=0; ii<n->itemp->rank; ++ii)
119	aprintf(" ;%d'>\t%d\n",ii,n->itemp->dim[ii]);
120	}
121	}
122	/#endif/
123
124	case FNS:
125	for(n=nlist; n->namep; n++)
126	if(n->use == DF \|\| n->use == MF \|\| n->use == NF) {
127	if(column+8 >= thread.width)
128	aprintf("\n\t");
129	aprintf(n->namep);
130	aputchar('\t');
131	}
132	aputchar('\n');
133	return;
134
135	case CLEAR:
136	clear();
137	aprintf("clear ws\n");
138	break;
139
140	case LIB:
141	listdir();
142	return;
143
144	case LOAD:
145	funload(2);
146	break;
147
148	case COPY:
149	funload(1);
150	return;
151
152	case DROPC:
153	i = 1;
154	goto drcom;
155
156	case SAVE:
157	i = 0;
158	drcom:
159	n = sp[-1];
160	sp--;
161	if(n->type != LV)
162	error("save B");
163	if(i) {
164	unlink(n->namep);
165	return;
166	}
167	i = creat(n->namep,0644);
168	if(i < 0)
169	error("cannot create");
170	wssave(i);
171	aputchar('\n');
172	return;
173	}
174	/* special return for after clear */
175	sp = stack;
176	reset();
177	}
178
179	/#ifdef SOMED/
180
181	prtype(type)
182	{
183	int typkey;
184
185	#define TYPCASE(type,print) case type: typkey = print; break;
186
187	switch(type) {
188	default:
189	aprintf("%d\n", type);
190	return;
191	TYPCASE(DA,'da')
192	TYPCASE(CH,'dh')
193	TYPCASE(LV,'lv')
194	TYPCASE(QD,'qd')
195	TYPCASE(QQ,'qq')
196	TYPCASE(IN,'in')
197	TYPCASE(EL,'el')
198	TYPCASE(NF,'nf')
199	TYPCASE(MF,'mf')
200	TYPCASE(DF,'df')
201	TYPCASE(QC,'qc')
202	}
203	aputchar(typkey.c[0]); aputchar(typkey.c[1]); aputchar('\n');
204	return;
205	}
206
207	/#endif/