Mercurial > hg > Members > kono > os9 > sbc09

comparison mc09/mc2.c @ 160:1a30cd6e5973

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
move mc09 to top
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Tue, 05 Feb 2019 09:03:07 +0900
parents os9/mc09/mc2.c@c4e909f21b25
children
comparison
equal deleted inserted replaced
159:1d574c5b3383 160:1a30cd6e5973
1
2 #define DEBUG error(-1)
3
4 #include "mclibos9.c"
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
148 #define HEAPSIZE 1000
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;
179 char *ccout,*modname;
180 if(argc==1) exit(1);
181 lsrc = chk = asmf = 0;
182 ccout = "C.OUT";
183 modname = "aout";
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;
194 case 'M': case 'm':
195 modname = av[ac2]+2;
196 break;
197 case 'C': case 'c':
198 chk = 1;
199 break;
200 default:
201 error(OPTION);
202 exit(1);
203 }
204 fclose(stdout);
205 if (!chk) {
206 if ( (obuf = fopen(ccout,"w")) == NULL ) error(FILERR);
207 else {
208 printf("\tmod _eom,_name,_tylg,_atrv,_start,1024\n"); /* os9 module header */
209 printf("_name fcs /%s/\n\tfcb 0\n",modname);
210 }
211 }
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);
245 printf("_GLOBALS\tEQU\t%u\n",gpc);
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)
1861 printf("\tLEAX\t*+5,PCR\n\tBRA\t_%d\n",lb);
1862 else
1863 printf("\tLEAX\t*+6,PCR\n\tLBRA\t_%d\n",lb);
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 }
2816 else if (macroeq("asm"))
2817 { if (asmf) error(MCERR);
2818 asmf = 2; lineno--; glineno--;
2819 chptr = ";;";
2820 }
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 }
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
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 }