/* Copyright (C) 1993 by Thomas Glen Smith.  All Rights Reserved. */
/* monfront APL2 V1.0.0 ************************************************
* Called from execmoni to execute a scalar monadic function.           *
***********************************************************************/
#define INCLUDES APLCB+FUNSTRUC
#include "includes.h"
typedef void (*OPER)();/* Entry to monadic scalar proc. */
Aplcb monfront(fun,rite)
Scalar_monadics *fun;
Aplcb rite; /* function argument  */
{	Complex; Errinit; Errstop; Getcb; Intcopy; Integer; Real;
     OPER oper=NULL; extern int aplerr;
     Aplcb out=NULL; int *dimptr,i,intype,outype,ritetype;
     char *idata,*odata;

	if (errinit()) return(errstop(0,NULL,rite,NULL));
     switch(intype = outype = ritetype = rite->aplflags & APLMASK) {
     	case APLINT:
          	if (NULL != (oper = fun->procs.ppint)) break;
               intype = APLNUMB; /* desired input type */
     	case APLNUMB:
               outype = APLINT;
          	if (NULL != (oper = fun->procs.ppmix)) break;
               outype = APLNUMB;
          	if (NULL != (oper = fun->procs.ppdbl)) break;
               intype = outype = APLCPLX; /* desired I/O types */
          case APLCPLX:
          	if (NULL != (oper = fun->procs.ppcpx)) break;
               intype = outype = APLNUMB;
          	if (NULL != (oper = fun->procs.ppdbl)) break;
          default: break; /* no can do */
     } /* end switch */
     if (oper == NULL) return(errstop(73,NULL,rite,NULL));
     if (intype != ritetype) switch(intype) {
     	case APLNUMB: rite = real(rite);
               break;
          case APLCPLX: rite = complex(rite);
               break;
          case APLINT: rite = integer(rite);
               break;
          default: aplerr = 999; /* intenal error */
               break;
     } /* end switch */
	if (aplerr) return(errstop(0,NULL,rite,NULL));
	out=getcb(NULL,rite->aplcount,outype+APLTEMP,rite->aplrank,NULL);
	if (out->aplrank > 1)
		dimptr=intcopy(out->apldim,rite->apldim,out->aplrank,1);
	if (out->aplcount) {
		odata = out->aplptr.aplchar;
		idata = rite->aplptr.aplchar;
		for (i = out->aplcount; i > 0; i--) {
          	(*oper)(idata,odata);
			odata += out->aplsize;
               idata += rite->aplsize;
	     }
     }
	return(errstop(0,NULL,rite,out));
}