/* Copyright (C) 1996 by Thomas Glen Smith. All Rights Reserved. */ /* dyadoper APL2 V1.0.0 ************************************************ * Called by dyadcom and execdote to select the subroutine to handle * * scalar dyadic operations for the given datatype. * ***********************************************************************/ #define INCLUDES APLCB+APLCHDEF+FUNCODES+FUNSTRUC #include "includes.h" SCALAR_PROC dyadoper(fun, pintype, poutype, ltype, rtype, flags, code) Scalar_dyadics *fun; /* Describes the scalar dyadic. */ int *pintype,*poutype; /* Set by dyadoper to required data types. */ int ltype,rtype,flags,code; /* Argument data types. */ { Dyadopec; extern int aplerr; SCALAR_PROC oper=NULL; if (ltype == APLCHAR || rtype == APLCHAR) return(dyadopec(fun,pintype,poutype,ltype,rtype,flags)); if (code == CIRCLE) { *pintype = *poutype = APLCPLX; oper = fun->procs.ppcpx; } else switch(ltype | rtype) { case APLINT: *pintype = *poutype = APLINT; if (NULL != (oper = fun->procs.ppint)) break; case APLNUMB: case APLNUMB | APLINT: *pintype = *poutype = APLNUMB; if (NULL != (oper = fun->procs.ppdbl)) break; if (flags == EQNE || flags == SCDO) { *poutype = APLINT; if (NULL != (oper = fun->procs.ppmix)) break; } case APLCPLX: case APLCPLX | APLNUMB: case APLCPLX | APLINT: *pintype = *poutype = APLCPLX; oper = fun->procs.ppcpx; if (oper == NULL) { /* try mix */ *poutype = APLINT; oper = fun->procs.ppmpx; } break; default: oper = NULL; break; } /* end switch */ if (oper == NULL) { *pintype = *poutype = APLNUMB; oper = fun->procs.ppdbl; } return(oper); }