mirror of
https://github.com/SEPPDROID/Digital-Research-Source-Code.git
synced 2025-10-24 17:04:19 +00:00
Upload
Digital Research
This commit is contained in:
514
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102/as68/expr.lis
Normal file
514
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102/as68/expr.lis
Normal file
@@ -0,0 +1,514 @@
|
||||
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
|
||||
Reference in New Issue
Block a user