mirror of
https://github.com/SEPPDROID/Digital-Research-Source-Code.git
synced 2025-10-23 16:34:07 +00:00
515 lines
15 KiB
Plaintext
515 lines
15 KiB
Plaintext
1File: EXPR.C Page 1
|
|
1 /*
|
|
2 Copyright 1981
|
|
3 Alcyon Corporation
|
|
4 8716 Production Ave.
|
|
5 San Diego, Ca. 92121
|
|
6 */
|
|
7
|
|
8 /* Expression evaluator */
|
|
9
|
|
10 # include "as68.h"
|
|
11
|
|
12 /*precedence of operators*/
|
|
13 # define PAO 2 /*AND, OR*/
|
|
14 # define PPM 2 /*+ -*/
|
|
15 # define PMD 3 /** /*/
|
|
16 # define PLP 1 /* (*/
|
|
17 # define PRP 4 /* )*/
|
|
18 # define PEE 0 /* all other special chars*/
|
|
19
|
|
20
|
|
21 /*global integers for this package*/
|
|
22 struct it exitm; /*expression item*/
|
|
23 int prcnt; /*paren count*/
|
|
24 int rval; /*relocation value*/
|
|
25 int lpflg;
|
|
26 int lastopr; /*last token was operator when set*/
|
|
27
|
|
28 long gval(); /*get operand value*/
|
|
29
|
|
30 /*
|
|
31 * expression evaluator
|
|
32 * call with:
|
|
33 * address of function to get input
|
|
34 * returns:
|
|
35 * item type in itype
|
|
36 * item value in ival
|
|
37 * relocation flag in reloc:
|
|
38 * 0 => absolute
|
|
39 * 1 => data
|
|
40 * 2 => text
|
|
41 * 3 => bss
|
|
42 * 4 => external
|
|
43 *
|
|
44 * The only expressions involving externals which are legal are
|
|
45 * external+constant or external-constant
|
|
46 */
|
|
47
|
|
48 struct it *piop, *pitr;
|
|
49 int iop, itr;
|
|
50
|
|
51 struct it opstk[OPSTLEN]; /*operator stack*/
|
|
52 struct it tree[TREELEN]; /*operand stack*/
|
|
53
|
|
54 expr(iploc)
|
|
55 int (*iploc)();
|
|
56 {
|
|
57 register int i, ipr;
|
|
58
|
|
59 extflg = starmul = iop = lpflg = 0;
|
|
1File: EXPR.C Page 2
|
|
60 piop = &opstk[0];
|
|
61 itr = -1; /*tree stack pointer*/
|
|
62 pitr = &tree[0];
|
|
63 pitr--;
|
|
64 /* form end of expression operator*/
|
|
65 opstk[0].itty = ITSP; /*special character*/
|
|
66 opstk[0].itop.wd2 = '?';
|
|
67 lastopr = 1;
|
|
68
|
|
69 /* get an input item*/
|
|
70 while(1) {
|
|
71 if(itr >= TREELEN-2) {
|
|
72 rpterr("expr tree overflow\n");
|
|
73 abort();
|
|
74 }
|
|
75 if(iop >= OPSTLEN-1) {
|
|
76 rpterr("expr opstk overflow\n");
|
|
77 abort();
|
|
78 }
|
|
79 (*iploc)(); /*get an input term*/
|
|
80 if (itype==ITPC) return;
|
|
81 starmul=0; /* * is location counter*/
|
|
82
|
|
83 /* special character*/
|
|
84 if(itype==ITSP) {
|
|
85 ipr = gprc(i=ival.wd2); /*get precedence of character*/
|
|
86 if(ipr==PEE) /*end of expression*/
|
|
87 break;
|
|
88 lastopr = 1;
|
|
89 if(ipr==PLP) { /*left paren*/
|
|
90 lpflg++;
|
|
91 prcnt++;
|
|
92 iop++; /*up stack pointer*/
|
|
93 piop++;
|
|
94 piop->swd1=exitm.swd1; /*put operator on stack*/
|
|
95 piop->itop=exitm.itop;
|
|
96 continue;
|
|
97 }
|
|
98 if(ipr==PRP) { /*right paren*/
|
|
99 if(lpflg) { exerr(1); return; }
|
|
100 starmul = 1; /* * is multiply*/
|
|
101 prcnt--; /*down one level*/
|
|
102
|
|
103 while (piop->itop != '(') { /* top stk is '(' */
|
|
104 itr++; /*up tree pointer*/
|
|
105 pitr++;
|
|
106 pitr->swd1 = piop->swd1; /*move operator*/
|
|
107 pitr->itop = piop->itop;
|
|
108 iop--; /*reduce operand stack*/
|
|
109 piop--;
|
|
110 }
|
|
111 iop--; /*remove stack*/
|
|
112 piop--;
|
|
113 continue;
|
|
114 }
|
|
115
|
|
116 while(ipr<=gprc(i=piop->itop.wd2)) { /* >= precedence */
|
|
117 itr++;
|
|
118 pitr++;
|
|
1File: EXPR.C Page 3
|
|
119 pitr->swd1 = piop->swd1; /*move operator*/
|
|
120 pitr->itop = piop->itop;
|
|
121 iop--; /*reduce operand stack*/
|
|
122 piop--;
|
|
123 }
|
|
124 iop++; /*up operator stack*/
|
|
125 piop++;
|
|
126 piop->swd1 = exitm.swd1; /*put in operator stack*/
|
|
127 piop->itop = exitm.itop;
|
|
128 continue;
|
|
129 }
|
|
130
|
|
131 /* symbol or constant*/
|
|
132 else {
|
|
133 lastopr = lpflg = 0; /*clear flag*/
|
|
134 itr++; /*up tree pointer*/
|
|
135 pitr++;
|
|
136 pitr->swd1 = exitm.swd1; /*put in tree*/
|
|
137 pitr->itop = exitm.itop;
|
|
138 starmul = 1; /* * is multiply*/
|
|
139 continue;
|
|
140 }
|
|
141 } /* end while(1)... */
|
|
142
|
|
143 /*output the rest of the operator stack to the tree*/
|
|
144 for(i=iop; i>=0; i--) {
|
|
145 itr++;
|
|
146 pitr++;
|
|
147 pitr->swd1 = piop->swd1; /*move operator*/
|
|
148 pitr->itop = piop->itop;
|
|
149 piop--;
|
|
150 }
|
|
151
|
|
152 collapse();
|
|
153 }
|
|
154
|
|
155 /* collapse the tree into one entry*/
|
|
156 collapse()
|
|
157 {
|
|
158 register int rv1, rv2, topr, i, bos;
|
|
159 register long tv1, tv2;
|
|
160
|
|
161 bos = 0;
|
|
162 exct1:
|
|
163 if(itr>=3) {
|
|
164 piop = &tree[bos];
|
|
165 iop = bos;
|
|
166 while (iop<=(itr-3+bos) && (piop->itty==ITSP ||
|
|
167 (piop+1)->itty==ITSP || (piop+2)->itty!=ITSP)) {
|
|
168 iop++;
|
|
169 piop++;
|
|
170 }
|
|
171 if (iop<=(itr-3+bos)) {
|
|
172 tv1 = gval(piop); /*get value of first operand*/
|
|
173 rv1 = rval; /*relocation value*/
|
|
174 tv2 = gval(piop+1);
|
|
175 rv2 = rval;
|
|
176 topr = (piop+2)->itop; /*operator*/
|
|
177
|
|
1File: EXPR.C Page 4
|
|
178 /* handle operators */
|
|
179 if (topr == '+') {
|
|
180 tv1=+ tv2;
|
|
181 rv1 = ckrl1(rv1,rv2); /*relocation*/
|
|
182 }
|
|
183 else if (topr == '-') {
|
|
184 tv1 =- tv2;
|
|
185 rv1 = ckrl2(rv1,rv2); /*relocation*/
|
|
186 }
|
|
187 else {
|
|
188 switch(topr) { /*operator*/
|
|
189 case '/': /* division */
|
|
190 tv1 =/ tv2; break;
|
|
191 case '*': /* multiplication */
|
|
192 tv1 =* tv2; break;
|
|
193 case '&': /* logical and */
|
|
194 tv1 =& tv2; break;
|
|
195 case '!': /* logical or */
|
|
196 tv1 =| tv2; break;
|
|
197 case '<': /* left shift */
|
|
198 tv1 =<< tv2.wd2; break;
|
|
199 case '>': /* right shift */
|
|
200 tv1 =>> tv2.wd2; break;
|
|
201 default: /*invalid operator*/
|
|
202 exerr(2); return;
|
|
203 }
|
|
204 rv1 = ckrl3(rv1,rv2); /* relocation */
|
|
205 }
|
|
206
|
|
207 /*put new value in tree*/
|
|
208 if (iop==bos) {
|
|
209 bos =+ 2;
|
|
210 iop = bos;
|
|
211 }
|
|
212 piop = &tree[iop];
|
|
213 piop->itty = ITCN; /*must be constant*/
|
|
214 piop->itop = tv1; /*value*/
|
|
215 piop->itrl = rv1; /*relocation value*/
|
|
216
|
|
217 if (iop != bos) { /* push up the rest of the tree... */
|
|
218 i = iop + 2 - bos;
|
|
219 pitr = piop+2;
|
|
220 for(; i<itr; i++) {
|
|
221 piop++;
|
|
222 pitr++;
|
|
223 piop->swd1 = pitr->swd1;
|
|
224 piop->itop = pitr->itop;
|
|
225 }
|
|
226 }
|
|
227 itr =- 2;
|
|
228 goto exct1;
|
|
229 }
|
|
230 }
|
|
231
|
|
232 /* check for unary minus and unary plus*/
|
|
233 if (tree[bos+1].itty!=ITSP && tree[bos].itop.wd2=='?')
|
|
234 { exerr(3); return; }
|
|
235 if (tree[bos+1].itty!=ITSP || tree[bos].itty==ITSP) {
|
|
236 reloc = ABS;
|
|
1File: EXPR.C Page 5
|
|
237 ival = 0;
|
|
238 itype = ITCN;
|
|
239 return;
|
|
240 }
|
|
241
|
|
242 if(tree[bos+1].itop.wd2!='?') { /*end of statement*/
|
|
243 if(tree[bos+1].itop.wd2!='+') { /*ignore unary plus*/
|
|
244 if(tree[bos+1].itop.wd2!='-') { /* invalid operator */
|
|
245 exerr(4);
|
|
246 return;
|
|
247 }
|
|
248 tree[bos+1].itop = -gval(&tree[bos]);
|
|
249 tree[bos+1].itty = ITCN;
|
|
250 tree[bos+1].itrl = tree[bos].itrl;
|
|
251 bos++;
|
|
252 itr--;
|
|
253 goto exct1;
|
|
254 }
|
|
255 }
|
|
256 /* send results back to caller*/
|
|
257 if ((itype = tree[bos].itty)==ITCN)
|
|
258 ival = gval(&tree[bos]);
|
|
259 else {
|
|
260 ival = tree[bos].itop;
|
|
261 if(itype==ITSY && !(ival.ptrw2->flags&SYDF)) { /*undef symbol*/
|
|
262 reloc = ABS;
|
|
263 ival = 0;
|
|
264 itype = ITCN;
|
|
265 return;
|
|
266 }
|
|
267 }
|
|
268 get_val(tree[bos].itrl);
|
|
269 }
|
|
270
|
|
271 /*
|
|
272 *if defined symbol get value and say constant
|
|
273 * except for externals and equated registers
|
|
274 */
|
|
275 get_val(reloc_val)
|
|
276 int reloc_val;
|
|
277 {
|
|
278 if(itype==ITSY && (ival.ptrw2->flags&(SYXR|SYER))==0) {
|
|
279 if(ival.ptrw2->flags&SYRA) /*get symbol relocation factor*/
|
|
280 reloc = DATA;
|
|
281 else if(ival.ptrw2->flags&SYRO)
|
|
282 reloc = TEXT;
|
|
283 else if(ival.ptrw2->flags&SYBS)
|
|
284 reloc = BSS;
|
|
285 else reloc = ABS;
|
|
286 ival = ival.ptrw2->vl1; /*symbol vaue*/
|
|
287 itype = ITCN; /*constant*/
|
|
288 }
|
|
289 else
|
|
290 if(itype == ITSY && ival.ptrw2->flags&SYXR) { /*external symbol*/
|
|
291 fixext(ival.ptrw2);
|
|
292 reloc = EXTRN;
|
|
293 }
|
|
294 else
|
|
295 reloc = reloc_val; /*relocation value of item*/
|
|
1File: EXPR.C Page 6
|
|
296 }
|
|
297
|
|
298 exerr(n) /* [vlh] */
|
|
299 int n;
|
|
300 {
|
|
301 uerr(6);
|
|
302 ival = 0;
|
|
303 itype = ITCN;
|
|
304 reloc = ABS;
|
|
305 }
|
|
306
|
|
307 /*
|
|
308 * get precedence of a operator
|
|
309 * call with
|
|
310 * operator
|
|
311 * returns
|
|
312 * precedence
|
|
313 */
|
|
314 gprc(dprc)
|
|
315 {
|
|
316
|
|
317 switch(dprc) {
|
|
318
|
|
319 case '+':
|
|
320 case '-':
|
|
321 case '&': /* and*/
|
|
322 case '!': /* or*/
|
|
323 case '^': /*exclusive or*/
|
|
324 return(PPM);
|
|
325
|
|
326 case '/':
|
|
327 case '*':
|
|
328 case '<': /*left shift*/
|
|
329 case '>': /*right shift*/
|
|
330 return(PMD);
|
|
331
|
|
332 case '(':
|
|
333 if(lastopr)
|
|
334 return(PLP);
|
|
335 break;
|
|
336
|
|
337 case ')':
|
|
338 if(!prcnt) /*no left parens*/
|
|
339 break;
|
|
340 return(PRP);
|
|
341
|
|
342 }
|
|
343 return(PEE); /*end of expression*/
|
|
344 }
|
|
345
|
|
346 /*
|
|
347 * get value from an it format item
|
|
348 * call with
|
|
349 * address of it format item
|
|
350 * returns
|
|
351 * the value
|
|
352 * relocation value in rval
|
|
353 * calls uerr if it cant get a value
|
|
354 */
|
|
1File: EXPR.C Page 7
|
|
355 long gval(avwrd)
|
|
356 struct it *avwrd;
|
|
357 {
|
|
358 register struct it *vwrd;
|
|
359 register struct symtab *p;
|
|
360
|
|
361 vwrd = avwrd;
|
|
362 if(vwrd->itty == ITCN) { /*constant*/
|
|
363 rval = vwrd->itrl;
|
|
364 return(vwrd->itop); /*value*/
|
|
365 }
|
|
366 if(vwrd->itty != ITSY) {
|
|
367 uerr(6);
|
|
368 rval = ABS;
|
|
369 return(0);
|
|
370 }
|
|
371 p = vwrd->itop.ptrw2;
|
|
372 if(p->flags&SYXR) { /*external reference*/
|
|
373 fixext(p);
|
|
374 return(0);
|
|
375 }
|
|
376 if((p->flags&SYDF) != SYDF || (p->flags&SYER)) {
|
|
377 uerr(6);
|
|
378 rval = ABS;
|
|
379 return(0);
|
|
380 }
|
|
381 rval = (p->flags&SYRA) ? DATA : (p->flags&SYRO) /* reloc of item */
|
|
382 ? TEXT : (p->flags&SYBS) ? BSS : ABS;
|
|
383 return(p->vl1);
|
|
384 }
|
|
385
|
|
386 /*
|
|
387 * get items for expression evaluator (pass one)
|
|
388 * returns:
|
|
389 * item type in itype
|
|
390 * item value in ival
|
|
391 * item in it format in exitm
|
|
392 */
|
|
393 p1gi()
|
|
394 {
|
|
395 if(fcflg) /*used item so must pass it*/
|
|
396 gterm(TRUE);
|
|
397 if(!fcflg && ckspc(fchr)==1) {
|
|
398 fcflg=1; /*just pass first character*/
|
|
399 itype=ITSP; /*special char*/
|
|
400 ival=fchr; /*value is the char*/
|
|
401 }
|
|
402 else { /*get a whole term*/
|
|
403 fcflg = 0;
|
|
404 gterm(TRUE); /*get a term*/
|
|
405 if(itype==ITSY) { /* got a symbol*/
|
|
406 ival.ptrw2=lemt(sirt,FALSE); /*look it up in main table*/
|
|
407 if(ival.ptrw2==lmte) /*not there before*/
|
|
408 mmte(); /*put it in table*/
|
|
409 }
|
|
410 else
|
|
411 if(itype == ITCN)
|
|
412 exitm.itrl = reloc;
|
|
413 }
|
|
1File: EXPR.C Page 8
|
|
414 exitm.itty = itype;
|
|
415 exitm.itop = ival;
|
|
416 }
|
|
417
|
|
418 /*
|
|
419 * get items for expression evaluator (pass 2)
|
|
420 * returns:
|
|
421 * item type in itype
|
|
422 * item value in ival
|
|
423 * item in it format in exitm
|
|
424 */
|
|
425 p2gi()
|
|
426 {
|
|
427 if(pitw==pnite) { /*end of statement*/
|
|
428 itype = ITSP;
|
|
429 ival = ' '; /*blank*/
|
|
430 exitm.itty = itype;
|
|
431 exitm.itop = ival;
|
|
432 return;
|
|
433 }
|
|
434
|
|
435 if((itype = pitw->itty) == ITPC) { /*vlh*/
|
|
436 pitw->itop = loctr;
|
|
437 if (p2flg || format==6) itype = pitw->itty = ITCN;
|
|
438 }
|
|
439 ival = pitw->itop; /*value*/
|
|
440 exitm.swd1 = pitw->swd1;
|
|
441 exitm.itop = ival;
|
|
442 pitw++;
|
|
443 }
|
|
444
|
|
445 /*
|
|
446 *check for a special character
|
|
447 * call with
|
|
448 * character to check
|
|
449 * returns:
|
|
450 * 0 => character is number or letter
|
|
451 */
|
|
452 ckspc(acksc)
|
|
453 {
|
|
454 register cksc;
|
|
455
|
|
456 cksc = acksc;
|
|
457 if (isalnum(cksc)) return(0);
|
|
458 return((index("_~*.@$%\'",cksc) != -1) ? 0 : 1); /*[vlh] compacted*/
|
|
459 }
|
|
460
|
|
461 /* generate new relocation for op + op*/
|
|
462 ckrl1(rv1,rv2)
|
|
463 {
|
|
464 if(rv1==rv2)
|
|
465 return(rv1);
|
|
466 if(rv1==ABS || rv2==ABS)
|
|
467 return(rv1+rv2); /*the one that is not ABS*/
|
|
468 uerr(27);
|
|
469 return(ABS);
|
|
470 }
|
|
471
|
|
472 /*generate new relocation for op - op*/
|
|
1File: EXPR.C Page 9
|
|
473 ckrl2(rv1,rv2)
|
|
474 {
|
|
475 if(rv2==EXTRN)
|
|
476 uerr(26);
|
|
477 if(rv1==rv2)
|
|
478 return(ABS);
|
|
479 if(rv2==ABS)
|
|
480 return(rv1+rv2);
|
|
481 uerr(27);
|
|
482 return(ABS);
|
|
483 }
|
|
484
|
|
485 /*generate new relocation for op /*&|<>^! op*/
|
|
486 ckrl3(rv1,rv2)
|
|
487 {
|
|
488 if(rv1!=ABS || rv2!=ABS)
|
|
489 uerr(27);
|
|
490 return(ABS);
|
|
491 }
|
|
492
|
|
493 fixext(p)
|
|
494 struct symtab *p;
|
|
495 {
|
|
496 if(extflg)
|
|
497 uerr(36); /*two externals in expr*/
|
|
498 extflg++;
|
|
499 extref = p->vl1.wd2; /*get external #*/
|
|
500 rval = EXTRN;
|
|
501 itype = ITCN;
|
|
502 ival = 0;
|
|
503 }
|
|
504
|
|
505
|