source: vital-to8-sdk/mc09/src/mc2.c @ 1

Last change on this file since 1 was 1, checked in by svn, 5 years ago

Import initial

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