.CM  SCRIPT , Version - 1.1 , last edited by Manuela Rathmann
.ad 8
.bm 8
.fm 4
.bt $Copyright (c) 1997-2005 SAP AG$$Page %$
.tm 12
.hm 6
.hs 3
.TT 1 $SQL$Project Distributed Database System$VSP42$
.tt 2 $$$
.TT 3 $RudolfM$GETSTRING-Conversions$1997-01-17$
***********************************************************
.nf
 
.nf
 
 .nf

    ========== licence begin  GPL
    Copyright (c) 1997-2005 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
 
 
.fo
.nf
.sp
MODULE  :  GETSTRING-Conversions
=========
.sp
Purpose : Conversion from VDN-Numbers into plain text numbers
.CM *-END-* purpose -------------------------------------
.sp
.cp 3
Define  :
 
        PROCEDURE
              s42gstr (
                    VAR buf  : tsp00_MoveObj;
                    pos      : tsp00_Int4;
                    len      : integer;
                    frac     : integer;
                    origlen  : integer;
                    VAR dest : tsp00_MoveObj;
                    dpos     : tsp00_Int4;
                    VAR dlen : integer;
                    VAR res  : tsp00_NumError);
 
        PROCEDURE
              s42gchr (
                    VAR buf  : tsp00_MoveObj;
                    pos      : tsp00_Int4;
                    len      : integer;
                    frac     : integer;
                    origlen  : integer;
                    VAR dest : tsp00_MoveObj;
                    dpos     : tsp00_Int4;
                    VAR dlen : integer;
                    VAR res  : tsp00_NumError);
 
        PROCEDURE
              s42gochr (
                    VAR buf  : tsp00_MoveObj;
                    pos      : tsp00_Int4;
                    VAR dest : tsp00_MoveObj;
                    dpos     : tsp00_Int4;
                    VAR dlen : integer;
                    VAR res  : tsp00_NumError);
 
.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :
 
.CM *-END-* use -----------------------------------------
.sp;.cp 3
Synonym :
 
.CM *-END-* synonym -------------------------------------
.sp;.cp 3
Author  : RudolfM
.sp
.cp 3
Created : 1984-07-25
.sp
.cp 3
.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 number is located
 pos   : position of the number in this array or record
 len   : output length of the number in digits (not in bytes!)
 frac  : number of decimal places or FLOAT
 origlen : internal length of the number in digits
           (len <= origlen possible)
 dest  : destination variable for the conversion of the appropriate
         type
 dpos  : for strings, position in destination array
 dlen  : for strings, length of the result
         for DECIMAL and ZONED, number of digits
 dfrac : for DECIMAL and ZONED, number of decimal places
 res   : response concerning success or error situations
.sp;.fo
The parameter BUF indicates the storage location of the VDN number.
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 ORIGLEN indicates the number of positions of the number that
is present internally.  In this way, the number can be output with a
shorter length than that with which it was stored during a PUT conversion.
An errored operation of this parameter falsifies the last position of
negative values.
.sp
The parameter DEST
is the output parameter for the
standard data types.
.sp
In the case of S42GSTR, S42GCHR and S42GOCHR, in addition to the string,
the string length is supplied as an output parameter for DEST.
.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 S42GSTR
.sp
Changes a VDN number to a string that is stored right-justified
at a specific position in a longer string.  If an overflow occurs,
asterisks are stored. Right-justified means that
the length of the generated string is always the same for a given
len, frac and origlen, independent of the actual number value.
Example:
    -111
 9999999
.sp
PROCEDURE S42GCHR
.sp
Corresponds to the procedure S42GSTR, except that it supplies the
numerical representation left-justified.
Note                                        :
in the parameter DEST, S42GCHR allocates several blanks to the
characters that follow DLEN!
If an overflow occurs, asterisks are stored.
.sp
PROCEDURE S42GOCHR
.sp
Corresponds to the procedure S42GOCHR, except that is trims
leading and following '0' and the '0' between '-' and '.'.
This procedure is used for implicit conversion number -> char
for ORACLE.
.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
      s42gstr (
            VAR buf  : tsp00_MoveObj;
            pos      : tsp00_Int4;
            len      : integer;
            frac     : integer;
            origlen  : integer;
            VAR dest : tsp00_MoveObj;
            dpos     : tsp00_Int4;
            VAR dlen : integer;
            VAR res  : tsp00_NumError);
 
VAR
      i               : integer;
      exp             : integer;
      lo_dig          : integer;
      hi_dig          : integer;
      point_pos       : integer;
      digitcount      : integer;
      actuallen       : integer;
      fill            : integer;
      buflen          : integer;
      elen            : integer;
      integer_digits  : integer;
      fraction        : integer;
      not_finished    : boolean;
      is_float        : boolean;
      negative        : boolean;
      n               : tsp00_Number;
 
LABEL
      999;
 
BEGIN
res          := num_ok;
negative     := false;
not_finished := true;
digitcount   := 0;
buflen       := ((origlen + 1) DIV 2) + 1;
IF  frac = csp_float_frac
THEN
    BEGIN
    is_float       := true;
    integer_digits := 1;
    IF  len = 1
    THEN
        fraction := 1
    ELSE
        fraction := len - 1;
    (*ENDIF*) 
    END
ELSE
    BEGIN
    is_float       := false;
    integer_digits := len - frac;
    fraction       := frac;
    END;
(*ENDIF*) 
dlen          := 1;
elen          := len;
dest [ dpos ] := ' ';
exp           := ord ( buf [ pos ]);
IF  exp = 0
THEN
    res := num_overflow
ELSE
    BEGIN
    IF  exp = csp_zero_exp_value
    THEN
        IF  len = frac
        THEN
            exp := 192
        ELSE
            exp := 193;
        (*ENDIF*) 
    (*ENDIF*) 
    FOR i := 1 TO buflen DO
        n [ i ] := buf [ pos + i - 1 ];
    (*ENDFOR*) 
    IF  exp < csp_zero_exp_value
    THEN
        BEGIN
        negative := true;
        sp42complement (n, buflen);
        exp      := 256 - exp;
        END;
    (*ENDIF*) 
    IF  len > origlen
    THEN
        actuallen := buflen
    ELSE
        actuallen := ((len + 1) DIV 2) + 1;
    (*ENDIF*) 
    WHILE (actuallen > 2) AND not_finished DO
        IF  n [ actuallen ] = chr (0)
        THEN
            actuallen := actuallen - 1
        ELSE
            not_finished := false;
        (*ENDIF*) 
    (*ENDWHILE*) 
    FOR i := 2 TO actuallen DO
        (* all digits left justified and without separation *)
        BEGIN
        hi_dig     := ord ( n [ i ]) DIV 16;
        lo_dig     := ord ( n [ i ]) MOD 16;
        IF  (hi_dig > 9) OR (lo_dig > 9)
        THEN
            BEGIN
            res := num_invalid;
            goto 999
            END;
        (*ENDIF*) 
        digitcount := digitcount + 2;
        dlen       := dlen + 1;
        dest [ dpos + dlen - 1 ] := chr (hi_dig + ord ('0'));
        IF  digitcount <= len
        THEN
            BEGIN
            dlen := dlen + 1;
            dest [ dpos + dlen - 1 ] := chr (lo_dig + ord ('0'));
            END
        ELSE
            BEGIN
            digitcount := digitcount - 1;
            IF  lo_dig <> 0
            THEN
                res := num_trunc;
            (*ENDIF*) 
            lo_dig := 1;
            END;
        (*ENDIF*) 
        END;
    (*ENDFOR*) 
    IF  lo_dig = 0
    THEN
        BEGIN
        digitcount := digitcount - 1;
        dest [ dpos + dlen - 1 ] := ' ';
        dlen := dlen - 1;
        END;
    (*ENDIF*) 
    point_pos := exp - 192;
    IF  (point_pos > integer_digits) AND (NOT is_float)
    THEN
        res := num_overflow;
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  (res = num_ok) OR (res = num_trunc)
THEN
    BEGIN
    IF  (NOT is_float) AND (digitcount < point_pos)
        AND (point_pos <= csp_fixed) AND (point_pos >= 0)
    THEN
        BEGIN
        (* CASE1: expand integer part of numstring to specified length *)
        FOR i := 1 TO point_pos - digitcount DO
            dest [ dpos + dlen + i - 1 ] := '0';
        (*ENDFOR*) 
        dlen := dlen + point_pos - digitcount;
        END;
    (*ENDIF*) 
    IF  (NOT is_float) AND (fraction = 0)
        AND (digitcount > point_pos)
        AND (point_pos <= csp_fixed) AND (point_pos >= 0)
    THEN
        BEGIN
        (* CASE2: truncate integer numstring to specified length *)
        res := num_trunc;
        FOR i := 1 TO digitcount - point_pos DO
            dest [ dpos + dlen - i ] := ' ';
        (*ENDFOR*) 
        dlen := dlen - (digitcount - point_pos);
        IF  point_pos = 0
        THEN
            BEGIN
            dlen := dlen + 1;
            dest [ dpos + dlen - 1 ] := '0';
            END;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  (NOT is_float) AND (fraction = 0)
        AND (point_pos < 0)
    THEN
        BEGIN
        (* CASE3: return '0', input is fraction but frac is 0 *)
        res := num_trunc;
        dest [dpos] := '0';
        dlen := 1;
        elen := 0;
        negative := false;
        END;
    (*ENDIF*) 
    IF  (NOT is_float) AND (fraction > 0)
    THEN
        BEGIN
        IF  (point_pos > 0) AND (point_pos < csp_fixed)
        THEN
            (* CASE1 : fixed point with integral part *)
            (* point_pos = digits to the left of the decimal point *)
            BEGIN
            (* dlen includes leading blank *)
            FOR i := dlen DOWNTO point_pos + 2 DO
                dest [ dpos + i ] := dest [ dpos + i - 1 ];
            (*ENDFOR*) 
            dest [ dpos + point_pos + 1 ] := '.';
            dlen := dlen + 1;
            elen := len + 1;
            IF  frac > dlen - (point_pos + 2)
            THEN
                BEGIN
                FOR i := 1 TO frac - (dlen - (point_pos + 2)) DO
                    dest [ dpos + dlen + i - 1 ] := '0';
                (*ENDFOR*) 
                END
            ELSE
                BEGIN
                IF  frac < dlen - (point_pos + 2)
                THEN
                    res := num_trunc;
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            dlen := point_pos + 2 + frac;
            (* sign, point_pos digits, point, frac digits *)
            END;
        (*ENDIF*) 
        IF  point_pos <= 0
        THEN
            BEGIN
            (* CASE2 : fixed point without integral part *)
            (* abs (point_pos) = leading zeros in fraction *)
            point_pos := abs (point_pos);
            IF  point_pos < frac
            THEN
                BEGIN
                (* move fraction to the right and insert zeros *)
                FOR i := dlen DOWNTO 2 DO
                    dest [ dpos + point_pos + i + 1 ] :=
                          dest [ dpos + i - 1 ];
                (*ENDFOR*) 
                FOR i := 1 TO point_pos DO
                    dest [ dpos + i + 2 ] := '0';
                (*ENDFOR*) 
                IF  (dlen - 1) + point_pos > frac
                THEN
                    BEGIN
                    (* dlen - 1 = mantissa, point_pos = leading zeros *)
                    FOR i := frac + 3 TO dlen + point_pos + 1 DO
                        dest [ dpos + i ] := ' ';
                    (*ENDFOR*) 
                    res := num_trunc;
                    END
                ELSE
                    BEGIN
                    (* old dlen + leading zeros + '0.' *)
                    dlen := dlen + point_pos + 2;
                    FOR i := dlen + 1 TO frac + 3 DO
                        dest [ dpos + i - 1 ] := '0';
                    (*ENDFOR*) 
                    END
                (*ENDIF*) 
                END
            ELSE
                BEGIN
                (* abs (point_pos) is >= frac and no integral part *)
                (* original fraction is truncated, result is 0.0... *)
                FOR i := 1 TO frac DO
                    dest [ dpos + i + 2 ] := '0';
                (*ENDFOR*) 
                negative := false;
                res      := num_trunc;
                END;
            (*ENDIF*) 
            dest [ dpos + 1 ] := '0';
            dest [ dpos + 2 ] := '.';
            (* now dest [dpos] = blank, [dpos+1] = 0, [dpos+2] = . *)
            dlen := 3 + frac;
            IF  len = frac
            THEN
                elen := len + 2
            ELSE
                elen := len + 1;
            (*ENDIF*) 
            (* end of fixed point with only fraction *)
            END;
        (* end of fixed point with fraction *)
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  NOT is_float
    THEN
        BEGIN
        FOR i := dlen DOWNTO 2 DO
            (* copy string to the right *)
            dest [ dpos + elen - dlen + i ] := dest [ dpos + i - 1 ];
        (*ENDFOR*) 
        FOR i := 1 TO elen - dlen + 1 DO
            (* erase string remainder on the left *)
            dest [ dpos + i ] := ' ';
        (*ENDFOR*) 
        dlen := elen + 1;
        END
    ELSE
        BEGIN
        fill := len + 1 - dlen;
        IF  len > 1
        THEN
            BEGIN
            FOR i := dlen DOWNTO 3 DO
                dest [ dpos + i ] := dest [ dpos + i - 1 ];
            (*ENDFOR*) 
            dest [ dpos + 2 ] := '.';
            dlen := dlen + 1;
            FOR i := 1 TO fill DO
                dest [ dpos + dlen + i - 1 ] := '0';
            (*ENDFOR*) 
            END;
        (*ENDIF*) 
        dlen := dlen + fill + 1;
        dest [ dpos + dlen - 1 ] := 'E';
        IF  exp <= 192
        THEN
            BEGIN
            dlen := dlen + 1;
            dest [ dpos + dlen - 1 ] := '-';
            exp := 192 - exp + 1;
            END
        ELSE
            BEGIN
            dlen := dlen + 1;
            dest [ dpos + dlen - 1 ] := '+';
            exp := exp - 192 - 1;
            END;
        (*ENDIF*) 
        dlen := dlen + 2;
        dest [ dpos + dlen - 2 ] := chr ( (exp DIV 10) + ord ('0'));
        dest [ dpos + dlen - 1 ] := chr ( (exp MOD 10) + ord ('0'));
        END;
    (*ENDIF*) 
    IF  negative
    THEN
        BEGIN
        i := 1;
        not_finished := true;
        WHILE (i < dlen) AND not_finished DO
            IF  dest [ dpos + i - 1 ] = ' '
            THEN
                i := i + 1
            ELSE
                not_finished := false;
            (*ENDIF*) 
        (*ENDWHILE*) 
        dest [ dpos + i - 2 ] := '-';
        END;
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  res = num_overflow
THEN
    BEGIN
    IF  frac = csp_float_frac
    THEN
        IF  len = 1
        THEN
            dlen := 6
        ELSE
            dlen := len + 6
        (*ENDIF*) 
    ELSE
        IF  frac = 0
        THEN
            dlen := len + 1
        ELSE
            IF  len = frac
            THEN
                dlen := len + 3
            ELSE
                dlen := len + 2;
            (*ENDIF*) 
        (*ENDIF*) 
    (*ENDIF*) 
    FOR i := 1 TO dlen DO
        dest [ dpos + i - 1 ] := '*';
    (*ENDFOR*) 
    END;
(*ENDIF*) 
999 : ;
END; (* s42gstr *)
 
(*------------------------------*) 
 
PROCEDURE
      s42gchr (
            VAR buf  : tsp00_MoveObj;
            pos      : tsp00_Int4;
            len      : integer;
            frac     : integer;
            origlen  : integer;
            VAR dest : tsp00_MoveObj;
            dpos     : tsp00_Int4;
            VAR dlen : integer;
            VAR res  : tsp00_NumError);
 
VAR
      i                 : integer;
      lead_blank_count  : integer;
      nonblank          : boolean;
 
BEGIN
s42gstr (buf, pos, len, frac, origlen, dest, dpos, dlen, res);
lead_blank_count := 0;
nonblank         := false;
WHILE (lead_blank_count < dlen - 1) AND NOT nonblank DO
    IF  dest [ dpos + lead_blank_count ] = ' '
    THEN
        lead_blank_count := lead_blank_count + 1
    ELSE
        nonblank := true;
    (*ENDIF*) 
(*ENDWHILE*) 
FOR i := 1 TO dlen - lead_blank_count DO
    dest [ dpos + i - 1 ] := dest [ dpos + lead_blank_count + i - 1 ];
(*ENDFOR*) 
FOR i := dlen - lead_blank_count + 1  TO dlen DO
    dest [ dpos + i - 1 ] := ' ';
(*ENDFOR*) 
dlen := dlen - lead_blank_count;
END; (* s42gchr *)
 
(*------------------------------*) 
 
PROCEDURE
      s42gostr (
            VAR buf  : tsp00_MoveObj;
            pos      : tsp00_Int4;
            VAR dest : tsp00_MoveObj;
            dpos     : tsp00_Int4;
            VAR dlen : integer;
            VAR res  : tsp00_NumError);
 
VAR
      i               : integer;
      exp             : integer;
      lo_dig          : integer;
      hi_dig          : integer;
      point_pos       : integer;
      digitcount      : integer;
      actuallen       : integer;
      buflen          : integer;
      len             : integer;
      frac            : integer;
      integer_digits  : integer;
      not_finished    : boolean;
      negative        : boolean;
      n               : tsp00_Number;
 
BEGIN
res := num_ok;
negative := false;
not_finished := true;
digitcount := 0;
buflen := mxsp_number;
integer_digits := csp_fixed;
len  := csp_fixed;
frac := csp_fixed;
dlen := 1;
dest [ dpos + dlen - 1 ] := ' ';
exp  := ord ( buf [ pos ]);
IF  exp = 0
THEN
    res := num_overflow
ELSE
    BEGIN
    IF  exp = csp_zero_exp_value
    THEN
        exp := 193;
    (*ENDIF*) 
    FOR i := 1 TO buflen DO
        n [ i ] := buf [ pos + i - 1 ];
    (*ENDFOR*) 
    IF  exp < csp_zero_exp_value
    THEN
        BEGIN
        negative := true;
        sp42complement (n, buflen);
        exp := 256 - exp;
        END;
    (*ENDIF*) 
    actuallen := ((len + 1) DIV 2) + 1;
    WHILE (actuallen > 2) AND not_finished DO
        IF  n [ actuallen ] = chr (0)
        THEN
            actuallen := actuallen - 1
        ELSE
            not_finished := false;
        (*ENDIF*) 
    (*ENDWHILE*) 
    FOR i := 2 TO actuallen DO
        BEGIN
        hi_dig     := ord ( n [ i ]) DIV 16;
        lo_dig     := ord ( n [ i ]) MOD 16;
        digitcount := digitcount + 2;
        dlen       := dlen + 1;
        dest [ dpos + dlen - 1 ] := chr (hi_dig + ord ('0'));
        IF  digitcount <= len
        THEN
            BEGIN
            dlen := dlen + 1;
            dest [ dpos + dlen - 1 ] := chr (lo_dig + ord ('0'));
            END
        ELSE
            BEGIN
            digitcount := digitcount - 1;
            IF  lo_dig <> 0
            THEN
                res := num_trunc;
            (*ENDIF*) 
            lo_dig := 1;
            END;
        (*ENDIF*) 
        END;
    (*ENDFOR*) 
    IF  (lo_dig = 0)
    THEN
        BEGIN
        digitcount := digitcount - 1;
        dest [ dpos + dlen - 1 ] := ' ';
        dlen       := dlen - 1;
        END;
    (*ENDIF*) 
    point_pos := exp - 192;
    IF  (point_pos > integer_digits)
    THEN
        res := num_overflow
    ELSE
        BEGIN
        IF  (digitcount < point_pos)
            AND (point_pos <= csp_fixed) AND (point_pos >= 0)
        THEN
            BEGIN
            FOR i := 1 TO point_pos - digitcount DO
                dest [ dpos + dlen + i - 1 ] := '0';
            (*ENDFOR*) 
            dlen := dlen + point_pos - digitcount;
            END;
        (*ENDIF*) 
        IF  (point_pos > 0) AND (point_pos < csp_fixed)
        THEN
            BEGIN
            IF  dlen - 1 <> point_pos
            THEN
                BEGIN
                FOR i := dlen DOWNTO point_pos + 2 DO
                    dest [ dpos + i ] := dest [ dpos + i - 1 ];
                (*ENDFOR*) 
                dest [ dpos + point_pos + 1 ] := '.';
                dlen := dlen + 1;
                END;
            (*ENDIF*) 
            IF  frac < dlen - (point_pos + 2)
            THEN
                res := num_trunc;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        IF  point_pos <= 0
        THEN
            IF  - point_pos < frac
            THEN
                BEGIN
                FOR i := dlen DOWNTO 2 DO
                    dest [ dpos - point_pos + i + 1 ] :=
                          dest [ dpos + i - 1 ];
                (*ENDFOR*) 
                dest [ dpos + 1 ] := ' ';
                dest [ dpos + 2 ] := '.';
                FOR i := 1 TO - point_pos DO
                    dest [ dpos + 3 + i - 1 ] := '0';
                (*ENDFOR*) 
                IF  (dlen - 1) - point_pos > frac
                THEN
                    BEGIN
                    FOR i := frac + 3 + 1 TO dlen + 2 - point_pos DO
                        dest [ dpos + i - 1 ] := ' ';
                    (*ENDFOR*) 
                    dlen := frac + 3;
                    res := num_trunc;
                    END
                ELSE
                    BEGIN
                    dlen := dlen + 2 - point_pos;
                    FOR i := dlen + 1 TO frac + 3 DO
                        dest [ dpos + i - 1 ] := ' ';
                    (*ENDFOR*) 
                    END
                (*ENDIF*) 
                END
            ELSE
                BEGIN
                dest [ dpos + 1 ] := ' ';
                dest [ dpos + 2 ] := '.';
                FOR i := 1 TO frac DO
                    dest [ dpos + 3 + i - 1 ] := '0';
                (*ENDFOR*) 
                dlen := 3 + frac;
                negative := false;
                res      := num_trunc;
                END;
            (*ENDIF*) 
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  negative
    THEN
        BEGIN
        i := 1;
        not_finished := true;
        WHILE (i < dlen) AND not_finished DO
            IF  dest [ dpos + i - 1 ] = ' '
            THEN
                i := i + 1
            ELSE
                not_finished := false;
            (*ENDIF*) 
        (*ENDWHILE*) 
        dest [ dpos + i - 2 ] := '-';
        END;
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  res = num_overflow
THEN
    BEGIN
    dlen := len + 3;
    FOR i := 1 TO dlen DO
        dest [ dpos + i - 1 ] := '*';
    (*ENDFOR*) 
    END;
(*ENDIF*) 
END; (* s42gostr *)
 
(*------------------------------*) 
 
PROCEDURE
      s42gochr (
            VAR buf  : tsp00_MoveObj;
            pos      : tsp00_Int4;
            VAR dest : tsp00_MoveObj;
            dpos     : tsp00_Int4;
            VAR dlen : integer;
            VAR res  : tsp00_NumError);
 
VAR
      i                 : integer;
      lead_blank_count  : integer;
      nonblank          : boolean;
 
BEGIN
s42gostr (buf, pos, dest, dpos, dlen, res);
lead_blank_count := 0;
nonblank         := false;
WHILE (lead_blank_count < dlen - 1) AND NOT nonblank DO
    IF  dest [ dpos + lead_blank_count ] = ' '
    THEN
        lead_blank_count := lead_blank_count + 1
    ELSE
        nonblank := true;
    (*ENDIF*) 
(*ENDWHILE*) 
FOR i := 1 TO dlen - lead_blank_count DO
    dest [ dpos + i - 1 ] := dest [ dpos + lead_blank_count + i - 1 ];
(*ENDFOR*) 
FOR i := dlen - lead_blank_count + 1  TO dlen DO
    dest [ dpos + i - 1 ] := ' ';
(*ENDFOR*) 
dlen := dlen - lead_blank_count;
END; (* s42gochr *)
 
(*------------------------------*) 
 
PROCEDURE
      sp42complement (
            VAR n : tsp00_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; (* sp42complement *)
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
.PA 
