Mercurial > hg > Members > kono > os9 > sbc09
annotate mc09/mc2.c @ 178:4d83154d2a78
add - {} some builtin in TL/1
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Mon, 15 Apr 2019 09:43:28 +0900 |
parents | 1a30cd6e5973 |
children |
rev | line source |
---|---|
99 | 1 |
2 #define DEBUG error(-1) | |
3 | |
102 | 4 #include "mclibos9.c" |
99 | 5 |
6 #define INT (-1) | |
7 #define CHAR (-2) | |
8 #define UNSIGNED (-3) | |
9 #define POINTER (-4) | |
10 #define ARRAY (-5) | |
11 #define STRUCT (-6) | |
12 #define UNION (-7) | |
13 #define FUNCTION (-8) | |
14 #define EMPTY (-9) | |
15 | |
16 #define STATIC (-10) | |
17 #define GOTO (-11) | |
18 #define RETURN (-12) | |
19 #define BREAK (-13) | |
20 #define CONTINUE (-14) | |
21 #define IF (-15) | |
22 #define ELSE (-16) | |
23 #define FOR (-17) | |
24 #define DO (-18) | |
25 #define WHILE (-19) | |
26 #define SWITCH (-20) | |
27 #define CASE (-21) | |
28 #define DEFAULT (-22) | |
29 #define RESERVE (-23) | |
30 #define TAG (-24) | |
31 #define FIELD (-25) | |
32 #define IDENT (-26) | |
33 #define STRING (-27) | |
34 #define MACRO (-28) | |
35 #define BLABEL (-29) | |
36 #define FLABEL (-30) | |
37 #define TYPEDEF (-31) | |
38 #define SIZEOF (-32) | |
39 #define TYPE (-33) | |
40 #define LONG (-34) | |
41 #define SHORT (-35) | |
42 | |
43 #define TOP 0 | |
44 #define GDECL 1 | |
45 #define GSDECL 2 | |
46 #define GUDECL 3 | |
47 #define ADECL 4 | |
48 #define LDECL 5 | |
49 #define LSDECL 6 | |
50 #define LUDECL 7 | |
51 #define STADECL 8 | |
52 #define STAT 9 | |
53 #define GTDECL 10 | |
54 #define LTDECL 11 | |
55 | |
56 #define GVAR 1 | |
57 #define RGVAR 2 | |
58 #define CRGVAR 3 | |
59 #define LVAR 4 | |
60 #define RLVAR 5 | |
61 #define CRLVAR 6 | |
62 #define CONST 7 | |
63 #define FNAME 8 | |
64 #define INDIRECT 9 | |
65 #define RINDIRECT 10 | |
66 #define CRINDIRECT 11 | |
67 #define ADDRESS 12 | |
68 #define MINUS 13 | |
69 #define LNOT 14 | |
70 #define BNOT 15 | |
71 #define INC 16 | |
72 #define POSTINC 17 | |
73 #define PREINC 18 | |
74 #define CPOSTINC 19 | |
75 #define CPREINC 20 | |
76 #define DEC 21 | |
77 #define CPOSTDEC 22 | |
78 #define CPREDEC 23 | |
79 #define MUL 24 | |
80 #define UMUL 25 | |
81 #define DIV 26 | |
82 #define UDIV 27 | |
83 #define MOD 28 | |
84 #define UMOD 29 | |
85 #define ADD 30 | |
86 #define SUB 31 | |
87 #define RSHIFT 32 | |
88 #define URSHIFT 33 | |
89 #define LSHIFT 34 | |
90 #define ULSHIFT 35 | |
91 #define GT 36 | |
92 #define UGT 37 | |
93 #define GE 38 | |
94 #define UGE 39 | |
95 #define LT 40 | |
96 #define ULT 41 | |
97 #define LE 42 | |
98 #define ULE 43 | |
99 #define EQ 44 | |
100 #define NEQ 45 | |
101 #define BAND 46 | |
102 #define EOR 47 | |
103 #define BOR 48 | |
104 #define LAND 49 | |
105 #define LOR 50 | |
106 #define COND 51 | |
107 #define ASS 52 | |
108 #define CASS 53 | |
109 #define ASSOP 54 | |
110 #define CASSOP 55 | |
111 #define COMMA 56 | |
112 #define LPAR 57 | |
113 #define RPAR 58 | |
114 #define LBRA 59 | |
115 #define RBRA 60 | |
116 #define LC 61 | |
117 #define RC 62 | |
118 #define COLON 63 | |
119 #define SM 64 | |
120 #define PERIOD 65 | |
121 #define ARROW 66 | |
122 | |
123 #define US 1 | |
124 #define AS 100 | |
125 | |
126 #define FILERR 1 | |
127 #define DCERR 2 | |
128 #define STERR 3 | |
129 #define EXERR 4 | |
130 #define CNERR 5 | |
131 #define CHERR 6 | |
132 #define GSERR 7 | |
133 #define LSERR 8 | |
134 #define STRERR 9 | |
135 #define LNERR 10 | |
136 #define EOFERR 11 | |
137 #define MCERR 12 | |
138 #define INCERR 13 | |
139 #define HPERR 14 | |
140 #define TYERR 15 | |
141 #define LVERR 16 | |
142 #define UDERR 17 | |
143 #define OPTION 18 | |
144 | |
145 #define GSYMS 450 | |
146 #define LSYMS 50 | |
147 | |
111
c4e909f21b25
micro c,j self compiled on os9 level2
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
106
diff
changeset
|
148 #define HEAPSIZE 1000 |
99 | 149 #define CHEAPSIZE 3000 |
150 #define LBUFSIZE 256 | |
151 | |
152 #define FILES 3 | |
153 | |
154 int sym,ch,chsave,type,mode,gfree,lfree,mflag,lineno,glineno; | |
155 int labelno,gpc,lvar,disp; | |
156 int symval,args,heap[HEAPSIZE]; | |
157 int blabel,clabel,dlabel,cslabel,ilabel,control,ac,ac2,lsrc,chk,asmf; | |
158 | |
159 unsigned hash; | |
160 | |
161 char linebuf[LBUFSIZE],cheap[CHEAPSIZE],*chptr,*chptrsave; | |
162 char name[9],*cheapp,**av,/*obuf[320],*/*sptr,escape(); | |
163 | |
164 FILE *obuf; | |
165 | |
166 typedef struct nametable { | |
167 char nm[9]; | |
168 int sc,ty,dsp; } NMTBL; | |
169 | |
170 NMTBL ntable[GSYMS+LSYMS],*nptr,*gnptr,*decl0(),*decl1(),*lsearch(),*gsearch(); | |
171 | |
172 struct {int fd,ln;/*char fcb[320]*/FILE *fcb;} *filep,filestack[FILES]; | |
173 | |
174 main(argc,argv) | |
175 int argc; | |
176 char **argv; | |
177 {NMTBL *nptr; | |
178 int i; | |
102 | 179 char *ccout,*modname; |
99 | 180 if(argc==1) exit(1); |
181 lsrc = chk = asmf = 0; | |
182 ccout = "C.OUT"; | |
102 | 183 modname = "aout"; |
99 | 184 ac=argc; |
185 av=argv; | |
186 for (ac2=1; (ac2 < ac) && (*av[ac2] == '-'); ++ac2) | |
187 switch (*(av[ac2]+1)) | |
188 {case 'S': case 's': | |
189 lsrc = 1; | |
190 break; | |
191 case 'O': case 'o': | |
192 ccout = av[ac2]+2; | |
193 break; | |
102 | 194 case 'M': case 'm': |
195 modname = av[ac2]+2; | |
196 break; | |
99 | 197 case 'C': case 'c': |
198 chk = 1; | |
199 break; | |
200 default: | |
201 error(OPTION); | |
202 exit(1); | |
203 } | |
204 fclose(stdout); | |
102 | 205 if (!chk) { |
206 if ( (obuf = fopen(ccout,"w")) == NULL ) error(FILERR); | |
207 else { | |
111
c4e909f21b25
micro c,j self compiled on os9 level2
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
106
diff
changeset
|
208 printf("\tmod _eom,_name,_tylg,_atrv,_start,1024\n"); /* os9 module header */ |
104 | 209 printf("_name fcs /%s/\n\tfcb 0\n",modname); |
102 | 210 } |
211 } | |
99 | 212 init(); |
213 while(1) | |
214 { for (nptr = &ntable[GSYMS],i=LSYMS; i--;) | |
215 (nptr++)->sc = EMPTY; | |
216 mode=TOP; | |
217 while(getsym()==SM); | |
218 mode=GDECL; | |
219 args=0; | |
220 decl(); | |
221 } | |
222 } | |
223 error(n) | |
224 int n; | |
225 { if(n == EOFERR) | |
226 if(filep!=filestack) | |
227 { lineno=filep->ln; | |
228 fclose(filep->fcb); | |
229 fprintf(stderr,"End of inclusion.\n"); | |
230 --filep; | |
231 return; | |
232 } | |
233 else if(ac2!=ac) | |
234 { fclose(filep->fcb); | |
235 newfile(); | |
236 return; | |
237 } | |
238 else if(mode == TOP) | |
239 { fprintf(stderr,"\nCompiled %u lines.\n",glineno-1); | |
240 if (!chk) fprintf(stderr, | |
241 "Total internal labels : %u.\n",labelno-1); | |
242 fprintf(stderr, | |
243 "Total global variables : %u bytes.\n\n",gpc); | |
244 printf("_%d\tRTS\n_INITIALIZE\tEQU\t_1\n",ilabel); | |
100 | 245 printf("_GLOBALS\tEQU\t%u\n",gpc); |
99 | 246 exit(0); |
247 } | |
248 fprintf(stderr,"%5d:%s.\n",lineno, | |
249 (n==FILERR) ? "Can't open specified file" : | |
250 (n==DCERR) ? "Declaration syntax" : | |
251 (n==STERR) ? "Statement syntax" : | |
252 (n==EXERR) ? "Expression syntax" : | |
253 (n==CNERR) ? "Constant required" : | |
254 (n==CHERR) ? "Illegal character" : | |
255 (n==GSERR) ? "Too many global symbols" : | |
256 (n==LSERR) ? "Too many local symbols" : | |
257 (n==STRERR) ? "Too many strings or macros" : | |
258 (n==LNERR) ? "Line too long" : | |
259 (n==EOFERR) ? "Unexpected end of file" : | |
260 (n==MCERR) ? "Macro syntax" : | |
261 (n==INCERR) ? "Include syntax" : | |
262 (n==HPERR) ? "Too long expression" : | |
263 (n==TYERR) ? "Type mismatch" : | |
264 (n==LVERR) ? "Lvalue required" : | |
265 (n==UDERR) ? "Undeclared identifier" : | |
266 (n==OPTION) ? "Illegal option" : | |
267 "Bug of compiler"); | |
268 errmsg(); | |
269 exit(1); | |
270 } | |
271 errmsg() | |
272 {char *p,*lim; | |
273 if(lineno==0) return; | |
274 fprintf(stderr,"%s",linebuf); | |
275 lim=(mflag?chptrsave:chptr); | |
276 for (p=linebuf; p < lim;) | |
277 fprintf(stderr,(*p++ == '\t') ? "\t" : " "); | |
278 fprintf (stderr,"^\n"); | |
279 } | |
280 checksym(s) | |
281 int s; | |
282 {char *p; | |
283 if (sym != s) | |
284 { p=(s==RPAR) ? "')'": (s==RBRA) ? "']'": (s==SM) ? "';'": | |
285 (s==LPAR) ? "'('": (s==WHILE) ? "'while'": | |
286 (s==COLON) ? "':'": "Identifier"; | |
287 fprintf(stderr,"%d:%s expected.\n",lineno,p); | |
288 errmsg(); | |
289 } | |
290 else getsym(); | |
291 } | |
292 init() | |
293 {NMTBL *nptr; | |
294 int i; | |
295 for(nptr = ntable,i = GSYMS; i--;) (nptr++)->sc = EMPTY; | |
296 reserve("int",INT); | |
297 reserve("void",INT); | |
298 reserve("char",CHAR); | |
299 reserve("struct",STRUCT); | |
300 reserve("union",UNION); | |
301 reserve("unsigned",UNSIGNED); | |
302 reserve("static",STATIC); | |
303 reserve("goto",GOTO); | |
304 reserve("return",RETURN); | |
305 reserve("break",BREAK); | |
306 reserve("continue",CONTINUE); | |
307 reserve("if",IF); | |
308 reserve("else",ELSE); | |
309 reserve("for",FOR); | |
310 reserve("do",DO); | |
311 reserve("while",WHILE); | |
312 reserve("switch",SWITCH); | |
313 reserve("case",CASE); | |
314 reserve("default",DEFAULT); | |
315 reserve("typedef",TYPEDEF); | |
316 reserve("sizeof",SIZEOF); | |
317 reserve("long",LONG); | |
318 reserve("short",SHORT); | |
319 gpc=glineno=mflag=0; | |
320 gfree=ilabel=1; | |
321 labelno=2; | |
322 cheapp=cheap; | |
323 lfree=HEAPSIZE; | |
324 filep=filestack; | |
325 newfile(); | |
326 getline(); | |
327 getch(); | |
328 } | |
329 newfile() | |
330 { lineno=0; | |
331 fprintf(stderr,"%s:\n",av[ac2]); | |
332 if ( (filep->fcb = fopen(av[ac2++],"rc")) == NULL ) error(FILERR); | |
333 } | |
334 reserve(s,d) | |
335 char *s; | |
336 int d; | |
337 {NMTBL *nptr; | |
338 char *t; | |
339 hash=0; | |
340 t=name; | |
341 while(*t++ = *s) hash=7*(hash+*s++); | |
342 (nptr = gsearch())->sc = RESERVE; | |
343 nptr->dsp = d; | |
344 } | |
345 | |
346 decl() | |
347 {NMTBL *n; | |
348 int t; | |
349 if(sym==STATIC) | |
350 if(mode==LDECL) | |
351 { getsym(); | |
352 mode=STADECL; | |
353 } | |
354 else error(DCERR); | |
355 else if(sym==TYPEDEF) | |
356 if(mode==GDECL) | |
357 { getsym(); | |
358 mode=GTDECL; | |
359 } | |
360 else if(mode==LDECL) | |
361 { getsym(); | |
362 mode=LTDECL; | |
363 } | |
364 else error(DCERR); | |
365 if((t=typespec())==0) return; | |
366 if(sym==SM) return; | |
367 type=t; | |
368 n=decl0(); | |
369 reverse(t); | |
370 if(args||sym==LC) {fdecl(n);return;} | |
371 def(n); | |
372 while(sym==COMMA) | |
373 { getsym(); | |
374 type=t; | |
375 n=decl0(); | |
376 reverse(t); | |
377 if(args) error(DCERR); | |
378 def(n); | |
379 } | |
380 if(sym!=SM) error(DCERR); | |
381 if(mode==GTDECL) mode=GDECL; | |
382 if(mode==STADECL||mode==LTDECL) mode=LDECL; | |
383 } | |
384 typespec() | |
385 {int t; | |
386 switch(sym) | |
387 {case INT: | |
388 case CHAR: | |
389 t= sym; | |
390 getsym(); | |
391 break; | |
392 case STRUCT: | |
393 case UNION: | |
394 t=sdecl(sym); | |
395 break; | |
396 case UNSIGNED: | |
397 t = UNSIGNED; | |
398 if(getsym()==INT) getsym(); | |
399 break; | |
400 case SHORT: | |
401 t=CHAR; | |
402 if(getsym()==INT) getsym(); | |
403 break; | |
404 case LONG: | |
405 t=INT; | |
406 if(getsym()==INT) getsym(); | |
407 break; | |
408 default: | |
409 if(sym==IDENT) | |
410 if(nptr->sc==TYPE) | |
411 { t=nptr->ty; | |
412 getsym(); | |
413 break; | |
414 } | |
415 else if(nptr->sc==EMPTY && gnptr->sc==TYPE) | |
416 { t=gnptr->ty; | |
417 getsym(); | |
418 break; | |
419 } | |
420 if(mode==LDECL) return 0; | |
421 t= INT; | |
422 } | |
423 return t; | |
424 } | |
425 struct nametable *decl0() | |
426 {NMTBL *n; | |
427 if(sym==MUL) | |
428 { getsym(); | |
429 n=decl0(); | |
430 type=list2(POINTER,type); | |
431 return n; | |
432 } | |
433 return decl1(); | |
434 } | |
435 NMTBL *decl1() | |
436 {NMTBL *n; | |
437 int i,t; | |
438 if(sym==LPAR) | |
439 { getsym(); | |
440 n=decl0(); | |
441 checksym(RPAR); | |
442 } | |
443 else if (sym == IDENT) | |
444 { n=nptr; | |
445 getsym(); | |
446 } | |
447 else error(DCERR); | |
448 while(1) | |
449 if(sym==LBRA) | |
450 if(getsym()==RBRA) | |
451 { getsym(); | |
452 if(mode!=ADECL) error(DCERR); | |
453 t=type; | |
454 type=list2(POINTER,type); | |
455 } | |
456 else | |
457 { t=type; | |
458 i=cexpr(expr()); | |
459 checksym(RBRA); | |
460 type=list3(ARRAY,t,i); | |
461 } | |
462 else if(sym==LPAR) | |
463 { if(mode==GDECL) {mode=ADECL;getsym();mode=GDECL;} | |
464 else getsym(); | |
465 if(sym==RPAR) getsym(); | |
466 else | |
467 { n->sc=FUNCTION; | |
468 adecl(); | |
469 n->sc=EMPTY; | |
470 } | |
471 type=list2(FUNCTION,type); | |
472 } | |
473 else return n; | |
474 } | |
475 adecl() | |
476 { if(mode!=GDECL) error(DCERR); | |
477 mode=ADECL; | |
478 args= 2; | |
479 while(1) | |
480 { if(sym!=IDENT) error(DCERR); | |
481 nptr->ty = INT; | |
482 nptr->sc = LVAR; | |
483 nptr->dsp = (args += 2); | |
484 if(getsym()!=COMMA) break; | |
485 getsym(); | |
486 } | |
487 checksym(RPAR); | |
488 mode=GDECL; | |
489 return; | |
490 } | |
491 reverse(t1) | |
492 int t1; | |
493 {int t2,t3; | |
494 t2=t1; | |
495 while(type!=t1) | |
496 { t3=cadr(type); | |
497 rplacad(type,t2); | |
498 t2=type; | |
499 type=t3; | |
500 } | |
501 type=t2; | |
502 } | |
503 size(t) | |
504 int t; | |
505 { if(t==CHAR) return 1; | |
506 if(scalar(t)) return 2; | |
507 if(car(t)==STRUCT||car(t)==UNION) | |
508 { if(cadr(t)==-1) error(DCERR); | |
509 return(cadr(t)); | |
510 } | |
511 if(car(t)==ARRAY) return(size(cadr(t))*caddr(t)); | |
512 else error(DCERR); | |
513 /*NOTREACHED*/ | |
514 } | |
515 def(n) | |
516 NMTBL *n; | |
517 {int sz,nsc,ndsp,slfree,l,t,e; | |
518 if(car(type)==FUNCTION) | |
519 { fcheck(n); | |
520 return; | |
521 } | |
522 if (n->sc!=EMPTY && | |
523 (mode!=ADECL || n->sc!=LVAR || n->ty!=INT) && | |
524 (mode!=GSDECL&&mode!=LSDECL || n->sc!=FIELD || n->dsp!=disp) && | |
525 (mode!=GUDECL&&mode!=LUDECL || n->sc!=FIELD || n->dsp!=0) ) | |
526 error(DCERR); | |
527 sz = size(n->ty = type); | |
528 switch(mode) | |
529 {case GDECL: | |
530 printf("%s\tEQU\t%u\n",n->nm,gpc); | |
531 case STADECL: | |
532 nsc = GVAR; | |
533 ndsp = gpc; | |
534 if(sym==ASS) | |
535 { t=type; | |
536 if(!scalar(t)) | |
537 error(TYERR); | |
538 if(mode==STADECL) printf("\tBRA\t_%d\n",l=fwdlabel()); | |
539 fwddef(ilabel); | |
540 getsym(); | |
541 slfree=lfree; | |
542 e=expr1(); | |
543 if(car(e)==CONST) | |
544 { lddim(cadr(e)); | |
545 indexy(t==CHAR?"STB":"STD",gpc); | |
546 } | |
547 else if(t!=CHAR) | |
548 { if(car(e)==ADDRESS&&car(cadr(e))==GVAR) | |
549 leaxy(cadr(cadr(e))); | |
550 else if(car(e)==FNAME) | |
551 leaxpcr((NMTBL *)cadr(e)); | |
552 else error(TYERR); | |
553 stxy(gpc); | |
554 } | |
555 else error(TYERR); | |
556 lfree=slfree; | |
557 jmp(ilabel=fwdlabel()); | |
558 if(mode==STADECL) fwddef(l); | |
559 type=t; | |
560 } | |
561 gpc +=sz; | |
562 break; | |
563 case GSDECL: | |
564 nsc = FIELD; | |
565 ndsp = disp; | |
566 disp += sz; | |
567 break; | |
568 case GUDECL: | |
569 nsc = FIELD; | |
570 ndsp = 0; | |
571 if (disp < sz) disp = sz; | |
572 break; | |
573 case GTDECL: | |
574 nsc = TYPE; | |
575 break; | |
576 case ADECL: | |
577 if(type==CHAR) ++(n->dsp); | |
578 else if (!scalar(type)) error(TYERR); | |
579 return; | |
580 case LDECL: | |
581 nsc = LVAR; | |
582 ndsp = (disp -= sz); | |
583 break; | |
584 case LSDECL: | |
585 nsc = FIELD; | |
586 ndsp = disp; | |
587 disp += sz; | |
588 break; | |
589 case LUDECL: | |
590 nsc = FIELD; | |
591 ndsp = 0; | |
592 if (disp < sz) disp = sz; | |
593 break; | |
594 case LTDECL: | |
595 nsc = TYPE; | |
596 break; | |
597 default: | |
598 error(DCERR); | |
599 } | |
600 n->sc = nsc; | |
601 n->dsp = ndsp; | |
602 } | |
603 sdecl(s) | |
604 int s; | |
605 {int smode,sdisp,type; | |
606 NMTBL *nptr0; | |
607 smode=mode; | |
608 if (mode==GDECL || mode==GSDECL || mode==GUDECL || mode==GTDECL) | |
609 mode=(s==STRUCT?GSDECL:GUDECL); | |
610 else mode=(s==STRUCT?LSDECL:LUDECL); | |
611 sdisp=disp; | |
612 disp=0; | |
613 if (getsym() == IDENT) | |
614 { nptr0 = nptr; | |
615 if (getsym() == LC) | |
616 { if (nptr0->sc != EMPTY) error(DCERR); | |
617 nptr0->sc = TAG; | |
618 nptr0->ty = list2(s,-1); | |
619 while (getsym() != RC) decl(); | |
620 getsym(); | |
621 rplacad(type = nptr0->ty,disp); | |
622 } | |
623 else | |
624 { if(nptr0->sc == EMPTY) nptr0=gnptr; | |
625 if(nptr0->sc == EMPTY) error(UDERR); | |
626 if(nptr0->sc != TAG) error(TYERR); | |
627 type = nptr0->ty; | |
628 } | |
629 } | |
630 else if(sym==LC) | |
631 { while(getsym() != RC) decl(); | |
632 getsym(); | |
633 type = list2(s,disp); | |
634 } | |
635 else error(DCERR); | |
636 disp=sdisp; | |
637 mode=smode; | |
638 return type; | |
639 } | |
640 fdecl(n) | |
641 NMTBL *n; | |
642 { args=0; | |
643 fcheck(n); | |
644 mode=ADECL; | |
645 lfree= HEAPSIZE; | |
646 while (sym!=LC) {decl(); getsym();} | |
647 disp=0; | |
648 mode=STAT; | |
649 while (typeid(getsym()) || sym==STATIC || sym==TYPEDEF) | |
650 { mode=LDECL; | |
651 decl(); | |
652 mode=STAT; | |
653 } | |
654 control=1; | |
655 printf("%s\n\tPSHS\tU\n\tLEAU\t,S\n",n->nm); | |
656 if(disp) printf("\tLEAS\t%d,S\n",disp); | |
657 lvar= -disp; | |
658 while(sym!=RC) statement(); | |
659 if (control) return2(); | |
660 } | |
661 fcheck(n) | |
662 NMTBL *n; | |
663 { if(mode!=GDECL||car(type)!=FUNCTION) error(DCERR); | |
664 if(n->sc==FUNCTION) compatible(n->ty,cadr(type)); | |
665 else if(n->sc!=EMPTY) error(DCERR); | |
666 n->sc=FUNCTION; | |
667 n->ty=cadr(type); | |
668 } | |
669 compatible(t1,t2) | |
670 int t1,t2; | |
671 { if(integral(t1)) | |
672 { if(t1!=t2) error(TYERR); | |
673 } | |
674 else if(car(t1)!=car(t2)) error(TYERR); | |
675 else if((car(t1)==STRUCT || car(t1)==UNION) && cadr(t1)!=cadr(t2)) | |
676 error(TYERR); | |
677 else if(car(t1)==POINTER || car(t1)==ARRAY ||car(t1)==FUNCTION) | |
678 compatible(cadr(t1),cadr(t2)); | |
679 } | |
680 scalar(t) | |
681 int t; | |
682 { return(integral(t)||car(t)==POINTER); | |
683 } | |
684 integral(t) | |
685 int t; | |
686 { return(t==INT||t==CHAR||t==UNSIGNED); | |
687 } | |
688 | |
689 statement() | |
690 {int slfree; | |
691 switch(sym) | |
692 {case IF: | |
693 doif(); | |
694 return; | |
695 case WHILE: | |
696 dowhile(); | |
697 return; | |
698 case DO: | |
699 dodo(); | |
700 return; | |
701 case FOR: | |
702 dofor(); | |
703 return; | |
704 case SWITCH: | |
705 doswitch(); | |
706 return; | |
707 case LC: | |
708 docomp(); | |
709 return; | |
710 case BREAK: | |
711 jmp(blabel); | |
712 getsym(); | |
713 checksym(SM); | |
714 return; | |
715 case CONTINUE: | |
716 jmp(clabel); | |
717 getsym(); | |
718 checksym(SM); | |
719 return; | |
720 case CASE: | |
721 docase(); | |
722 statement(); | |
723 return; | |
724 case DEFAULT: | |
725 dodefault(); | |
726 statement(); | |
727 return; | |
728 case RETURN: | |
729 doreturn(); | |
730 return; | |
731 case GOTO: | |
732 dogoto(); | |
733 return; | |
734 case SM: | |
735 getsym(); | |
736 return; | |
737 default:if(sym==IDENT&&skipspc()==':') | |
738 { dolabel(); | |
739 statement(); | |
740 } | |
741 else | |
742 { slfree=lfree; | |
743 gexpr(expr()); | |
744 lfree=slfree; | |
745 checksym(SM); | |
746 } | |
747 } | |
748 } | |
749 doif() | |
750 {int l1,l2,slfree; | |
751 getsym(); | |
752 checksym(LPAR); | |
753 slfree=lfree; | |
754 bexpr(expr(),0,l1=fwdlabel()); | |
755 lfree=slfree; | |
756 checksym(RPAR); | |
757 statement(); | |
758 if(sym==ELSE) | |
759 { if (l2 = control) jmp(l2=fwdlabel()); | |
760 fwddef(l1); | |
761 getsym(); | |
762 statement(); | |
763 if (l2) fwddef(l2); | |
764 } | |
765 else fwddef(l1); | |
766 } | |
767 dowhile() | |
768 {int sbreak,scontinue,slfree,e; | |
769 sbreak=blabel; | |
770 scontinue=clabel; | |
771 blabel=fwdlabel(); | |
772 clabel=backdef(); | |
773 getsym(); | |
774 checksym(LPAR); | |
775 slfree=lfree; | |
776 e=expr(); | |
777 checksym(RPAR); | |
778 if(sym==SM) | |
779 { bexpr(e,1,clabel); | |
780 lfree=slfree; | |
781 getsym(); | |
782 } | |
783 else | |
784 { bexpr(e,0,blabel); | |
785 lfree=slfree; | |
786 statement(); | |
787 jmp(clabel); | |
788 } | |
789 fwddef(blabel); | |
790 clabel=scontinue; | |
791 blabel=sbreak; | |
792 } | |
793 dodo() | |
794 {int sbreak,scontinue,l,slfree; | |
795 sbreak=blabel; | |
796 scontinue=clabel; | |
797 blabel=fwdlabel(); | |
798 clabel=fwdlabel(); | |
799 l=backdef(); | |
800 getsym(); | |
801 statement(); | |
802 fwddef(clabel); | |
803 checksym(WHILE); | |
804 checksym(LPAR); | |
805 slfree=lfree; | |
806 bexpr(expr(),1,l); | |
807 lfree=slfree; | |
808 checksym(RPAR); | |
809 checksym(SM); | |
810 fwddef(blabel); | |
811 clabel=scontinue; | |
812 blabel=sbreak; | |
813 } | |
814 dofor() | |
815 {int sbreak,scontinue,l,e,slfree; | |
816 sbreak=blabel; | |
817 scontinue=clabel; | |
818 blabel=fwdlabel(); | |
819 getsym(); | |
820 checksym(LPAR); | |
821 slfree=lfree; | |
822 if(sym!=SM) | |
823 { gexpr(expr()); | |
824 checksym(SM); | |
825 } | |
826 else getsym(); | |
827 lfree=slfree; | |
828 l=backdef(); | |
829 if(sym!=SM) | |
830 { bexpr(expr(),0,blabel); | |
831 checksym(SM); | |
832 } | |
833 else getsym(); | |
834 lfree=slfree; | |
835 if(sym==RPAR) | |
836 { clabel=l; | |
837 getsym(); | |
838 statement(); | |
839 } | |
840 else | |
841 { clabel=fwdlabel(); | |
842 e=expr(); | |
843 checksym(RPAR); | |
844 statement(); | |
845 fwddef(clabel); | |
846 gexpr(e); | |
847 lfree=slfree; | |
848 } | |
849 jmp(l); | |
850 fwddef(blabel); | |
851 clabel=scontinue; | |
852 blabel=sbreak; | |
853 } | |
854 doswitch() | |
855 {int sbreak,scase,sdefault,slfree; | |
856 sbreak=blabel; | |
857 blabel=fwdlabel(); | |
858 sdefault=dlabel; | |
859 dlabel=0; | |
860 scase=cslabel; | |
861 getsym(); | |
862 checksym(LPAR); | |
863 slfree=lfree; | |
864 gexpr(expr()); | |
865 lfree=slfree; | |
866 checksym(RPAR); | |
867 cslabel = control = 0; | |
868 statement(); | |
869 if(dlabel) printf("_%d\tEQU\t_%d\n",cslabel,dlabel); | |
870 else fwddef(cslabel); | |
871 cslabel=scase; | |
872 dlabel=sdefault; | |
873 fwddef(blabel); | |
874 blabel=sbreak; | |
875 } | |
876 docomp() | |
877 { getsym(); | |
878 while(sym!=RC) statement(); | |
879 getsym(); | |
880 } | |
881 docase() | |
882 {int c,n,l,slfree; | |
883 c=0; | |
884 n=2; | |
885 slfree=lfree; | |
886 while(sym==CASE) | |
887 { getsym(); | |
888 c=list2(cexpr(expr()),c); | |
889 n+=6; | |
890 checksym(COLON); | |
891 } | |
892 l=fwdlabel(); | |
893 if (control) | |
894 { control=0; | |
895 if (n>127) jmp(l); | |
896 else printf("\tBRA\t_%d\n",l); | |
897 } | |
898 if (cslabel) fwddef(cslabel); | |
899 while(cadr(c)) | |
900 { cmpdimm(car(c)); | |
901 if((n-=6)>127) jcond(l,0); | |
902 else printf("\tBEQ\t_%d\n",l); | |
903 c=cadr(c); | |
904 } | |
905 lfree=slfree; | |
906 cmpdimm(car(c)); | |
907 jcond(cslabel=fwdlabel(),1); | |
908 fwddef(l); | |
909 } | |
910 dodefault() | |
911 { getsym(); | |
912 checksym(COLON); | |
913 if (dlabel) error(STERR); | |
914 if (!cslabel) jmp(cslabel = fwdlabel()); | |
915 dlabel = backdef(); | |
916 } | |
917 doreturn() | |
918 {int slfree; | |
919 if(getsym()==SM) | |
920 { getsym(); | |
921 return2(); | |
922 return; | |
923 } | |
924 slfree=lfree; | |
925 gexpr(expr()); | |
926 lfree=slfree; | |
927 checksym(SM); | |
928 control=0; | |
929 switch(lvar) | |
930 {case 0: | |
931 ret(""); | |
932 return; | |
933 case 2: | |
934 ret("X,"); | |
935 return; | |
936 default:unlink(); | |
937 return; | |
938 } | |
939 } | |
940 return2() | |
941 { control=0; | |
942 switch(lvar) | |
943 {case 0: | |
944 ret(""); | |
945 return; | |
946 case 1: | |
947 ret("A,"); | |
948 return; | |
949 case 2: | |
950 ret("D,"); | |
951 return; | |
952 case 3: | |
953 ret("A,X,"); | |
954 return; | |
955 case 4: | |
956 ret("D,X,"); | |
957 return; | |
958 default:unlink(); | |
959 return; | |
960 } | |
961 } | |
962 ret(reg) | |
963 char *reg; | |
964 { printf("\tPULS\t%sU,PC\n",reg); | |
965 } | |
966 unlink() | |
967 { printf("\tLEAS\t,U\n"); | |
968 ret(""); | |
969 } | |
970 dogoto() | |
971 {NMTBL *nptr0; | |
972 getsym(); | |
973 nptr0=nptr; | |
974 checksym(IDENT); | |
975 if(nptr0->sc == BLABEL || nptr0->sc == FLABEL) jmp(nptr0->dsp); | |
976 else if(nptr0->sc == EMPTY) | |
977 { nptr0->sc = FLABEL; | |
978 jmp(nptr0->dsp = fwdlabel()); | |
979 } | |
980 else error(STERR); | |
981 checksym(SM); | |
982 } | |
983 dolabel() | |
984 { if(nptr->sc == FLABEL) fwddef(nptr->dsp); | |
985 else if(nptr->sc != EMPTY) error(TYERR); | |
986 nptr->sc = BLABEL; | |
987 nptr->dsp = backdef(); | |
988 getsym(); | |
989 checksym(COLON); | |
990 } | |
991 | |
992 expr() | |
993 { return(rvalue(expr0())); | |
994 } | |
995 expr0() | |
996 {int e; | |
997 e=expr1(); | |
998 while(sym==COMMA) {getsym();e=list3(COMMA,e,rvalue(expr1()));} | |
999 return e; | |
1000 } | |
1001 expr1() | |
1002 {int e1,e2,t,op; | |
1003 e1=expr2(); | |
1004 switch (sym) | |
1005 {case ASS: | |
1006 lcheck(e1); | |
1007 t=type; | |
1008 getsym(); | |
1009 e2=rvalue(expr1()); | |
1010 if(t==CHAR) {type= INT;return(list3(CASS,e1,e2));} | |
1011 type=t; | |
1012 return(list3(ASS,e1,e2)); | |
1013 case ADD+AS: case SUB+AS: case MUL+AS: case DIV+AS: case MOD+AS: | |
1014 case RSHIFT+AS: case LSHIFT+AS: case BAND+AS: case EOR+AS: case BOR+AS: | |
1015 op = sym-AS; | |
1016 lcheck(e1); | |
1017 t=type; | |
1018 getsym(); | |
1019 e2=rvalue(expr1()); | |
1020 if(!integral(type)) error(TYERR); | |
1021 if((t==UNSIGNED||type==UNSIGNED)&& | |
1022 (op==MUL||op==DIV||op==MOD||op==RSHIFT||op==LSHIFT)) | |
1023 op=op+US; | |
1024 if(t==CHAR) | |
1025 { type= INT; | |
1026 return(list4(CASSOP,e1,e2,op)); | |
1027 } | |
1028 type=t; | |
1029 if(integral(t)) return(list4(ASSOP,e1,e2,op)); | |
1030 if((op!=ADD&&op!=SUB)||car(t)!=POINTER) error(TYERR); | |
1031 e2=binop(MUL,e2,list2(CONST,size(cadr(t))),INT,UNSIGNED); | |
1032 type=t; | |
1033 return list4(ASSOP,e1,e2,op); | |
1034 default: | |
1035 return(e1); | |
1036 } | |
1037 } | |
1038 expr2() | |
1039 {int e1,e2,e3,t; | |
1040 e1=expr3(); | |
1041 if(sym==COND) | |
1042 { e1=rvalue(e1); | |
1043 getsym(); | |
1044 e2=rvalue(expr2()); | |
1045 t=type; | |
1046 checksym(COLON); | |
1047 e3=rvalue(expr2()); | |
1048 if(car(e1)==CONST) | |
1049 if(cadr(e1)) {type=t;return e2;} | |
1050 else return e3; | |
1051 if(type==INT||t!=INT&&type==UNSIGNED) type=t; | |
1052 return(list4(COND,e1,e2,e3)); | |
1053 } | |
1054 return(e1); | |
1055 } | |
1056 expr3() | |
1057 {int e; | |
1058 e=expr4(); | |
1059 while(sym==LOR) | |
1060 { e=rvalue(e); | |
1061 getsym(); | |
1062 e=list3(LOR,e,rvalue(expr4())); | |
1063 type= INT; | |
1064 } | |
1065 return(e); | |
1066 } | |
1067 expr4() | |
1068 {int e; | |
1069 e=expr5(); | |
1070 while(sym==LAND) | |
1071 { e=rvalue(e); | |
1072 getsym(); | |
1073 e=list3(LAND,e,rvalue(expr5())); | |
1074 type= INT; | |
1075 } | |
1076 return(e); | |
1077 } | |
1078 expr5() | |
1079 {int e1,e2,t; | |
1080 e1=expr6(); | |
1081 while(sym==BOR) | |
1082 { e1=rvalue(e1); | |
1083 t=type; | |
1084 getsym(); | |
1085 e2=rvalue(expr6()); | |
1086 e1=binop(BOR,e1,e2,t,type); | |
1087 } | |
1088 return(e1); | |
1089 } | |
1090 expr6() | |
1091 {int e1,e2,t; | |
1092 e1=expr7(); | |
1093 while(sym==EOR) | |
1094 { e1=rvalue(e1); | |
1095 t=type; | |
1096 getsym(); | |
1097 e2=rvalue(expr7()); | |
1098 e1=binop(EOR,e1,e2,t,type); | |
1099 } | |
1100 return(e1); | |
1101 } | |
1102 expr7() | |
1103 {int e1,e2,t; | |
1104 e1=expr8(); | |
1105 while(sym==BAND) | |
1106 { e1=rvalue(e1); | |
1107 t=type; | |
1108 getsym(); | |
1109 e2=rvalue(expr8()); | |
1110 e1=binop(BAND,e1,e2,t,type); | |
1111 } | |
1112 return(e1); | |
1113 } | |
1114 expr8() | |
1115 {int e,op; | |
1116 e=expr9(); | |
1117 while((op=sym)==EQ||op==NEQ) | |
1118 { e=rvalue(e); | |
1119 getsym(); | |
1120 e=list3(op,e,rvalue(expr9())); | |
1121 type= INT; | |
1122 } | |
1123 return e; | |
1124 } | |
1125 expr9() | |
1126 {int e1,e2,t,op; | |
1127 e1=expr10(); | |
1128 while((op=sym)==GT||op==GE||op==LT||op==LE) | |
1129 { e1=rvalue(e1); | |
1130 t=type; | |
1131 getsym(); | |
1132 e2=rvalue(expr10()); | |
1133 if(t==INT&&type==INT) e1=list3(op,e1,e2); | |
1134 else e1=list3(op+US,e1,e2); | |
1135 type= INT; | |
1136 } | |
1137 return e1; | |
1138 } | |
1139 expr10() | |
1140 {int e1,e2,t,op; | |
1141 e1=expr11(); | |
1142 while((op=sym)==RSHIFT||op==LSHIFT) | |
1143 { e1=rvalue(e1); | |
1144 t=type; | |
1145 getsym(); | |
1146 e2=rvalue(expr11()); | |
1147 e1=binop(op,e1,e2,t,type); | |
1148 } | |
1149 return e1; | |
1150 } | |
1151 expr11() | |
1152 {int e1,e2,t,op; | |
1153 e1=expr12(); | |
1154 while((op=sym)==ADD||op==SUB) | |
1155 { e1=rvalue(e1); | |
1156 t=type; | |
1157 getsym(); | |
1158 e2=rvalue(expr12()); | |
1159 e1=binop(op,e1,e2,t,type); | |
1160 } | |
1161 return e1; | |
1162 } | |
1163 expr12() | |
1164 {int e1,e2,t,op; | |
1165 e1=expr13(); | |
1166 while((op=sym)==MUL||op==DIV||op==MOD) | |
1167 { e1=rvalue(e1); | |
1168 t=type; | |
1169 getsym(); | |
1170 e2=rvalue(expr13()); | |
1171 e1=binop(op,e1,e2,t,type); | |
1172 } | |
1173 return e1; | |
1174 } | |
1175 expr13() | |
1176 {int e,op; | |
1177 switch (op = sym) | |
1178 {case INC: case DEC: | |
1179 getsym(); | |
1180 lcheck(e=expr13()); | |
1181 if(type==CHAR) | |
1182 { type= INT; | |
1183 return(list2(op==INC?CPREINC:CPREDEC,e)); | |
1184 } | |
1185 if(integral(type)) | |
1186 return(list3(PREINC,e,op==INC?1:-1)); | |
1187 if(car(type)!=POINTER) error(TYERR); | |
1188 return(list3(PREINC,e, | |
1189 op==INC?size(cadr(type)):-size(cadr(type)) )); | |
1190 case MUL: | |
1191 getsym(); | |
1192 e=rvalue(expr13()); | |
1193 return(indop(e)); | |
1194 case BAND: | |
1195 getsym(); | |
1196 switch(car(e=expr13())) | |
1197 {case INDIRECT: | |
1198 e=cadr(e); | |
1199 break; | |
1200 case GVAR: | |
1201 case LVAR: | |
1202 e=list2(ADDRESS,e); | |
1203 break; | |
1204 case FNAME: | |
1205 return e; | |
1206 default:error(LVERR); | |
1207 } | |
1208 type=list2(POINTER,type); | |
1209 return e; | |
1210 case SUB: | |
1211 getsym(); | |
1212 e=rvalue(expr13()); | |
1213 if(!integral(type)) error(TYERR); | |
1214 return(car(e)==CONST?list2(CONST,-cadr(e)):list2(MINUS,e)); | |
1215 case BNOT: | |
1216 getsym(); | |
1217 e=rvalue(expr13()); | |
1218 if(!integral(type)) error(TYERR); | |
1219 return(car(e)==CONST?list2(CONST,~cadr(e)):list2(BNOT,e)); | |
1220 case LNOT: | |
1221 getsym(); | |
1222 return(list2(LNOT,rvalue(expr13()))); | |
1223 case SIZEOF: | |
1224 if(getsym()==LPAR) | |
1225 if(typeid(getsym())) | |
1226 { e=list2(CONST,size(typename())); | |
1227 type=INT; | |
1228 checksym(RPAR); | |
1229 return e; | |
1230 } | |
1231 else | |
1232 { e=expr0(); | |
1233 checksym(RPAR); | |
1234 expr16(e); | |
1235 if(sym==INC||sym==DEC) | |
1236 { getsym(); | |
1237 if(type==CHAR) type=INT; | |
1238 else if(!scalar(type)) | |
1239 error(TYERR); | |
1240 } | |
1241 } | |
1242 else expr13(); | |
1243 e=list2(CONST,size(type)); | |
1244 type=INT; | |
1245 return e; | |
1246 } | |
1247 e=expr14(); | |
1248 if((op=sym)==INC||op==DEC) | |
1249 { lcheck(e); | |
1250 getsym(); | |
1251 if(type==CHAR) | |
1252 { type= INT; | |
1253 return(list2(op==INC?CPOSTINC:CPOSTDEC,e)); | |
1254 } | |
1255 if(integral(type)) | |
1256 return(list3(POSTINC,e,op==INC?1:-1)); | |
1257 if(car(type)!=POINTER) error(TYERR); | |
1258 return (list3(POSTINC,e, | |
1259 op == INC ? size(cadr(type)): -size(cadr(type)) )); | |
1260 } | |
1261 return e; | |
1262 } | |
1263 expr14() | |
1264 {int e1,t; | |
1265 switch(sym) | |
1266 {case IDENT: | |
1267 switch(nptr->sc) | |
1268 {case GVAR: | |
1269 e1=list2(GVAR,nptr->dsp); | |
1270 type=nptr->ty; | |
1271 getsym(); | |
1272 break; | |
1273 case LVAR: | |
1274 e1=list2(LVAR,nptr->dsp); | |
1275 type=nptr->ty; | |
1276 getsym(); | |
1277 break; | |
1278 case FUNCTION: | |
1279 e1=list2(FNAME,(int)nptr); | |
1280 type=list2(FUNCTION,nptr->ty); | |
1281 getsym(); | |
1282 break; | |
1283 case EMPTY: | |
1284 if(getsym()==LPAR) | |
1285 { nptr->sc = FUNCTION; | |
1286 nptr->ty= INT; | |
1287 type= list2(FUNCTION,INT); | |
1288 e1=expr15(list2(FNAME,(int)nptr)); | |
1289 break; | |
1290 } | |
1291 default:error(UDERR); | |
1292 } | |
1293 break; | |
1294 case STRING: | |
1295 e1=list3(STRING,(int)sptr,symval); | |
1296 type=list3(ARRAY,CHAR,symval); | |
1297 getsym(); | |
1298 break; | |
1299 case CONST: | |
1300 type= INT; | |
1301 e1=list2(CONST,symval); | |
1302 getsym(); | |
1303 break; | |
1304 case LPAR: | |
1305 if(typeid(getsym())) | |
1306 { t=typename(); | |
1307 checksym(RPAR); | |
1308 e1=expr13(); | |
1309 type=t; | |
1310 return e1; | |
1311 } | |
1312 e1=expr0(); | |
1313 checksym(RPAR); | |
1314 break; | |
1315 default:error(EXERR); | |
1316 } | |
1317 return expr16(e1); | |
1318 } | |
1319 expr16(e1) | |
1320 int e1; | |
1321 {int e2,t; | |
1322 while(1) | |
1323 if(sym==LBRA) | |
1324 { e1=rvalue(e1); | |
1325 t=type; | |
1326 getsym(); | |
1327 e2=rvalue(expr0()); | |
1328 checksym(RBRA); | |
1329 e1=binop(ADD,e1,e2,t,type); | |
1330 e1=indop(e1); | |
1331 } | |
1332 else if(sym==LPAR) e1=expr15(e1); | |
1333 else if(sym==PERIOD) e1=strop(e1); | |
1334 else if(sym==ARROW) e1=strop(indop(rvalue(e1))); | |
1335 else break; | |
1336 if(car(e1)==FNAME) type=list2(POINTER,type); | |
1337 return e1; | |
1338 } | |
1339 rvalue(e) | |
1340 int e; | |
1341 { if(type==CHAR) | |
1342 { type= INT; | |
1343 switch(car(e)) | |
1344 {case GVAR: | |
1345 return(list2(CRGVAR,cadr(e))); | |
1346 case LVAR: | |
1347 return(list2(CRLVAR,cadr(e))); | |
1348 case INDIRECT: | |
1349 return(list2(CRINDIRECT,cadr(e))); | |
1350 default:return(e); | |
1351 } | |
1352 } | |
1353 if(!integral(type)) | |
1354 if(car(type)==ARRAY) | |
1355 { type=list2(POINTER,cadr(type)); | |
1356 if(car(e)==INDIRECT) return cadr(e); | |
1357 return list2(ADDRESS,e); | |
1358 } | |
1359 else if(car(type)!=POINTER) error(TYERR); | |
1360 switch(car(e)) | |
1361 {case GVAR: | |
1362 return(list2(RGVAR,cadr(e))); | |
1363 case LVAR: | |
1364 return(list2(RLVAR,cadr(e))); | |
1365 case INDIRECT: | |
1366 return(list2(RINDIRECT,cadr(e))); | |
1367 default:return(e); | |
1368 } | |
1369 } | |
1370 lcheck(e) | |
1371 int e; | |
1372 { if(!scalar(type)||car(e)!=GVAR&&car(e)!=LVAR&&car(e)!=INDIRECT) | |
1373 error(LVERR); | |
1374 } | |
1375 indop(e) | |
1376 int e; | |
1377 { if(type!=INT&&type!=UNSIGNED) | |
1378 if(car(type)==POINTER) type=cadr(type); | |
1379 else error(TYERR); | |
1380 else type= CHAR; | |
1381 if(car(e)==ADDRESS) return(cadr(e)); | |
1382 return(list2(INDIRECT,e)); | |
1383 } | |
1384 strop(e) | |
1385 { getsym(); | |
1386 if (sym!=IDENT||nptr->sc!=FIELD) error(TYERR); | |
1387 if (integral(type)||car(type)!=STRUCT && car(type)!=UNION) | |
1388 e=rvalue(e); | |
1389 type = nptr->ty; | |
1390 switch(car(e)) | |
1391 {case GVAR: | |
1392 case LVAR: | |
1393 e=list2(car(e),cadr(e) + nptr->dsp); | |
1394 break; | |
1395 case INDIRECT: | |
1396 if(!nptr->dsp) break; | |
1397 e=list2(INDIRECT,list3(ADD,cadr(e),list2(CONST,nptr->dsp))); | |
1398 break; | |
1399 default: | |
1400 e=list2(INDIRECT,list3(ADD,e,list2(CONST,nptr->dsp))); | |
1401 } | |
1402 getsym(); | |
1403 return e; | |
1404 } | |
1405 binop(op,e1,e2,t1,t2) | |
1406 int op,e1,e2,t1,t2; | |
1407 {int e; | |
1408 if(car(e1)==CONST&&car(e2)==CONST) | |
1409 { e1=cadr(e1); | |
1410 e2=cadr(e2); | |
1411 type= INT; | |
1412 switch(op) | |
1413 {case BOR: | |
1414 e=e1|e2;break; | |
1415 case EOR: | |
1416 e=e1^e2;break; | |
1417 case BAND: | |
1418 e=e1&e2;break; | |
1419 case ADD: | |
1420 if(integral(t1)) | |
1421 { if(integral(t2)) | |
1422 e=e1+e2; | |
1423 else | |
1424 { if(car(t2)!=POINTER) error(TYERR); | |
1425 e=size(cadr(t2))*e1+e2; | |
1426 type=t2; | |
1427 } | |
1428 } | |
1429 else | |
1430 { if(car(t1)!=POINTER) error(TYERR); | |
1431 e=e1+size(cadr(t1))*e2; | |
1432 type=t1; | |
1433 } | |
1434 break; | |
1435 case SUB: | |
1436 if(integral(t1)) | |
1437 e=e1-e2; | |
1438 else | |
1439 { if(car(t1)!=POINTER) error(TYERR); | |
1440 e=e1-size(cadr(t1))*e2; | |
1441 type=t1; | |
1442 } | |
1443 break; | |
1444 case MUL: | |
1445 e=e1*e2;break; | |
1446 case DIV: | |
1447 if(!e2) error(EXERR);e=e1/e2;break; | |
1448 case MOD: | |
1449 if(!e2) error(EXERR);e=e1%e2;break; | |
1450 case RSHIFT: | |
1451 e=e1>>e2;break; | |
1452 case LSHIFT: | |
1453 e=e1<<e2; | |
1454 } | |
1455 return list2(CONST,e); | |
1456 } | |
1457 if((op==ADD||op==MUL||op==BOR||op==EOR||op==BAND)&& | |
1458 (car(e1)==CONST||car(e2)!=CONST&& | |
1459 (car(e1)==RGVAR||car(e1)==RLVAR))) | |
1460 {e=e1;e1=e2;e2=e;e=t1;t1=t2;t2=e;} | |
1461 if(op==ADD) | |
1462 { if(integral(t1)) | |
1463 { if(integral(t2)) | |
1464 { if(t1==INT) type=t2;else type=t1; | |
1465 return(list3(ADD,e1,e2)); | |
1466 } | |
1467 if(car(t2)!=POINTER) error(TYERR); | |
1468 e=binop(MUL,e1,list2(CONST,size(cadr(t2))),t1,INT); | |
1469 type=t2; | |
1470 return(list3(ADD,e,e2)); | |
1471 } | |
1472 if(car(t1)!=POINTER||!integral(t2)) error(TYERR); | |
1473 e=binop(MUL,e2,list2(CONST,size(cadr(t1))),t2,INT); | |
1474 type=t1; | |
1475 if(car(e1)==ADDRESS&&car(e)==CONST) | |
1476 return(list2(ADDRESS,list2(car(cadr(e1)), | |
1477 cadr(cadr(e1))+cadr(e)))); | |
1478 return(list3(ADD,e1,e)); | |
1479 } | |
1480 if(op==SUB) | |
1481 { if(integral(t1)) | |
1482 { if(!integral(t2)) error(TYERR); | |
1483 if(t1==INT) type=t2;else type=t1; | |
1484 return(list3(SUB,e1,e2)); | |
1485 } | |
1486 if(car(t1)!=POINTER) error(TYERR); | |
1487 if(integral(t2)) | |
1488 { e=binop(MUL,e2,list2(CONST,size(cadr(t1))),t2,INT); | |
1489 type=t1; | |
1490 return(list3(SUB,e1,e)); | |
1491 } | |
1492 if(car(t2)!=POINTER) | |
1493 error(TYERR); | |
1494 compatible(t1,t2); | |
1495 e=list3(SUB,e1,e2); | |
1496 e=binop(DIV,e,list2(CONST,size(cadr(t1))),UNSIGNED,INT); | |
1497 type= INT; | |
1498 return e; | |
1499 } | |
1500 if(!integral(t1)||!integral(t2)) error(TYERR); | |
1501 if(t1==INT) type=t2;else type=t1; | |
1502 if((op==MUL||op==DIV)&&car(e2)==CONST&&cadr(e2)==1) return e1; | |
1503 if(op==BOR||op==EOR||op==BAND) return(list3(op,e1,e2)); | |
1504 return(list3(type==UNSIGNED?op+US:op,e1,e2)); | |
1505 } | |
1506 expr15(e1) | |
1507 int e1; | |
1508 {int t,args; | |
1509 t=type; | |
1510 if(integral(t)||car(t)!=FUNCTION) | |
1511 error(TYERR); | |
1512 t=cadr(t); | |
1513 getsym(); | |
1514 args=0; | |
1515 while(sym!=RPAR) | |
1516 { args=list2(rvalue(expr1()),args); | |
1517 if(sym!=COMMA) break; | |
1518 getsym(); | |
1519 } | |
1520 checksym(RPAR); | |
1521 if(t==CHAR) type= INT;else type=t; | |
1522 return list3(FUNCTION,e1,args); | |
1523 } | |
1524 typeid(s) | |
1525 int s; | |
1526 { return (integral(s) || s==SHORT || s==LONG || s==STRUCT || s==UNION || | |
1527 (s==IDENT && nptr->sc==TYPE)); | |
1528 } | |
1529 typename() | |
1530 {int t; | |
1531 type=t=typespec(); | |
1532 ndecl0(); | |
1533 reverse(t); | |
1534 return type; | |
1535 } | |
1536 ndecl0() | |
1537 { if(sym==MUL) | |
1538 { getsym(); | |
1539 return type=list2(POINTER,ndecl0()); | |
1540 } | |
1541 return ndecl1(); | |
1542 } | |
1543 ndecl1() | |
1544 {int i,t; | |
1545 if(sym==LPAR) | |
1546 if(getsym()==RPAR) {type=list2(FUNCTION,type); getsym();} | |
1547 else | |
1548 { ndecl0(); | |
1549 checksym(RPAR); | |
1550 } | |
1551 while(1) | |
1552 if(sym==LBRA) | |
1553 { getsym(); | |
1554 t=type; | |
1555 i=cexpr(expr()); | |
1556 checksym(RBRA); | |
1557 type=list3(ARRAY,t,i); | |
1558 } | |
1559 else if(sym==LPAR) | |
1560 { getsym(); | |
1561 checksym(RPAR); | |
1562 type=list2(FUNCTION,type); | |
1563 } | |
1564 else return type; | |
1565 } | |
1566 | |
1567 bexpr(e1,cond,l1) | |
1568 int e1,l1; | |
1569 char cond; | |
1570 {int e2,l2; | |
1571 if (chk) return; | |
1572 e2=cadr(e1); | |
1573 switch(car(e1)) | |
1574 {case LNOT: | |
1575 bexpr(e2,!cond,l1); | |
1576 return; | |
1577 case GT: | |
1578 rexpr(e1,l1,cond?"GT":"LE"); | |
1579 return; | |
1580 case UGT: | |
1581 rexpr(e1,l1,cond?"HI":"LS"); | |
1582 return; | |
1583 case GE: | |
1584 rexpr(e1,l1,cond?"GE":"LT"); | |
1585 return; | |
1586 case UGE: | |
1587 rexpr(e1,l1,cond?"HS":"LO"); | |
1588 return; | |
1589 case LT: | |
1590 rexpr(e1,l1,cond?"LT":"GE"); | |
1591 return; | |
1592 case ULT: | |
1593 rexpr(e1,l1,cond?"LO":"HS"); | |
1594 return; | |
1595 case LE: | |
1596 rexpr(e1,l1,cond?"LE":"GT"); | |
1597 return; | |
1598 case ULE: | |
1599 rexpr(e1,l1,cond?"LS":"HI"); | |
1600 return; | |
1601 case EQ: | |
1602 rexpr(e1,l1,cond?"EQ":"NE"); | |
1603 return; | |
1604 case NEQ: | |
1605 rexpr(e1,l1,cond?"NE":"EQ"); | |
1606 return; | |
1607 case LAND: | |
1608 bexpr(e2,0,cond?(l2=fwdlabel()):l1); | |
1609 bexpr(caddr(e1),cond,l1); | |
1610 if(cond) fwddef(l2); | |
1611 return; | |
1612 case LOR: | |
1613 bexpr(e2,1,cond?l1:(l2=fwdlabel())); | |
1614 bexpr(caddr(e1),cond,l1); | |
1615 if(!cond) fwddef(l2); | |
1616 return; | |
1617 case CRGVAR: | |
1618 ldby(e2); | |
1619 jcond(l1,cond); | |
1620 return; | |
1621 case CRLVAR: | |
1622 ldbu(e2); | |
1623 jcond(l1,cond); | |
1624 return; | |
1625 case CONST: | |
1626 if(cond&&e2||!cond&&!e2) jmp(l1); | |
1627 return; | |
1628 case RGVAR: | |
1629 case RLVAR: | |
1630 case CRINDIRECT: | |
1631 gexpr(e1); | |
1632 jcond(l1,cond); | |
1633 return; | |
1634 default:gexpr(e1); | |
1635 subdim(0); | |
1636 jcond(l1,cond); | |
1637 return; | |
1638 } | |
1639 } | |
1640 rexpr(e1,l1,s) | |
1641 int e1,l1; | |
1642 char *s; | |
1643 { gexpr(list3(SUB,cadr(e1),caddr(e1))); | |
1644 printf("\tLB%s\t_%d\n",s,l1); | |
1645 } | |
1646 jcond(l,cond) | |
1647 int l; | |
1648 char cond; | |
1649 { printf("\tLB%s\t_%d\n",cond?"NE":"EQ",l); | |
1650 } | |
1651 jmp(l) | |
1652 int l; | |
1653 { control=0; | |
1654 printf("\tLBRA\t_%d\n",l); | |
1655 } | |
1656 fwdlabel() | |
1657 { return labelno++; | |
1658 } | |
1659 fwddef(l) | |
1660 int l; | |
1661 { control=1; | |
1662 printf("_%d\n",l); | |
1663 } | |
1664 backdef() | |
1665 { control=1; | |
1666 printf("_%d\n",labelno); | |
1667 return labelno++; | |
1668 } | |
1669 | |
1670 gexpr(e1) | |
1671 int e1; | |
1672 {int e2,e3; | |
1673 if (chk) return; | |
1674 e2 = cadr(e1); | |
1675 switch (car(e1)) | |
1676 {case GVAR: | |
1677 leaxy(e2); | |
1678 return; | |
1679 case RGVAR: | |
1680 lddy(e2); | |
1681 return; | |
1682 case CRGVAR: | |
1683 ldby(e2); | |
1684 sex(); | |
1685 return; | |
1686 case LVAR: | |
1687 leaxu(e2); | |
1688 return; | |
1689 case RLVAR: | |
1690 lddu(e2); | |
1691 return; | |
1692 case CRLVAR: | |
1693 ldbu(e2); | |
1694 sex(); | |
1695 return; | |
1696 case FNAME: | |
1697 leaxpcr((NMTBL *)e2); | |
1698 tfrxd(); | |
1699 return; | |
1700 case CONST: | |
1701 if (e2) lddim(e2); | |
1702 else clrd(); | |
1703 return; | |
1704 case STRING: | |
1705 string(e1); | |
1706 return; | |
1707 case FUNCTION: | |
1708 function(e1); | |
1709 return; | |
1710 case INDIRECT: | |
1711 indirect(e1); | |
1712 return; | |
1713 case RINDIRECT: case CRINDIRECT: | |
1714 rindirect(e1); | |
1715 return; | |
1716 case ADDRESS: | |
1717 gexpr(e2); | |
1718 tfrxd(); | |
1719 return; | |
1720 case MINUS: | |
1721 gexpr(e2); | |
1722 printf("\tNEGA\n\tNEGB\n\tSBCA\t#0\n"); | |
1723 return; | |
1724 case BNOT: | |
1725 gexpr(e2); | |
1726 printf("\tCOMA\n\tCOMB\n"); | |
1727 return; | |
1728 case PREINC: | |
1729 switch (car(e2)) | |
1730 {case GVAR: case LVAR: | |
1731 ldd(e2); | |
1732 adddim(caddr(e1)); | |
1733 std(e2); | |
1734 return; | |
1735 default: | |
1736 gexpr(e2); | |
1737 lddx(); | |
1738 adddim(caddr(e1)); | |
1739 stdx(); | |
1740 return; | |
1741 } | |
1742 case POSTINC: | |
1743 switch (car(e2)) | |
1744 {case GVAR: case LVAR: | |
1745 ldd(e2); | |
1746 adddim(e3 = caddr(e1)); | |
1747 std(e2); | |
1748 subdim(e3); | |
1749 return; | |
1750 default: | |
1751 gexpr(e2); | |
1752 lddx(); | |
1753 adddim(e3=caddr(e1)); | |
1754 stdx(); | |
1755 subdim(e3); | |
1756 return; | |
1757 } | |
1758 case CPOSTINC: | |
1759 gexpr(e2); | |
1760 ldbx(); | |
1761 incx(); | |
1762 sex(); | |
1763 return; | |
1764 case CPREINC: | |
1765 gexpr(e2); | |
1766 incx(); | |
1767 ldbx(); | |
1768 sex(); | |
1769 return; | |
1770 case CPOSTDEC: | |
1771 gexpr(e2); | |
1772 ldbx(); | |
1773 decx(); | |
1774 sex(); | |
1775 return; | |
1776 case CPREDEC: | |
1777 gexpr(e2); | |
1778 decx(); | |
1779 ldbx(); | |
1780 sex(); | |
1781 return; | |
1782 case MUL: case UMUL: | |
1783 if (car(e3=caddr(e1)) == CONST) | |
1784 { if (0 < (e3 = cadr(e3)) && e3 <= 10) | |
1785 { gexpr(e2); | |
1786 switch (e3) | |
1787 {case 8: | |
1788 asld(); | |
1789 case 4: | |
1790 asld(); | |
1791 case 2: | |
1792 asld(); | |
1793 case 1: | |
1794 return; | |
1795 case 10: | |
1796 asld(); | |
1797 case 5: | |
1798 pushd(); | |
1799 asld(); | |
1800 asld(); | |
1801 addds(); | |
1802 return; | |
1803 case 6: | |
1804 asld(); | |
1805 case 3: | |
1806 pushd(); | |
1807 asld(); | |
1808 addds(); | |
1809 return; | |
1810 case 9: case 7: | |
1811 pushd(); | |
1812 asld(); | |
1813 asld(); | |
1814 asld(); | |
1815 if (e3 == 9) addds(); else subds(); | |
1816 return; | |
1817 } | |
1818 } | |
1819 } | |
1820 case DIV: case UDIV: case MOD: case UMOD: | |
1821 case LSHIFT: case ULSHIFT: case RSHIFT: case URSHIFT: | |
1822 binexpr(e1); | |
1823 return; | |
1824 case ADD: case SUB: case BAND: case EOR: case BOR: | |
1825 machinop(e1); | |
1826 return; | |
1827 case COND: | |
1828 e2=fwdlabel(); | |
1829 bexpr(cadr(e1),0,e2); | |
1830 gexpr(caddr(e1)); | |
1831 jmp(e3=fwdlabel()); | |
1832 fwddef(e2); | |
1833 gexpr(cadddr(e1)); | |
1834 fwddef(e3); | |
1835 return; | |
1836 case ASS: case CASS: | |
1837 assign(e1); | |
1838 return; | |
1839 case ASSOP: case CASSOP: | |
1840 assop(e1); | |
1841 return; | |
1842 case COMMA: | |
1843 gexpr(e2); | |
1844 gexpr(caddr(e1)); | |
1845 return; | |
1846 default: | |
1847 bexpr(e1,1,e2=fwdlabel()); | |
1848 clrd(); | |
1849 printf("\tBRA\t*+5\n"); | |
1850 fwddef(e2); | |
1851 lddim(1); | |
1852 } | |
1853 } | |
1854 string(e1) | |
1855 int e1; | |
1856 {char *s; | |
1857 int i,l,lb; | |
1858 s=(char *)cadr(e1); | |
1859 lb=fwdlabel(); | |
1860 if ((l = caddr(e1)) < 128) | |
105 | 1861 printf("\tLEAX\t*+5,PCR\n\tBRA\t_%d\n",lb); |
99 | 1862 else |
105 | 1863 printf("\tLEAX\t*+6,PCR\n\tLBRA\t_%d\n",lb); |
99 | 1864 do |
1865 { printf("\tFCB\t%d",*s++); | |
1866 for (i=8; --l && --i;) printf(",%d",*s++); | |
1867 printf("\n"); | |
1868 } | |
1869 while (l); | |
1870 fwddef(lb); | |
1871 } | |
1872 function(e1) | |
1873 int e1; | |
1874 {int e2,e3,e4,e5,nargs; | |
1875 NMTBL *n; | |
1876 e2 = cadr(e1); | |
1877 nargs = 0; | |
1878 for (e3 = caddr(e1); e3; e3 = cadr(e3)) | |
1879 { n=(NMTBL *)(e5=(cadr(e4 = car(e3)))); | |
1880 switch(car(e4)) | |
1881 {case FNAME: | |
1882 leaxpcr(n); | |
1883 pushx(); | |
1884 break; | |
1885 case ADDRESS: | |
1886 gexpr(e5); | |
1887 pushx(); | |
1888 break; | |
1889 default:gexpr(e4); | |
1890 pushd(); | |
1891 } | |
1892 ++nargs; | |
1893 } | |
1894 if (car(e2) == FNAME) | |
1895 { n=(NMTBL *)cadr(e2); | |
1896 printf("\tLBSR\t%s\n",n->nm); | |
1897 } | |
1898 else | |
1899 { gexpr(e2); | |
1900 printf("\tJSR\t,X\n"); | |
1901 } | |
1902 if (nargs) printf("\tLEAS\t%d,S\n",2*nargs); | |
1903 } | |
1904 indirect(e1) | |
1905 int e1; | |
1906 {int e2,e3,e4; | |
1907 e3 = cadr(e2 = cadr(e1)); | |
1908 switch(car(e2)) | |
1909 {case RGVAR: case RLVAR: | |
1910 ldx(e2); | |
1911 return; | |
1912 case ADD: | |
1913 if(car(e3)==ADDRESS) | |
1914 { gexpr(caddr(e2)); | |
1915 gexpr(cadr(e3)); | |
1916 opdx("LEAX"); | |
1917 return; | |
1918 } | |
1919 switch(car(e4 = caddr(e2))) | |
1920 {case RGVAR: case RLVAR: | |
1921 gexpr(e3); | |
1922 ldx(e4); | |
1923 opdx("LEAX"); | |
1924 return; | |
1925 } | |
1926 default: | |
1927 gexpr(e2); | |
1928 tfrdx(); | |
1929 } | |
1930 } | |
1931 | |
1932 machinop(e1) | |
1933 int e1; | |
1934 {int e2,e3; | |
1935 e2 = cadr(e1); | |
1936 switch (car(e3 = caddr(e1))) | |
1937 {case RGVAR: case RLVAR: case CONST: | |
1938 gexpr(e2); | |
1939 oprt(car(e1),e3); | |
1940 return; | |
1941 default: | |
1942 gexpr(e3); | |
1943 pushd(); | |
1944 gexpr(e2); | |
1945 tosop(car(e1)); | |
1946 return; | |
1947 } | |
1948 } | |
1949 | |
1950 rindirect(e1) | |
1951 int e1; | |
1952 {char *op; | |
1953 int e2,e3,e4,byte,l; | |
1954 op = ((byte = (car(e1) == CRINDIRECT)) ? "LDB" : "LDD"); | |
1955 e3 = cadr(e2 = cadr(e1)); | |
1956 switch (car(e2)) | |
1957 {case RGVAR: case RLVAR: | |
1958 indir(op,e2); | |
1959 sextend(byte); | |
1960 return; | |
1961 case ADD: | |
1962 if(car(e3)==ADDRESS) | |
1963 { gexpr(caddr(e2)); | |
1964 gexpr(cadr(e3)); | |
1965 opdx(op); | |
1966 sextend(byte); | |
1967 return; | |
1968 } | |
1969 switch(car(e4=caddr(e2))) | |
1970 {case RGVAR: case RLVAR: | |
1971 gexpr(e3); | |
1972 ldx(e4); | |
1973 opdx(op); | |
1974 sextend(byte); | |
1975 return; | |
1976 case CONST: | |
1977 switch (car(e3)) | |
1978 {case RGVAR: case RLVAR: | |
1979 ldx(e3); | |
1980 indexx(op,cadr(e4)); | |
1981 sextend(byte); | |
1982 return; | |
1983 } | |
1984 default: | |
1985 gexpr(e3); | |
1986 pushd(); | |
1987 gexpr(e4); | |
1988 pulx(); | |
1989 opdx(op); | |
1990 sextend(byte); | |
1991 return; | |
1992 } | |
1993 case PREINC: | |
1994 if ((l = caddr(e2)) == -1 || l == -2) | |
1995 switch (car(e3)) | |
1996 {case GVAR: case LVAR: | |
1997 ldx(e3); | |
1998 predecx(op,l); | |
1999 stx(e3); | |
2000 sextend(byte); | |
2001 return; | |
2002 } | |
2003 break; | |
2004 case POSTINC: | |
2005 if ((l = caddr(e2)) == 1 || l == 2) | |
2006 switch (car(e3)) | |
2007 {case GVAR: case LVAR: | |
2008 ldx(e3); | |
2009 postincx(op,l); | |
2010 stx(e3); | |
2011 sextend(byte); | |
2012 return; | |
2013 } | |
2014 break; | |
2015 } | |
2016 gexpr(e2); | |
2017 tfrdx(); | |
2018 indexx(op,0); | |
2019 sextend(byte); | |
2020 } | |
2021 assign(e1) | |
2022 int e1; | |
2023 {char *op; | |
2024 int e2,e3,e4,e5,l; | |
2025 op = (car(e1) == CASS ? "STB" : "STD"); | |
2026 e3 = cadr(e2 = cadr(e1)); | |
2027 e4 = caddr(e1); | |
2028 switch(car(e2)) | |
2029 {case GVAR: case LVAR: | |
2030 gexpr(e4); | |
2031 index(op,e2); | |
2032 return; | |
2033 case INDIRECT: | |
2034 switch(car(e3)) | |
2035 {case RGVAR: case RLVAR: | |
2036 gexpr(e4); | |
2037 indir(op,e3); | |
2038 return; | |
2039 case ADD: | |
2040 if (car(caddr(e3)) == CONST) | |
2041 switch (car(e5=cadr(e3))) | |
2042 {case RGVAR: case RLVAR: | |
2043 gexpr(e4); | |
2044 ldx(e5); | |
2045 indexx(op,cadr(caddr(e3))); | |
2046 return; | |
2047 } | |
2048 break; | |
2049 case PREINC: | |
2050 if ((l = caddr(e3)) == -1 || l == -2) | |
2051 switch (car(e5=cadr(e3))) | |
2052 {case GVAR: case LVAR: | |
2053 gexpr(e4); | |
2054 ldx(e5); | |
2055 predecx(op,l); | |
2056 stx(e5); | |
2057 return; | |
2058 } | |
2059 break; | |
2060 case POSTINC: | |
2061 if ((l = caddr(e3)) == 1 || l == 2) | |
2062 switch (car(e5=cadr(e3))) | |
2063 {case GVAR: case LVAR: | |
2064 gexpr(e4); | |
2065 ldx(e5); | |
2066 postincx(op,l); | |
2067 stx(e5); | |
2068 return; | |
2069 } | |
2070 break; | |
2071 } | |
2072 } | |
2073 switch (car(e4)) | |
2074 {case RGVAR: case CRGVAR: case RLVAR: case CRLVAR: case CONST: | |
2075 gexpr(e2); | |
2076 gexpr(e4); | |
2077 break; | |
2078 default: | |
2079 gexpr(e4); | |
2080 pushd(); | |
2081 gexpr(e2); | |
2082 pulld(); | |
2083 } | |
2084 indexx(op,0); | |
2085 return; | |
2086 } | |
2087 assop(e1) | |
2088 int e1; | |
2089 {int e2,e3,byte,op; | |
2090 char *ldop,*stop; | |
2091 ldop = ((byte = (car(e1) == CASSOP)) ? "LDB" : "LDD"); | |
2092 stop = (byte ? "STB" : "STD"); | |
2093 e2 = cadr(e1); | |
2094 e3 = caddr(e1); | |
2095 op = cadddr(e1); | |
2096 switch (car(e2)) | |
2097 {case GVAR: case LVAR: | |
2098 switch (car(e3)) | |
2099 {case RGVAR: case RLVAR: case CONST: | |
2100 if (simpop(op)) | |
2101 { index(ldop,e2); | |
2102 sextend(byte); | |
2103 oprt(op,e3); | |
2104 index(stop,e2); | |
2105 return; | |
2106 } | |
2107 default: | |
2108 gexpr(e3); | |
2109 pushd(); | |
2110 index(ldop,e2); | |
2111 sextend(byte); | |
2112 tosop(op); | |
2113 index(stop,e2); | |
2114 return; | |
2115 } | |
2116 default: | |
2117 switch (car(e3)) | |
2118 {case RGVAR: case RLVAR: case CONST: | |
2119 if (simpop(op)) | |
2120 { gexpr(e2); | |
2121 indexx(ldop,0); | |
2122 sextend(byte); | |
2123 oprt(op,e3); | |
2124 indexx(stop,0); | |
2125 return; | |
2126 } | |
2127 default: | |
2128 gexpr(e3); | |
2129 pushd(); | |
2130 gexpr(e2); | |
2131 indexx(ldop,0); | |
2132 sextend(byte); | |
2133 tosop(op); | |
2134 indexx(stop,0); | |
2135 return; | |
2136 } | |
2137 } | |
2138 } | |
2139 simpop(op) | |
2140 int op; | |
2141 { return (op == ADD || op == SUB || | |
2142 op == BAND || op == EOR || op == BOR); | |
2143 } | |
2144 oprt(op,e1) | |
2145 int op,e1; | |
2146 {int e2; | |
2147 e2 = cadr(e1); | |
2148 switch (car(e1)) | |
2149 {case RGVAR: | |
2150 oprt1(op,"Y",e2); | |
2151 return; | |
2152 case RLVAR: | |
2153 oprt1(op,"U",e2); | |
2154 return; | |
2155 case CONST: | |
2156 oprtc(op,e2); | |
2157 return; | |
2158 } | |
2159 } | |
2160 oprt1(op,index,n) | |
2161 int op,n; | |
2162 char *index; | |
2163 { switch (op) | |
2164 {case ADD: | |
2165 printf("\tADDD\t%d,%s\n",n,index); | |
2166 return; | |
2167 case SUB: | |
2168 printf("\tSUBD\t%d,%s\n",n,index); | |
2169 return; | |
2170 case BAND: case EOR: case BOR: | |
2171 dualop(op,index,n); | |
2172 return; | |
2173 } | |
2174 } | |
2175 dualop(op,index,n) | |
2176 int op; | |
2177 char *index; | |
2178 int n; | |
2179 {char *ops; | |
2180 ops = ((op == BAND) ? "AND" : | |
2181 (op == EOR) ? "EOR" : | |
2182 (op == BOR) ? "OR" : (char *)DEBUG); | |
2183 printf("\t%sA\t%d,%s\n\t%sB\t%d+1,%s\n",ops,n,index,ops,n,index); | |
2184 } | |
2185 | |
2186 oprtc(op,n) | |
2187 int op,n; | |
2188 { switch (op) | |
2189 {case ADD: | |
2190 adddim(n); | |
2191 return; | |
2192 case SUB: | |
2193 subdim(n); | |
2194 return; | |
2195 case BAND: case EOR: case BOR: | |
2196 dualc(op,n); | |
2197 return; | |
2198 } | |
2199 } | |
2200 dualc(op,n) | |
2201 int op; | |
2202 int n; | |
2203 {char *ops; | |
2204 ops = ((op == BAND) ? "AND" : | |
2205 (op == EOR) ? "EOR" : | |
2206 (op == BOR) ? "OR" : (char *)DEBUG); | |
2207 printf("\t%sA\t#%d\n\t%sB\t#%d\n",ops,(n >> 8) & 0xff,ops,n & 0xff); | |
2208 } | |
2209 tosop(op) | |
2210 int op; | |
2211 { switch (op) | |
2212 {case ADD: | |
2213 addds(); | |
2214 return; | |
2215 case SUB: | |
2216 subds(); | |
2217 return; | |
2218 case BAND: case EOR: case BOR: | |
2219 dualtosop(op); | |
2220 return; | |
2221 default: | |
2222 pulx(); | |
2223 library(op); | |
2224 } | |
2225 } | |
2226 dualtosop(op) | |
2227 int op; | |
2228 {char *ops; | |
2229 ops = ((op == BAND) ? "AND" : | |
2230 (op == EOR) ? "EOR" : | |
2231 (op == BOR) ? "OR" : (char *)DEBUG); | |
2232 printf("\t%sA\t,S+\n\t%sB\t,S+\n",ops,ops); | |
2233 } | |
2234 pushd() | |
2235 { printf("\tPSHS\tD\n"); | |
2236 } | |
2237 pushx() | |
2238 { printf("\tPSHS\tX\n"); | |
2239 } | |
2240 pulld() | |
2241 { printf("\tPULS\tD\n"); | |
2242 } | |
2243 pulx() | |
2244 { printf("\tPULS\tX\n"); | |
2245 } | |
2246 tfrdx() | |
2247 { printf("\tTFR\tD,X\n"); | |
2248 } | |
2249 tfrxd() | |
2250 { printf("\tTFR\tX,D\n"); | |
2251 } | |
2252 /* | |
2253 exgdx() | |
2254 { printf("\tEXG\tD,X\n"); | |
2255 } | |
2256 */ | |
2257 asld() | |
2258 { printf("\tASLB\n\tROLA\n"); | |
2259 } | |
2260 adddim(n) | |
2261 { printf("\tADDD\t#%d\n",n); | |
2262 } | |
2263 subdim(n) | |
2264 { printf("\tSUBD\t#%d\n",n); | |
2265 } | |
2266 cmpdimm(n) | |
2267 int n; | |
2268 { printf("\tCMPD\t#%d\n",n); | |
2269 } | |
2270 addds() | |
2271 { printf("\tADDD\t,S++\n"); | |
2272 } | |
2273 subds() | |
2274 { printf("\tSUBD\t,S++\n"); | |
2275 } | |
2276 clrd() | |
2277 { printf("\tCLRA\n\tCLRB\n"); | |
2278 } | |
2279 lddim(n) | |
2280 int n; | |
2281 { printf("\tLDD\t#%d\n",n); | |
2282 } | |
2283 | |
2284 ldd(e) | |
2285 int e; | |
2286 { switch (car(e)) | |
2287 {case GVAR: | |
2288 lddy(cadr(e)); | |
2289 return; | |
2290 case LVAR: | |
2291 lddu(cadr(e)); | |
2292 return; | |
2293 default: | |
2294 DEBUG; | |
2295 } | |
2296 } | |
2297 | |
2298 lddx() | |
2299 { printf("\tLDD\t,X\n"); | |
2300 } | |
2301 lddy(n) | |
2302 int n; | |
2303 { printf("\tLDD\t%d,Y\n",n); | |
2304 } | |
2305 lddu(n) | |
2306 int n; | |
2307 { printf("\tLDD\t%d,U\n",n); | |
2308 } | |
2309 | |
2310 std(e) | |
2311 int e; | |
2312 { switch (car(e)) | |
2313 {case GVAR: | |
2314 stdy(cadr(e)); | |
2315 return; | |
2316 case LVAR: | |
2317 stdu(cadr(e)); | |
2318 return; | |
2319 default: | |
2320 DEBUG; | |
2321 } | |
2322 } | |
2323 stdx() | |
2324 { printf("\tSTD\t,X\n"); | |
2325 } | |
2326 stdy(n) | |
2327 int n; | |
2328 { printf("\tSTD\t%d,Y\n",n); | |
2329 } | |
2330 stdu(n) | |
2331 int n; | |
2332 { printf("\tSTD\t%d,U\n",n); | |
2333 } | |
2334 | |
2335 ldbx() | |
2336 { printf("\tLDB\t,X\n"); | |
2337 } | |
2338 /* | |
2339 stbx() | |
2340 { printf("\tSTB\t,X\n"); | |
2341 } | |
2342 */ | |
2343 ldby(n) | |
2344 int n; | |
2345 { printf("\tLDB\t%d,Y\n",n); | |
2346 } | |
2347 ldbu(n) | |
2348 int n; | |
2349 { printf("\tLDB\t%d,U\n",n); | |
2350 } | |
2351 predecx(op,l) | |
2352 char *op; | |
2353 int l; | |
2354 { printf("\t%s\t,%sX\n",op,(l == -1 ? "-" : "--")); | |
2355 } | |
2356 postincx(op,l) | |
2357 char *op; | |
2358 int l; | |
2359 { printf("\t%s\t,X%s\n",op,(l == 1 ? "+" : "++")); | |
2360 } | |
2361 leaxy(n) | |
2362 int n; | |
2363 { printf("\tLEAX\t%d,Y\n",n); | |
2364 } | |
2365 leaxu(n) | |
2366 int n; | |
2367 { printf("\tLEAX\t%d,U\n",n); | |
2368 } | |
2369 leaxpcr(n) | |
2370 NMTBL *n; | |
2371 { printf("\tLEAX\t%s,PCR\n",n->nm); | |
2372 } | |
2373 | |
2374 ldx(e) | |
2375 int e; | |
2376 { switch (car(e)) | |
2377 {case GVAR: case RGVAR: | |
2378 ldxy(cadr(e)); | |
2379 return; | |
2380 case LVAR: case RLVAR: | |
2381 ldxu(cadr(e)); | |
2382 return; | |
2383 default: | |
2384 DEBUG; | |
2385 } | |
2386 } | |
2387 | |
2388 ldxy(n) | |
2389 int n; | |
2390 { printf("\tLDX\t%d,Y\n",n); | |
2391 } | |
2392 ldxu(n) | |
2393 int n; | |
2394 { printf("\tLDX\t%d,U\n",n); | |
2395 } | |
2396 /* | |
2397 ldxi(n) | |
2398 int n; | |
2399 { printf("\tLDX\t#%d\n",n); | |
2400 } | |
2401 */ | |
2402 stx(e) | |
2403 int e; | |
2404 { switch (car(e)) | |
2405 {case GVAR: | |
2406 stxy(cadr(e)); | |
2407 return; | |
2408 case LVAR: | |
2409 stxu(cadr(e)); | |
2410 return; | |
2411 default: | |
2412 DEBUG; | |
2413 } | |
2414 } | |
2415 | |
2416 stxy(n) | |
2417 int n; | |
2418 { printf("\tSTX\t%d,Y\n",n); | |
2419 } | |
2420 stxu(n) | |
2421 int n; | |
2422 { printf("\tSTX\t%d,U\n",n); | |
2423 } | |
2424 | |
2425 sex() | |
2426 { printf("\tSEX\n"); | |
2427 } | |
2428 incx() | |
2429 { printf("\tINC\t,X\n"); | |
2430 } | |
2431 decx() | |
2432 { printf("\tDEC\t,X\n"); | |
2433 } | |
2434 opdx(op) | |
2435 char *op; | |
2436 { printf("\t%s\tD,X\n",op); | |
2437 } | |
2438 indexx(op,n) | |
2439 char *op; | |
2440 int n; | |
2441 { printf("\t%s\t%d,X\n",op,n); | |
2442 } | |
2443 | |
2444 index(op,e) | |
2445 char *op; | |
2446 int e; | |
2447 { switch (car(e)) | |
2448 {case GVAR: | |
2449 indexy(op,cadr(e)); | |
2450 return; | |
2451 case LVAR: | |
2452 indexu(op,cadr(e)); | |
2453 return; | |
2454 default: | |
2455 DEBUG; | |
2456 } | |
2457 } | |
2458 | |
2459 indexy(op,n) | |
2460 char *op; | |
2461 int n; | |
2462 { printf("\t%s\t%d,Y\n",op,n); | |
2463 } | |
2464 indexu(op,n) | |
2465 char *op; | |
2466 int n; | |
2467 { printf("\t%s\t%d,U\n",op,n); | |
2468 } | |
2469 | |
2470 | |
2471 indir(op,e) | |
2472 char *op; | |
2473 int e; | |
2474 { switch (car(e)) | |
2475 {case RGVAR: | |
2476 indiry(op,cadr(e)); | |
2477 return; | |
2478 case RLVAR: | |
2479 indiru(op,cadr(e)); | |
2480 return; | |
2481 default: | |
2482 DEBUG; | |
2483 } | |
2484 } | |
2485 | |
2486 indiry(op,n) | |
2487 char *op; | |
2488 int n; | |
2489 { printf("\t%s\t[%d,Y]\n",op,n); | |
2490 } | |
2491 indiru(op,n) | |
2492 char *op; | |
2493 int n; | |
2494 { printf("\t%s\t[%d,U]\n",op,n); | |
2495 } | |
2496 sextend(byte) | |
2497 int byte; | |
2498 { if (byte) sex(); | |
2499 } | |
2500 binexpr(e1) | |
2501 int e1; | |
2502 { gexpr(caddr(e1)); | |
2503 pushd(); | |
2504 gexpr(cadr(e1)); | |
2505 pulx(); | |
2506 library(car(e1)); | |
2507 } | |
2508 library(op) | |
2509 int op; | |
2510 { printf("\tLBSR\t_0000%d\n", | |
2511 ((op == MUL || op == UMUL) ? 1 : | |
2512 (op == DIV) ? 2 : | |
2513 (op == UDIV) ? 3 : | |
2514 (op == MOD) ? 4 : | |
2515 (op == UMOD) ? 5 : | |
2516 (op == LSHIFT) ? 6 : | |
2517 (op == ULSHIFT) ? 7 : | |
2518 (op == RSHIFT) ? 8 : | |
2519 (op == URSHIFT) ? 9 : DEBUG)); | |
2520 } | |
2521 cexpr(e) | |
2522 int e; | |
2523 { if (car(e) != CONST) error(CNERR); | |
2524 return (cadr(e)); | |
2525 } | |
2526 | |
2527 getsym() | |
2528 {NMTBL *nptr0,*nptr1; | |
2529 int i; | |
2530 char c; | |
2531 if (alpha(skipspc())) | |
2532 { i = hash = 0; | |
2533 while (alpha(ch) || digit(ch)) | |
2534 { if (i <= 7) hash=7*(hash+(name[i++]=ch)); | |
2535 getch(); | |
2536 } | |
2537 name[i] = '\0'; | |
2538 nptr0 = gsearch(); | |
2539 if (nptr0->sc == RESERVE) return sym = nptr0->dsp; | |
2540 if (nptr0->sc == MACRO && !mflag) | |
2541 { mflag++; | |
2542 chsave = ch; | |
2543 chptrsave = chptr; | |
2544 chptr = (char *)nptr0->dsp; | |
2545 getch(); | |
2546 return getsym(); | |
2547 } | |
2548 sym = IDENT; | |
2549 gnptr=nptr=nptr0; | |
2550 if (mode==GDECL || mode==GSDECL || mode==GUDECL || | |
2551 mode==GTDECL || mode==TOP) | |
2552 return sym; | |
2553 nptr1=lsearch(); | |
2554 if (mode==STAT) | |
2555 if (nptr1->sc == EMPTY) return sym; | |
2556 else { nptr=nptr1; return sym;} | |
2557 nptr=nptr1; | |
2558 return sym; | |
2559 } | |
2560 else if (digit(ch)) | |
2561 { symval=0; | |
2562 if (ch == '0') | |
2563 { if (getch() == 'x' || ch == 'X') | |
2564 while(1) | |
2565 if(digit(getch())) | |
2566 symval=symval*16+ch-'0'; | |
2567 else if('a'<=ch&&ch<='f') | |
2568 symval=symval*16+ch-'a'+10; | |
2569 else if('A'<=ch&&ch<='F') | |
2570 symval=symval*16+ch-'A'+10; | |
2571 else break; | |
2572 else while (digit(ch)) {symval=symval*8+ch-'0';getch();} | |
2573 } | |
2574 else while(digit(ch)) {symval=symval*10+ch-'0';getch();} | |
2575 return sym=CONST; | |
2576 } | |
2577 else if(ch=='\'') | |
2578 { getch(); | |
2579 symval=escape(); | |
2580 if(ch!='\'') error(CHERR); | |
2581 getch(); | |
2582 return sym=CONST; | |
2583 } | |
2584 else if(ch=='"') | |
2585 { getstring(); | |
2586 return sym= STRING; | |
2587 } | |
2588 c=ch; | |
2589 getch(); | |
2590 switch(c) | |
2591 {case '*': | |
2592 return postequ(MUL,MUL+AS); | |
2593 case '&': | |
2594 if(ch=='&') {getch();return sym=LAND;} | |
2595 return postequ(BAND,BAND+AS); | |
2596 case '-': | |
2597 if(ch=='>') {getch();return sym=ARROW;} | |
2598 if(ch=='-') {getch();return sym=DEC;} | |
2599 return postequ(SUB,SUB+AS); | |
2600 case '!': | |
2601 return postequ(LNOT,NEQ); | |
2602 case '~': | |
2603 return sym=BNOT; | |
2604 case '+': | |
2605 if(ch=='+') {getch();return sym=INC;} | |
2606 return postequ(ADD,ADD+AS); | |
2607 case '%': | |
2608 return postequ(MOD,MOD+AS); | |
2609 case '^': | |
2610 return postequ(EOR,EOR+AS); | |
2611 case '|': | |
2612 if(ch=='|') {getch();return sym=LOR;} | |
2613 return postequ(BOR,BOR+AS); | |
2614 case '=': | |
2615 return postequ(ASS,EQ); | |
2616 case '>': | |
2617 if(ch=='>') {getch();return postequ(RSHIFT,RSHIFT+AS);} | |
2618 return postequ(GT,GE); | |
2619 case '<': | |
2620 if(ch=='<') {getch();return postequ(LSHIFT,LSHIFT+AS);} | |
2621 return postequ(LT,LE); | |
2622 case '(': | |
2623 return sym=LPAR; | |
2624 case ')': | |
2625 return sym=RPAR; | |
2626 case '[': | |
2627 return sym=LBRA; | |
2628 case ']': | |
2629 return sym=RBRA; | |
2630 case '{': | |
2631 return sym=LC; | |
2632 case '}': | |
2633 return sym=RC; | |
2634 case ',': | |
2635 return sym=COMMA; | |
2636 case ';': | |
2637 return sym=SM; | |
2638 case ':': | |
2639 return sym=COLON; | |
2640 case '?': | |
2641 return sym=COND; | |
2642 case '.': | |
2643 return sym=PERIOD; | |
2644 case '/': | |
2645 if(ch!='*') return postequ(DIV,DIV+AS); | |
2646 getch(); | |
2647 while(ch=='*'?getch()!='/':getch()); | |
2648 getch(); | |
2649 return getsym(); | |
2650 default: | |
2651 error(CHERR); | |
2652 return getsym(); | |
2653 } | |
2654 } | |
2655 postequ(s1,s2) | |
2656 int s1,s2; | |
2657 { if(ch=='=') {getch();return sym=s2;} | |
2658 return sym=s1; | |
2659 } | |
2660 alpha(c) | |
2661 char c; | |
2662 { return('a'<=c&&c<='z'||'A'<=c&&c<='Z'||c=='_'); | |
2663 } | |
2664 digit(c) | |
2665 char c; | |
2666 { return('0'<=c&&c<='9'); | |
2667 } | |
2668 NMTBL *gsearch() | |
2669 {NMTBL *nptr,*iptr; | |
2670 iptr=nptr= &ntable[hash % GSYMS]; | |
2671 while(nptr->sc!=EMPTY && neqname(nptr->nm)) | |
2672 { if (++nptr== &ntable[GSYMS]) nptr=ntable; | |
2673 if (nptr==iptr) error(GSERR); | |
2674 } | |
2675 if (nptr->sc == EMPTY) copy(nptr->nm); | |
2676 return nptr; | |
2677 } | |
2678 NMTBL *lsearch() | |
2679 {NMTBL *nptr,*iptr; | |
2680 iptr=nptr= &ntable[hash%LSYMS+GSYMS]; | |
2681 while(nptr->sc!=EMPTY && neqname(nptr->nm)) | |
2682 { if (++nptr== &ntable[LSYMS+GSYMS]) nptr= &ntable[GSYMS]; | |
2683 if (nptr==iptr) error(LSERR); | |
2684 } | |
2685 if (nptr->sc == EMPTY) copy(nptr->nm); | |
2686 return nptr; | |
2687 } | |
2688 neqname(p) | |
2689 char *p; | |
2690 {char *q; | |
2691 q=name; | |
2692 while(*p) if(*p++ != *q++) return 1; | |
2693 return *q!=0; | |
2694 } | |
2695 copy(p) | |
2696 char *p; | |
2697 {char *q; | |
2698 q=name; | |
2699 while(*p++= *q++); | |
2700 } | |
2701 getstring() | |
2702 { getch(); | |
2703 symval = 0; | |
2704 sptr = cheapp; | |
2705 while (ch != '"') | |
2706 { *cheapp++ = escape(); | |
2707 symval++; | |
2708 if (cheapp >= cheap+CHEAPSIZE) error(STRERR); | |
2709 } | |
2710 getch(); | |
2711 *cheapp++ = '\0'; | |
2712 symval++; | |
2713 } | |
2714 skipspc() | |
2715 { while(ch=='\t'||ch=='\n'||ch==' '||ch=='\r') getch(); | |
2716 return ch; | |
2717 } | |
2718 getch() | |
2719 { if(*chptr) return ch= *chptr++; | |
2720 if(mflag) {mflag=0;chptr=chptrsave;return ch=chsave;} | |
2721 getline(); | |
2722 return getch(); | |
2723 } | |
2724 char escape() | |
2725 {char c; | |
2726 if ((c=ch) == '\\') | |
2727 { if (digit(c=getch())) | |
2728 { c = ch-'0'; | |
2729 if (digit(getch())) | |
2730 { c = c*8+ch-'0'; | |
2731 if (digit(getch())) {c=c*8+ch-'0';getch();} | |
2732 } | |
2733 return c; | |
2734 } | |
2735 getch(); | |
2736 switch(c) | |
2737 {case 'n': | |
2738 return '\n'; | |
2739 case 't': | |
2740 return '\t'; | |
2741 case 'b': | |
2742 return '\b'; | |
2743 case 'r': | |
2744 return '\r'; | |
2745 case 'f': | |
2746 return '\f'; | |
2747 case '\n': | |
2748 return escape(); | |
2749 default: | |
2750 return c; | |
2751 } | |
2752 } | |
2753 if (c == '\n') error(EXERR); | |
2754 getch(); | |
2755 return c; | |
2756 } | |
2757 FILE *getfname() | |
2758 {int i; | |
2759 char name[14]; | |
2760 getch(); | |
2761 if(skipspc()!='"') error(INCERR); | |
2762 for(i=0;(getch()!='"' && ch!='\n');) | |
2763 if(i<13) name[i++]=ch; | |
2764 if(ch=='\n') error(INCERR); | |
2765 name[i]=0; | |
2766 return ( (filep+1)->fcb = fopen(name,"rc") ); | |
2767 } | |
2768 getline() | |
2769 {int i; | |
2770 int c; | |
2771 lineno++; | |
2772 glineno++; | |
2773 chptr=linebuf; | |
2774 i=0; | |
2775 while ((*chptr++ = c = getc(filep->fcb)) != '\n') | |
2776 { if (++i > LBUFSIZE-2) error(LNERR); | |
2777 if (c==EOF) | |
2778 { error(EOFERR); | |
2779 --chptr; | |
2780 } | |
2781 } | |
2782 *chptr = '\0'; | |
2783 if (lsrc && !asmf) printf("* %s",linebuf); | |
2784 if (*(chptr = linebuf) == '#') | |
2785 { ++chptr; | |
2786 if (macroeq("define")) | |
2787 { i=mode; | |
2788 mode=GDECL; | |
2789 ch= *chptr; | |
2790 if (getsym() == IDENT) | |
2791 { if (nptr->sc == EMPTY) | |
2792 { nptr->sc = MACRO; | |
2793 nptr->dsp = (int)cheapp; | |
2794 while ((*cheapp++ = c = *chptr++) | |
2795 && c != '\n'); | |
2796 *cheapp++ = '\0'; | |
2797 if (cheapp >= cheap+CHEAPSIZE) | |
2798 error(STRERR); | |
2799 if (!c) error(EOFERR); | |
2800 } | |
2801 else error(MCERR); | |
2802 } | |
2803 else error(MCERR); | |
2804 mode=i; | |
2805 *(chptr = linebuf) = '\0'; | |
2806 } | |
2807 else if (macroeq("include")) | |
2808 { fprintf(stderr,"%s",linebuf); | |
2809 if(filep+1 >= filestack + FILES) error(FILERR); | |
2810 if ( ((filep+1)->fcb=getfname()) == NULL) error(FILERR); | |
2811 (filep+1)->ln=lineno; | |
2812 lineno=0; | |
2813 ++filep; | |
2814 *(chptr = linebuf) = '\0'; | |
2815 } | |
106 | 2816 else if (macroeq("asm")) |
2817 { if (asmf) error(MCERR); | |
2818 asmf = 2; lineno--; glineno--; | |
2819 chptr = ";;"; | |
2820 } | |
99 | 2821 else if (macroeq("endasm")) |
2822 { if (!asmf) error(MCERR); | |
2823 asmf = 0; | |
2824 } | |
2825 else if (macroeq(" ")) | |
2826 getline(); | |
2827 else error(MCERR); | |
2828 } | |
106 | 2829 if (asmf==2) asmf=1; /* return ";" to get correct macro alignment */ |
2830 else if (asmf==1) { | |
2831 while (asmf) | |
2832 { printf("%s",linebuf); | |
2833 getline(); | |
2834 } | |
2835 } | |
2836 | |
99 | 2837 } |
2838 | |
2839 macroeq(s) | |
2840 char *s; | |
2841 {char *p; | |
2842 for (p = chptr; *s;) if (*s++ != *p++) return 0; | |
2843 chptr = p; | |
2844 return 1; | |
2845 } | |
2846 | |
2847 car(e) | |
2848 int e; | |
2849 { return heap[e]; | |
2850 } | |
2851 cadr(e) | |
2852 int e; | |
2853 { return heap[e+1]; | |
2854 } | |
2855 caddr(e) | |
2856 int e; | |
2857 { return heap[e+2]; | |
2858 } | |
2859 cadddr(e) | |
2860 int e; | |
2861 { return heap[e+3]; | |
2862 } | |
2863 list2(e1,e2) | |
2864 int e1,e2; | |
2865 {int e; | |
2866 e=getfree(2); | |
2867 heap[e]=e1; | |
2868 heap[e+1]=e2; | |
2869 return e; | |
2870 } | |
2871 list3(e1,e2,e3) | |
2872 int e1,e2,e3; | |
2873 {int e; | |
2874 e=getfree(3); | |
2875 heap[e]=e1; | |
2876 heap[e+1]=e2; | |
2877 heap[e+2]=e3; | |
2878 return e; | |
2879 } | |
2880 list4(e1,e2,e3,e4) | |
2881 int e1,e2,e3,e4; | |
2882 {int e; | |
2883 e=getfree(4); | |
2884 heap[e]=e1; | |
2885 heap[e+1]=e2; | |
2886 heap[e+2]=e3; | |
2887 heap[e+3]=e4; | |
2888 return e; | |
2889 } | |
2890 getfree(n) | |
2891 int n; | |
2892 {int e; | |
2893 switch (mode) | |
2894 {case GDECL: case GSDECL: case GUDECL: case GTDECL: | |
2895 e=gfree; | |
2896 gfree+=n; | |
2897 break; | |
2898 default: | |
2899 lfree-=n; | |
2900 e=lfree; | |
2901 } | |
2902 if(lfree<gfree) error(HPERR); | |
2903 return e; | |
2904 } | |
2905 rplacad(e,n) | |
2906 int e,n; | |
2907 { heap[e+1]=n; | |
2908 return e; | |
2909 } |