.CM  SCRIPT , Version - 1.1 , last edited by holger
.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$VSP43$
.tt 2 $$$
.TT 3 $RudolfM$PUTSTRING-Conversions$1997-01-17$
***********************************************************
.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  : PUTSTRING-Conversions
=========
.sp
Purpose : Conversion from plain text numbers into VDN-numbers
.CM *-END-* purpose -------------------------------------
.sp
.cp 3
Define  :
 
        PROCEDURE
              s43pstr (
                    VAR buf    : tsp00_MoveObj;
                    pos        : tsp00_Int4;
                    len        : integer;
                    frac       : integer;
                    VAR source : tsp00_MoveObj;
                    spos       : tsp00_Int4;
                    slen       : integer;
                    VAR res    : tsp00_NumError);
 
        PROCEDURE
              s43pstr1 (
                    VAR buf    : tsp00_MoveObj;
                    pos        : tsp00_Int4;
                    len        : integer;
                    frac       : integer;
                    VAR source : tsp00_MoveObj;
                    spos       : tsp00_Int4;
                    slen       : integer;
                    VAR res    : tsp00_NumError);
 
        PROCEDURE
              s43pstr2 (
                    VAR buf    : tsp00_MoveObj;
                    pos        : tsp00_Int4;
                    len        : integer;
                    frac       : integer;
                    VAR source : tsp00_MoveObj;
                    spos       : tsp00_Int4;
                    slen       : integer;
                    VAR res    : tsp00_NumError);
 
        PROCEDURE
              s43pstr3 (
                    VAR buf    : tsp00_MoveObj;
                    pos        : tsp00_Int4;
                    len        : integer;
                    frac       : integer;
                    VAR source : tsp00_MoveObj;
                    spos       : tsp00_Int4;
                    slen       : integer;
                    VAR res    : tsp00_NumError);
 
        PROCEDURE
              s43lfrac (
                    VAR source  : tsp00_MoveObj;
                    spos        : tsp00_Int4;
                    slen        : integer;
                    VAR diglen  : integer;
                    VAR digfrac : integer;
                    VAR bytelen : integer);
 
.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :
 
        FROM
              Number-Arithmetic : VSP51;
 
        PROCEDURE
              s51kroun (
                    VAR source     : tsp00_C24;
                    spos           : tsp00_Int4;
                    slen           : integer;
                    VAR result     : tsp00_C24;
                    respos         : tsp00_Int4;
                    reslen         : integer;
                    resfrac        : integer;
                    VAR resbytelen : integer;
                    VAR ret        : tsp00_NumError);
 
.CM *-END-* use -----------------------------------------
.sp;.cp 3
Synonym :
 
        PROCEDURE
              s51kroun;
 
              tsp00_MoveObj tsp00_C24
 
.CM *-END-* synonym -------------------------------------
.sp;.cp 3
Author  : RudolfM
.sp
.cp 3
Created : 1984-07-25
.sp
.cp 3
Version : 1998-02-26
.sp
.cp 3
Release :  6.2   Date : 1997-01-17
.sp
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Specification:
 
 num_error = (num_ok, num_trunc, num_overflow, num_invalid);
.sp
Meaning of the parameters:
.sp;.nf
 buf    : array or record in which the VDN number is stored
 pos    : position at which the VDN number is to be stored
 len    : length of the VDN number is digits (not in bytes!)
 frac   : number of decimal places or FLOAT
 source : source variable of appropriate type
 spos   : for strings, position of the source string in source
          array
 slen   : for strings, precise (!) length of the source string
          for DECIMAL and ZONED, number of digits
 sfrac  : for DECIMAL and ZONED, number of decimal places
 res    : response concerning success or error situations
.sp;.fo
The parameter BUF identifies the record or array in which the
VDN number is to be stored.
The number of
.oc _/;positions
 (not bytes!) of the VDN number is indicated by LEN;
the number of decimal places is indicated by FRAC.
A FLOAT VDN number is signalled by FRAC = -1
 (use constant FLOAT).
.sp
The parameter SOURCE in S43PSTR
is an input parameter for the string
to be converted.
.sp
When SLEN is entered, the
exact (!) string length must be specified.
.sp
After each call of a conversion procedure, the response RES
is to be queried which supplies information on whether the procedure
ran correctly or whether there were exceptional or error conditions
during the conversion.
.sp
PROCEDURE S43PSTR
.sp
Stores a number as a VDN number in a string form that is
located at a specific position in a longer string of the length
 (exactly) specified.
For the syntax of the string, the VDN declarations for numeric
literals apply.
.sp
PROCEDURE S43LFRAC
.sp
Identifies the number of positions and decimal places of a VDN number
and its length in bytes.
.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    :
 
 
TYPE (* mindestens tsp00_Number + 1 Ziffer mehr Platz, *)
      (* aber c21 gab es nicht *)
      tsp43_long_number = tsp00_C24;
      (* PTS 1000743 E.Z. *)
      (* CR 154 E.Z. *)
 
 
(*------------------------------*) 
 
PROCEDURE
      s43pstr (
            VAR buf    : tsp00_MoveObj;
            pos        : tsp00_Int4;
            len        : integer;
            frac       : integer;
            VAR source : tsp00_MoveObj;
            spos       : tsp00_Int4;
            slen       : integer;
            VAR res    : tsp00_NumError);
 
VAR
      dec_point       : boolean;
      sign_symbol     : boolean;
      negative        : boolean;
      zero_dig        : boolean;
      hi_dig_pos      : boolean;
      lead_frac_zeros : boolean;
      exp_sign        : boolean;
      i               : integer;
      ni              : integer;
      buflen          : integer;
      hi_dig          : integer;
      lo_dig          : integer;
      exp             : integer;
      expo            : integer;
      slimit          : integer;
      dig_count       : integer;
      max_dig_count   : integer;
      frac_dig_count  : integer;
      exp_dig_count   : integer;
      exp_dig1        : integer;
      exp_dig2        : integer;
      exp_dig3        : integer;
      exp_negative    : integer;
 
      n : RECORD
            CASE boolean OF
                true :
                    (ln : tsp43_long_number);
                false :
                    (n : tsp00_Number)
                END;
            (*ENDCASE*) 
 
 
BEGIN
WHILE (slen > 1) AND (source [ spos + slen - 1 ] = ' ') DO
    slen := slen - 1;
(*ENDWHILE*) 
res             := num_ok;
hi_dig_pos      := true;
dec_point       := false;
zero_dig        := false;
lead_frac_zeros := false;
sign_symbol     := false;
negative        := false;
slimit          := spos + slen;
ni              := 1;
exp             := 0;
n.ln [ 1 ]      := chr (0);
dig_count       := 0;
frac_dig_count  := 0;
exp_dig_count   := 0;
max_dig_count   := csp_fixed+1;
WHILE ( (res = num_ok)  OR (res = num_trunc)) AND (spos < slimit) DO
    BEGIN
    CASE source [ spos ] OF
        '0', '1', '2', '3', '4', '5', '6', '7', '8', '9' :
            IF  (source [ spos ] = '0')
                AND NOT dec_point
                AND (dig_count = 0)
            THEN
                BEGIN
                zero_dig := true;
                IF  spos < slimit
                THEN
                    spos := spos + 1
                ELSE
                    res := num_invalid
                (*ENDIF*) 
                END
            ELSE
                BEGIN
                zero_dig := false;
                IF  dec_point AND (source [ spos ] = '0')
                    AND lead_frac_zeros
                THEN
                    exp := exp - 1
                ELSE
                    lead_frac_zeros := false;
                (*ENDIF*) 
                IF  dec_point
                THEN
                    frac_dig_count := frac_dig_count + 1;
                (*ENDIF*) 
                IF  NOT lead_frac_zeros
                THEN
                    BEGIN
                    IF  dig_count + 1 > max_dig_count
                    THEN
                        BEGIN
                        dig_count := dig_count + 1;
                        IF  spos < slimit
                        THEN
                            spos := spos + 1
                        ELSE
                            res := num_invalid
                        (*ENDIF*) 
                        END
                    ELSE
                        IF  hi_dig_pos
                        THEN
                            BEGIN
                            hi_dig := ord (source [ spos ]) - ord ('0');
                            hi_dig_pos := false;
                            dig_count := dig_count + 1;
                            IF  spos < slimit
                            THEN
                                spos := spos + 1
                            ELSE
                                res := num_invalid
                            (*ENDIF*) 
                            END
                        ELSE
                            BEGIN
                            lo_dig := ord (source [ spos ]) - ord ('0');
                            hi_dig_pos := true;
                            dig_count := dig_count + 1;
                            ni := ni + 1;
                            n.ln [ ni ] := chr (hi_dig * 16 + lo_dig);
                            IF  spos < slimit
                            THEN
                                spos := spos + 1
                            ELSE
                                res:= num_invalid
                            (*ENDIF*) 
                            END;
                        (*ENDIF*) 
                    (*ENDIF*) 
                    END
                ELSE
                    IF  spos < slimit
                    THEN
                        spos := spos + 1
                    ELSE
                        res := num_invalid;
                    (*ENDIF*) 
                (*ENDIF*) 
                END;
            (*ENDIF*) 
        '.' :
            IF  NOT dec_point
            THEN
                BEGIN
                dec_point := true;
                IF  zero_dig
                    OR (dig_count = 0)
                THEN
                    lead_frac_zeros := true;
                (*ENDIF*) 
                exp := dig_count - 1;
                IF  spos < slimit
                THEN
                    spos := spos + 1
                ELSE
                    res := num_invalid
                (*ENDIF*) 
                END
            ELSE
                res := num_invalid;
            (*ENDIF*) 
        '+' :
            IF  NOT sign_symbol
                AND NOT dec_point
                AND (dig_count = 0)
            THEN
                BEGIN
                sign_symbol := true;
                IF  spos < slimit
                THEN
                    spos := spos + 1
                ELSE
                    res := num_invalid
                (*ENDIF*) 
                END
            ELSE
                res := num_invalid;
            (*ENDIF*) 
        '-' :
            IF  NOT sign_symbol
                AND NOT dec_point
                AND (dig_count = 0)
            THEN
                BEGIN
                sign_symbol := true;
                negative := true;
                IF  spos < slimit
                THEN
                    spos := spos + 1
                ELSE
                    res := num_invalid
                (*ENDIF*) 
                END
            ELSE
                res := num_invalid;
            (*ENDIF*) 
        ' ' :
            IF  (dig_count = 0) AND (NOT zero_dig)
                AND
                (spos < slimit)
            THEN
                spos := spos + 1
            ELSE
                res := num_invalid;
            (*ENDIF*) 
        'E' , 'e':
            BEGIN
            exp_negative := + 1;
            exp_sign := false;
            IF  (spos >= slimit) OR
                ((dig_count = 0) AND NOT zero_dig AND NOT lead_frac_zeros)
            THEN
                res := num_invalid
            ELSE
                BEGIN
                IF  NOT dec_point
                THEN
                    exp := dig_count - 1;
                (*ENDIF*) 
                spos := spos + 1;
                WHILE ( (res = num_ok) OR (res = num_trunc))
                      AND (spos < slimit)
                      AND (source [ spos ] <> ' ') DO
                    CASE source [ spos ] OF
                        '+' :
                            IF  NOT exp_sign
                            THEN
                                BEGIN
                                exp_sign := true;
                                IF  spos < slimit
                                THEN
                                    spos := spos + 1
                                ELSE
                                    res := num_invalid
                                (*ENDIF*) 
                                END
                            ELSE
                                res := num_invalid;
                            (*ENDIF*) 
                        '-' :
                            IF  NOT exp_sign
                            THEN
                                BEGIN
                                exp_sign := true;
                                exp_negative := - 1;
                                IF  spos < slimit
                                THEN
                                    spos := spos + 1
                                ELSE
                                    res := num_invalid
                                (*ENDIF*) 
                                END
                            ELSE
                                res := num_invalid;
                            (*ENDIF*) 
                        '0', '1', '2', '3', '4', '5', '6', '7', '8', '9' :
                            IF  exp_dig_count >= 3
                            THEN
                                res := num_overflow
                            ELSE
                                BEGIN
                                exp_dig_count := exp_dig_count + 1;
                                IF  exp_dig_count = 1
                                THEN
                                    exp_dig1 := ord (source [ spos ])
                                          - ord ('0');
                                (*ENDIF*) 
                                IF  exp_dig_count = 2
                                THEN
                                    exp_dig2 := ord (source [ spos ])
                                          - ord ('0');
                                (*ENDIF*) 
                                IF  exp_dig_count = 3
                                THEN
                                    BEGIN
                                    exp_dig3 := ord (source [ spos ])
                                          - ord ('0');
                                    IF  exp_dig1 <> 0
                                    THEN
                                        res := num_overflow;
                                    (*ENDIF*) 
                                    END;
                                (*ENDIF*) 
                                IF  spos < slimit
                                THEN
                                    spos := spos + 1;
                                (*ENDIF*) 
                                END;
                            (*ENDIF*) 
                        OTHERWISE
                            res := num_invalid;
                        END;
                    (*ENDCASE*) 
                (*ENDWHILE*) 
                IF  exp_dig_count = 0
                THEN
                    res := num_invalid;
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            END;
        OTHERWISE
            res := num_invalid;
        END;
    (*ENDCASE*) 
    END;
(*ENDWHILE*) 
IF  (res = num_ok) OR (res = num_trunc)
THEN
    IF  (dig_count > 0) OR zero_dig
        OR (dec_point AND (frac_dig_count > 0))
    THEN
        BEGIN
        IF  NOT dec_point AND (exp_dig_count = 0)
        THEN
            exp := dig_count - 1;
        (*ENDIF*) 
        IF  NOT hi_dig_pos
        THEN
            IF  dig_count <= max_dig_count
            THEN
                BEGIN
                ni := ni + 1;
                n.ln [ ni ] := chr (hi_dig * 16 )
                END;
            (*ENDIF*) 
        (*ENDIF*) 
        FOR i := ni + 1 TO mxsp_c24 DO
            n.ln [ i ] := chr (0);
        (*ENDFOR*) 
        IF  (n.n = csp_null_number) OR zero_dig
        THEN
            BEGIN
            exp := csp_zero_exp_value;
            negative := false;
            n.ln [ mxsp_number + 1 ] := chr(0)
            END
        ELSE
            IF  negative
            THEN
                exp := 63 - exp
            ELSE
                exp := 193 + exp;
            (*ENDIF*) 
        (*ENDIF*) 
        IF  exp_dig_count = 1
        THEN
            IF  negative
            THEN
                exp := exp - exp_dig1 * exp_negative
            ELSE
                exp := exp + exp_dig1 * exp_negative
            (*ENDIF*) 
        ELSE
            IF  exp_dig_count = 2
            THEN
                IF  negative
                THEN
                    exp := exp - (exp_dig1 * 10 + exp_dig2) * exp_negative
                ELSE
                    exp := exp + (exp_dig1 * 10 + exp_dig2) * exp_negative
                (*ENDIF*) 
            ELSE
                IF  exp_dig_count = 3
                THEN
                    IF  negative
                    THEN
                        exp := exp - (exp_dig2 * 10 + exp_dig3) * exp_negative
                    ELSE
                        exp := exp + (exp_dig2 * 10 + exp_dig3) * exp_negative;
                    (*ENDIF*) 
                (*ENDIF*) 
            (*ENDIF*) 
        (*ENDIF*) 
        IF  n.ln [ 2 ] < chr (10)
        THEN
            sp43normalize (n.ln, ni, exp);
        (*ENDIF*) 
        IF  ( ( (NOT negative) AND (exp <= csp_zero_exp_value))
            OR  ( (negative) AND (exp >= csp_zero_exp_value)))
            AND NOT ( (exp = csp_zero_exp_value) AND (n.n = csp_null_number))
        THEN
            res := num_overflow
        ELSE
            BEGIN
            IF  negative
            THEN
                sp43complement (n.ln, ni);
            (*ENDIF*) 
            IF  (exp > 0) AND (exp <= 255)
            THEN
                BEGIN
                n.ln [ 1 ] := chr (exp);
                buflen := ( (len + 1) DIV 2) + 1;
                IF  (frac <> csp_float_frac) OR (dig_count > len)
                THEN
                    BEGIN
                    s51kroun (n.ln, 1, ni, n.ln, 1, len, frac, ni, res);
                    IF  res = num_ok
                    THEN
                        BEGIN
                        exp := ord(n.ln [ 1 ]);
                        FOR i := ni + 1 TO buflen DO
                            n.ln [ i ] := chr (0);
                        (*ENDFOR*) 
                        END
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
                IF  negative
                THEN
                    expo := 256 - exp
                ELSE
                    expo := exp;
                (*ENDIF*) 
                expo := expo - 193;
                IF  (frac <> csp_float_frac) AND (exp <> csp_zero_exp_value) AND
                    ( (expo >= (len - frac))
                    OR (expo < - frac))
                THEN
                    res := num_overflow
                ELSE
                    BEGIN
                    IF  (exp > 0) AND (exp <= 255)
                    THEN
                        FOR i := 1 TO buflen DO
                            buf [ pos + i - 1 ] := n.ln [ i ]
                        (*ENDFOR*) 
                    ELSE
                        res := num_overflow;
                    (*ENDIF*) 
                    END
                (*ENDIF*) 
                END
            ELSE
                res := num_overflow;
            (*ENDIF*) 
            END
        (*ENDIF*) 
        END
    ELSE
        res := num_invalid
    (*ENDIF*) 
(*ENDIF*) 
END; (* s43pstr *)
 
(*------------------------------*) 
 
PROCEDURE
      s43pstr1 (
            VAR buf    : tsp00_MoveObj;
            pos        : tsp00_Int4;
            len        : integer;
            frac       : integer;
            VAR source : tsp00_MoveObj;
            spos       : tsp00_Int4;
            slen       : integer;
            VAR res    : tsp00_NumError);
 
BEGIN
s43pstr (buf,pos,len,frac,source,spos,slen,res);
END;
 
(*------------------------------*) 
 
PROCEDURE
      s43pstr2 (
            VAR buf    : tsp00_MoveObj;
            pos        : tsp00_Int4;
            len        : integer;
            frac       : integer;
            VAR source : tsp00_MoveObj;
            spos       : tsp00_Int4;
            slen       : integer;
            VAR res    : tsp00_NumError);
 
BEGIN
s43pstr (buf,pos,len,frac,source,spos,slen,res);
END;
 
(*------------------------------*) 
 
PROCEDURE
      s43pstr3 (
            VAR buf    : tsp00_MoveObj;
            pos        : tsp00_Int4;
            len        : integer;
            frac       : integer;
            VAR source : tsp00_MoveObj;
            spos       : tsp00_Int4;
            slen       : integer;
            VAR res    : tsp00_NumError);
 
BEGIN
s43pstr (buf,pos,len,frac,source,spos,slen,res);
END;
 
(*------------------------------*) 
 
PROCEDURE
      s43lfrac (
            VAR source  : tsp00_MoveObj;
            spos        : tsp00_Int4;
            slen        : integer;
            VAR diglen  : integer;
            VAR digfrac : integer;
            VAR bytelen : integer);
 
VAR
      not_finished   : boolean;
      exp            : integer;
      point_pos      : integer;
 
BEGIN
bytelen := slen;
not_finished := true;
WHILE (bytelen > 1) AND not_finished DO
    IF  source [ spos + bytelen - 1 ] = chr (0)
    THEN
        bytelen := bytelen - 1
    ELSE
        not_finished := false;
    (*ENDIF*) 
(*ENDWHILE*) 
diglen := (bytelen - 1) * 2;
IF  ord (source [ spos + bytelen - 1 ]) MOD 16 = 0
THEN
    diglen := diglen - 1;
(*ENDIF*) 
exp := ord (source [ spos ]);
IF  exp = csp_zero_exp_value
THEN
    BEGIN
    diglen := 1;
    digfrac := 0;
    bytelen := 2;
    END
ELSE
    BEGIN
    IF  exp < csp_zero_exp_value
    THEN
        exp := 256 - exp;
    (*ENDIF*) 
    point_pos := exp - 192;
    IF  abs (point_pos) > csp_fixed
    THEN
        digfrac := csp_float_frac
    ELSE
        BEGIN
        IF  (point_pos > 0) AND (point_pos >= diglen)
        THEN
            BEGIN
            diglen := point_pos;
            digfrac := 0;
            bytelen := ( (diglen + 1) DIV 2) + 1;
            END;
        (*ENDIF*) 
        IF  (point_pos > 0) AND (point_pos < diglen)
        THEN
            digfrac := diglen - point_pos;
        (*ENDIF*) 
        IF  point_pos <= 0
        THEN
            BEGIN
            diglen := diglen - point_pos;
            IF  diglen > csp_fixed
            THEN
                BEGIN
                diglen := csp_fixed;
                IF  abs (point_pos) > csp_fixed
                THEN
                    digfrac := csp_float_frac
                ELSE
                    digfrac := diglen;
                (*ENDIF*) 
                END
            ELSE
                digfrac := diglen;
            (*ENDIF*) 
            bytelen := ( (diglen + 1) DIV 2) + 1;
            END;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDIF*) 
END; (* s43lfrac *)
 
(*------------------------------*) 
 
PROCEDURE
      sp43complement (
            VAR n : tsp43_long_number;
            actl  : integer);
 
VAR
      low   : integer;
      high  : integer;
      i     : integer;
      a     : integer;
 
BEGIN
WHILE (ord (n [ actl ]) = 0) AND (actl > 1) DO
    actl := actl - 1;
(*ENDWHILE*) 
IF  actl > 1
THEN
    BEGIN
    a  := ord (n [ actl ]);
    IF  (a MOD 16) = 0
    THEN
        a := a - 7
    ELSE
        a := a - 1;
    (*ENDIF*) 
    n [ actl ] := chr (a);
    FOR i := 2  TO actl DO
        BEGIN
        high := 9 - ord (n [ i ]) DIV 16;
        low := 9 - ord (n [ i ]) MOD 16;
        n [ i ] := chr (high * 16 + low);
        END;
    (*ENDFOR*) 
    END;
(*ENDIF*) 
END; (* sp43complement *)
 
(*------------------------------*) 
 
PROCEDURE
      sp43normalize (
            VAR result      : tsp43_long_number;
            actl            : integer;
            VAR result_expo : integer);
 
VAR
      not_finished : boolean;
      i            : integer;
      shift        : integer;
 
BEGIN
IF  result [ 2 ] < chr (10)
THEN
    BEGIN
    shift := 0;
    i := 2;
    not_finished := true;
    WHILE (i <= actl) AND not_finished DO
        IF  result [ i ] = chr (0)
        THEN
            BEGIN
            shift := shift + 2;
            i := i + 1;
            END
        ELSE
            not_finished := false;
        (*ENDIF*) 
    (*ENDWHILE*) 
    IF  (NOT not_finished) AND (result [ i ] < chr (10))
    THEN
        shift := shift + 1;
    (*ENDIF*) 
    IF  not_finished
    THEN
        result_expo := csp_zero_exp_value  (* result is zero *)
    ELSE
        BEGIN
        sp43left_shift (result, actl, shift);
        IF  result_expo >= csp_zero_exp_value
        THEN
            BEGIN
            result_expo := result_expo - shift;
            IF  result_expo < csp_zero_exp_value
            THEN
                BEGIN
                result_expo := csp_zero_exp_value;
                FOR i := 2 TO actl DO
                    result [ i ] := chr (0);
                (*ENDFOR*) 
                END
            (*ENDIF*) 
            END
        ELSE
            BEGIN
            result_expo := result_expo + shift;
            IF  result_expo > csp_zero_exp_value
            THEN
                BEGIN
                result_expo := csp_zero_exp_value;
                FOR i := 2 TO actl DO
                    result [ i ] := chr (0);
                (*ENDFOR*) 
                END
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDIF*) 
END; (* sp43normalize *)
 
(*------------------------------*) 
 
PROCEDURE
      sp43left_shift (
            VAR source : tsp43_long_number;
            actl       : integer;
            shift      : integer);
 
VAR
      i : integer;
 
BEGIN
IF  odd (shift)
THEN
    BEGIN
    shift := shift - 1;
    sp43mul10 ( source, actl);
    END;
(*ENDIF*) 
shift := shift DIV 2;
IF  shift > mxsp_c24
THEN
    shift := mxsp_c24;
(*ENDIF*) 
IF  shift > 0
THEN
    BEGIN
    FOR i := 1 TO actl - shift DO
        source [ i ] := source [ i + shift ];
    (*ENDFOR*) 
    FOR i := actl - shift + 1 TO actl DO
        source [ i ] := chr (0);
    (*ENDFOR*) 
    END;
(*ENDIF*) 
END; (* sp43left_shift *)
 
(*------------------------------*) 
 
PROCEDURE
      sp43mul10 (
            VAR n : tsp43_long_number;
            actl  : integer);
 
VAR
      i      : integer;
      hi_dig : integer;
      lo_dig : integer;
 
BEGIN
FOR i := 1 TO actl DO
    BEGIN
    hi_dig := ord (n [ i ]) MOD 16;
    IF  i < actl
    THEN
        lo_dig := ord (n [ i + 1 ]) DIV 16
    ELSE
        lo_dig := 0;
    (*ENDIF*) 
    n [ i ] := chr (hi_dig * 16 + lo_dig);
    END;
(*ENDFOR*) 
END; (* sp43mul10 *)
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
*-PRETTY-*  statements    :        265
*-PRETTY-*  lines of code :        783        PRETTYX 3.10 
*-PRETTY-*  lines in file :        996         1997-12-10 
.PA 
