/*--------------------------------------------------------------------+
|                                                                     |
|              Copyright 1995 (c), SAS Institute Inc.                  |
|                Unpublished - All Rights Reserved                    |
|                                                                     |
|                     S A S / C  S A M P L E                          |
|                                                                     |
|       Name: RXLOCFN                                                 |
|                                                                     |
|   Language: C                                                       |
|                                                                     |
| EntryPoint: REXMAIN                                                 |
|                                                                     |
| EntryType : OS Entry Linkage                                        |
|                                                                     |
| Files Note: 'prefix' is the installation defined high level         |
|             qualifier for the SAS/C product.                        |
|                                                                     |
|   Function: Provide a REXX function package containing the functions|
|             - csqrt(d)      compute square root                     |
|             - csin(d)       compute trigometric sine                |
|             - ccos(d)       compute trigometric cosine              |
|                                                                     |
|    Purpose: Demonstrate how to write and execute a REXX function    |
|             package for CMS using facilities provided by SAS/C.     |
|                                                                     |
| MVS - Not Supported                                                 |
|                                                                     |
| CMS -                                                               |
|     Source: SAMPLC   MACLIB (RXLOCFN)                               |
|                                                                     |
|    Compile: global maclib lc370                                     |
|             lc370 rxlocfn ( rent                                    |
|                                                                     |
|       Link: global txtlib lc370bas lc370std                         |
|             clink rxlocfn                                           |
|             load clink370 ( rld reset rexxmain                      |
|                                                                     |
|     Genmod: genmod rxlocfn(from @extern#                            |
|                                                                     |
|    Execute: Not Applicable                                          |
|                                                                     |
|      Notes:                                                         |
|             - See 'CMSRXFN' in SAS/C Library Reference Vol 2        |
|               for additional information on using the SAS/C         |
|               REXX interface.                                       |
|                                                                     |
+--------------------------------------------------------------------*/
#pragma eject

#include <cmsexec.h>
#include <stdio.h>
#include <stdlib.h>
#include <math.h>
#include <string.h>
#include <options.h>

/*-------------------------------------------------------------------+
| Since this program cannot be invoked directly from the command     |
| line, run-time options should be specified via the '_options'      |
| variable.                                                          |
+-------------------------------------------------------------------*/

/* int _options = _DEBUG; */

static int csin(), ccos(), csqrt();
static double todouble();
static void result();

/*-------------------------------------------------------------------+
| Define the values of 'fncv' and 'fncc'                             |
+-------------------------------------------------------------------*/

REXX_FNC funlist(||) = {&csin, &ccos, &csqrt};
#define NFUNCS sizeof(funlist)/sizeof(REXX_FNC)


void main(argc,argv)
int argc;
char *argv(||);

   {

   int rc;

   rc = cmsrxfn(argc,argv,NFUNCS,funlist);

   /*----------------------------------------------------------------+
   | A positive return code from cmsrxfn() indicates that either a   |
   | NUCXDROP RXLOCFN was entered, or an ABEND occurred in CMS.      |
   | A negative return code indicates that initialization did not    |
   | complete.                                                       |
   +----------------------------------------------------------------*/

   if (rc < 0) puts("RXLOCFN did not initialize.");

   }

/*-------------------------------------------------------------------+
| Compute trigometric sine.  Example:  x = csin(y)                   |
+-------------------------------------------------------------------*/

static csin(args)
struct REXX_PLIST args(||);

   {

   register double r;

   /*----------------------------------------------------------------+
   | Ensure that there is exactly one argument and that it is 15 or  |
   | fewer characters long.  (Other validation is probably useful,   |
   | but it has been omitted here.)                                  |
   +----------------------------------------------------------------*/

   if (args->ad == REXX_LAST_AD || args->len > 15 ||
       args(|1|).ad != REXX_LAST_AD) return 1;

   /* Perform other parameter validation as necessary.              */

                                  /* Convert to double.             */
   r = todouble(args->ad,args->len);
   r = sin(r);                    /* Get the sine.                  */
   result(r);                     /* Set Rexx 'result' variable.    */
   return 0;                      /* Tell Rexx it worked.           */

   }

/*-------------------------------------------------------------------+
| Compute trigometric cosine.  Example:  x= ccos(y)                  |
+-------------------------------------------------------------------*/

static ccos(args)
struct REXX_PLIST args(||);

   {

   register double r;

   if (args->ad == REXX_LAST_AD || args->len > 15 ||
       args(|1|).ad != REXX_LAST_AD) return 1;
   r = todouble(args->ad,args->len);
   r = cos(r);
   result(r);
   return 0;

   }

/*-------------------------------------------------------------------+
| Compute square root.  Example:  x = csqrt(y)                       |
+-------------------------------------------------------------------*/

static csqrt(args)
struct REXX_PLIST args(||);

   {

   register double r;

   if (args->ad == REXX_LAST_AD || args->len > 15 ||
       args(|1|).ad != REXX_LAST_AD) return 1;
   r = todouble(args->ad,args->len);
   if (r < 0.0) return 1;
   r = sqrt(r);
   result(r);
   return 0;

   }

/*-------------------------------------------------------------------+
| Convert Rexx parameter to double representation.                   |
+-------------------------------------------------------------------*/

static double todouble(str,len)   /* Convert string to double.      */
char *str;
int len;

   {

   char buff(|16|);
   double d;

   memcpy(buff,str,len);          /* Copy to a temporary buffer and */
   buff(|len|) = '\0';            /*  add a null terminator.        */
   d = strtod(buff,0);
   return d;                      /* Return converted argument.     */

   }

/*-------------------------------------------------------------------+
| Convert function result to character and set Rexx 'result' variable|
+-------------------------------------------------------------------*/

static void result(r)             /* Set Rexx 'result' variable.    */
double r;

   {                              /* Need enough room to handle     */
                                  /* leading zero, sign, decimal    */
   char buff(|15|);               /* point, and exponent.           */

                                  /* This is similar to REXX's      */
   sprintf(buff,"%.9G",r);        /* NUMERIC DIGITS 9 format.       */

   rxresult(buff);
   }