----------------------------------------------------------------------------------                                                                            ---- File    : simple_lookup.adb                              $Revision: 1.6 $  ---- Abstract:                                                                  ----      Body of the Ada S-Function simple_lookup. This example S-Function     ----      illustrates the idea of writing a "wrapper" S-Function that "wraps"   ----      standalone Ada code (i.e., ada packages and procedures) both for      ----      use with Simulink as an S-Function, and directly with Ada code        ----      generated using the RTW Ada Coder.                                    ----                                                                            ----      For the purpose of illustration, a simple lookup table example is     ----      implemented here as an S-Function. This S-Function takes three        ----      parameters:                                                           ----        Parameter 1: "Xvalues", which must be a monotonically increasing    ----                     double vector with atleast two elements:               ----                                                                            ----                              -inf < X1 < X2 < ... < Xn < inf               ----                                                                            ----        Parameter 2: "Yvalues", which must be a double vector and it should ----                     have one element more than the Xvalues vector:         ----                                                                            ----                              Y0, Y1, Y2, ..., Yn                           ----                                                                            ----        Parameter 3: "LookupMethod", which must be one of the two strings,  ----                     either "left" or "right". This specifies which lookup  ----                     method to use.                                         ----                                                                            ----     The two simple algoithms implemented in the package lookup_methods     ----     allow us to make this S-function have the following functionality:     ----                                                                            ----     If Lookup Method == "left" then:                                       ----                                                                            ----                         inp <= X1  =>  out1 = y0                           ----                  X1   < inp <= X2  =>  out1 = y1                           ----                  X2   < inp <= X3  =>  out1 = y2                           ----                                :                                           ----                                :                                           ----                  Xn-1 < inp <= Xn  =>  out1 = yn-1                         ----                  Xn   < inp        =>  out1 = yn                           ----                                                                            ----     If Lookup Method == "right" then:                                      ----                                                                            ----                          inp < X1  =>  out1 = y0                           ----                  X1   <= inp < X2  =>  out1 = y1                           ----                  X2   <= inp < X3  =>  out1 = y2                           ----                                :                                           ----                                :                                           ----                  Xn-1 <= inp < Xn  =>  out1 = yn-1                         ----                  Xn   <= inp       =>  out1 = yn                           ----                                                                            ----                                                                            ----    The second output port is used as an intermediate storage area by the   ----    lookup algorithm to remember the last index into the table, this index  ----    is used as a starting point for the search to bracket the input.        ----                                                                            ----    The lookup algorithms used in this S-Function are not used or related   ----    to the actual lookup table blocks that you see in the Simulink block    ----    library. This S-Funciton and the supporting lookup_methods package is   ----    merely used to illustrate the functionality of Ada S-Functions.         ----                                                                            ---- Author  : Murali Yeddanapudi and Tom Weis, 26-Jul-1999                     ----                                                                            ---- Copyright 1990-2002 The MathWorks, Inc.--                                                                            ----------------------------------------------------------------------------------with Lookup_Methods;with Simulink; use Simulink;with Ada.Exceptions; use Ada.Exceptions;package body Simple_Lookup is   X_VALUES_PRM_IDX    : constant integer := 0;   Y_VALUES_PRM_IDX    : constant integer := 1;   LOOKUP_MTH_PRM_IDX  : constant integer := 2;   NUM_PARAMS_EXPECTED : constant integer := 3;   -- Procedure: IsLookupValuesParameterValid ----------------------------------   -- Abstract::   --      Utility subrutine to check if the x and y table data parameters are   --      valid.   --   function IsLookupValuesParameterValid     (S : in SimStruct; PrmIdx : in Integer) return Boolean is      NumDims : Integer := ssGetParameterNumDimensions(S, PrmIdx);      Dims : array(0 .. NumDims-1) of Integer;      for Dims'Address use ssGetParameterDimensions(S, PrmIdx);      Width : Integer := SsGetParameterWidth(S, PrmIdx);   begin      if ( not(ssGetParameterIsDouble(S, PrmIdx)) or (NumDims /= 2) or           (Dims(0) /= 1 and Dims(1) /= 1) or (Width < 2) ) then         return(FALSE);      else         return(TRUE);      end if;   end IsLookupValuesParameterValid; -------------------------------------------   -- Procedure: mdlCheckParameters --------------------------------------------   -- Abstract::   --      Verify that the parameter passed to the S-Function via its dialog   --      box are okay.   --   procedure mdlCheckParameters(S : in SimStruct) is      NumActParams : Integer := ssGetNumParameters(S);   begin      -- Expected number of parameters      if (NumActParams /= NUM_PARAMS_EXPECTED) then         ssSetErrorStatus(S, "Parameter count mismatch. Expecting " &                          Integer'Image(NUM_PARAMS_EXPECTED) & " parameter " &                          "while " & Integer'Image(NumActParams) & " were " &                          "provided in the block dialog box");         return;      end if;      -- X values parameter must be a double vector with atleast two elements.      if not(IsLookupValuesParameterValid(S, X_VALUES_PRM_IDX)) then         ssSetErrorStatus(S, "The X data parameter mustbe a double " &                          "vector with atleast two elements");         return;      end if;      -- Y values parameter must be a double vector with atleast two elements.      if not(IsLookupValuesParameterValid(S, Y_VALUES_PRM_IDX)) then         ssSetErrorStatus(S, "The Y data parameter must be a double " &                          "vector with atleast two elements");         return;      end if;      -- Lookup method must be string that is either "left" or "right"      declare         ErrMsg : String := "The " & Integer'Image(LOOKUP_MTH_PRM_IDX+1) &           "rd parameter must be a string, either 'left' or 'right', that " &           "specifies the lookup method";      begin         if ssGetParameterIsChar(S, LOOKUP_MTH_PRM_IDX) then            declare               LookupMth : String := ssGetStringParameter(S,LOOKUP_MTH_PRM_IDX);            begin               if (LookupMth /= "left" and LookupMth /= "right") then                  ssSetErrorStatus(S, ErrMsg);               end if;            end;         else            ssSetErrorStatus(S, ErrMsg);            return;         end if;      end;      declare         XLen    : Integer := ssGetParameterWidth(S, X_VALUES_PRM_IDX);         XValues : array(1 .. XLen) of Real_T;         for XValues'Address use ssGetParameterAddress(S, X_VALUES_PRM_IDX);         YLen : Integer := ssGetParameterWidth(S, Y_VALUES_PRM_IDX);      begin         -- Y values vector must be one longer than the X values vector         if ( XLen+1 /=  YLen ) then            ssSetErrorStatus(S, "The Y values vector length (" &                             Integer'Image(YLen) & ") must be one greater " &                             "than the x values parameter vector length (" &                             Integer'Image(XLen) & ")");            return;         end if;         -- X values vector must be monotonically increasing         for I in 1 .. XLen-1 loop            if ( XValues(I) > XValues(I+1) ) then               ssSetErrorStatus(S, "X values parameter values must " &                                "be monotonically increasing");