home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / me34src.zip / me3 / mc / vcomp.c < prev   
C/C++ Source or Header  |  1995-01-14  |  12KB  |  472 lines
  1. /* 
  2.  * vcomp.c : compile vars and the like
  3.  */
  4.  
  5. /* Copyright 1990, 1991, 1992 Craig Durland
  6.  *   Distributed under the terms of the GNU General Public License.
  7.  *   Distributed "as is", without warranties of any kind, but comments,
  8.  *     suggestions and bug reports are welcome.
  9.  */
  10.  
  11. #include <stdio.h>
  12. #include <os.h>
  13. #include "mc.h"
  14. #include "opcode.h"
  15. #include "mm.h"
  16.  
  17. extern char ebuf[], token[], temp[], *typename(), *spoof();
  18. extern unsigned int class, vtype(), mmtype();
  19. extern int32 atoN();
  20. extern KeyWord *global_look_for(), *global_look_up();
  21. extern MMDatum *getconst(), *cid_to_const();
  22. extern Var *vid_to_Var();
  23.  
  24.     /* process a function pointer: foo (foo) (foo args) */
  25. static void fcnptr(eval)
  26. {
  27.   if (eval)    /* (foo) or (foo args) */
  28.     { genop(PUSHRV); vargs(); genop(DOOP); class = UNKNOWN; }
  29.   else class = FCNPTR;
  30. }
  31.  
  32.     /* process a var pointer: (ptr) (ptr val) */
  33. void evalvp(arg,offset,scope,type)
  34. {
  35.   int t = (type & ~POINTER), mt = mmtype(type);
  36.  
  37.   gonumx((int32)0); genop(SHOVERV);
  38.   if (arg) { gonumx((int32)offset); genop(ARG); }
  39.   else
  40.   {
  41.     genop(SHOVERV);
  42.     gonum16((scope == LOCAL ? RVLBASE : RVGBASE),offset);
  43.     gonum8(GETRVAR,BLOB);
  44.   }
  45.   lookahead(); 
  46.   if (class == DELIMITER && *token == END_EXP) gonum8(GETRVAR,t);  /* (ptr) */
  47.   else        /* (ptr val) */
  48.   {
  49.     genop(SHOVERV); compile(); type_check(mt,0);
  50.     gonum8(SETRVAR,t);
  51.   }
  52.   class = mt;
  53. }
  54.  
  55.     /* Generate code for evaluating (returning the contents of) a local or
  56.      *   global variable, prototype or constant.
  57.      * Generates code for (var) or var.  Doesn't handle args, use a
  58.      *   different routine.
  59.      * Input
  60.      *   name : Name of variable to compile
  61.      *   eval : TRUE if (name), FALSE if ... name ...
  62.      * Notes:
  63.      *   Its probably not worth breaking this into two routines:  one that
  64.      *     looks up the name and another that compiles.  The routines that
  65.      *     call this (that already know the var) do so in rare cases.
  66.      */
  67. void genvar(name,eval) char *name;
  68. {
  69.   int scope, offset, var_id;
  70.   unsigned int type;
  71.   KeyWord *kw;
  72.  
  73.   if (-1 == (var_id = find_local_var(name)))    /* not a local var or proto */
  74.     if (kw = global_look_up(name))        /* its something global */
  75.     {
  76.       switch (kw->type)
  77.       {
  78.     case KWGlobalVar:
  79.       var_id = kw->token;
  80.       break;
  81.     case KWConst:
  82.     {
  83.       MMDatum *rv;
  84.  
  85.       if (!eval)        /* const is legal */
  86.       {
  87.         rv = cid_to_const(kw->token);
  88.         switch (class = rv->type)
  89.         {
  90.           case STRING:  gostr(RVSTR,rv->val.str);    break;
  91.           case NUMBER:  gonumx(rv->val.num);    break;
  92.           case BOOLEAN: gonum8(RVBOOL,rv->val.num); break;
  93.         }
  94.         return;
  95.       }
  96.             /* (const) is illegal */
  97.       bitch(spoof(ebuf,"(%s [args]) not legal for a constant.%s",
  98.         name,
  99.         "\n  (Can't evaluate or assign to a constant - no ()'s)."));
  100.     }
  101.       }
  102.     }
  103.  
  104.   if (var_id == -1)
  105.     bitch(spoof(ebuf,"\"%s\" is not a variable or constant.",name));
  106.  
  107.         /* Some type of variable */
  108.   type = vtype(var_id); offset = voffset(var_id); scope = vscope(var_id);
  109.  
  110.   if (scope == PROTOTYPE)        /* its a proto */
  111.   {
  112.     if (eval && (type & POINTER)) evalvp(TRUE,offset,0,type);
  113.     else
  114.     {
  115.       gonumx((int32)offset); genop(ARG);
  116.       if (type == FCNPTR) fcnptr(eval);
  117.       else
  118.     class = (type == ARRAY) ? BLOB : type;
  119.     }
  120.     return;
  121.   }
  122.  
  123.     /* its a local or global variable */
  124.   if (eval && (type & POINTER)) evalvp(FALSE,offset,scope,type);
  125.   else
  126.   {
  127.     if (type == ARRAY || type == BLOB)
  128.       gonum16((scope == LOCAL ? RVLBASE : RVGBASE),offset);
  129.     else
  130.       go2num((scope == LOCAL ? GETLVAR : GETGVAR),
  131.           (type & POINTER) ? BLOB : type, offset);
  132.     if (type == FCNPTR) fcnptr(eval);
  133.     else class = type;
  134.   }
  135. }
  136.  
  137.     /* Compile a variable or prototype.
  138.      * Syntax compiled:  (var [args])
  139.      * Var name has already been parsed.
  140.      * Input:
  141.      *   var_id:
  142.      *     -1 : Compile a local variable (name is in token[]).
  143.      *     != -1 : The id of the variable to compile.
  144.      * Returns:
  145.      *   FALSE : token[] not a local variable
  146.      * Notes:
  147.      *   Constants not compiled.
  148.      */
  149. var_compile(var_id)    /* handle (var [value(s)]) */
  150. {
  151.   int arg, scope, offset;
  152.   unsigned int type;
  153.   Var *var;
  154.   MMDatum *rv;
  155.  
  156.   if (var_id == -1 && (-1 == (var_id = find_local_var(token))))
  157.     return FALSE;
  158.  
  159.   var = vid_to_Var(var_id);
  160.  
  161.   scope = var->scope; offset = var->offset; type = var->type;
  162.   arg = (scope == PROTOTYPE);
  163.  
  164.   if (type == FCNPTR) { genvar(token,TRUE); return TRUE; }
  165.  
  166.   if (type == ARRAY)
  167.   {
  168.     int j,m,num_subscripts,x,z, tsize, compiled, *dim;
  169.  
  170.     compiled = FALSE;
  171.     z = 0; type = var->sub_type; tsize = typesize(type);
  172.     dim = var->dim; num_subscripts = var->dims; m = num_subscripts - 1;
  173.     if (type == STRING) num_subscripts--;
  174.     for (j = 0; j < num_subscripts; j++)    /* suck up subscripts */
  175.     {
  176.       lookahead();
  177.     /* check to see if next thing is a constant */
  178.       if (class == TOKEN &&
  179.           (rv = getconst(token)) && (-1 == find_local_var(token)))
  180.       {
  181.     if (rv->type == NUMBER) x = rv->val.num;
  182.     else
  183.     {
  184.       moan(spoof(ebuf,
  185.         "Constant \"%s\" is not a number - \n%s", token,
  186.         "  it can't be used as a subscript."));
  187.       x = 0;
  188.         }
  189.     goto num;
  190.       }
  191.  
  192.       if (class == DELIMITER || class == TOKEN)
  193.       {
  194.     if (class == DELIMITER && *token == END_EXP)
  195.       if (j == 0)            /* (var) */
  196.       {
  197.         class = BLOB;
  198.         if (arg) { gonumx((int32)offset); genop(ARG); }
  199.         else gonum16((scope == LOCAL ? RVLBASE : RVGBASE),offset);
  200.  
  201.         return TRUE;
  202.       }
  203.       else
  204.       {
  205.         moan(spoof(ebuf,"Need %d subscript(s).",num_subscripts));
  206.         break;
  207.       }
  208.  
  209.     if (compiled) genop(SHOVERV);
  210.     compile(); type_check(NUMBER,0);
  211.     if (j < m) { genop(SHOVERV); gonumx((int32)dim[j+1]); genop(MUL); }
  212.     if (compiled) genop(ADD);
  213.     compiled = TRUE;
  214.       }
  215.       else
  216.         if (class == NUMBER)
  217.     {
  218.       x = atoN(token);
  219.     num:
  220.       get_token();
  221.       if (x < 0 || x >= dim[j])
  222.       {
  223.         moan(spoof(ebuf,"Subscript #%d (%s) out of bounds [0,%d).",
  224.         j+1, token, dim[j]));
  225.         x = 0;
  226.       }
  227.       if (j < m) x *= dim[j+1];
  228.       z += x;
  229.     }
  230.     else
  231.     {
  232.       get_token();
  233.       moan(spoof(ebuf,"\"%s\" is not an array subscript.",token));
  234.     }
  235.     }
  236.     z = z*tsize + (arg ? 0 : offset);    /* offset from base address */
  237.  
  238.     /* now check to see if it is assignment or eval */
  239.     lookahead(); 
  240.         /* TRUE => eval */
  241.     x = (class == DELIMITER && *token == END_EXP) ? TRUE : FALSE;
  242.  
  243.     if (arg)
  244.     {
  245.       if (!compiled) gonumx((int32)z);
  246.       else
  247.       {
  248.         genop(SHOVERV); gonumx((int32)tsize); genop(MUL);
  249.     if (z) { genop(SHOVERV); gonumx((int32)z); genop(ADD); }
  250.       }
  251.       genop(SHOVERV);
  252.       gonumx((int32)offset); genop(ARG);
  253.       if (x) gonum8(GETRVAR,type);
  254.       else
  255.       {
  256.         genop(SHOVERV); compile(); type_check(type,0);
  257.     gonum8(SETRVAR,type);
  258.       }
  259.     }
  260.     else
  261.     {
  262.       if (!compiled)
  263.       {
  264.     if (x) go2num((scope == LOCAL ? GETLVAR : GETGVAR),type,z);
  265.     else
  266.     {
  267.       compile(); type_check(type,0);
  268.       go2num((scope == LOCAL ? SETLVAR : SETGVAR), type,z);
  269.     }
  270.       }
  271.       else
  272.       {
  273.     genop(SHOVERV); gonumx((int32)tsize); genop(MUL);
  274.     genop(SHOVERV); gonum16((scope == LOCAL ? RVLBASE : RVGBASE),z);
  275.     if (x) gonum8(GETRVAR,type);
  276.     else
  277.     {
  278.       genop(SHOVERV);
  279.       compile(); type_check(type,0);
  280.       gonum8(SETRVAR,type);
  281.     }
  282.       }
  283.     }
  284.     class = type;
  285.  
  286.     return TRUE;    /* done with arrays */
  287.   }
  288.  
  289.     /* its a variable or constant */
  290.   lookahead();
  291.   if (class == DELIMITER && *token == END_EXP)    /* (var) or (const) */
  292.     genvar(var->name,TRUE);
  293.   else            /* var assignment: (var value) */
  294.   {
  295.     if (arg)        /* (foo "hoho") where foo is (arg n) */
  296.     {
  297.       switch (type)
  298.       {
  299.     case LIST:
  300.     case STRING:
  301. /* !!!??? this may not be right */
  302.         /* get the arg (an object) (I hope) */
  303.       gonumx((int32)offset); genop(ARG); genop(SHOVERV);
  304.       compile(); type_check(type,0);
  305.       gonum8(SETRVAR,type);
  306.       break;
  307.     case (POINTER | INT32):   evalvp(TRUE,offset,scope,INT32);   break;
  308.     case (POINTER | INT16):   evalvp(TRUE,offset,scope,INT16);   break;
  309.     case (POINTER | INT8):    evalvp(TRUE,offset,scope,INT8);    break;
  310.     case (POINTER | BOOLEAN): evalvp(TRUE,offset,scope,BOOLEAN); break;
  311.     default:
  312.       moan(spoof(ebuf,
  313.         "Can't change stack variable \"%s\" (of type %s).",
  314.         var->name, typename(var->type)));
  315.       compile();        /* try to recover */
  316.       break;
  317.       }
  318.     }
  319.     else        /* (int var)(var 123) */
  320.     {
  321.       compile(); type_check(type,0);
  322.       go2num((scope == LOCAL ? SETLVAR : SETGVAR),
  323.     (type & POINTER) ? BLOB : type, offset);
  324.     }
  325.   }
  326.   return TRUE;
  327. }
  328.  
  329. isvarok(clevel,class)
  330. {
  331.   if (clevel == 0 || class == VAROK) return TRUE;
  332.   moan("Can't create vars here.");
  333.   return FALSE;
  334. }
  335.  
  336.     /* Compile (type var-name ...)
  337.      * For example:
  338.      *   (int a) (int a b c) (array int b)
  339.      * Input:
  340.      *   type:  Variable type.
  341.      *   local:  TRUE if variable is local to a function.
  342.      * Notes:
  343.      *   type already parsed (before calling this routine).
  344.      */
  345. void vdeclare(type,local)
  346. {
  347.   int x, total_bytes;
  348.  
  349.   x = typesize(type);
  350.   total_bytes = 0;
  351.   do
  352.   {
  353.     get_token();
  354.     if (class != TOKEN) bitch(spoof(ebuf,"%s is not a var name.",token));
  355.     create_var(token, type, x, (local ? LOCAL : GLOBAL));
  356.     total_bytes += x;
  357.     lookahead();
  358.   } while (class == TOKEN);
  359.   if (local) gonum16(LALLOC, total_bytes);
  360. }
  361.  
  362. void pointer(local)        /* (pointer type name ...) */
  363. {
  364.   int t = -1;
  365.   KeyWord *kw;
  366.  
  367.   get_token();
  368.   if (class == TOKEN && (kw = global_look_for(token, KWMutt))) t = kw->token;
  369.   switch (t)
  370.   {
  371.     case 62: vdeclare(POINTER | BOOLEAN,local); break;
  372.     case 61: vdeclare(POINTER | INT16,    local); break;
  373.     case 75: vdeclare(POINTER | INT8,    local); break;
  374.     case 31: vdeclare(POINTER | INT32,    local); break;
  375.     case 60: vdeclare(POINTER | STRING,    local); break;
  376.     default:
  377.       moan(spoof(ebuf,"%s is not a pointer type.",token));
  378.       vdeclare(POINTER | BOOLEAN,local);
  379.   }
  380. }
  381.  
  382. static int getnum(n) int *n;
  383. {
  384.   char *errmsg = "Array dimensions are positive numeric constants.";
  385.   int x;
  386.   MMDatum *rv;
  387.  
  388.   lookahead();
  389.   if (class==DELIMITER || (class==TOKEN && (rv = getconst(token))==NULL))
  390.     return FALSE;
  391.   get_token();
  392.   if (class == TOKEN)
  393.   {
  394.     if (rv->type != NUMBER) bitch(errmsg);
  395.     x = rv->val.num;
  396.   }
  397.   else { if (class != NUMBER) bitch(errmsg); x = atoN(token); }
  398.   if (x <= 0) { moan(errmsg); x = 1; }
  399.   *n = x;
  400.   return TRUE;
  401. }
  402.  
  403. int ntharg;    /* arg & proto count for defun */
  404.  
  405. void array(scope,arg)            /* (array type name subs) */
  406. {
  407.   int t,size,x, n, dim[MAXDIM],z, tsize;
  408.   unsigned int type;
  409.   KeyWord *kw;
  410.  
  411.   size = 0;
  412.   get_token();
  413.   t = -1;
  414.   if (class == TOKEN && (kw = global_look_for(token, KWMutt))) t = kw->token;
  415.   switch(t)
  416.   {
  417.     default:
  418.       moan(spoof(ebuf,"%s is not an array type.",token));
  419.       type = BOOLEAN; goto defvar;
  420.     case 62:        /* (array bool name d1 ...) */
  421.       type = BOOLEAN;
  422.   defvar:
  423.       tsize = typesize(type);
  424.       do
  425.       {
  426.     z = 1; n = 0;
  427.     get_token(); strcpy(temp,token);    /* get and save name */
  428.     if (class != TOKEN) bitch(spoof(ebuf,"%s is not a var name.",token));
  429.     while (TRUE)
  430.     {
  431.       if (!getnum(&x)) break;
  432.       if (n >= MAXDIM)
  433.         bitch(spoof(ebuf,"Too many dimensions (max is %d).",MAXDIM)); 
  434.       z *= (dim[n++] = x);
  435.     }
  436.     if (n == 0) moan("An array needs dimensions.");
  437.     z *= tsize; size += z;
  438.     if (arg) add_to_proto(temp,ntharg++,type,n,dim);
  439.     else add_array(temp,type,z,scope,n,dim);
  440.     lookahead();
  441.       } while (class == TOKEN);
  442.       if (!arg && scope == LOCAL) gonum16(LALLOC,size);
  443.       break;
  444.     case 75: type = INT8;  goto defvar;        /* (byte var [var ...]) */
  445.     case 61: type = INT16; goto defvar;        /* (int var [var ...]) */
  446.     case 31: type = INT32; goto defvar;        /* (INT var [var ...]) */
  447.     case 60:        /* (array string n) */
  448.       moan("I don't support string arrays (anymore)!");        /* ??? */
  449. #if 0
  450.       size = 0;
  451.       do
  452.       {
  453.     get_token(); strcpy(temp,token);    /* get and save name */
  454.     if (class != TOKEN) bitch(spoof(ebuf,"%s is not a var name.",token));
  455.  
  456.     t = getnum(&n) && getnum(&x);
  457.     if (!t || x > MAXSTRLEN)
  458.       bitch(spoof(ebuf,
  459.         "String length is a postive numeric constant <= %d.",MAXSTRLEN));
  460.     dim[0] = n; dim[1] = x+1;
  461.     z = dim[0]*dim[1]*sizeof(char);
  462.     size += z;
  463.     if (arg) add_to_proto(temp,ntharg++,STRING,2,dim);
  464.     else add_array(temp,STRING,z,scope,2,dim);
  465.     lookahead();
  466.       } while (class == TOKEN);
  467. /*      if (!arg && scope == LOCAL) gonum16(LALLOC,size);*/
  468. #endif
  469.       break;
  470.   }
  471. }
  472.