-lval.constval)
-lval.constval))
callfunction(symbol * sym){   int                 close, lvalue;   int                 argpos;	/* index in the output stream (argpos==nargs if positional parameters) */   int                 argidx = 0;	/* index in "arginfo" list */   int                 nargs = 0;	/* number of arguments */   int                 heapalloc = 0;   int                 namedparams = FALSE;   value               lval = { 0 };   arginfo            *arg;   char                arglist[sMAXARGS];   constvalue          arrayszlst = { NULL, "", 0, 0 };	/* array size list starts empty */   cell                lexval;   char               *lexstr;   assert(sym != NULL);   arg = sym->dim.arglist;   assert(arg != NULL);   stgmark(sSTARTREORDER);   for (argpos = 0; argpos < sMAXARGS; argpos++)      arglist[argpos] = ARG_UNHANDLED;   if (!matchtoken(')'))     {	do	  {	     if (matchtoken('.'))	       {		  namedparams = TRUE;		  if (needtoken(tSYMBOL))		     tokeninfo(&lexval, &lexstr);		  else		     lexstr = "";		  argpos = findnamedarg(arg, lexstr);		  if (argpos < 0)		    {		       error(17, lexstr);	/* undefined symbol */		       break;	/* exit loop, argpos is invalid */		    }		/* if */		  needtoken('=');		  argidx = argpos;	       }	     else	       {		  if (namedparams)		     error(44);	/* positional parameters must precede named parameters */		  argpos = nargs;	       }		/* if */	     stgmark((char)(sEXPRSTART + argpos));	/* mark beginning of new expression in stage */	     if (arglist[argpos] != ARG_UNHANDLED)		error(58);	/* argument already set */	     if (matchtoken('_'))	       {		  arglist[argpos] = ARG_IGNORED;	/* flag argument as "present, but ignored" */		  if (arg[argidx].ident == 0 || arg[argidx].ident == iVARARGS)		    {		       error(202);	/* argument count mismatch */		    }		  else if (!arg[argidx].hasdefault)		    {		       error(34, nargs + 1);	/* argument has no default value */		    }		/* if */		  if (arg[argidx].ident != 0 && arg[argidx].ident != iVARARGS)		     argidx++;		  /* The rest of the code to handle default values is at the bottom		   * of this routine where default values for unspecified parameters		   * are (also) handled. Note that above, the argument is flagged as		   * ARG_IGNORED.		   */	       }	     else	       {		  arglist[argpos] = ARG_DONE;	/* flag argument as "present" */		  lvalue = hier14(&lval);		  switch (arg[argidx].ident)		    {		    case 0:		       error(202);	/* argument count mismatch */		       break;		    case iVARARGS:		       /* always pass by reference */		       if (lval.ident == iVARIABLE || lval.ident == iREFERENCE)			 {			    assert(lval.sym != NULL);			    if ((lval.sym->usage & uCONST) != 0				&& (arg[argidx].usage & uCONST) == 0)			      {				 /* treat a "const" variable passed to a function with a non-const				  * "variable argument list" as a constant here */				 assert(lvalue);				 rvalue(&lval);	/* get value in PRI */				 setheap_pri();	/* address of the value on the heap in PRI */				 heapalloc++;			      }			    else if (lvalue)			      {				 address(lval.sym);			      }			    else			      {				 setheap_pri();	/* address of the value on the heap in PRI */				 heapalloc++;			      }	/* if */			 }		       else if (lval.ident == iCONSTEXPR				|| lval.ident == iEXPRESSION				|| lval.ident == iARRAYCHAR)			 {			    /* fetch value if needed */			    if (lval.ident == iARRAYCHAR)			       rvalue(&lval);			    /* allocate a cell on the heap and store the			     * value (already in PRI) there */			    setheap_pri();	/* address of the value on the heap in PRI */			    heapalloc++;			 }	/* if */		       /* ??? handle const array passed by reference */		       /* otherwise, the address is already in PRI */		       if (lval.sym != NULL)			  markusage(lval.sym, uWRITTEN);/* * Dont need this warning - its varargs. there is no way of knowing the * required tag/type... *           if (!checktag(arg[argidx].tags,arg[argidx].numtags,lval.tag))            error(213); */		       break;		    case iVARIABLE:		       if (lval.ident == iLABEL || lval.ident == iFUNCTN			   || lval.ident == iREFFUNC || lval.ident == iARRAY			   || lval.ident == iREFARRAY)			  error(35, argidx + 1);	/* argument type mismatch */		       if (lvalue)			  rvalue(&lval);	/* get value (direct or indirect) */		       /* otherwise, the expression result is already in PRI */		       assert(arg[argidx].numtags > 0);		       check_userop(NULL, lval.tag, arg[argidx].tags[0], 2,				    NULL, &lval.tag);		       if (!checktag			   (arg[argidx].tags, arg[argidx].numtags, lval.tag))			  error(213);		       argidx++;	/* argument done */		       break;		    case iREFERENCE:		       if (!lvalue || lval.ident == iARRAYCHAR)			  error(35, argidx + 1);	/* argument type mismatch */		       if (lval.sym != NULL && (lval.sym->usage & uCONST) != 0			   && (arg[argidx].usage & uCONST) == 0)			  error(35, argidx + 1);	/* argument type mismatch */		       if (lval.ident == iVARIABLE || lval.ident == iREFERENCE)			 {			    if (lvalue)			      {				 assert(lval.sym != NULL);				 address(lval.sym);			      }			    else			      {				 setheap_pri();	/* address of the value on the heap in PRI */				 heapalloc++;			      }	/* if */			 }	/* if */		       /* otherwise, the address is already in PRI */		       if (!checktag			   (arg[argidx].tags, arg[argidx].numtags, lval.tag))			  error(213);		       argidx++;	/* argument done */		       if (lval.sym != NULL)			  markusage(lval.sym, uWRITTEN);		       break;		    case iREFARRAY:		       if (lval.ident != iARRAY && lval.ident != iREFARRAY			   && lval.ident != iARRAYCELL)			 {			    error(35, argidx + 1);	/* argument type mismatch */			    break;			 }	/* if */		       if (lval.sym != NULL && (lval.sym->usage & uCONST) != 0			   && (arg[argidx].usage & uCONST) == 0)			  error(35, argidx + 1);	/* argument type mismatch */		       /* Verify that the dimensions match with those in arg[argidx].		        * A literal array always has a single dimension.		        * An iARRAYCELL parameter is also assumed to have a single dimension.		        */		       if (lval.sym == NULL || lval.ident == iARRAYCELL)			 {			    if (arg[argidx].numdim != 1)			      {				 error(48);	/* array dimensions must match */			      }			    else if (arg[argidx].dim[0] != 0)			      {				 assert(arg[argidx].dim[0] > 0);				 if (lval.ident == iARRAYCELL)				   {				      error(47);	/* array sizes must match */				   }				 else				   {				      assert(lval.constval != 0);	/* literal array must have a size */				      /* A literal array must have exactly the same size as the				       * function argument; a literal string may be smaller than				       * the function argument.				       */				      if (lval.constval > 0					  && arg[argidx].dim[0] != lval.constval					  || lval.constval < 0					  && arg[argidx].dim[0] <					  -lval.constval)					 error(47);	/* array sizes must match */				   }	/* if */			      }	/* if */			    if (lval.ident != iARRAYCELL)			      {				 /* save array size, for default values with uSIZEOF flag */				 cell                array_sz = lval.constval;				 assert(array_sz != 0);	/* literal array must have a size */				 if (array_sz < 0)				    array_sz = -array_sz;				 append_constval(&arrayszlst, arg[argidx].name,						 array_sz, 0);			      }	/* if */			 }		       else			 {			    symbol             *sym = lval.sym;			    short               level = 0;			    assert(sym != NULL);			    if (sym->dim.array.level + 1 != arg[argidx].numdim)			       error(48);	/* array dimensions must match */			    /* the lengths for all dimensions must match, unless the dimension			     * length was defined at zero (which means "undefined")			     */			    while (sym->dim.array.level > 0)			      {				 assert(level < sDIMEN_MAX);				 if (arg[argidx].dim[level] != 0				     && sym->dim.array.length !=				     arg[argidx].dim[level])				    error(47);	/* array sizes must match */				 append_constval(&arrayszlst, arg[argidx].name,						 sym->dim.array.length, level);				 sym = finddepend(sym);				 assert(sym != NULL);				 level++;			      }	/* if */			    /* the last dimension is checked too, again, unless it is zero */			    assert(level < sDIMEN_MAX);			    assert(sym != NULL);			    if (arg[argidx].dim[level] != 0				&& sym->dim.array.length !=				arg[argidx].dim[level])			       error(47);	/* array sizes must match */			    append_constval(&arrayszlst, arg[argidx].name,					    sym->dim.array.length, level);			 }	/* if */		       /* address already in PRI */		       if (!checktag			   (arg[argidx].tags, arg[argidx].numtags, lval.tag))			  error(213);		       // ??? set uWRITTEN?		       argidx++;	/* argument done */		       break;		    }		/* switch */		  push1();	/* store the function argument on the stack */		  endexpr(FALSE);	/* mark the end of a sub-expression */	       }		/* if */	     assert(arglist[argpos] != ARG_UNHANDLED);	     nargs++;	     close = matchtoken(')');	     if (!close)	/* if not paranthese... */		if (!needtoken(','))	/* ...should be comma... */		   break;	/* ...but abort loop if neither */	  }	while (!close && freading && !matchtoken(tENDEXPR));	/* do */     }				/* if */   /* check remaining function arguments (they may have default values) */   for (argidx = 0; arg[argidx].ident != 0 && arg[argidx].ident != iVARARGS;	argidx++)     {	if (arglist[argidx] == ARG_DONE)	   continue;		/* already seen and handled this argument */	/* in this first stage, we also skip the arguments with uSIZEOF and uTAGOF;	 * these are handled last	 */	if ((arg[argidx].hasdefault & uSIZEOF) != 0	    || (arg[argidx].hasdefault & uTAGOF) != 0)	  {	     assert(arg[argidx].ident == iVARIABLE);	     continue;	  }			/* if */	stgmark((char)(sEXPRSTART + argidx));	/* mark beginning of new expression in stage */	if (arg[argidx].hasdefault)	  {	     if (arg[argidx].ident == iREFARRAY)	       {		  short               level;		  setdefarray(arg[argidx].defvalue.array.data,			      arg[argidx].defvalue.array.size,			      arg[argidx].defvalue.array.arraysize,			      &arg[argidx].defvalue.array.addr,			      (arg[argidx].usage & uCONST) != 0);		  if ((arg[argidx].usage & uCONST) == 0)		     heapalloc += arg[argidx].defvalue.array.arraysize;		  /* keep the lengths of all dimensions of a multi-dimensional default array */		  assert(arg[argidx].numdim > 0);		  if (arg[argidx].numdim == 1)		    {		       append_constval(&arrayszlst, arg[argidx].name,				       arg[argidx].defvalue.array.arraysize, 0);		    }		  else		    {		       for (level = 0; level < arg[argidx].numdim; level++)			 {			    assert(level < sDIMEN_MAX);			    append_constval(&arrayszlst, arg[argidx].name,					    arg[argidx].dim[level], level);			 }	/* for */		    }		/* if */	       }	     else if (arg[argidx].ident == iREFERENCE)	       {		  setheap(arg[argidx].defvalue.val);		  /* address of the value on the heap in PRI */		  heapalloc++;	       }	     else	       {		  int                 dummytag = arg[argidx].tags[0];		  const1(arg[argidx].defvalue.val);		  assert(arg[argidx].numtags > 0);		  check_userop(NULL, arg[argidx].defvalue_tag,			       arg[argidx].tags[0], 2, NULL, &dummytag);		  assert(dummytag == arg[argidx].tags[0]);	       }		/* if */	     push1();		/* store the function argument on the stack */	     endexpr(FALSE);	/* mark the end of a sub-expression */	  }	else	  {	     error(202, argidx);	/* argument count mismatch */	  }			/* if */	if (arglist[argidx] == ARG_UNHANDLED)	   nargs++;	arglist[argidx] = ARG_DONE;     }				/* for */   /* now a second loop to catch the arguments with default values that are    * the "sizeof" or "tagof" of other arguments    */   for (argidx = 0; arg[argidx].ident != 0 && arg[argidx].ident != iVARARGS;	argidx++)     {	constvalue         *asz;	cell                array_sz;	if (arglist[argidx] == ARG_DONE)	   continue;		/* already seen and handled this argument */	stgmark((char)(sEXPRSTART + argidx));	/* mark beginning of new expression in stage */	assert(arg[argidx].ident == iVARIABLE);	/* if "sizeof", must be single cell */	/* if unseen, must be "sizeof" or "tagof" */	assert((arg[argidx].hasdefault & uSIZEOF) != 0	       || (arg[argidx].hasdefault & uTAGOF) != 0);	if ((arg[argidx].hasdefault & uSIZEOF) != 0)	  {	     /* find the argument; if it isn't found, the argument's default value	      * was a "sizeof" of a non-array (a warning for this was already given	      * when declaring the function)	      */	     asz = find_constval(&arrayszlst, arg[argidx].defvalue.size.symname,				 arg[argidx].defvalue.size.level);	     if (asz != NULL)	       {		  array_sz = asz->value;		  if (array_sz == 0)		     error(224, arg[argidx].name);	/* indeterminate array size in "sizeof" expression */	       }	     else	       {		  array_sz = 1;	       }		/* if */	  }	else	  {	     symbol             *sym;	     assert((arg[argidx].hasdefault & uTAGOF) != 0);	     sym = findloc(arg[argidx].defvalue.size.symname);	     if (sym == NULL)		sym = findglb(arg[argidx].defvalue.size.symname);	     array_sz = (sym != NULL) ? sym->tag : 0;	     exporttag(array_sz);	  }			/* if */	const1(array_sz);	push1();		/* store the function argument on the stack */	endexpr(FALSE);	if (arglist[argidx] == ARG_UNHANDLED)	   nargs++;	arglist[argidx] = ARG_DONE;     }				/* for */   stgmark(sENDREORDER);	/* mark end of reversed evaluation */   pushval((cell) nargs * sizeof(cell));   ffcall(sym, nargs);   if (sc_status != statSKIP)      markusage(sym, uREAD);	/* do not mark as "used" when this call itself is skipped */   if (sym->x.lib != NULL)      sym->x.lib->value += 1;	/* increment "usage count" of the library */   modheap(-heapalloc * sizeof(cell));   sideeffect = TRUE;		/* assume functions carry out a side-effect */   delete_consttable(&arrayszlst);	/* clear list of array sizes */}