.CM *ID* VSP52    VDN      changed on 1992-05-22-13.43.39 by KERN      *
.CM  SCRIPT , Version - 1.1 , last edited by M.Rathmann
.ad 8
.bm 8
.fm 4
.bt $Copyright (c) 1998-2004 SAP AG$$Page %$
.tm 12
.hm 6
.hs 3
.TT 1 $SQL$Project Distributed Database System$VSP52$
.tt 2 $$$
.TT 3 $$Exponential-Functions$1998-06-25$
***********************************************************
.nf

.nf


    ========== licence begin  GPL
    Copyright (c) 1998-2004 SAP AG

    This program is free software; you can redistribute it and/or
    modify it under the terms of the GNU General Public License
    as published by the Free Software Foundation; either version 2
    of the License, or (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
    ========== licence end

.fo


.fo
.nf
.sp
MODULE  : Exponential-Functions
=========
.sp
Purpose : square root; power
.CM *-END-* purpose -------------------------------------
.sp
.cp 3
Define  :
 
        PROCEDURE
              s52power (
                    VAR base       : tsp00_MoveObj;
                    basepos        : tsp00_Int4;
                    baselen        : integer;
                    basefrac       : integer;
                    VAR power      : tsp00_MoveObj;
                    ppos           : tsp00_Int4;
                    plen           : integer;
                    pfrac          : integer;
                    VAR result     : tsp00_MoveObj;
                    respos         : tsp00_Int4;
                    reslen         : integer;
                    resfrac        : integer;
                    VAR ret        : tsp00_NumError);
 
        PROCEDURE
              s52sqrt (
                    VAR source     : tsp00_MoveObj;
                    spos           : tsp00_Int4;
                    slen           : integer;
                    VAR result     : tsp00_MoveObj;
                    respos         : tsp00_Int4;
                    reslen         : integer;
                    resfrac        : integer;
                    VAR ret        : tsp00_NumError);
 
.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :
 
        FROM
              GET-Conversions : VSP40;
 
        PROCEDURE
              s40glint (
                    VAR buf  : tsp00_Number;
                    pos      : tsp00_Int4;
                    len      : integer;
                    VAR dest : tsp00_Int4;
                    VAR res  : tsp00_NumError);
 
        PROCEDURE
              s40glrel (
                    VAR buf  : tsp00_MoveObj;
                    pos      : tsp00_Int4;
                    len      : integer;
                    VAR dest : tsp00_Longreal;
                    VAR res  : tsp00_NumError);
 
      ------------------------------ 
 
        FROM
              PUT-Conversions : VSP41;
 
        PROCEDURE
              s41plrel (
                    VAR buf : tsp00_Number;
                    pos     : tsp00_Int4;
                    len     : integer;
                    frac    : integer;
                    source  : tsp00_Longreal;
                    VAR res : tsp00_NumError);
 
      ------------------------------ 
 
        FROM
              Number-Arithmetic : VSP51;
 
        PROCEDURE
              s51abs (
                    VAR source     : tsp00_Number;
                    spos           : tsp00_Int4;
                    slen           : integer;
                    VAR result     : tsp00_MoveObj;
                    respos         : tsp00_Int4;
                    reslen         : integer;
                    resfrac        : integer;
                    VAR resbytelen : integer;
                    VAR ret        : tsp00_NumError);
 
        PROCEDURE
              s51add (
                    VAR left       : tsp00_Number;
                    lpos           : tsp00_Int4;
                    llen           : integer;
                    VAR right      : tsp00_Number;
                    rpos           : tsp00_Int4;
                    rlen           : integer;
                    VAR result     : tsp00_Number;
                    respos         : tsp00_Int4;
                    reslen         : integer;
                    resfrac        : integer;
                    VAR resbytelen : integer;
                    VAR ret        : tsp00_NumError);
 
        PROCEDURE
              s51mul (
                    VAR left       : tsp00_Number;
                    lpos           : tsp00_Int4;
                    llen           : integer;
                    VAR right      : tsp00_Number;
                    rpos           : tsp00_Int4;
                    rlen           : integer;
                    VAR result     : tsp00_Number;
                    respos         : tsp00_Int4;
                    reslen         : integer;
                    resfrac        : integer;
                    VAR resbytelen : integer;
                    VAR ret        : tsp00_NumError);
 
        PROCEDURE
              s51neg (
                    VAR source     : tsp00_Number;
                    spos           : tsp00_Int4;
                    slen           : integer;
                    VAR result     : tsp00_Number;
                    respos         : tsp00_Int4;
                    reslen         : integer;
                    resfrac        : integer;
                    VAR resbytelen : integer;
                    VAR ret        : tsp00_NumError);
 
        PROCEDURE
              s51div (
                    VAR left       : tsp00_Number;
                    lpos           : tsp00_Int4;
                    llen           : integer;
                    VAR right      : tsp00_Number;
                    rpos           : tsp00_Int4;
                    rlen           : integer;
                    VAR result     : tsp00_Number;
                    respos         : tsp00_Int4;
                    reslen         : integer;
                    resfrac        : integer;
                    VAR resbytelen : integer;
                    VAR ret        : tsp00_NumError);
 
        PROCEDURE
              s51isint (
                    VAR source : tsp00_Number;
                    spos       : tsp00_Int4;
                    slen       : integer;
                    VAR isint  : boolean;
                    VAR ret    : tsp00_NumError);
 
        PROCEDURE
              s51round (
                    VAR source     : tsp00_Number;
                    spos           : tsp00_Int4;
                    slen           : integer;
                    round          : integer;
                    VAR result     : tsp00_MoveObj;
                    respos         : tsp00_Int4;
                    reslen         : integer;
                    resfrac        : integer;
                    VAR resbytelen : integer;
                    VAR ret        : tsp00_NumError);
 
        PROCEDURE
              s51trunc (
                    VAR source         : tsp00_Number;
                    spos               : tsp00_Int4;
                    slen               : integer;
                    trunc              : integer;
                    VAR result         : tsp00_Number;
                    respos             : tsp00_Int4;
                    reslen             : integer;
                    resfrac            : integer;
                    VAR resbytelen     : integer;
                    VAR ret            : tsp00_NumError);
 
.CM *-END-* use -----------------------------------------
.sp;.cp 3
Synonym :
 
        PROCEDURE
              s40glint;
 
              tsp00_MoveObj tsp00_Number
 
        PROCEDURE
              s41plrel;
 
              tsp00_MoveObj tsp00_Number
 
        PROCEDURE
              s51abs;
 
              tsp00_MoveObj tsp00_Number
 
        PROCEDURE
              s51add;
 
              tsp00_MoveObj tsp00_Number
              tsp00_MoveObj tsp00_Number
              tsp00_MoveObj tsp00_Number
 
        PROCEDURE
              s51mul;
 
              tsp00_MoveObj tsp00_Number
              tsp00_MoveObj tsp00_Number
              tsp00_MoveObj tsp00_Number
 
        PROCEDURE
              s51neg;
 
              tsp00_MoveObj tsp00_Number
              tsp00_MoveObj tsp00_Number
 
        PROCEDURE
              s51div;
 
              tsp00_MoveObj tsp00_Number
              tsp00_MoveObj tsp00_Number
              tsp00_MoveObj tsp00_Number
 
        PROCEDURE
              s51isint;
 
              tsp00_MoveObj tsp00_Number
 
        PROCEDURE
              s51round;
 
              tsp00_MoveObj tsp00_Number
 
        PROCEDURE
              s51trunc;
 
              tsp00_MoveObj tsp00_Number
              tsp00_MoveObj tsp00_Number
 
.CM *-END-* synonym -------------------------------------
.sp;.cp 3
Author  : 
.sp
.cp 3
Created : 1992-04-01
.sp
.cp 3
Version : 1998-06-25
.sp
.cp 3
Release :      Date : 1998-06-25
.sp
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Specification:
 
.CM *-END-* specification -------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Description:
 
.CM *-END-* description ---------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.nf
.oc _/1
Structure:
 
.CM *-END-* structure -----------------------------------
.sp 2
**********************************************************
.sp
.cp 10
.nf
.oc _/1
.CM -lll-
Code    :
 
 
(*------------------------------*) 
 
PROCEDURE
      s52sqrt (
            VAR source     : tsp00_MoveObj;
            spos           : tsp00_Int4;
            slen           : integer;
            VAR result     : tsp00_MoveObj;
            respos         : tsp00_Int4;
            reslen         : integer;
            resfrac        : integer;
            VAR ret        : tsp00_NumError);
 
VAR
      exp        : integer;
      i          : integer;
      loop_cnt   : integer;
      resbytelen : integer;
      r          : tsp00_Longreal;
      x          : tsp00_Number;
      x0         : tsp00_Number;
      x1         : tsp00_Number;
      na_half    : tsp00_Number;
      accu       : tsp00_Number;
 
BEGIN
exp := ord (source [spos]);
IF  exp < csp_zero_exp_value
THEN
    ret := num_invalid
ELSE
    BEGIN
    ret := num_ok;
    x   := csp_null_number;
    FOR i := 1 TO slen DO
        x[i] := source[spos + i - 1];
    (*ENDFOR*) 
    IF  exp > csp_zero_exp_value
    THEN
        BEGIN
        s40glrel (source, spos, slen,  r, ret);
        IF  (ret = num_ok) OR (ret = num_trunc)
        THEN
            BEGIN
            (* start value of iteration is result of *)
            (* pascal sqrt function                  *)
            r := sqrt (r);
            s41plrel (x1, 1, csp_fixed, csp_float_frac, r, ret);
            na_half   := csp_a_half_number;
            loop_cnt  := 0;
            REPEAT
                loop_cnt := loop_cnt + 1;
                x0       := x1;
                s51div (x, 1, sizeof (x), x0, 1, sizeof (x0),
                      accu, 1, csp_fixed, csp_float_frac, resbytelen, ret);
                IF  (ret = num_ok) OR (ret = num_trunc)
                THEN
                    s51add (x0, 1, sizeof (x0), accu, 1, sizeof (accu),
                          accu, 1, csp_fixed, csp_float_frac, resbytelen, ret);
                (*ENDIF*) 
                IF  (ret = num_ok) OR (ret = num_trunc)
                THEN
                    s51mul (accu, 1, sizeof (accu),
                          na_half, 1, sizeof (na_half),
                          x1, 1, csp_fixed, csp_float_frac, resbytelen, ret);
                (*ENDIF*) 
            UNTIL
                (x0 = x1) OR (loop_cnt > mxsp_number)
                OR
                ((ret <> num_ok) AND (ret <> num_trunc));
            (*ENDREPEAT*) 
            END
        ELSE
            x0 := x;
        (*ENDIF*) 
        s51abs (x0, 1, sizeof (x0),
              result, respos, reslen, resfrac, resbytelen, ret)
        END;
    (*ENDIF*) 
    END;
(*ENDIF*) 
END; (* s52sqrt *)
 
(*------------------------------*) 
 
PROCEDURE
      s52power (
            VAR base       : tsp00_MoveObj;
            basepos        : tsp00_Int4;
            baselen        : integer;
            basefrac       : integer;
            VAR power      : tsp00_MoveObj;
            ppos           : tsp00_Int4;
            plen           : integer;
            pfrac          : integer;
            VAR result     : tsp00_MoveObj;
            respos         : tsp00_Int4;
            reslen         : integer;
            resfrac        : integer;
            VAR ret        : tsp00_NumError);
 
VAR
      is_int     : boolean;
      erg_neg    : boolean;
      power_neg  : boolean;
      i          : integer;
      resbytelen : integer;
      ipower     : tsp00_Int4;
      n_one      : tsp00_Number;
      nhalf      : tsp00_Number;
      n_help     : tsp00_Number;
      nbase      : tsp00_Number;
      nresult    : tsp00_Number;
      npower     : tsp00_Number;
 
BEGIN
npower := csp_null_number;
FOR i := 1 TO plen DO
    npower[i] := power[ppos + i - 1];
(*ENDFOR*) 
s51isint (npower, 1, sizeof (npower), is_int, ret);
IF  ret = num_ok
THEN
    IF  is_int
    THEN
        BEGIN
        nbase := csp_null_number;
        FOR i := 1 TO  baselen DO
            nbase[i] := base[basepos + i - 1];
        (*ENDFOR*) 
        erg_neg   := false;
        power_neg := false;
        nhalf     := csp_a_half_number;
        IF  npower [1] < csp_zero_exponent
        THEN (* a ** (-n) = 1 / ( a ** n) *)
            BEGIN
            s51neg (npower, 1, sizeof (npower),
                  npower, 1, csp_fixed, csp_float_frac, resbytelen, ret);
            power_neg := true
            END;
        (*ENDIF*) 
        IF  nbase [1] < csp_zero_exponent
        THEN
            BEGIN
            (* nbase < 0, check if result will be < 0 *)
            (* <=> power is odd                         *)
            s51neg (nbase, 1, sizeof (nbase),
                  nbase, 1, csp_fixed, csp_float_frac, resbytelen, ret);
            IF  ret in [ num_ok, num_trunc ]
            THEN
                BEGIN
                s51mul (npower, 1, sizeof (npower), nhalf, 1, 2,
                      n_help, 1, csp_fixed, csp_float_frac, resbytelen, ret);
                IF  ret in [ num_ok, num_trunc ]
                THEN
                    BEGIN
                    s51isint (n_help, 1, sizeof (n_help), is_int, ret);
                    erg_neg  := NOT is_int
                    END;
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        nresult := csp_one_number;
        WHILE  (npower > csp_maxlint) AND (ret = num_ok) DO
            BEGIN
            (* algorithm is executed on sqldb numbers until *)
            (* npower fits into a tsp00_Int4                  *)
            s51mul (npower, 1, sizeof (npower), nhalf, 1, 2,
                  npower, 1, csp_fixed, csp_float_frac, resbytelen, ret);
            s51isint (npower, 1, sizeof (npower), is_int, ret);
            IF  NOT is_int
            THEN (* npower is odd *)
                BEGIN
                s51trunc (npower, 1, sizeof (npower), 0,
                      npower, 1, csp_fixed, csp_float_frac, resbytelen, ret);
                s51mul (nbase, 1, sizeof (nbase),
                      nresult, 1, sizeof (nresult),
                      nresult, 1, csp_fixed, csp_float_frac, resbytelen, ret)
                END;
            (*ENDIF*) 
            IF  ret = num_ok
            THEN
                s51mul (nbase, 1, sizeof (nbase),
                      nbase, 1, sizeof (nbase),
                      nbase, 1, csp_fixed, csp_float_frac, resbytelen, ret);
            (*ENDIF*) 
            END;
        (*ENDWHILE*) 
        IF  ret = num_ok
        THEN
            s40glint (npower, 1, sizeof (npower), ipower, ret);
        (*ENDIF*) 
        WHILE (ipower > 0) AND (ret = num_ok) DO
            BEGIN
            IF  odd (ipower)
            THEN
                s51mul (nbase, 1, sizeof (nbase),
                      nresult, 1, sizeof (nresult),
                      nresult, 1, csp_fixed, csp_float_frac, resbytelen, ret);
            (*ENDIF*) 
            ipower := ipower DIV 2;
            IF  (ipower > 0) AND (ret = num_ok)
            THEN
                s51mul (nbase, 1, sizeof (nbase),
                      nbase, 1, sizeof (nbase),
                      nbase, 1, csp_fixed, csp_float_frac, resbytelen, ret);
            (*ENDIF*) 
            END;
        (*ENDWHILE*) 
        IF  power_neg AND (ret = num_ok)
        THEN
            BEGIN
            (* nresult := 1 / nresult *)
            n_one := csp_one_number;
            s51div (n_one, 1, sizeof (n_one),
                  nresult, 1, sizeof (nresult),
                  nresult, 1, csp_fixed, csp_float_frac, resbytelen, ret)
            END;
        (*ENDIF*) 
        IF  erg_neg AND (ret = num_ok)
        THEN
            s51neg (nresult, 1, sizeof (nresult),
                  nresult, 1, csp_fixed, csp_float_frac, resbytelen, ret);
        (*ENDIF*) 
        IF  ret = num_ok
        THEN
            s51round (nresult, 1, sizeof (nresult), csp_fixed,
                  result, respos, reslen, resfrac, resbytelen, ret)
        (*ENDIF*) 
        END
    ELSE
        ret := num_invalid
    (*ENDIF*) 
(*ENDIF*) 
END; (* s52power *)
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
*-PRETTY-*  statements    :         71
*-PRETTY-*  lines of code :        237        PRETTYX 3.10 
*-PRETTY-*  lines in file :        552         1997-12-10 
.PA 
