Mercurial > hg > Members > kono > os9 > sbc09

comparison os9/mc09/mc.c @ 99:92ed427b7f7d

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