home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / me34src.zip / me3 / mc / comp.c < prev    next >
C/C++ Source or Header  |  1995-01-14  |  9KB  |  368 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 get_pgm(), pgmaddr(), pcaddr();
  32. extern char
  33.   ebuf[], token[],
  34.   *pgmname(), *spoof(), *typename();
  35. extern int btv;
  36. extern unsigned int class, vtype(), vctype(), mmtype();
  37. extern int32 atoN();
  38. extern MMDatum *getconst();
  39. extern oMuttCmd *id_to_oMutt();
  40.  
  41. /* ******************************************************************** */
  42. /* ************************** Type Checking *************************** */
  43. /* ******************************************************************** */
  44.  
  45. static void typerr(msg,type,ap) char *msg; unsigned int type; va_list ap;
  46. {
  47.   register unsigned int t;
  48.  
  49.   spoof(ebuf,"%sexpected %s",msg,typename(type));
  50.   t = va_arg(ap,unsigned int);
  51.   while (type = t)
  52.   {
  53.     t = va_arg(ap,unsigned int);
  54.     strcat(ebuf, t ? ", " : " or ");
  55.     strcat(ebuf,typename(type));
  56.   }
  57.   strcat(ebuf,".");
  58.   moan(ebuf);
  59. }
  60.  
  61.   /* Check to see if class matches any of a list of types.
  62.    * Called:  cmp_types(type,...,0);
  63.    * Returns: 0 (class is UNKNOWN), 1 (class matches), 2 (no match).
  64.    */
  65. static int cmp_types(type, ap) unsigned int type; va_list ap;
  66. {
  67.   if (class == UNKNOWN) return 0;
  68.  
  69.   for (; type; type = va_arg(ap,unsigned int))
  70.   {
  71.     if (class == type ||
  72.         (mmtype(type) == NUMBER && mmtype(class) == NUMBER) ||
  73.         ((class & POINTER) && (type & POINTER)))
  74.     return 1;
  75.   }
  76.   return 2;
  77. }
  78.  
  79.     /* Zero terminated list of ONE type (eg type_check(NUMBER,0)).
  80.      * More than one type will mess things up.
  81.      * Written in this strange way so I can call cmp_types().
  82.      */
  83. /*VARARGS1*/
  84. #ifdef __STDC__
  85. void type_check(unsigned int type, ...)
  86. #else
  87. void type_check(type, va_alist) unsigned int type; va_dcl
  88. #endif
  89. {
  90.   int n;
  91.   va_list ap;
  92.  
  93.   VA_START(ap,type);
  94.   n = cmp_types(type, ap);
  95.  
  96.   switch(n)
  97.   {
  98.     case 0: gonum8(TYPECHECK,mmtype(type)); break;
  99.     case 2: VA_START(ap,type); typerr("Type mismatch: ",type,ap); break;
  100.   }
  101.  
  102.   va_end(ap);
  103.   class = type;
  104. }
  105.  
  106. /*VARARGS2*/
  107. #ifdef __STDC__
  108. void checkit(char *msg, unsigned int type, ...)
  109. #else
  110. void checkit(msg, type, va_alist)
  111.   char *msg; unsigned int type; va_dcl    /* zero terminated list of types */
  112. #endif
  113. {
  114.   char buf[90];
  115.   va_list ap;
  116.  
  117.   VA_START(ap,type);
  118.   if (cmp_types(type, ap) == 2)
  119.   {
  120.     VA_START(ap,type);
  121.     typerr(spoof(buf,"%s: Invalid type: ",msg), type,ap);
  122.   }
  123.   va_end(ap);
  124. }
  125.  
  126.     /* returns TRUE if conditions met */
  127. /*VARARGS1*/
  128. #ifdef __STDC__
  129. gaze_ahead(unsigned int tipe, ...)
  130. #else
  131. gaze_ahead(tipe, va_alist)
  132.   unsigned int tipe; va_dcl        /* zero terminated list of types */
  133. #endif
  134. {
  135.   int t;
  136.   unsigned int type;
  137.   MMDatum *rv;
  138.   va_list ap;
  139.  
  140.   lookahead();
  141.   if (class == DELIMITER)
  142.     if (*token == START_EXP || *token == START_PGM) return TRUE;
  143.     else return FALSE;
  144.  
  145.   VA_START(ap,tipe);
  146.   if (class == TOKEN)    /* check for var or const */
  147.   {
  148.     for (type = tipe; type; type = va_arg(ap,unsigned int))
  149.       if (type == TOKEN) goto ok;        /* class == type */
  150.  
  151.     if ((t = getvar(token)) != -1)    /* local or global var or prototype */
  152.     class = vctype(t);
  153.     else
  154.       if (rv = getconst(token)) class = rv->type;    /* constant */
  155.   }
  156.  
  157.   VA_START(ap, tipe);
  158.   if (cmp_types(tipe,ap) == 2)
  159.     { VA_START(ap, tipe); typerr("Invalid type: ",tipe,ap); }
  160.  
  161. ok:
  162.   va_end(ap);
  163.   return TRUE;
  164. }
  165.  
  166. /* ******************************************************************** */
  167. /* ******************************************************************** */
  168. /* ******************************************************************** */
  169.  
  170.     /* Generate the minimum code needed to push an arg of type class */
  171. void pushpush()
  172. {
  173.   switch (class)
  174.   {
  175.     case EMPTY:
  176.     case PUSHEDARGS:    return;        /* nothing to push */
  177.  
  178.     case STRING:
  179. /*    case FCNPTR:    /* ??? am I sure about fcnptr?? */
  180.     case UNKNOWN: genop(PUSHRV); break;
  181.  
  182.     default: genop(SHOVERV);
  183.   }
  184. }
  185.  
  186. void vargs()    /* compile args and push them */
  187. {
  188.   while (TRUE)
  189.   {
  190.     lookahead();
  191.     if (class == DELIMITER)
  192.       if (*token == START_EXP || *token == START_PGM || *token == START_IPGM)
  193.     { compile(); pushpush(); continue; }
  194.       else
  195.         if (*token == END_EXP) break;
  196.     else bitch("vargs is confused");
  197.     switch (class)
  198.     {
  199.       case STRING:  gostr(RVSTR,token);  genop(SHOVERV); break;
  200.       case NUMBER:  gonumx(atoN(token)); genop(SHOVERV); break;
  201.       case BOOLEAN: gonum8(RVBOOL,btv);  genop(SHOVERV); break;
  202.       case TOKEN:   genvar(token,FALSE); genop(SHOVERV); break;
  203.       default: bitch(spoof(ebuf,"Invalid parameter: %s",token));
  204.     }
  205.     get_token();    /* suck up token we just compiled */
  206.   }
  207. }
  208.  
  209. void opmath(opcode)        /* stuff like (+ 1 2 3) */
  210. {
  211.   compile(); type_check(NUMBER,0);
  212.   do { genop(SHOVERV); compile(); type_check(NUMBER,0); genop(opcode); }
  213.   while (gaze_ahead(NUMBER,0));
  214.   class = NUMBER;
  215. }
  216.  
  217. void opeq(opcode)    /* stuff like (+= var 1 2 3) */
  218. {
  219.   int t, scope, offset = 0;
  220.   unsigned int type = 0;
  221.  
  222.   get_token();
  223.   if (class != TOKEN)
  224.   {
  225.     spoof(ebuf,"%s is not a var name.",token);
  226.     if (class == DELIMITER) bitch(ebuf); else moan(ebuf);
  227.   }
  228.   else
  229.     if ((t = getvar(token)) == -1)
  230.       moan(spoof(ebuf,"Var %s not created yet.",token));
  231.     else
  232.     {
  233.       if (vctype(t) != NUMBER)
  234.     moan(spoof(ebuf,"Var %s needs to be numeric.",token));
  235.       type = vtype(t); scope = vscope(t); offset = voffset(t);
  236.     }
  237.  
  238.   go2num((scope == LOCAL ? GETLVAR : GETGVAR),type,offset); 
  239.  
  240.   do { genop(SHOVERV); compile(); type_check(NUMBER,0); genop(opcode); }
  241.   while (gaze_ahead(NUMBER,0));
  242.  
  243.   go2num((scope == LOCAL ? SETLVAR : SETGVAR),type,offset);
  244.  
  245.   class = NUMBER;
  246. }
  247.  
  248.     /* floc:  function location (address).
  249.      * Syntax:
  250.      *   (floc <STRING | TOKEN | string-var> [args])
  251.      */
  252. void floc()
  253. {
  254.   extern KeyWord *global_look_up();
  255.  
  256.   oMuttCmd *ptr;
  257.  
  258.   lookahead();
  259.   if (class == TOKEN)        /* (floc foo) */
  260.   {
  261.     KeyWord *kw;
  262.  
  263.     if (kw = global_look_up(token))
  264.     {
  265.       switch (kw->type)
  266.       {
  267.     case KWoMutt:
  268.       ptr = id_to_oMutt(kw->token);
  269.       genfp(OPTOKEN, ptr->token, token);
  270.       break;
  271.     case KWXToken:  genfp(OPXTOKEN,kw->token,token); break;
  272.     case KWProgram: genfa(pgmaddr(kw->token),token); break;
  273.       }
  274.     }
  275.     else genfa((address)NIL, token);    /* resolve it later */
  276.  
  277.     get_token();
  278.   }
  279.   else                /* (floc "foo"), (floc (...)) */
  280.     { compile(); type_check(STRING,0); genfp(OPNAME,0,""); }
  281.  
  282. /* !!!??? how come (string foo) (floc (foo)()) works but (floc foo()) don't?
  283.  */
  284.   lookahead();
  285.   if (class == DELIMITER && *token == END_EXP) class = FCNPTR;
  286.   else        /* (floc name args) => gen fcn call */
  287.   {
  288.      genop(PUSHRV);    /* push will set op stack for fcn call */
  289.      vargs();        /* compile fcn args */
  290.      genop(DOOP);    /* call the fcn */
  291.      class = UNKNOWN;
  292.   }
  293. }
  294.  
  295.     /* loc:  variable location (address)
  296.      * Syntax:  (loc TOKEN) where token is the name of a variable.
  297.      */
  298. void loc()
  299. {
  300.   int t, scope, offset;
  301.  
  302.   lookahead();
  303.   if (class == TOKEN)
  304.   {
  305.     get_token();
  306.     if ((t = getvar(token)) != -1)    /* (loc var-name) */
  307.     {
  308. if (vtype(t) == STRING || vtype(t) == LIST)
  309. moan(spoof(ebuf,"I need to think about (loc STRING) & (loc LIST): %s",token));
  310.       scope = vscope(t); offset = voffset(t);
  311.       gonum16((scope == LOCAL ? RVLBASE : RVGBASE),offset);
  312.       class = POINTER | vtype(t);
  313.     }
  314.     else    /* a token but not a variable */
  315.     {
  316.       moan(spoof(ebuf,
  317.     "(loc): Expected a variable name, not a \"%s\".", token));
  318.       class = POINTER | BOOLEAN;
  319.     }
  320.   }
  321.   else        /* not even a token */
  322.   {
  323.     moan(spoof(ebuf,
  324.     "(loc): Expected a variable name, not a \"%s\".", token));
  325.     compile(); class = POINTER | BOOLEAN;
  326.   }
  327. }
  328.  
  329. other_Mutt_cmd(ptr) oMuttCmd *ptr;
  330. {
  331.   if (ptr)
  332.   {
  333.     gonum16(PUSHTOKEN,ptr->token);
  334.     vargs(); genop(DOOP);
  335.     class = ptr->class;
  336.     return TRUE;
  337.   }
  338.   return FALSE;
  339. }
  340.  
  341.     /* Generate code to create the global objects and call all the MAIN
  342.      *   functions.
  343.      * Notes:
  344.      *   If no MAINs and no global objects, this is a no-op but I need an
  345.      *     entry point (by definition) so just put a (done) at the entry
  346.      *     point.
  347.      *   The init code is put after all other code.
  348.      */
  349. void finishup()
  350. {
  351.   extern address entrypt;        /* in code.c */
  352.  
  353.   int n;
  354.  
  355.   link();    /* !!! should really check for errors better */
  356.  
  357.   entrypt = pcaddr();            /* Address of init code */
  358.  
  359.   for (n = 0; (n = get_global_object(n)) != -1; n++)
  360.     genobj(CREATE_OBJ, GLOBAL, vtype(n), voffset(n));
  361.  
  362.   sort_pgms();        /* So I call the MAIN's in order */
  363.   for (n = 0; (n = get_main(n)) != -1; n++)
  364.     { goaddr(PUSHADDR, pgmaddr(n), pgmname(n)); genop(DOOP); }
  365.  
  366.   genop(DONE);                /* terminate init code */
  367. }
  368.