home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / editors / mutt / me2s_pl7.zoo / mu_edit2 / mc2 / comp.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-08-26  |  11.8 KB  |  454 lines
  1. /* 
  2.  * comp.c : odds and ends of the compiler
  3.  * Revision History:
  4.  *   3/92 : Changed all the vararg stuff to work with stdargs.
  5.  */
  6.  
  7. /* Copyright 1990, 1991, 1992 Craig Durland
  8.  *   Distributed under the terms of the GNU General Public License.
  9.  *   Distributed "as is", without warranties of any kind, but comments,
  10.  *     suggestions and bug reports are welcome.
  11.  */
  12.  
  13. #include <stdio.h>
  14. #include <os.h>
  15. #include "mc.h"
  16. #include "opcode.h"
  17. #include "mm.h"
  18.  
  19. #ifdef __STDC__
  20.  
  21. #include <stdarg.h>
  22. #define VA_START va_start
  23.  
  24. #else    /* __STDC__ */
  25.  
  26. #include <varargs.h>
  27. #define VA_START(a,b) va_start(a)
  28.  
  29. #endif
  30.  
  31. extern address getpgm(), pgmaddr(), pcaddr();
  32. extern char ebuf[], token[], temp[],
  33.   *pgmname(), *savestr(), *spoof(), *strcpy(), *typename();
  34. extern int btv, xtn, msize, omsize, moders;
  35. extern unsigned int class, vtype(), vctype(), mmtype();
  36. extern int32 atoN();
  37. extern MMDatum *getconst();
  38. extern MuttCmd muttcmds[], modifiers[];
  39. extern oMuttCmd omuttcmds[], *olookup();
  40. extern VBlob *proto_name();
  41.  
  42. int ddone_label = -1;        /* for defun */
  43.  
  44. /* ******************************************************************** */
  45. /* *************** Type Checking ************************************** */
  46. /* ******************************************************************** */
  47.  
  48. static void typerr(msg,type,ap) char *msg; unsigned int type; va_list ap;
  49. {
  50.   register unsigned int t;
  51.  
  52.   spoof(ebuf,"%sexpected %s",msg,typename(type));
  53.   t = va_arg(ap,unsigned int);
  54.   while (type = t)
  55.   {
  56.     t = va_arg(ap,unsigned int);
  57.     strcat(ebuf, t ? ", " : " or ");
  58.     strcat(ebuf,typename(type));
  59.   }
  60.   strcat(ebuf,".");
  61.   moan(ebuf);
  62. }
  63.  
  64.   /* Check to see if class matches any of a list of types.
  65.    * Called:  cmp_types(type,...,0);
  66.    * Returns: 0 (class is UNKNOWN), 1 (class matches), 2 (no match).
  67.    */
  68. static int cmp_types(type, ap) unsigned int type; va_list ap;
  69. {
  70.   if (class == UNKNOWN) return 0;
  71.  
  72.   for (; type; type = va_arg(ap,unsigned int))
  73.   {
  74.     if (class == type ||
  75.         (mmtype(type) == NUMBER && mmtype(class) == NUMBER) ||
  76.         ((class & POINTER) && (type & POINTER)))
  77.     return 1;
  78.   }
  79.   return 2;
  80. }
  81.  
  82.     /* Zero terminated list of ONE type (eg type_check(NUMBER,0)).
  83.      * More than one type will mess things up.
  84.      * Written in this strange way so I can call cmp_types().
  85.      */
  86. /*VARARGS1*/
  87. #ifdef __STDC__
  88. void type_check(unsigned int type, ...)
  89. #else
  90. void type_check(type, va_alist) unsigned int type; va_dcl
  91. #endif
  92. {
  93.   int n;
  94.   va_list ap;
  95.  
  96.   VA_START(ap,type);
  97.   n = cmp_types(type, ap);
  98.  
  99.   switch(n)
  100.   {
  101.     case 0: gonum8(TYPECHECK,mmtype(type)); break;
  102.     case 2: VA_START(ap,type); typerr("Type mismatch: ",type,ap); break;
  103.   }
  104.  
  105.   va_end(ap);
  106.   class = type;
  107. }
  108.  
  109. /*VARARGS2*/
  110. #ifdef __STDC__
  111. void checkit(char *msg, unsigned int type, ...)
  112. #else
  113. void checkit(msg, type, va_alist)
  114.   char *msg; unsigned int type; va_dcl    /* zero terminated list of types */
  115. #endif
  116. {
  117.   char buf[90];
  118.   va_list ap;
  119.  
  120.   VA_START(ap,type);
  121.   if (cmp_types(type, ap) == 2)
  122.   {
  123.     VA_START(ap,type);
  124.     typerr(spoof(buf,"%s: Invalid type: ",msg), type,ap);
  125.   }
  126.   va_end(ap);
  127. }
  128.  
  129.     /* returns TRUE if conditions met */
  130. /*VARARGS1*/
  131. #ifdef __STDC__
  132. gaze_ahead(unsigned int tipe, ...)
  133. #else
  134. gaze_ahead(tipe, va_alist)
  135.   unsigned int tipe; va_dcl        /* zero terminated list of types */
  136. #endif
  137. {
  138.   int t;
  139.   unsigned int type;
  140.   MMDatum *rv;
  141.   va_list ap;
  142.   VBlob *blob;
  143.  
  144.   lookahead();
  145.   if (class == DELIMITER)
  146.     if (*token == '(' || *token == '{') return TRUE;
  147.     else return FALSE;
  148.  
  149.   VA_START(ap,tipe);
  150.   if (class == TOKEN)    /* check for var or const */
  151.   {
  152.     for (type = tipe; type; type = va_arg(ap,unsigned int))
  153.       if (type == TOKEN) goto ok;        /* class == type */
  154.     if (blob = proto_name(token)) class = blob->type;    /* a prototype */
  155.     else
  156.       if ((t = getvar(token)) != -1)        /* local or global var */
  157.         class = vctype(t);
  158.       else
  159.         if (rv = getconst(token)) class = rv->type;    /* constant */
  160.   }
  161.  
  162.   VA_START(ap, tipe);
  163.   if (cmp_types(tipe,ap) == 2)
  164.     { VA_START(ap, tipe); typerr("Invalid type: ",tipe,ap); }
  165.  
  166. ok:
  167.   va_end(ap);
  168.   return TRUE;
  169. }
  170.  
  171. /* ******************************************************************** */
  172. /* ******************************************************************** */
  173. /* ******************************************************************** */
  174.  
  175.     /* Generate the minimum code needed to push an arg of type class */
  176. void pushpush()
  177. {
  178.   switch (class)
  179.   {
  180.     case EMPTY:
  181.     case PUSHEDARGS:    return;        /* nothing to push */
  182.  
  183.     case STRING:
  184. /*    case FCNPTR:    /* ??? am I sure about fcnptr?? */
  185.     case UNKNOWN: genop(PUSHRV); break;
  186.  
  187.     default: genop(SHOVERV);
  188.   }
  189. }
  190.  
  191. void vargs()    /* compile args and push them */
  192. {
  193.   while (TRUE)
  194.   {
  195.     lookahead();
  196.     if (class == DELIMITER)
  197.       if (*token=='(' || *token=='{') { compile(); pushpush(); continue; }
  198.       else
  199.         if (*token == ')') break;
  200.     else bitch("vargs is confused");
  201.     switch (class)
  202.     {
  203.       case STRING:  gostr(RVSTR,token);  genop(SHOVERV); break;
  204.       case NUMBER:  gonumx(atoN(token)); genop(SHOVERV); break;
  205.       case BOOLEAN: gonum8(RVBOOL,btv);  genop(SHOVERV); break;
  206.       case TOKEN:   genvar(token,FALSE); genop(SHOVERV); break;
  207.       default: bitch(spoof(ebuf,"Invalid parameter: %s",token));
  208.     }
  209.     get_token();    /* suck up token we just compiled */
  210.   }
  211. }
  212.  
  213. void opmath(opcode)        /* stuff like (+ 1 2 3) */
  214. {
  215.   compile(); type_check(NUMBER,0);
  216.   do { genop(SHOVERV); compile(); type_check(NUMBER,0); genop(opcode); }
  217.   while (gaze_ahead(NUMBER,0));
  218.   class = NUMBER;
  219. }
  220.  
  221. void opeq(opcode)    /* stuff like (+= var 1 2 3) */
  222. {
  223.   int t, scope, offset = 0;
  224.   unsigned int type = 0;
  225.  
  226.   get_token();
  227.   if (class != TOKEN)
  228.   {
  229.     spoof(ebuf,"%s is not a var name.",token);
  230.     if (class == DELIMITER) bitch(ebuf); else moan(ebuf);
  231.   }
  232.   else
  233.     if ((t = getvar(token)) == -1)
  234.       moan(spoof(ebuf,"Var %s not created yet.",token));
  235.     else
  236.     {
  237.       if (vctype(t) != NUMBER)
  238.     moan(spoof(ebuf,"Var %s needs to be numeric.",token));
  239.       type = vtype(t); scope = vscope(t); offset = voffset(t);
  240.     }
  241.  
  242.   go2num((scope == LOCAL ? GETLVAR : GETGVAR),type,offset); 
  243.  
  244.   do { genop(SHOVERV); compile(); type_check(NUMBER,0); genop(opcode); }
  245.   while (gaze_ahead(NUMBER,0));
  246.  
  247.   go2num((scope == LOCAL ? SETLVAR : SETGVAR),type,offset);
  248.  
  249.   class = NUMBER;
  250. }
  251.  
  252. extern int ntharg;    /* in vcomp.c */
  253.  
  254.     /* Define a function
  255.      * Syntax:
  256.      *   (defun pgm-name [(arg list)] [modifiers] pgm [another fcn])
  257.      *     pgm-name: TOKEN or STRING: name of the function being defined
  258.      *     arg-list:  a list of the function parameters.  Used to to a give
  259.      *       name to (arg n).
  260.      *       (type name ...)
  261.      *       (array type name [dims] ...)
  262.      *       (pointer type name ...)
  263.      *       (name ...)        Unknown type: same as (arg n)
  264.      *     modifiers:  stuff like HIDDEN, etc.
  265.      *     pgm:  the actual function code.
  266.      *     If another pgm-name follows the end of pgm, another function is
  267.      *       defined.
  268.      */
  269. void defun()
  270. {
  271.   int t, pgm, dim[MAXDIM];
  272.   unsigned int type;
  273.  
  274.   do
  275.   {
  276.         /* Get the name of the function */
  277.     get_token();
  278.     if (class != TOKEN && class != STRING)
  279.       bitch("Function names are tokens or strings.");
  280.     pgm = addpgm(token);
  281. /*strcpy(temp,token);    /* save pgm name */
  282.  
  283.     /* Parse arg-list */
  284.     ntharg = 0; addproto("pgm-name");
  285.     while (TRUE)
  286.     {
  287.       lookahead();
  288.       if (class != DELIMITER || *token != '(') break;
  289.       get_token(); lookahead(); t = -2;
  290.       if (class == TOKEN)
  291.     if ((t = lookup(token,muttcmds,msize)) != -1) get_token();
  292.       switch (t)
  293.       {
  294.     default: moan(spoof(ebuf,"%s is not an arg type.",token));
  295.     case -1: type = UNKNOWN; goto defvar; /* unknown token => untyped var */
  296.     case 62:                    /* bool */
  297.       type = BOOLEAN;
  298.       defvar:
  299.       do
  300.       {
  301.         get_token();
  302.         if (class != TOKEN)
  303.         bitch(spoof(ebuf,"%s is not a var name.",token));
  304.         moreproto(token,ntharg++,type,0,dim);
  305.         lookahead();
  306.       } while (class == TOKEN);
  307.       break;
  308.     case 61: case 75: case 31:    /* byte, int, INT all are NUMBER */
  309.         type = NUMBER; goto defvar;
  310.     case 60: type = STRING; goto defvar;        /* string */
  311.     case 27: type = LIST; goto defvar;        /* list */
  312.     case 73: array(LOCAL,TRUE); break;        /* array */
  313.     case 72:    /* (pointer { bool byte int INT defun } name ...) */
  314.       get_token(); t = -2;
  315.       if (class == TOKEN) t = lookup(token,muttcmds,msize);
  316.       switch (t)
  317.       {
  318.         default: moan(spoof(ebuf,"%s is not a pointer type.",token));
  319.         case -1: type = UNKNOWN; goto defvar;
  320.         case 62: type = POINTER | BOOLEAN;    goto defvar;    /* bool */
  321.         case 75: type = POINTER | INT8;    goto defvar;    /* byte */
  322.         case 61: type = POINTER | INT16;    goto defvar;    /* int */
  323.         case 31: type = POINTER | INT32;    goto defvar;    /* INT */
  324.         case 2:  type = FCNPTR;        goto defvar;    /* defun */
  325.       }
  326.       }
  327.       get_token();
  328.       if (class != DELIMITER || *token!=')') bitch("Bad arg list.");
  329.     }
  330.  
  331.             /* suck up function modifiers */
  332.     while (lookahead(), class == TOKEN)
  333.     {
  334.       get_token();
  335.       if ((t = lookup(token,modifiers,moders)) != -1) modpgm(pgm,t);
  336.       else moan(spoof(ebuf,"%s is an invalid pgm modifer.",token));
  337.     }
  338.  
  339.         /* Compile the code */
  340.     if (class != DELIMITER || *token != '{') bitch("Pgms must start with a {");
  341.     class = VAROK; compile();
  342.     genop(DONE);
  343.  
  344.         /* Clean up and get ready for another defun */
  345.     lookahead();
  346.     reset_vars(); killproto(); reset_named_labels();
  347.   } while (class == TOKEN || class == STRING);
  348. }
  349.  
  350.  
  351.     /* floc:  function location (address).
  352.      * Syntax:
  353.      *   (floc <STRING | TOKEN | string-var> [args])
  354.      */
  355. void floc()
  356. {
  357.   int t;
  358.   oMuttCmd *ptr;
  359.  
  360.   lookahead();
  361.   if (class == TOKEN)        /* (floc foo) */
  362.   {
  363.     if ((ptr = olookup(token,omuttcmds,omsize)))
  364.     genfp(OPTOKEN, ptr->token, token);
  365.     else
  366.       if ((t = getpgm(token)) != NIL) genfa(t,token);
  367.       else 
  368.     if (-1 != (t = lookup_ext_token_by_name(token)))
  369.         genfp(OPXTOKEN,t,token);
  370.     else genfa((address)NIL, token);    /* resolve it later */
  371.     get_token();
  372.   }
  373.   else                /* (floc "foo"), (floc (...)) */
  374.     { compile(); type_check(STRING,0); genfp(OPNAME,0,""); }
  375.  
  376. /* !!!??? how come (string foo) (floc (foo)()) works but (floc foo()) don't?
  377.  */
  378.   lookahead();
  379.   if (class == DELIMITER && *token == ')') class = FCNPTR;
  380.   else        /* (floc name args) => gen fcn call */
  381.   {
  382.      genop(PUSHRV);    /* push will set op stack for fcn call */
  383.      vargs();        /* compile fcn args */
  384.      genop(DOOP);    /* call the fcn */
  385.      class = UNKNOWN;
  386.   }
  387. }
  388.  
  389.     /* loc:  variable location (address)
  390.      * Syntax:  (loc TOKEN) where token is the name of a variable.
  391.      */
  392. void loc()
  393. {
  394.   int t, scope, offset;
  395.  
  396.   lookahead();
  397.   if (class == TOKEN)
  398.   {
  399.     get_token();
  400.     if ((t = getvar(token)) != -1)    /* (loc var-name) */
  401.     {
  402. if (vtype(t) == STRING || vtype(t) == LIST)
  403. moan(spoof(ebuf,"I need to think about (loc STRING) & (loc LIST): %s",token));
  404.       scope = vscope(t); offset = voffset(t);
  405.       gonum16((scope == LOCAL ? RVLBASE : RVGBASE),offset);
  406.       class = POINTER | vtype(t);
  407.     }
  408.     else
  409.     {
  410.       moan("loc expects TOKEN.");
  411.       compile(); class = POINTER | BOOLEAN;
  412.     }
  413.   }
  414. }
  415.  
  416. other_Mutt_cmd(name) char *name;
  417. {
  418.   oMuttCmd *ptr;
  419.  
  420.   if ((ptr = olookup(name,omuttcmds,omsize)))
  421.   {
  422.     gonum16(PUSHTOKEN,ptr->token);
  423.     vargs(); genop(DOOP);
  424.     class = ptr->class;
  425.     return TRUE;
  426.   }
  427.   return FALSE;
  428. }
  429.  
  430.     /* Generate code to create the global objects and call all the MAIN
  431.      *   functions.
  432.      * Notes:
  433.      *   If no MAINs and no global objects, this is a no-op but I need an
  434.      *     entry point (by definition) so just put a (done) at the entry
  435.      *     point.
  436.      *   The init code is put after all other code.
  437.      */
  438. void finishup()
  439. {
  440.   extern address entrypt;        /* in code.c */
  441.  
  442.   int n;
  443.  
  444.   entrypt = pcaddr();            /* Address of init code */
  445.  
  446.   for (n = 0; (n = get_global_object(n)) != -1; n++)
  447.     genobj(CREATE_OBJ, GLOBAL, vtype(n), voffset(n));
  448.  
  449.   for (n = 0; (n = get_main(n)) != -1; n++)
  450.     { goaddr(PUSHADDR, pgmaddr(n), pgmname(n)); genop(DOOP); }
  451.  
  452.   genop(DONE);                /* terminate init code */
  453. }
  454.