source: vital-to8-sdk/mc09/src/mc.c

Last change on this file was 1, checked in by svn, 8 months ago

Import initial

File size: 47.5 KB
Line 
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
156int sym,ch,chsave,type,mode,gfree,lfree,mflag,lineno,glineno;
157int labelno,gpc,lvar,disp;
158int symval,args,heap[HEAPSIZE];
159int blabel,clabel,dlabel,cslabel,ilabel,control,ac,ac2,lsrc,chk,asmf;
160
161unsigned hash;
162
163char linebuf[LBUFSIZE],cheap[CHEAPSIZE],*chptr,*chptrsave;
164char name[9],*cheapp,**av,/*obuf[320],*/*sptr,escape();
165
166FILE *obuf;
167
168typedef struct nametable {
169        char nm[9];
170        int sc,ty,dsp; } NMTBL;
171
172NMTBL ntable[GSYMS+LSYMS],*nptr,*gnptr,*decl0(),*decl1(),*lsearch(),*gsearch();
173
174struct {int fd,ln;/*char fcb[320]*/FILE *fcb;} *filep,filestack[FILES];
175
176main(argc,argv)
177int argc;
178char **argv;
179{NMTBL *nptr;
180int i;
181char *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}
216error(n)
217int 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}
264errmsg()
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}
273checksym(s)
274int 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}
285init()
286{NMTBL *nptr;
287int 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        mc_getline();
320        getch();
321}
322newfile()
323{       lineno=0;
324        fprintf(stderr,"%s:\n",av[ac2]);
325        if ( (filep->fcb = fopen(av[ac2++],"r")) == NULL ) error(FILERR);
326}
327reserve(s,d)
328char *s;
329int d;
330{NMTBL *nptr;
331char *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
339decl()
340{NMTBL *n;
341int 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}
377typespec()
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}
418struct 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}
428NMTBL *decl1()
429{NMTBL *n;
430int 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}
468adecl()
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}
484reverse(t1)
485int 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}
496size(t)
497int 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}
508def(n)
509NMTBL *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}
596sdecl(s)
597int s;
598{int smode,sdisp,type;
599NMTBL *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}
633fdecl(n)
634NMTBL *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}
654fcheck(n)
655NMTBL *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}
662compatible(t1,t2)
663int 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}
673scalar(t)
674int t;
675{       return(integral(t)||car(t)==POINTER);
676}
677integral(t)
678int t;
679{       return(t==INT||t==CHAR||t==UNSIGNED);
680}
681
682statement()
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}
742doif()
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}
760dowhile()
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}
786dodo()
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}
807dofor()
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}
847doswitch()
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}
869docomp()
870{       getsym();
871        while(sym!=RC) statement();
872        getsym();
873}
874docase()
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}
903dodefault()
904{       getsym();
905        checksym(COLON);
906        if (dlabel) error(STERR);
907        if (!cslabel) jmp(cslabel = fwdlabel());
908        dlabel = backdef();
909}
910doreturn()
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}
933return2()
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}
955ret(reg)
956char *reg;
957{       printf("\tPULS\t%sU,PC\n",reg);
958}
959unlink()
960{       printf("\tLEAS\t,U\n");
961        ret("");
962}
963dogoto()
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}
976dolabel()
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
985expr()
986{       return(rvalue(expr0()));
987}
988expr0()
989{int e;
990        e=expr1();
991        while(sym==COMMA) {getsym();e=list3(COMMA,e,rvalue(expr1()));}
992        return e;
993}
994expr1()
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}
1031expr2()
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}
1049expr3()
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}
1060expr4()
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}
1071expr5()
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}
1083expr6()
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}
1095expr7()
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}
1107expr8()
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}
1118expr9()
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}
1132expr10()
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}
1144expr11()
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}
1156expr12()
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}
1168expr13()
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}
1256expr14()
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}
1312expr16(e1)
1313int 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}
1332rvalue(e)
1333int 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}
1363lcheck(e)
1364int e;
1365{       if(!scalar(type)||car(e)!=GVAR&&car(e)!=LVAR&&car(e)!=INDIRECT)
1366                error(LVERR);
1367}
1368indop(e)
1369int 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}
1377strop(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}
1398binop(op,e1,e2,t1,t2)
1399int 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}
1499expr15(e1)
1500int 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}
1517typeid(s)
1518int s;
1519{       return (integral(s) || s==SHORT || s==LONG || s==STRUCT || s==UNION ||
1520                (s==IDENT && nptr->sc==TYPE));
1521}
1522typename()
1523{int t;
1524        type=t=typespec();
1525        ndecl0();
1526        reverse(t);
1527        return type;
1528}
1529ndecl0()
1530{       if(sym==MUL)
1531        {       getsym();
1532                return type=list2(POINTER,ndecl0());
1533        }
1534        return ndecl1();
1535}
1536ndecl1()
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
1560bexpr(e1,cond,l1)
1561int e1,l1;
1562char 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}
1633rexpr(e1,l1,s)
1634int e1,l1;
1635char *s;
1636{       gexpr(list3(SUB,cadr(e1),caddr(e1)));
1637        printf("\tLB%s\t_%d\n",s,l1);
1638}
1639jcond(l,cond)
1640int l;
1641char cond;
1642{       printf("\tLB%s\t_%d\n",cond?"NE":"EQ",l);
1643}
1644jmp(l)
1645int l;
1646{       control=0;
1647        printf("\tLBRA\t_%d\n",l);
1648}
1649fwdlabel()
1650{       return labelno++;
1651}
1652fwddef(l)
1653int l;
1654{       control=1;
1655        printf("_%d\n",l);
1656}
1657backdef()
1658{       control=1;
1659        printf("_%d\n",labelno);
1660        return labelno++;
1661}
1662
1663gexpr(e1)
1664int 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}
1847string(e1)
1848int e1;
1849{char *s;
1850int 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}
1865function(e1)
1866int e1;
1867{int e2,e3,e4,e5,nargs;
1868NMTBL *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}
1897indirect(e1)
1898int 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
1925machinop(e1)
1926int 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
1943rindirect(e1)
1944int e1;
1945{char *op;
1946int 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}
2014assign(e1)
2015int e1;
2016{char *op;
2017int 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}
2080assop(e1)
2081int e1;
2082{int e2,e3,byte,op;
2083char *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}
2132simpop(op)
2133int op;
2134{       return (op == ADD || op == SUB ||
2135                op == BAND || op == EOR || op == BOR);
2136}
2137oprt(op,e1)
2138int 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}
2153oprt1(op,index,n)
2154int op,n;
2155char *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}
2168dualop(op,index,n)
2169int op;
2170char *index;
2171int 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
2179oprtc(op,n)
2180int 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}
2193dualc(op,n)
2194int op;
2195int 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}
2202tosop(op)
2203int 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}
2219dualtosop(op)
2220int 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}
2227pushd()
2228{       printf("\tPSHS\tD\n");
2229}
2230pushx()
2231{       printf("\tPSHS\tX\n");
2232}
2233pulld()
2234{       printf("\tPULS\tD\n");
2235}
2236pulx()
2237{       printf("\tPULS\tX\n");
2238}
2239tfrdx()
2240{       printf("\tTFR\tD,X\n");
2241}
2242tfrxd()
2243{       printf("\tTFR\tX,D\n");
2244}
2245/*
2246exgdx()
2247{       printf("\tEXG\tD,X\n");
2248}
2249*/
2250asld()
2251{       printf("\tASLB\n\tROLA\n");
2252}
2253adddim(n)
2254{       printf("\tADDD\t#%d\n",n);
2255}
2256subdim(n)
2257{       printf("\tSUBD\t#%d\n",n);
2258}
2259cmpdimm(n)
2260int n;
2261{       printf("\tCMPD\t#%d\n",n);
2262}
2263addds()
2264{       printf("\tADDD\t,S++\n");
2265}
2266subds()
2267{       printf("\tSUBD\t,S++\n");
2268}
2269clrd()
2270{       printf("\tCLRA\n\tCLRB\n");
2271}
2272lddim(n)
2273int n;
2274{       printf("\tLDD\t#%d\n",n);
2275}
2276
2277ldd(e)
2278int 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
2291lddx()
2292{       printf("\tLDD\t,X\n");
2293}
2294lddy(n)
2295int n;
2296{       printf("\tLDD\t%d,Y\n",n);
2297}
2298lddu(n)
2299int n;
2300{       printf("\tLDD\t%d,U\n",n);
2301}
2302
2303std(e)
2304int 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}
2316stdx()
2317{       printf("\tSTD\t,X\n");
2318}
2319stdy(n)
2320int n;
2321{       printf("\tSTD\t%d,Y\n",n);
2322}
2323stdu(n)
2324int n;
2325{       printf("\tSTD\t%d,U\n",n);
2326}
2327
2328ldbx()
2329{       printf("\tLDB\t,X\n");
2330}
2331/*
2332stbx()
2333{       printf("\tSTB\t,X\n");
2334}
2335*/
2336ldby(n)
2337int n;
2338{       printf("\tLDB\t%d,Y\n",n);
2339}
2340ldbu(n)
2341int n;
2342{       printf("\tLDB\t%d,U\n",n);
2343}
2344predecx(op,l)
2345char *op;
2346int l;
2347{       printf("\t%s\t,%sX\n",op,(l == -1 ? "-" : "--"));
2348}
2349postincx(op,l)
2350char *op;
2351int l;
2352{       printf("\t%s\t,X%s\n",op,(l == 1 ? "+" : "++"));
2353}
2354leaxy(n)
2355int n;
2356{       printf("\tLEAX\t%d,Y\n",n);
2357}
2358leaxu(n)
2359int n;
2360{       printf("\tLEAX\t%d,U\n",n);
2361}
2362leaxpcr(n)
2363NMTBL *n;
2364{       printf("\tLEAX\t%s,PCR\n",n->nm);
2365}
2366
2367ldx(e)
2368int 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
2381ldxy(n)
2382int n;
2383{       printf("\tLDX\t%d,Y\n",n);
2384}
2385ldxu(n)
2386int n;
2387{       printf("\tLDX\t%d,U\n",n);
2388}
2389/*
2390ldxi(n)
2391int n;
2392{       printf("\tLDX\t#%d\n",n);
2393}
2394*/
2395stx(e)
2396int 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
2409stxy(n)
2410int n;
2411{       printf("\tSTX\t%d,Y\n",n);
2412}
2413stxu(n)
2414int n;
2415{       printf("\tSTX\t%d,U\n",n);
2416}
2417
2418sex()
2419{       printf("\tSEX\n");
2420}
2421incx()
2422{       printf("\tINC\t,X\n");
2423}
2424decx()
2425{       printf("\tDEC\t,X\n");
2426}
2427opdx(op)
2428char *op;
2429{       printf("\t%s\tD,X\n",op);
2430}
2431indexx(op,n)
2432char *op;
2433int n;
2434{       printf("\t%s\t%d,X\n",op,n);
2435}
2436
2437index(op,e)
2438char *op;
2439int 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
2452indexy(op,n)
2453char *op;
2454int n;
2455{       printf("\t%s\t%d,Y\n",op,n);
2456}
2457indexu(op,n)
2458char *op;
2459int n;
2460{       printf("\t%s\t%d,U\n",op,n);
2461}
2462
2463
2464indir(op,e)
2465char *op;
2466int 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
2479indiry(op,n)
2480char *op;
2481int n;
2482{       printf("\t%s\t[%d,Y]\n",op,n);
2483}
2484indiru(op,n)
2485char *op;
2486int n;
2487{       printf("\t%s\t[%d,U]\n",op,n);
2488}
2489sextend(byte)
2490int byte;
2491{       if (byte) sex();
2492}
2493binexpr(e1)
2494int e1;
2495{       gexpr(caddr(e1));
2496        pushd();
2497        gexpr(cadr(e1));
2498        pulx();
2499        library(car(e1));
2500}
2501library(op)
2502int 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}
2514cexpr(e)
2515int e;
2516{       if (car(e) != CONST) error(CNERR);
2517        return (cadr(e));
2518}
2519
2520getsym()
2521{NMTBL *nptr0,*nptr1;
2522int i;
2523char 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}
2648postequ(s1,s2)
2649int s1,s2;
2650{       if(ch=='=') {getch();return sym=s2;}
2651        return sym=s1;
2652}
2653alpha(c)
2654char c;
2655{       return('a'<=c&&c<='z'||'A'<=c&&c<='Z'||c=='_');
2656}
2657digit(c)
2658char c;
2659{       return('0'<=c&&c<='9');
2660}
2661NMTBL *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}
2671NMTBL *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}
2681neqname(p)
2682char *p;
2683{char *q;
2684        q=name;
2685        while(*p) if(*p++ != *q++) return 1;
2686        return *q!=0;
2687}
2688copy(p)
2689char *p;
2690{char *q;
2691        q=name;
2692        while(*p++= *q++);
2693}
2694getstring()
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}
2707skipspc()
2708{       while(ch=='\t'||ch=='\n'||ch==' '||ch=='\r') getch();
2709        return ch;
2710}
2711getch()
2712{       if(*chptr) return ch= *chptr++;
2713        if(mflag) {mflag=0;chptr=chptrsave;return ch=chsave;}
2714        mc_getline();
2715        return getch();
2716}
2717char 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}
2750FILE *getfname()
2751{int i;
2752char 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}
2761mc_getline(void)
2762{int i;
2763int 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                        mc_getline();
2813                        while (asmf)
2814                        {       printf("%s",linebuf);
2815                                mc_getline();
2816                        }
2817                }
2818                else if (macroeq("endasm"))
2819                {       if (!asmf) error(MCERR);
2820                        asmf = 0;
2821                }
2822                else if (macroeq(" "))
2823                        mc_getline();
2824                else error(MCERR);
2825        }
2826}
2827
2828macroeq(s)
2829char *s;
2830{char *p;
2831        for (p = chptr; *s;) if (*s++ != *p++) return 0;
2832        chptr = p;
2833        return 1;
2834}
2835
2836car(e)
2837int e;
2838{       return heap[e];
2839}
2840cadr(e)
2841int e;
2842{       return heap[e+1];
2843}
2844caddr(e)
2845int e;
2846{       return heap[e+2];
2847}
2848cadddr(e)
2849int e;
2850{       return heap[e+3];
2851}
2852list2(e1,e2)
2853int e1,e2;
2854{int e;
2855        e=getfree(2);
2856        heap[e]=e1;
2857        heap[e+1]=e2;
2858        return e;
2859}
2860list3(e1,e2,e3)
2861int 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}
2869list4(e1,e2,e3,e4)
2870int 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}
2879getfree(n)
2880int 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}
2894rplacad(e,n)
2895int e,n;
2896{       heap[e+1]=n;
2897        return e;
2898}
Note: See TracBrowser for help on using the repository browser.