|| (*argc == 'g') || (*argc == 's')
|| (*argc == 'i')
ffeintrin_check_ (ffeintrinImp imp, ffebldOp op,		  ffebld args, ffeinfoBasictype *xbt,		  ffeinfoKindtype *xkt,		  ffetargetCharacterSize *xsz,		  ffelexToken t,		  bool commit){  char *c = ffeintrin_imps_[imp].control;  bool subr = (c[0] == '-');  char *argc;  ffebld arg;  ffeinfoBasictype bt;  ffeinfoKindtype kt;  ffetargetCharacterSize sz = FFETARGET_charactersizeNONE;  ffeinfoKindtype firstarg_kt;  bool need_col;  ffeinfoBasictype col_bt = FFEINFO_basictypeNONE;  ffeinfoKindtype col_kt = FFEINFO_kindtypeNONE;  /* Check procedure type (function vs. subroutine) against     invocation.  */  if (op == FFEBLD_opSUBRREF)    {      if (!subr)	return FFEBAD_INTRINSIC_IS_FUNC;    }  else if (op == FFEBLD_opFUNCREF)    {      if (subr)	return FFEBAD_INTRINSIC_IS_SUBR;    }  else    return FFEBAD_INTRINSIC_REF;  /* Check the arglist for validity.  */  if ((args != NULL)      && (ffebld_head (args) != NULL))    firstarg_kt = ffeinfo_kindtype (ffebld_info (ffebld_head (args)));  else    firstarg_kt = FFEINFO_kindtype;  for (argc = &c[5],	 arg = args;       *argc != '\0';       )    {      char optional = '\0';      char required = '\0';      char extra = '\0';      char basic;      char kind;      bool lastarg_complex = FALSE;      /* We don't do anything with keywords yet.  */      do	{	} while (*(++argc) != '=');      ++argc;      if ((*argc == '?')	  || (*argc == '!')	  || (*argc == '*'))	optional = *(argc++);      if ((*argc == '+')	  || (*argc == 'n')	  || (*argc == 'p'))	required = *(argc++);      basic = *(argc++);      kind = *(argc++);      if ((*argc == '&')	  || (*argc == 'g')	  || (*argc == 's')	  || (*argc == 'w')	  || (*argc == 'x'))	extra = *(argc++);      if (*argc == ',')	++argc;      /* Break out of this loop only when current arg spec completely	 processed.  */      do	{	  bool okay;	  ffebld a;	  ffeinfo i;	  bool anynum;	  ffeinfoBasictype abt = FFEINFO_basictypeNONE;	  ffeinfoKindtype akt = FFEINFO_kindtypeNONE;	  if ((arg == NULL)	      || (ffebld_head (arg) == NULL))	    {	      if (required != '\0')		return FFEBAD_INTRINSIC_TOOFEW;	      if (optional == '\0')		return FFEBAD_INTRINSIC_TOOFEW;	      if (arg != NULL)		arg = ffebld_trail (arg);	      break;	/* Try next argspec. */	    }	  a = ffebld_head (arg);	  i = ffebld_info (a);	  anynum = (ffeinfo_basictype (i) == FFEINFO_basictypeHOLLERITH)	    || (ffeinfo_basictype (i) == FFEINFO_basictypeTYPELESS);	  /* See how well the arg matches up to the spec.  */	  switch (basic)	    {	    case 'A':	      okay = ffeinfo_basictype (i) == FFEINFO_basictypeCHARACTER;	      break;	    case 'C':	      okay = anynum		|| (ffeinfo_basictype (i) == FFEINFO_basictypeCOMPLEX);	      abt = FFEINFO_basictypeCOMPLEX;	      break;	    case 'I':	      okay = anynum		|| (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER);	      abt = FFEINFO_basictypeINTEGER;	      break;	    case 'L':	      okay = anynum		|| (ffeinfo_basictype (i) == FFEINFO_basictypeLOGICAL);	      abt = FFEINFO_basictypeLOGICAL;	      break;	    case 'R':	      okay = anynum		|| (ffeinfo_basictype (i) == FFEINFO_basictypeREAL);	      abt = FFEINFO_basictypeREAL;	      break;	    case 'B':	      okay = anynum		|| (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)		|| (ffeinfo_basictype (i) == FFEINFO_basictypeLOGICAL);	      break;	    case 'F':	      okay = anynum		|| (ffeinfo_basictype (i) == FFEINFO_basictypeCOMPLEX)		|| (ffeinfo_basictype (i) == FFEINFO_basictypeREAL);	      break;	    case 'N':	      okay = anynum		|| (ffeinfo_basictype (i) == FFEINFO_basictypeCOMPLEX)		|| (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)		|| (ffeinfo_basictype (i) == FFEINFO_basictypeREAL);	      break;	    case 'S':	      okay = anynum		|| (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)		|| (ffeinfo_basictype (i) == FFEINFO_basictypeREAL);	      break;	    case '-':	    default:	      okay = TRUE;	      break;	    }	  switch (kind)	    {	    case '1':	      okay &= anynum || (ffeinfo_kindtype (i) == 1);	      akt = 1;	      break;	    case '2':	      okay &= anynum || (ffeinfo_kindtype (i) == 2);	      akt = 2;	      break;	    case '3':	      okay &= anynum || (ffeinfo_kindtype (i) == 3);	      akt = 3;	      break;	    case 'A':	      okay &= anynum || (ffeinfo_kindtype (i) == firstarg_kt);	      akt = (firstarg_kt == FFEINFO_kindtype) ? FFEINFO_kindtypeNONE		: firstarg_kt;	      break;	    case 's':	      if (((((ffeinfo_basictype (i) != FFEINFO_basictypeNONE)		     || (ffeinfo_kindtype (i) != FFEINFO_kindtypeNONE)		     || (ffeinfo_kind (i) != FFEINFO_kindSUBROUTINE))		    && ((ffeinfo_basictype (i) != FFEINFO_basictypeINTEGER)			|| (ffeinfo_kindtype (i) != FFEINFO_kindtypeINTEGERDEFAULT)			|| (ffeinfo_kind (i) != FFEINFO_kindFUNCTION))		    && (ffeinfo_kind (i) != FFEINFO_kindNONE))		   || ((ffeinfo_where (i) != FFEINFO_whereDUMMY)		       && (ffeinfo_where (i) != FFEINFO_whereGLOBAL)))		  && ((ffeinfo_basictype (i) != FFEINFO_basictypeINTEGER)		      || (ffeinfo_kind (i) != FFEINFO_kindENTITY)))		okay = FALSE;	      break;	    case '0':	    default:	      break;	    }	  switch (extra)	    {	    case '&':	      if ((ffeinfo_kind (i) != FFEINFO_kindENTITY)		  || ((ffebld_op (a) != FFEBLD_opSYMTER)		      && (ffebld_op (a) != FFEBLD_opSUBSTR)		      && (ffebld_op (a) != FFEBLD_opARRAYREF)))		okay = FALSE;	      break;	    case 'g':	      if ((ffebld_op (a) != FFEBLD_opLABTER)		  && (ffebld_op (a) != FFEBLD_opLABTOK))		okay = FALSE;	      break;	    case 's':	      break;	    case 'w':	    case 'x':	      if ((ffeinfo_kind (i) != FFEINFO_kindENTITY)		  || (ffeinfo_rank (i) != 0)		  || ((ffebld_op (a) != FFEBLD_opSYMTER)		      && (ffebld_op (a) != FFEBLD_opARRAYREF)		      && (ffebld_op (a) != FFEBLD_opSUBSTR)))		okay = FALSE;	      break;	    default:	      if ((ffeinfo_kind (i) != FFEINFO_kindENTITY)		  || (ffeinfo_rank (i) != 0))		okay = FALSE;	      break;	    }	  if ((optional == '!')	      && lastarg_complex)	    okay = FALSE;	  if (!okay)	    {	      /* If it wasn't optional, it's an error,		 else maybe it could match a later argspec.  */	      if (optional == '\0')		return FFEBAD_INTRINSIC_REF;	      break;	/* Try next argspec. */	    }	  lastarg_complex	    = (ffeinfo_basictype (i) == FFEINFO_basictypeCOMPLEX);	  if (anynum)	    {	      /* If we know dummy arg type, convert to that now.  */	      if ((abt != FFEINFO_basictypeNONE)		  && (akt != FFEINFO_kindtypeNONE)		  && commit)		{		  /* We have a known type, convert hollerith/typeless		     to it.  */		  a = ffeexpr_convert (a, t, NULL,				       abt, akt, 0,				       FFETARGET_charactersizeNONE,				       FFEEXPR_contextLET);		  ffebld_set_head (arg, a);		}	    }	  arg = ffebld_trail (arg);	/* Arg accepted, now move on. */	  if (optional == '*')	    continue;	/* Go ahead and try another arg. */	  if (required == '\0')	    break;	  if ((required == 'n')	      || (required == '+'))	    {	      optional = '*';	      required = '\0';	    }	  else if (required == 'p')	    required = 'n';	} while (TRUE);    }  /* Ignore explicit trailing omitted args.  */  while ((arg != NULL) && (ffebld_head (arg) == NULL))    arg = ffebld_trail (arg);  if (arg != NULL)    return FFEBAD_INTRINSIC_TOOMANY;  /* Set up the initial type for the return value of the function.  */  need_col = FALSE;  switch (c[0])    {    case 'A':      bt = FFEINFO_basictypeCHARACTER;      sz = 1;      break;    case 'C':      bt = FFEINFO_basictypeCOMPLEX;      break;    case 'I':      bt = FFEINFO_basictypeINTEGER;      break;    case 'L':      bt = FFEINFO_basictypeLOGICAL;      break;    case 'R':      bt = FFEINFO_basictypeREAL;      break;    case 'B':    case 'F':    case 'N':    case 'S':      need_col = TRUE;      /* Fall through.  */    case '-':    default:      bt = FFEINFO_basictypeNONE;      break;    }  switch (c[1])    {    case '1':      kt = 1;      break;    case '2':      kt = 2;      break;    case '3':      kt = 3;      break;    case 'C':      if (ffe_is_90 ())	need_col = TRUE;      kt = 1;      break;    case '0':      need_col = TRUE;      /* Fall through.  */    case '-':    default:      kt = FFEINFO_kindtypeNONE;      break;    }  /* Determine collective type of COL, if there is one.  */  if (need_col || c[3] != '-')    {      bool okay = TRUE;      bool have_anynum = FALSE;      for (arg = args;	   arg != NULL;	   arg = (c[3] == '*') ? ffebld_trail (arg) : NULL)	{	  ffebld a = ffebld_head (arg);	  ffeinfo i;	  bool anynum;	  if (a == NULL)	    continue;	  i = ffebld_info (a);	  anynum = (ffeinfo_basictype (i) == FFEINFO_basictypeHOLLERITH)	    || (ffeinfo_basictype (i) == FFEINFO_basictypeTYPELESS);	  if (anynum)	    {	      have_anynum = TRUE;	      continue;	    }	  if ((col_bt == FFEINFO_basictypeNONE)	      && (col_kt == FFEINFO_kindtypeNONE))	    {	      col_bt = ffeinfo_basictype (i);	      col_kt = ffeinfo_kindtype (i);	    }	  else	    {	      ffeexpr_type_combine (&col_bt, &col_kt,				    col_bt, col_kt,				    ffeinfo_basictype (i),				    ffeinfo_kindtype (i),				    NULL);	      if ((col_bt == FFEINFO_basictypeNONE)		  || (col_kt == FFEINFO_kindtypeNONE))		return FFEBAD_INTRINSIC_REF;	    }	}      if (have_anynum	  && ((col_bt == FFEINFO_basictypeNONE)	      || (col_kt == FFEINFO_kindtypeNONE)))	{	  /* No type, but have hollerith/typeless.  Use type of return	     value to determine type of COL.  */	  switch (c[0])	    {	    case 'A':	      return FFEBAD_INTRINSIC_REF;	    case 'B':	    case 'I':	    case 'L':	      if ((col_bt != FFEINFO_basictypeNONE)		  && (col_bt != FFEINFO_basictypeINTEGER))		return FFEBAD_INTRINSIC_REF;	      /* Fall through.  */	    case 'N':	    case 'S':	    case '-':	    default:	      col_bt = FFEINFO_basictypeINTEGER;	      col_kt = FFEINFO_kindtypeINTEGER1;	      break;	    case 'C':	      if ((col_bt != FFEINFO_basictypeNONE)		  && (col_bt != FFEINFO_basictypeCOMPLEX))		return FFEBAD_INTRINSIC_REF;	      col_bt = FFEINFO_basictypeCOMPLEX;	      col_kt = FFEINFO_kindtypeREAL1;	      break;	    case 'R':	      if ((col_bt != FFEINFO_basictypeNONE)		  && (col_bt != FFEINFO_basictypeREAL))		return FFEBAD_INTRINSIC_REF;	      /* Fall through.  */	    case 'F':	      col_bt = FFEINFO_basictypeREAL;	      col_kt = FFEINFO_kindtypeREAL1;	      break;	    }	}      switch (c[0])	{	case 'B':	  okay = (col_bt == FFEINFO_basictypeINTEGER)	    || (col_bt == FFEINFO_basictypeLOGICAL);	  if (need_col)	    bt = col_bt;	  break;	case 'F':	  okay = (col_bt == FFEINFO_basictypeCOMPLEX)	    || (col_bt == FFEINFO_basictypeREAL);	  if (need_col)	    bt = col_bt;	  break;	case 'N':	  okay = (col_bt == FFEINFO_basictypeCOMPLEX)	    || (col_bt == FFEINFO_basictypeINTEGER)	    || (col_bt == FFEINFO_basictypeREAL);	  if (need_col)	    bt = col_bt;	  break;	case 'S':	  okay = (col_bt == FFEINFO_basictypeINTEGER)	    || (col_bt == FFEINFO_basictypeREAL)	    || (col_bt == FFEINFO_basictypeCOMPLEX);	  if (need_col)	    bt = ((col_bt != FFEINFO_basictypeCOMPLEX) ? col_bt		  : FFEINFO_basictypeREAL);	  break;	}      switch (c[1])	{	case '0':	  if (need_col)	    kt = col_kt;	  break;	case 'C':	  if (need_col && (col_bt == FFEINFO_basictypeCOMPLEX))	    kt = col_kt;	  break;	}      if (!okay)	return FFEBAD_INTRINSIC_REF;    }  /* Now, convert args in the arglist to the final type of the COL.  */  for (argc = &c[5],	 arg = args;       *argc != '\0';       )    {      char optional = '\0';      char required = '\0';      char extra = '\0';      char basic;      char kind;      bool lastarg_complex = FALSE;      /* We don't do anything with keywords yet.  */      do	{	} while (*(++argc) != '=');      ++argc;      if ((*argc == '?')	  || (*argc == '!')	  || (*argc == '*'))	optional = *(argc++);      if ((*argc == '+')	  || (*argc == 'n')	  || (*argc == 'p'))	required = *(argc++);      basic = *(argc++);      kind = *(argc++);      if ((*argc == '&')	  || (*argc == 'g')	  || (*argc == 's')	  || (*argc == 'w')	  || (*argc == 'x'))	extra = *(argc++);      if (*argc == ',')	++argc;      /* Break out of this loop only when current arg spec completely	 processed.  */      do	{	  bool okay;	  ffebld a;	  ffeinfo i;	  bool anynum;	  ffeinfoBasictype abt;	  ffeinfoKindtype akt;	  if ((arg == NULL)	      || (ffebld_head (arg) == NULL))	    {	      if (arg != NULL)		arg = ffebld_trail (arg);	      break;	/* Try next argspec. */	    }	  a = ffebld_head (arg);	  i = ffebld_info (a);	  anynum = (ffeinfo_basictype (i) == FFEINFO_basictypeHOLLERITH)	    || (ffeinfo_basictype (i) == FFEINFO_basictypeTYPELESS);	  /* Determine what the default type for anynum would be.  */	  abt = FFEINFO_basictypeNONE;	  akt = FFEINFO_kindtypeNONE;	  if (anynum)	    {	      switch (c[3])		{		case '-':		  break;		case '1':		  if (arg != args)		    break;		case '*':		  abt = col_bt;		  akt = col_kt;		  break;		}	    }	  /* Again, match arg up to the spec.  We go through all of	     this again to properly follow the contour of optional	     arguments.  Probably this level of flexibility is not	     needed, perhaps it's even downright naughty.  */	  switch (basic)	    {	    case 'A':	      okay = ffeinfo_basictype (i) == FFEINFO_basictypeCHARACTER;	      break;	    case 'C':	      okay = anynum		|| (ffeinfo_basictype (i) == FFEINFO_basictypeCOMPLEX);	      abt = FFEINFO_basictypeCOMPLEX;	      break;	    case 'I':	      okay = anynum		|| (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER);	      abt = FFEINFO_basictypeINTEGER;	      break;	    case 'L':	      okay = anynum		|| (ffeinfo_basictype (i) == FFEINFO_basictypeLOGICAL);	      abt = FFEINFO_basictypeLOGICAL;	      break;	    case 'R':	      okay = anynum		|| (ffeinfo_basictype (i) == FFEINFO_basictypeREAL);	      abt = FFEINFO_basictypeREAL;	      break;	    case 'B':	      okay = anynum		|| (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)		|| (ffeinfo_basictype (i) == FFEINFO_basictypeLOGICAL);	      break;	    case 'F':	      okay = anynum		|| (ffeinfo_basictype (i) == FFEINFO_basictypeCOMPLEX)		|| (ffeinfo_basictype (i) == FFEINFO_basictypeREAL);	      break;	    case 'N':	      okay = anynum		|| (ffeinfo_basictype (i) == FFEINFO_basictypeCOMPLEX)		|| (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)		|| (ffeinfo_basictype (i) == FFEINFO_basictypeREAL);	      break;	    case 'S':	      okay = anynum		|| (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)		|| (ffeinfo_basictype (i) == FFEINFO_basictypeREAL);	      break;	    case '-':	    default:	      okay = TRUE;	      break;	    }	  switch (kind)	    {	    case '1':	      okay &= anynum || (ffeinfo_kindtype (i) == 1);	      akt = 1;	      break;	    case '2':	      okay &= anynum || (ffeinfo_kindtype (i) == 2);	      akt = 2;	      break;	    case '3':	      okay &= anynum || (ffeinfo_kindtype (i) == 3);	      akt = 3;	      break;	    case 'A':	      okay &= anynum || (ffeinfo_kindtype (i) == firstarg_kt);	      akt = (firstarg_kt == FFEINFO_kindtype) ? FFEINFO_kindtypeNONE		: firstarg_kt;	      break;	    case 's':	      if (((((ffeinfo_basictype (i) != FFEINFO_basictypeNONE)		     || (ffeinfo_kindtype (i) != FFEINFO_kindtypeNONE)		     || (ffeinfo_kind (i) != FFEINFO_kindSUBROUTINE))		    && ((ffeinfo_basictype (i) != FFEINFO_basictypeINTEGER)			|| (ffeinfo_kindtype (i) != FFEINFO_kindtypeINTEGERDEFAULT)			|| (ffeinfo_kind (i) != FFEINFO_kindFUNCTION))		    && (ffeinfo_kind (i) != FFEINFO_kindNONE))		   || ((ffeinfo_where (i) != FFEINFO_whereDUMMY)		       && (ffeinfo_where (i) != FFEINFO_whereGLOBAL)))		  && ((ffeinfo_basictype (i) != FFEINFO_basictypeINTEGER)		      || (ffeinfo_kind (i) != FFEINFO_kindENTITY)))		okay = FALSE;	      break;	    case '0':	    default:	      break;	    }	  switch (extra)	    {	    case '&':	      if ((ffeinfo_kind (i) != FFEINFO_kindENTITY)		  || ((ffebld_op (a) != FFEBLD_opSYMTER)		      && (ffebld_op (a) != FFEBLD_opSUBSTR)		      && (ffebld_op (a) != FFEBLD_opARRAYREF)))		okay = FALSE;	      break;	    case 'g':	      if ((ffebld_op (a) != FFEBLD_opLABTER)		  && (ffebld_op (a) != FFEBLD_opLABTOK))		okay = FALSE;	      break;	    case 's':	      break;	    case 'w':	    case 'x':	      if ((ffeinfo_kind (i) != FFEINFO_kindENTITY)		  || (ffeinfo_rank (i) != 0)		  || ((ffebld_op (a) != FFEBLD_opSYMTER)		      && (ffebld_op (a) != FFEBLD_opARRAYREF)		      && (ffebld_op (a) != FFEBLD_opSUBSTR)))		okay = FALSE;	      break;	    default:	      if ((ffeinfo_kind (i) != FFEINFO_kindENTITY)		  || (ffeinfo_rank (i) != 0))		okay = FALSE;	      break;	    }	  if ((optional == '!')	      && lastarg_complex)	    okay = FALSE;	  if (!okay)	    {	      /* If it wasn't optional, it's an error,		 else maybe it could match a later argspec.  */	      if (optional == '\0')		return FFEBAD_INTRINSIC_REF;	      break;	/* Try next argspec. */	    }	  lastarg_complex	    = (ffeinfo_basictype (i) == FFEINFO_basictypeCOMPLEX);	  if (anynum && commit)	    {	      /* If we know dummy arg type, convert to that now.  */	      if (abt == FFEINFO_basictypeNONE)		abt = FFEINFO_basictypeINTEGER;	      if (akt == FFEINFO_kindtypeNONE)		akt = FFEINFO_kindtypeINTEGER1;	      /* We have a known type, convert hollerith/typeless to it.  */	      a = ffeexpr_convert (a, t, NULL,				   abt, akt, 0,				   FFETARGET_charactersizeNONE,				   FFEEXPR_contextLET);	      ffebld_set_head (arg, a);	    }	  else if ((c[3] == '*') && commit)	    {	      /* This is where we promote types to the consensus		 type for the COL.  Maybe this is where -fpedantic		 should issue a warning as well.  */	      a = ffeexpr_convert (a, t, NULL,				   col_bt, col_kt, 0,				   ffeinfo_size (i),				   FFEEXPR_contextLET);	      ffebld_set_head (arg, a);	    }	  arg = ffebld_trail (arg);	/* Arg accepted, now move on. */	  if (optional == '*')	    continue;	/* Go ahead and try another arg. */	  if (required == '\0')	    break;	  if ((required == 'n')	      || (required == '+'))	    {	      optional = '*';	      required = '\0';	    }	  else if (required == 'p')	    required = 'n';	} while (TRUE);    }  *xbt = bt;  *xkt = kt;  *xsz = sz;  return FFEBAD;}