Floating-Point Numbers on the BM i Operating System

**FREE
  // Prototype for FLOAT1
  Dcl-Pr Pgm_FLOAT1 ExtPgm('FLOAT1');
    argument        Float(8);
  End-Pr;
  // Procedure interface for FLOAT1
  Dcl-Pi Pgm_FLOAT1;
    argument        Float(8);
  End-Pi;
  Dsply '' '' argument;
  *inlr = *on;    

     A* This record format consists of one double-precision, floating-point
     A* field.  Type F denotes the field is floating-point, while the FLTPCN
     A* keyword determines the field's precision: *SINGLE for a 4-byte field,
     A* *DOUBLE for an 8-byte field.
     A*
     A          R FLOATREC
     A            FLD1          17F 7B      FLTPCN(*DOUBLE) 

     A* This display file works in conjunction with the ILE RPG program to
     A* select floating-point values from a DB file, add them up and calculate
     A* their mean.
     A*
     A                                      DSPSIZ(24 80 *DS3)
     A*
     A* The INVITE keyword is needed to display intermediate results.
     A*
     A                                      INVITE
     A          R DSPFREC
     A*
     A* User-specified lower and upper bounds for record retrieval.
     A*
     A                                  5 10'Lower Bound:'
     A            LT_OR_EQ      17F 7B  7 10FLTPCN(*DOUBLE)
     A                                      FLTFIXDEC
     A                                  5 50'Upper Bound:'
     A            GT_OR_EQ      17F 7B  7 50FLTPCN(*DOUBLE)
     A                                      FLTFIXDEC
     A*
     A* Value of current record.
     A*
     A N99                             10 10'Current Value:'
     A  99                             10 10'Last Value:'
     A            CUR_VAL       17F 7O 12 10FLTPCN(*DOUBLE)
     A                                      FLTFIXDEC
     A*
     A* Running total for all records retrieved.
     A*
     A N99                             10 50'Subtotal:'
     A  99                             10 50'Total:'
     A            CUR_SUM       17F 7O 12 50FLTPCN(*DOUBLE)
     A                                      FLTFIXDEC
     A*
     A* Number of records processed.
     A*
     A N99                             15 10'Number of Records Processed:'
     A  99                             15 10'Total Number of Records Processed:'
     A            CUR_N         17F 7O 17 10FLTPCN(*DOUBLE)
     A                                      FLTFIXDEC
     A*
     A* Running mean of record values retrieved.
     A*
     A                                 15 50'Mean:'
     A            CUR_MEAN      17F 7O 17 50FLTPCN(*DOUBLE)
     A                                      FLTFIXDEC 

**FREE
  //*********************************************************************************************
  // This program computes a running mean of floating-point values from DB file records.
  // The program first prompts the user for lower and upper bounds of numbers to be processed,
  // then retrieves all records within those bounds and processes them one by one.
  // The purpose of this program is primarily to demonstrate how approximate floating-point
  // values can be retrieved via SQL, given some tolerance value: this is important because
  // RPG opcodes such as CHAIN only match exact values, and floating-point numbers are most
  // often approximate.  For example, we may want to retrieve all records with a value of
  // 1 +/- 10 ** -3, i.e. 0.999 <= value <= 1.001: this is easily achieved using the technique
  // shown in this program.
  //
  // File containing floating-point values.
  //
  Dcl-F floatpf   ;
  //
  // Display file for intermediate and final results.
  //
  Dcl-F floatdspf1 WORKSTN;
  //
  // Prototype for QCMDEXC.  This is used to issue a DLYJOB command, so the user can read
  // intermediate results on the screen.
  //
  Dcl-Pr System_Command EXTPGM('QCMDEXC');
    Pr_Cmd          Char(80);
    Pr_Cmd_Length   Packed(15:5);
  End-Pr;
  //
  // Lower and upper bounds for floating-point number selection.
  //
  Dcl-S lower_bound     Float(8)        INZ(0);
  Dcl-S upper_bound     Float(8)        INZ(0);
  Dcl-S total           Float(8)        INZ(0);                            // Running total
  Dcl-S partial         Float(8)        INZ(0);                            //Value of current r
  Dcl-S n               Float(8)        INZ(0);                            // Numof recs so far
  Dcl-S mean            Float(8)        INZ(0);                            // Running mean
  Dcl-S count           Packed(10:0)    INZ(0);
  Dcl-S last_fetch      Ind             INZ(*OFF);                         //Last fetch indicat
  Dcl-S Command         Char(80)        INZ('DLYJOB DLY(1)');              //Used to hold scree
  Dcl-S Command_length  Packed(15:5)    INZ(80);                           //Standard cmd lengt
  Dcl-C OK              CONST(0);                                          // Successcode (SQL)
  //
  // Initialize lower/upper bounds in display file and show user.
  //
  lt_or_eq = lower_bound;
  gt_or_eq = upper_bound;
  Exfmt dspfrec;
  //
  // Read user-provided lower/upper bounds.
  //
  lower_bound = lt_or_eq;
  upper_bound = gt_or_eq;
  //
  // Select from the file all records whose value is within the lower/upper bounds.
  // Assign to cursor1 for fetching.
  //
  exec sql
   declare cursor1 cursor for
   select fld1, count(*)
          from floatpf
          where (fld1 >= :lower_bound) and (fld1 <= :upper_bound)
          group by fld1
          order by fld1;
  //
  // Open SQL cursor.
  //
  exec sql
   open cursor1;
  //
  last_fetch = *off;
  //
  // Process all matching records in a loop.
  //
  DoU last_fetch = *on;
    //
    // Fetch next matching record.
    //
    exec sql
     fetch cursor1
     into :partial, :count;
    If sqlcod = OK;                                                      // If successful fetch
      total = total + partial;                                             // Update total
      n = n + 1;                                                           // Increaserec count
      mean = total / n;                                                    // Recalculate mean
      cur_val = partial;                                                 // Current val -> DSPF
      cur_sum = total;                                                   // Current tot -> DSPF
      cur_n = n;                                                           // Rec count -> DSPF
      cur_mean = mean;                                                   //Current mean -> DSPF
      Write dspfrec;                                                     // Show updated values
      System_Command(Command:Command_Length);                            // Delay for user read
    Else;                                                                  // If fetch failed
      last_fetch = *on;                                                    // End loop
    EndIf;
  EndDo;
  //
  // Change DSPF prompts for the final result, then display and leave on screen.
  //
  *in99 = *on;
  Exfmt dspfrec;
  //
  // Close SQL cursor.
  //
  exec sql
   close cursor1;
  *inlr = *on;                                                             // End program 

Compile using CRTSQLRPGI OBJ(<yourlib>/FLOAT4) SRCFILE(<yourlib>/QRPGLESRC) SRCMBR(FLOAT4) OBJTYPE(*PGM)

Add a couple of records to file FLOATPF using SQL:
insert into floatpf values('123.E0')
insert into floatpf values('234.E0')

Call the program from command line
 ===> call float4   
Enter the values for Lower Bound and Upper Bound and press Enter        

 


 

A Note on Complex Numbers

Specific ILE-bindable CEE math APIs are available in different versions, some taking complex numbers as arguments.  
While it does not exist in native form on OS/400, the complex data type can be implemented as a data structure containing two floating point fields; 
depending on how the component fields are defined, a complex variable may be single- or double-precision.

Of all ILE languages, ILE C is best suited for handling this data type.  
The appropriate definitions can be found in the header file QSYSINC/H,LETYPE and the relevant API prototypes are in QSYSINC/H,LEMATH.
5770SS1 option 13 must be installed for library QSYSINC  to be loaded on the system.
The following code samples illustrate how to invoke the API for complex number multiplication using ILE RPG IV.  
The actual invocation is done via an ILE C module.  
The two modules are intended to be bound into a single program, the ILE RPG IV module being the entry point.

ILE RPG Source FLOAT6

**FREE
  //  This ILE RPG module indirectly uses API CEESEMLT to perform complex number
  //  multiplication.  The multiplication is performed via an intermediate C function,
  //  which transfers the operands to appropriate data structures, calls the API, and
  //  returns the result.
  //  Complex variables are defined in the source code as pairs of double-precision
  //  fields.  This is because, unlike C, RPG does not readily allow for defining
  //  data structures as data types.
  //
  Dcl-S Std_Double      Float(8);                                          //data type definiti
  Dcl-S var1_r          like(Std_Double);                                  // 1stoperand (real)
  Dcl-S var1_i          like(Std_Double);                                  // 1stoperand (imag)
  Dcl-S var2_r          like(Std_Double);                                  // 2ndoperand (real)
  Dcl-S var2_i          like(Std_Double);                                  // 2ndoperand (imag)
  Dcl-S result_r        like(Std_Double);                                  // result (real)
  Dcl-S result_i        like(Std_Double);                                  // result (imag)
  //
  //  Definition of C function prototype.  The function's arguments are 3 pairs of
  //  double-precision variables: the first two pairs for the two operands to be
  //  multiplied, and the last pair for the function to return the result.
  //
  //
  //  Internal prototype name is complex_c; external name of C function is
  //  'complex_multiply' (the external name is case-sensitive).
  //
  Dcl-Pr complex_c extproc('complex_multiply');
  //
  //  First operand
  //
    parm1           like(Std_Double) value;
    parm2           like(Std_Double) value;
  //
  //  Second operand
  //
    parm3           like(Std_Double) value;
    parm4           like(Std_Double) value;
  //
  //  The last two fields are passed by address, to allow the C function to return
  //  the multiplication's result.
  //
    parm5           Pointer         value;
    parm6           Pointer         value;
  End-Pr;
  //
  //  Set first operand to 1 + 2i
  //
  var1_r = 1;
  var1_i = 2;
  //
  //  Set second operand to 1 - 2i
  //
  var2_r = 1;
  var2_i = -2;
  //
  //  Multiply operands and return result
  //
  complex_c(var1_r : var1_i : var2_r : var2_i :
                %addr(result_r) : %addr(result_i));
  //
  //  The LR indicator needs to be turned on to signal end of program.  Note: this module
  //  is the ILE program's entry point.
  //
  *inlr = *on; 

ILE C Source FLOATC

/*
    This C module is designed as an interface between ILE RPG (or other ILE languages
    supporting the double-precision data type) and API CEESEMLT, which multiplies
    double-precision complex numbers.  The (ILE RPG) calling module sends each complex
    parameter as a pair of double-precision parameters.  The C function complex_multiply
    transfers the values to variables of type _COMPLEX16 (double-precision complex;see
    definition in QSYSINC/H,LETYPE), then invokes CEESEMLT.  The API is prototyped in
    QSYSINC/H,LEMATH.
*/

/*  Header letype.h contains the definitions for data types _COMPLEX16 and _FEEDBACK.             */
#include <letype.h>

/*  Header lemath.h contains the prototype for API CEESEMLT.                                      */
#include <lemath.h>

/*  Definitions of first operand, second operand, result for complex multiplication.              */
_COMPLEX16 var1, var2, result;

/*  Feedback area for API to return any errors.                                                   */
_FEEDBACK fc;

/*
    The function below interfaces with a caller, in this case written in ILE
    RPG, and with the complex multiplication API CEESEMLT.  The arguments
    represent:
    (1)  Real part of first operand
    (2)  Imaginary part of first operand
    (3)  Real part of second operand
    (4)  Imaginary part of second operand
    (5)  Real part of result
    (6)  Imaginary part of result
    The arguments are 6 individually defined double-precision fields, rather
    than 3 complex data structures; this is intended to allow interfacing of
    the function with languages not having the data structure facilities
    needed to call the API directly.
*/

void complex_multiply(double arg1r, double arg1i, double arg2r, double arg2i,
                      double * result_r, double * result_i)
{

/*  Load real and imaginary parts of first operand into data structure.                           */
  var1.real = arg1r;
  var1.imaginary = arg1i;

/*  Load real and imaginary parts of second operand into data structure.                          */
  var2.real = arg2r;
  var2.imaginary = arg2i;

/*  Invoke API  */
  CEESEMLT(&var1, &var2, &result, &fc);

/*  Load real and imaginary parts of result into arguments and return to caller.                  */
  *result_r = result.real;
  *result_i = result.imaginary;
  return;
}