Mercurial > hg > Members > kono > os9 > sbc09

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