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

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

Import initial

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