.CM  SCRIPT , Version - 1.1 , last edited by holger
.ad 8
.bm 8
.fm 4
.bt $Copyright by   SAP AG, 2001$$Page %$
.tm 12
.hm 6
.hs 3
.tt 1 $SQL$Project Distributed Database System$VSP30$
.tt 2 $$$
.tt 3 $$RTE-Extension-30$1999-09-01$
***********************************************************
.nf
 
 
    ========== licence begin LGPL
    Copyright (C) 2000 SAP AG
 
    This library is free software; you can redistribute it and/or
    modify it under the terms of the GNU Lesser General Public
    License as published by the Free Software Foundation; either
    version 2.1 of the License, or (at your option) any later version.
 
    This library 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
    Lesser General Public License for more details.
 
    You should have received a copy of the GNU Lesser General Public
    License along with this library; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
    ========== licence end
 
.fo
.nf
.sp
Module  : RTE-Extension-30
=========
.sp
Purpose : buffer handling and comparison routines
.CM *-END-* purpose -------------------------------------
.sp
.cp 3
Define  :
 
        PROCEDURE
              s30cmp (VAR buf1   : tsp_moveobj        (*ptocSynonym const void**);
                    fieldpos1    : tsp_int4;
                    fieldlength1 : tsp_int4;
                    VAR buf2     : tsp_moveobj        (*ptocSynonym const void**);
                    fieldpos2    : tsp_int4;
                    fieldlength2 : tsp_int4;
                    VAR l_result : tsp_lcomp_result);
 
        PROCEDURE
              s30cmp1 (VAR buf1  : tsp_moveobj;
                    fieldpos1    : tsp_int4;
                    fieldlength1 : tsp_int4;
                    VAR buf2     : tsp_moveobj;
                    fieldpos2    : tsp_int4;
                    fieldlength2 : tsp_int4;
                    VAR l_result : tsp_lcomp_result);
 
        PROCEDURE
              s30cmp2 (VAR buf1  : tsp_moveobj;
                    fieldpos1    : tsp_int4;
                    fieldlength1 : tsp_int4;
                    VAR buf2     : tsp_moveobj;
                    fieldpos2    : tsp_int4;
                    fieldlength2 : tsp_int4;
                    VAR l_result : tsp_lcomp_result);
 
        PROCEDURE
              s30cmp3 (VAR buf1  : tsp_moveobj;
                    fieldpos1    : tsp_int4;
                    fieldlength1 : tsp_int4;
                    VAR buf2     : tsp_moveobj;
                    fieldpos2    : tsp_int4;
                    fieldlength2 : tsp_int4;
                    VAR l_result : tsp_lcomp_result);
 
        PROCEDURE
              s30gkey (VAR buf : tsp_buf;
                    pos        : integer;
                    length     : integer;
                    VAR k      : tsp_key);
 
        FUNCTION
              s30eq (VAR a : tsp_moveobj              (*ptocSynonym const void**);
                    VAR b  : tsp_moveobj              (*ptocSynonym const void**);
                    b_pos  : tsp_int4;
                    length : tsp_int4) : boolean;
 
        FUNCTION
              s30eq1 (VAR a : tsp_moveobj;
                    VAR b   : tsp_moveobj;
                    b_pos   : tsp_int4;
                    length  : tsp_int4) : boolean;
 
        FUNCTION
              s30eqkey (VAR a : tsp_sname;
                    VAR b     : tsp_moveobj;
                    b_pos     : tsp_int4;
                    length    : integer) : boolean;
 
        FUNCTION
              s30klen (VAR str : tsp_moveobj           (*ptocSynonym const void**);
                    val : char;
                    cnt : integer) : integer;
 
        FUNCTION
              s30lnr (VAR str : tsp_moveobj            (*ptocSynonym const void**);
                    skip_val  : char;
                    start_pos : tsp_int4;
                    length    : tsp_int4) : tsp_int4;
 
        FUNCTION
              s30lnr1 (VAR str : tsp_moveobj;
                    skip_val   : char;
                    start_pos  : tsp_int4;
                    length     : tsp_int4) : tsp_int4;
 
        FUNCTION
              s30lnr_defbyte (str : tsp_moveobj_ptr   (*ptocSynonym const void**);
                    defbyte   : char;
                    start_pos : tsp_int4;
                    length    : tsp_int4) : tsp_int4;
 
        FUNCTION
              s30nlen (VAR str : tsp_moveobj          (*ptocSynonym const void**);
                    val   : char;
                    start : tsp_int4;
                    cnt   : tsp_int4) : tsp_int4;
 
        FUNCTION
              s30len (VAR str : tsp_moveobj           (*ptocSynonym const void**);
                    val : char;
                    cnt : tsp_int4) : tsp_int4;
 
        FUNCTION
              s30len1 (VAR str : tsp_moveobj;
                    val : char;
                    cnt : tsp_int4) : tsp_int4;
 
        FUNCTION
              s30len2 (VAR str : tsp_moveobj;
                    val : char;
                    cnt : tsp_int4) : tsp_int4;
 
        FUNCTION
              s30len3 (VAR str : tsp_moveobj;
                    val : char;
                    cnt : tsp_int4) : tsp_int4;
 
        FUNCTION
              s30len4 (VAR str : tsp_moveobj;
                    val : char;
                    cnt : tsp_int4) : tsp_int4;
 
        PROCEDURE
              s30map (VAR code_t : tsp_ctable;
                    VAR source   : tsp_moveobj        (*ptocSynonym const void**);
                    source_pos   : tsp_int4;
                    VAR destin   : tsp_moveobj;
                    destin_pos   : tsp_int4;
                    length       : tsp_int4);
 
        PROCEDURE
              s30luc (VAR buf1   : tsp_moveobj        (*ptocSynonym const void**);
                    fieldpos1    : tsp_int4;
                    fieldlength1 : tsp_int4;
                    VAR buf2     : tsp_moveobj        (*ptocSynonym const void**);
                    fieldpos2    : tsp_int4;
                    fieldlength2 : tsp_int4;
                    VAR l_result : tsp_lcomp_result);
 
        PROCEDURE
              s30luc1 (VAR buf1  : tsp_moveobj;
                    fieldpos1    : tsp_int4;
                    fieldlength1 : tsp_int4;
                    VAR buf2     : tsp_moveobj;
                    fieldpos2    : tsp_int4;
                    fieldlength2 : tsp_int4;
                    VAR l_result : tsp_lcomp_result);
 
        PROCEDURE
              s30lcm (VAR buf1   : tsp_moveobj        (*ptocSynonym const void**);
                    fieldpos1    : tsp_int4;
                    fieldlength1 : tsp_int4;
                    VAR buf2     : tsp_moveobj        (*ptocSynonym const void**);
                    fieldpos2    : tsp_int4;
                    fieldlength2 : tsp_int4;
                    VAR l_result : tsp_lcomp_result);
 
        PROCEDURE
              s30lcm1 (VAR buf1  : tsp_moveobj;
                    fieldpos1    : tsp_int4;
                    fieldlength1 : tsp_int4;
                    VAR buf2     : tsp_moveobj;
                    fieldpos2    : tsp_int4;
                    fieldlength2 : tsp_int4;
                    VAR l_result : tsp_lcomp_result);
 
        PROCEDURE
              s30lcm2 (VAR buf1  : tsp_moveobj;
                    fieldpos1    : tsp_int4;
                    fieldlength1 : tsp_int4;
                    VAR buf2     : tsp_moveobj;
                    fieldpos2    : tsp_int4;
                    fieldlength2 : tsp_int4;
                    VAR l_result : tsp_lcomp_result);
 
        PROCEDURE
              s30lcm3 (VAR buf1  : tsp_moveobj;
                    fieldpos1    : tsp_int4;
                    fieldlength1 : tsp_int4;
                    VAR buf2     : tsp_moveobj;
                    fieldpos2    : tsp_int4;
                    fieldlength2 : tsp_int4;
                    VAR l_result : tsp_lcomp_result);
 
        FUNCTION
              s30lenl (VAR str : tsp_moveobj          (*ptocSynonym const void**);
                    val   : char;
                    start : tsp_int4;
                    cnt   : tsp_int4) : tsp_int4;
 
        FUNCTION
              s30gad (VAR b : tsp_moveobj) : tsp_addr;
 
        FUNCTION
              s30gad1 (VAR b : tsp_moveobj) : tsp_addr;
 
        FUNCTION
              s30gad2 (VAR b : tsp_moveobj) : tsp_addr;
 
        FUNCTION
              s30gad3 (VAR b : tsp_moveobj) : tsp_addr;
 
        FUNCTION
              s30gad4 (VAR b : tsp_moveobj) : tsp_addr;
 
        FUNCTION
              s30gad5 (VAR b : tsp_moveobj) : tsp_addr;
 
        FUNCTION
              s30gad6 (VAR b : tsp_moveobj) : tsp_addr;
 
        FUNCTION
              s30gad7 (VAR b : tsp_moveobj) : tsp_addr;
 
        FUNCTION
              s30unilnr (str  : tsp_moveobj_ptr       (*ptocSynonym const void**);
                    skip_val  : tsp_c2;
                    start_pos : tsp_int4;
                    length    : tsp_int4) : tsp_int4;
 
        PROCEDURE
              s30xorc4 (c4_1      : tsp_c4;
                    c4_2          : tsp_c4;
                    VAR c4_target : tsp_c4);
 
        PROCEDURE
              s30surrogate_incr (VAR surrogate : tsp_c8);
 
.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :
 
        FROM
              RTE-Extension-10 : VSP10;
 
        PROCEDURE
              s10mv (size1   : tsp_int4;  size2 : tsp_int4;
                    VAR val1 : tsp_buf;   p1    : tsp_int4;
                    VAR val2 : tsp_key;   p2    : tsp_int4;
                    cnt      : tsp_int4);
 
.CM *-END-* use -----------------------------------------
.sp;.cp 3
Synonym :
 
        PROCEDURE
              s10mv;
 
              tsp_moveobj   tsp_buf
              tsp_moveobj   tsp_key
 
.CM *-END-* synonym -------------------------------------
.sp;.cp 3
Author  :
.sp
.cp 3
Created : 1979-06-07
.sp
.cp 3
Version : 2001-01-24
.sp
.cp 3
Release :      Date : 1999-09-01
.sp
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Specification:
 
The position information POS indicates
the first byte of the field concerned.
The first byte in the buffer is addressable via POS = 1.
.sp 2
Procedure PUTKEY
.sp
This procedure transfers a key from K with the length LENGTH starting
at POS to the buffer BUF.
.sp
.cp 5
Procedure GETKEY
.sp
This procedure transfers a key from the buffer BUF to K with the length
LENGTH starting at POS.  The key in K is not filled with binary zeros.
The other parameters can be allocated at random; they are not changed.
.sp 2
FUNCTION   S30EQ:
.sp
Compares cnt bytes of the string a with the buffer contents b
starting at position bi.
If all bytes are identical, the function value 'true' is returned.
.sp 4
FUNCTION   S30EQ1:
.sp
Compares cnt bytes of the string a with the buffer contents b
starting at position bi.
If all bytes are identical, the function value 'true' is
returned.
.sp 4
FUNCTION   S30EQKEY:
.sp
Compares a short name a with the buffer contents b starting at
position bi with a length of cnt bytes, and checks whether the name
is not longer than cnt.  If yes, the function value 'true' is returned.
.sp 4
FUNCTION   S30KLEN:
.sp
Calculates the exact length of the string str with the length cnt
backwards until a byte is found that is not equal to val.
.sp 4
FUNCTION   S30LNR:
.sp
Calculates the exact length of the string str in the buffer
starting at position 'start' and with the length cnt
backwards until a byte is found that is not equal to val.
.sp 4
FUNCTION   S30LEN:
.sp
Calculates the exact length of the string str with the length
cnt forwards until the next byte that equals val is found.
.sp 4
FUNCTION   S30LENL:
.sp
Calculates the exact length of the string str in the buffer
starting at position 'start' and with the length cnt
forwards until the next byte that equals val is found.
.sp 4
PROCEDURE  S30MAP:
.sp
Translates a source object 'source' starting at position spos with the
code_table code_t to a destination object dest starting at position dpos
with the length 'length'.
.sp 4
PROCEDURE  S30LCM:
.sp
Compares two strings in buffers buf1 and buf2 at positions
fieldpos1 and fieldpos2 with the lengths fieldlength1 and fieldlength2.
The shorter string is filled with binary zeros.
l_result can assume three values:
   1. if  1 > 2  ::=  l_greater
   2. if  1 < 2  ::=  l_less
   3. if  1 = 2  ::=  l_equal.
.sp 4
PROCEDURE  S30LCM1:
.sp
Compares two strings in buffers buf1 and buf2 at positions
fieldpos1 and fieldpos2 with the lengths fieldlength1 and fieldlength2.
The shorter string is filled with binary zeros.
l_result can assume three values:
   1. if  1 > 2  ::=  l_greater
   2. if  1 < 2  ::=  l_less
   3. if  1 = 2  ::=  l_equal.
.sp 4
PROCEDURE  S30LUC:
.sp
Compares two strings in buffers buf1 and buf2 at positions
fieldpos1 and fieldpos2 with the lengths fieldlength1 and fieldlength2.
The shorter string is filled with undefbytes (in buf1 at fieldpos1).
l_result can assume three values:
   1. if  1 > 2  ::=  l_greater
   2. if  1 < 2  ::=  l_less
   3. if  1 = 2  ::=  l_equal.
   4. if  1 or 2 undef  ::=  l_undef,
      or  l1 or l2 = 0  ::=  l_undef.
.sp 4
PROCEDURE  S30GPNT:
.sp
Calculates a new pointer 'point' at the position in a storage-space
area with the initial pointer panf.
.sp 4
PROCEDURE  S30XORC4:
.sp
Executes an EXCLUSIVE OR between C4_1 and C4_2 and assigns the result
to C4_TARGET.
.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
      s30cmp (VAR buf1   : tsp_moveobj;
            fieldpos1    : tsp_int4;
            fieldlength1 : tsp_int4;
            VAR buf2     : tsp_moveobj;
            fieldpos2    : tsp_int4;
            fieldlength2 : tsp_int4;
            VAR l_result : tsp_lcomp_result);
 
VAR
      prefix_length  : tsp_int4;
      i              : tsp_int4;
      prefix_compare : tsp_lcomp_result;
 
BEGIN
(* buf1 field > buf2 field  =>  l_result = l_greater *)
l_result := l_equal;
IF  fieldlength1 <= 0
THEN
    BEGIN
    IF  fieldlength2 <= 0
    THEN
        l_result := l_equal
    ELSE (* fieldlength2 > 0 *)
        l_result := l_less
    (*ENDIF*) 
    END
ELSE (* fieldlength1 > 0 *)
    IF  fieldlength2 <= 0
    THEN
        l_result := l_greater
    ELSE (* fieldlength1 > 0 AND fieldlength2 > 0 *)
        BEGIN
        IF  fieldlength1 > fieldlength2
        THEN
            prefix_length := fieldlength2
        ELSE
            prefix_length := fieldlength1;
        (*ENDIF*) 
        i := 0;
        prefix_compare := l_equal;
        REPEAT
            IF  buf1 [fieldpos1+i] <> buf2 [fieldpos2+i]
            THEN
                BEGIN
                IF  buf1 [fieldpos1+i] > buf2 [fieldpos2+i]
                THEN
                    prefix_compare := l_greater
                ELSE
                    prefix_compare := l_less
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            i := i + 1
        UNTIL
            (prefix_compare <> l_equal) OR (i >= prefix_length);
        (*ENDREPEAT*) 
        CASE prefix_compare OF
            l_greater:
                l_result := l_greater;
            l_less:
                l_result := l_less;
            l_equal:
                BEGIN
                IF  fieldlength1 = fieldlength2
                THEN
                    l_result := l_equal
                ELSE
                    IF  fieldlength1 > fieldlength2
                    THEN
                        l_result := l_greater
                    ELSE (* fieldlength1 < fieldlength2 *)
                        l_result := l_less
                    (*ENDIF*) 
                (*ENDIF*) 
                END
            END
        (*ENDCASE*) 
        END
    (*ENDIF*) 
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      s30cmp1 (VAR buf1  : tsp_moveobj;
            fieldpos1    : tsp_int4;
            fieldlength1 : tsp_int4;
            VAR buf2     : tsp_moveobj;
            fieldpos2    : tsp_int4;
            fieldlength2 : tsp_int4;
            VAR l_result : tsp_lcomp_result);
 
VAR
      prefix_length  : tsp_int4;
      i              : tsp_int4;
      prefix_compare : tsp_lcomp_result;
 
BEGIN
(* buf1 field > buf2 field  =>  l_result = l_greater *)
l_result := l_equal;
IF  fieldlength1 <= 0
THEN
    BEGIN
    IF  fieldlength2 <= 0
    THEN
        l_result := l_equal
    ELSE (* fieldlength2 > 0 *)
        l_result := l_less
    (*ENDIF*) 
    END
ELSE (* fieldlength1 > 0 *)
    IF  fieldlength2 <= 0
    THEN
        l_result := l_greater
    ELSE (* fieldlength1 > 0 AND fieldlength2 > 0 *)
        BEGIN
        IF  fieldlength1 > fieldlength2
        THEN
            prefix_length := fieldlength2
        ELSE
            prefix_length := fieldlength1;
        (*ENDIF*) 
        i := 0;
        prefix_compare := l_equal;
        REPEAT
            IF  buf1 [fieldpos1+i] <> buf2 [fieldpos2+i]
            THEN
                BEGIN
                IF  buf1 [fieldpos1+i] > buf2 [fieldpos2+i]
                THEN
                    prefix_compare := l_greater
                ELSE
                    prefix_compare := l_less
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            i := i + 1
        UNTIL
            (prefix_compare <> l_equal) OR (i >= prefix_length);
        (*ENDREPEAT*) 
        CASE prefix_compare OF
            l_greater:
                l_result := l_greater;
            l_less:
                l_result := l_less;
            l_equal:
                BEGIN
                IF  fieldlength1 = fieldlength2
                THEN
                    l_result := l_equal
                ELSE
                    IF  fieldlength1 > fieldlength2
                    THEN
                        l_result := l_greater
                    ELSE (* fieldlength1 < fieldlength2 *)
                        l_result := l_less
                    (*ENDIF*) 
                (*ENDIF*) 
                END
            END
        (*ENDCASE*) 
        END
    (*ENDIF*) 
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      s30cmp2 (VAR buf1  : tsp_moveobj;
            fieldpos1    : tsp_int4;
            fieldlength1 : tsp_int4;
            VAR buf2     : tsp_moveobj;
            fieldpos2    : tsp_int4;
            fieldlength2 : tsp_int4;
            VAR l_result : tsp_lcomp_result);
 
VAR
      prefix_length  : tsp_int4;
      i              : tsp_int4;
      prefix_compare : tsp_lcomp_result;
 
BEGIN
(* buf1 field > buf2 field  =>  l_result = l_greater *)
l_result := l_equal;
IF  fieldlength1 <= 0
THEN
    BEGIN
    IF  fieldlength2 <= 0
    THEN
        l_result := l_equal
    ELSE (* fieldlength2 > 0 *)
        l_result := l_less
    (*ENDIF*) 
    END
ELSE (* fieldlength1 > 0 *)
    IF  fieldlength2 <= 0
    THEN
        l_result := l_greater
    ELSE (* fieldlength1 > 0 AND fieldlength2 > 0 *)
        BEGIN
        IF  fieldlength1 > fieldlength2
        THEN
            prefix_length := fieldlength2
        ELSE
            prefix_length := fieldlength1;
        (*ENDIF*) 
        i := 0;
        prefix_compare := l_equal;
        REPEAT
            IF  buf1 [fieldpos1+i] <> buf2 [fieldpos2+i]
            THEN
                BEGIN
                IF  buf1 [fieldpos1+i] > buf2 [fieldpos2+i]
                THEN
                    prefix_compare := l_greater
                ELSE
                    prefix_compare := l_less
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            i := i + 1
        UNTIL
            (prefix_compare <> l_equal) OR (i >= prefix_length);
        (*ENDREPEAT*) 
        CASE prefix_compare OF
            l_greater:
                l_result := l_greater;
            l_less:
                l_result := l_less;
            l_equal:
                BEGIN
                IF  fieldlength1 = fieldlength2
                THEN
                    l_result := l_equal
                ELSE
                    IF  fieldlength1 > fieldlength2
                    THEN
                        l_result := l_greater
                    ELSE (* fieldlength1 < fieldlength2 *)
                        l_result := l_less
                    (*ENDIF*) 
                (*ENDIF*) 
                END
            END
        (*ENDCASE*) 
        END
    (*ENDIF*) 
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      s30cmp3 (VAR buf1  : tsp_moveobj;
            fieldpos1    : tsp_int4;
            fieldlength1 : tsp_int4;
            VAR buf2     : tsp_moveobj;
            fieldpos2    : tsp_int4;
            fieldlength2 : tsp_int4;
            VAR l_result : tsp_lcomp_result);
 
VAR
      prefix_length  : tsp_int4;
      i              : tsp_int4;
      prefix_compare : tsp_lcomp_result;
 
BEGIN
(* buf1 field > buf2 field  =>  l_result = l_greater *)
l_result := l_equal;
IF  fieldlength1 <= 0
THEN
    BEGIN
    IF  fieldlength2 <= 0
    THEN
        l_result := l_equal
    ELSE (* fieldlength2 > 0 *)
        l_result := l_less
    (*ENDIF*) 
    END
ELSE (* fieldlength1 > 0 *)
    IF  fieldlength2 <= 0
    THEN
        l_result := l_greater
    ELSE (* fieldlength1 > 0 AND fieldlength2 > 0 *)
        BEGIN
        IF  fieldlength1 > fieldlength2
        THEN
            prefix_length := fieldlength2
        ELSE
            prefix_length := fieldlength1;
        (*ENDIF*) 
        i := 0;
        prefix_compare := l_equal;
        REPEAT
            IF  buf1 [fieldpos1+i] <> buf2 [fieldpos2+i]
            THEN
                BEGIN
                IF  buf1 [fieldpos1+i] > buf2 [fieldpos2+i]
                THEN
                    prefix_compare := l_greater
                ELSE
                    prefix_compare := l_less
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            i := i + 1
        UNTIL
            (prefix_compare <> l_equal) OR (i >= prefix_length);
        (*ENDREPEAT*) 
        CASE prefix_compare OF
            l_greater:
                l_result := l_greater;
            l_less:
                l_result := l_less;
            l_equal:
                BEGIN
                IF  fieldlength1 = fieldlength2
                THEN
                    l_result := l_equal
                ELSE
                    IF  fieldlength1 > fieldlength2
                    THEN
                        l_result := l_greater
                    ELSE (* fieldlength1 < fieldlength2 *)
                        l_result := l_less
                    (*ENDIF*) 
                (*ENDIF*) 
                END
            END
        (*ENDCASE*) 
        END
    (*ENDIF*) 
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      s30gkey (VAR buf : tsp_buf;
            pos        : integer;
            length     : integer;
            VAR k : tsp_key);
 
BEGIN
s10mv  (sizeof (buf), sizeof (k), buf, pos, k, 1, length);
END;
 
(*------------------------------*) 
 
FUNCTION
      s30eq (VAR a : tsp_moveobj;
            VAR b  : tsp_moveobj;
            b_pos  : tsp_int4;
            length : tsp_int4) : boolean;
 
VAR
      equal : boolean;
      i     : tsp_int4;
 
BEGIN
i     := 1;
equal := true;
WHILE (i <= length) AND equal DO
    BEGIN
    equal := (a [i] = b [b_pos-1+i]);
    i     := i + 1
    END;
(*ENDWHILE*) 
s30eq := equal
END;
 
(*------------------------------*) 
 
FUNCTION
      s30eq1 (VAR a : tsp_moveobj;
            VAR b   : tsp_moveobj;
            b_pos   : tsp_int4;
            length  : tsp_int4) : boolean;
 
VAR
      equal : boolean;
      i     : tsp_int4;
 
BEGIN
i     := 1;
equal := true;
WHILE (i <= length) AND equal DO
    BEGIN
    equal := (a [i] = b [b_pos-1+i]);
    i     := i + 1
    END;
(*ENDWHILE*) 
s30eq1 := equal
END;
 
(*------------------------------*) 
 
FUNCTION
      s30eqkey (VAR a : tsp_sname;
            VAR b     : tsp_moveobj;
            b_pos     : tsp_int4;
            length    : integer) : boolean;
 
VAR
      equal : boolean;
      i     : integer;
 
BEGIN
IF  length > sizeof (a)
THEN
    equal := false
ELSE
    BEGIN
    i     := 1;
    equal := true;
    WHILE (i <= length) AND equal DO
        BEGIN
        equal := (a [i] = b [b_pos-1+i]);
        i     := i + 1
        END;
    (*ENDWHILE*) 
    IF  equal AND (i <= sizeof (a))
    THEN
        BEGIN
        IF  a [i] <> bsp_c1
        THEN
            equal := false
        (*ENDIF*) 
        END
    (*ENDIF*) 
    END;
(*ENDIF*) 
s30eqkey := equal
END;
 
(*------------------------------*) 
 
FUNCTION
      s30klen (VAR str : tsp_moveobj;
            val : char;
            cnt : integer) : integer;
 
VAR
      i : integer;
      finish : boolean;
 
BEGIN
i := cnt;
finish := false;
WHILE  (i >= 1) AND NOT finish DO
    IF  str [ i ] <> val
    THEN
        BEGIN
        s30klen := i;
        finish := true;
        END
    ELSE
        i := i-1;
    (*ENDIF*) 
(*ENDWHILE*) 
IF  NOT finish
THEN
    s30klen := 0;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      s30lnr (VAR str : tsp_moveobj;
            skip_val  : char;
            start_pos : tsp_int4;
            length    : tsp_int4) : tsp_int4;
 
VAR
      i      : tsp_int4;
      finish : boolean;
 
BEGIN
i      := start_pos + length - 1;
finish := false;
WHILE (i >= start_pos) AND NOT finish DO
    IF  str [i] <> skip_val
    THEN
        BEGIN
        s30lnr := i - start_pos + 1;
        finish := true;
        END
    ELSE
        i := i-1;
    (*ENDIF*) 
(*ENDWHILE*) 
IF  NOT finish
THEN
    s30lnr := 0
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      s30lnr1 (VAR str : tsp_moveobj;
            skip_val   : char;
            start_pos  : tsp_int4;
            length     : tsp_int4) : tsp_int4;
 
VAR
      i      : tsp_int4;
      finish : boolean;
 
BEGIN
i      := start_pos + length - 1;
finish := false;
WHILE  (i >= start_pos) AND NOT finish DO
    IF  str [i] <> skip_val
    THEN
        BEGIN
        s30lnr1 := i - start_pos + 1;
        finish  := true;
        END
    ELSE
        i := i-1;
    (*ENDIF*) 
(*ENDWHILE*) 
IF  NOT finish
THEN
    s30lnr1 := 0
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      s30lnr_defbyte (str : tsp_moveobj_ptr;
            defbyte   : char;
            start_pos : tsp_int4;
            length    : tsp_int4) : tsp_int4;
 
VAR
      i      : tsp_int4;
      finish : boolean;
 
BEGIN
i      := start_pos + length - 1;
finish := false;
IF  defbyte = csp_unicode_def_byte
THEN
    WHILE (i > start_pos) AND NOT finish DO
        BEGIN
        IF  (str^[i-1] <> csp_unicode_mark) OR (str^[i] <> bsp_c1)
        THEN
            BEGIN
            s30lnr_defbyte := i - start_pos + 1;
            finish := true;
            END
        ELSE
            i := i-2;
        (*ENDIF*) 
        END
    (*ENDWHILE*) 
ELSE
    WHILE (i >= start_pos) AND NOT finish DO
        BEGIN
        IF  str^ [i] <> defbyte
        THEN
            BEGIN
            s30lnr_defbyte := i - start_pos + 1;
            finish := true;
            END
        ELSE
            i := i-1;
        (*ENDIF*) 
        END;
    (*ENDWHILE*) 
(*ENDIF*) 
IF  NOT finish
THEN
    s30lnr_defbyte := 0
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      s30nlen (VAR str : tsp_moveobj;
            val   : char;
            start : tsp_int4;
            cnt   : tsp_int4) : tsp_int4;
 
VAR
      finish : boolean;
      i      : tsp_int4;
 
BEGIN
i := start + 1;
finish := false;
WHILE  (i <= cnt) AND NOT finish DO
    IF  str [ i ] <> val
    THEN
        BEGIN
        s30nlen := i;
        finish  := true;
        END
    ELSE
        i := i + 1;
    (*ENDIF*) 
(*ENDWHILE*) 
IF  NOT finish
THEN
    s30nlen := start;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      s30len (VAR str : tsp_moveobj;
            val : char;
            cnt : tsp_int4) : tsp_int4;
 
VAR
      i : tsp_int4;
      finish : boolean;
 
BEGIN
i := 1;
finish := false;
WHILE  (i <= cnt) AND NOT finish DO
    IF  str[ i ] = val
    THEN
        BEGIN
        s30len := i-1;
        finish := true;
        END
    ELSE
        i := i+1;
    (*ENDIF*) 
(*ENDWHILE*) 
IF  NOT  finish
THEN
    s30len := cnt ;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      s30len1 (VAR str : tsp_moveobj;
            val : char;
            cnt : tsp_int4) : tsp_int4;
 
BEGIN
s30len1 := s30len (str, val, cnt);
END;
 
(*------------------------------*) 
 
FUNCTION
      s30len2 (VAR str : tsp_moveobj;
            val : char;
            cnt : tsp_int4) : tsp_int4;
 
BEGIN
s30len2 := s30len (str, val, cnt);
END;
 
(*------------------------------*) 
 
FUNCTION
      s30len3 (VAR str : tsp_moveobj;
            val : char;
            cnt : tsp_int4) : tsp_int4;
 
BEGIN
s30len3 := s30len (str, val, cnt);
END;
 
(*------------------------------*) 
 
FUNCTION
      s30len4 (VAR str : tsp_moveobj;
            val : char;
            cnt : tsp_int4) : tsp_int4;
 
BEGIN
s30len4 := s30len (str, val, cnt);
END;
 
(*------------------------------*) 
 
PROCEDURE
      s30map (VAR code_t : tsp_ctable;
            VAR source   : tsp_moveobj;
            source_pos   : tsp_int4;
            VAR destin   : tsp_moveobj;
            destin_pos   : tsp_int4;
            length       : tsp_int4);
 
VAR
      i : tsp_int4;
 
BEGIN
FOR i := 0 TO length-1 DO
    destin [destin_pos+i] := code_t [ord (source [source_pos+i]) + 1]
(*ENDFOR*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      s30luc (VAR buf1   : tsp_moveobj;
            fieldpos1    : tsp_int4;
            fieldlength1 : tsp_int4;
            VAR buf2     : tsp_moveobj;
            fieldpos2    : tsp_int4;
            fieldlength2 : tsp_int4;
            VAR l_result : tsp_lcomp_result);
 
VAR
      check_trailing_defbyte : boolean;
      prefix_compare         : tsp_lcomp_result;
      def_byte               : char;
      prefix_length          : tsp_int4;
      i                      : tsp_int4;
 
BEGIN
(*  collogica  implementierung nicht getestet 4.7.85 *)
IF  (fieldlength1 < 1) OR (fieldlength2 < 1)
THEN
    l_result := l_undef
ELSE
    IF  (buf1 [fieldpos1] = chr (255)) OR
        (buf2 [fieldpos2] = chr (255))
    THEN
        l_result := l_undef
    ELSE
        BEGIN
        IF  fieldlength1 > fieldlength2
        THEN
            prefix_length := fieldlength2 - 1
        ELSE
            prefix_length := fieldlength1 - 1;
        (*ENDIF*) 
        i                      := 1;
        prefix_compare         := l_equal;
        def_byte               := buf1 [fieldpos1];
        check_trailing_defbyte := false;
        WHILE (prefix_compare = l_equal) AND (i <= prefix_length) DO
            BEGIN
            IF  buf1 [fieldpos1+i] > buf2 [fieldpos2+i]
            THEN
                BEGIN
                prefix_compare := l_greater;
                IF  def_byte = csp_unicode_def_byte
                THEN
                    check_trailing_defbyte :=
                          (buf1 [fieldpos1+i-1] = csp_unicode_mark) AND
                          (buf1 [fieldpos1+i]   = csp_ascii_blank)
                ELSE
                    check_trailing_defbyte := buf1 [fieldpos1+i] = def_byte
                (*ENDIF*) 
                END
            ELSE
                IF  buf1 [fieldpos1+i] < buf2 [fieldpos2+i]
                THEN
                    BEGIN
                    prefix_compare := l_less;
                    IF  def_byte = csp_unicode_def_byte
                    THEN
                        check_trailing_defbyte :=
                              (buf2 [fieldpos2+i-1] = csp_unicode_mark) AND
                              (buf2 [fieldpos2+i]   = csp_ascii_blank)
                    ELSE
                        check_trailing_defbyte := buf2 [fieldpos2+i] = def_byte
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
            (*ENDIF*) 
            i := i + 1
            END;
        (*ENDWHILE*) 
        CASE prefix_compare OF
            l_greater:
                IF  check_trailing_defbyte
                THEN
                    BEGIN
                    i := i - 1;
                    IF  def_byte = csp_unicode_def_byte
                    THEN
                        i := i - 1;
                    (*ENDIF*) 
                    IF  s30lnr_defbyte (@buf1, def_byte,
                        fieldpos1+i, fieldlength1-i) = 0
                    THEN
                        l_result := l_less
                    ELSE
                        l_result := l_greater
                    (*ENDIF*) 
                    END
                ELSE
                    l_result := l_greater;
                (*ENDIF*) 
            l_less:
                IF  check_trailing_defbyte
                THEN
                    BEGIN
                    i := i - 1;
                    IF  def_byte = csp_unicode_def_byte
                    THEN
                        i := i - 1;
                    (*ENDIF*) 
                    IF  s30lnr_defbyte (@buf2, def_byte,
                        fieldpos2+i, fieldlength2-i) = 0
                    THEN
                        l_result := l_greater
                    ELSE
                        l_result := l_less
                    (*ENDIF*) 
                    END
                ELSE
                    l_result := l_less;
                (*ENDIF*) 
            l_equal:
                BEGIN
                IF  fieldlength1 = fieldlength2
                THEN
                    l_result := l_equal
                ELSE
                    IF  fieldlength1 > fieldlength2
                    THEN
                        BEGIN
                        IF  s30lnr_defbyte (@buf1, def_byte,
                            fieldpos1+i, fieldlength1-i) = 0
                        THEN
                            l_result := l_equal
                        ELSE
                            l_result := l_greater
                        (*ENDIF*) 
                        END
                    ELSE (* fieldlength1 < fieldlength2 *)
                        BEGIN
                        IF  s30lnr_defbyte (@buf2, def_byte,
                            fieldpos2+i, fieldlength2-i) = 0
                        THEN
                            l_result := l_equal
                        ELSE
                            l_result := l_less
                        (*ENDIF*) 
                        END
                    (*ENDIF*) 
                (*ENDIF*) 
                END
            END
        (*ENDCASE*) 
        END;
    (*ENDIF*) 
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      s30luc1 (VAR buf1  : tsp_moveobj;
            fieldpos1    : tsp_int4;
            fieldlength1 : tsp_int4;
            VAR buf2     : tsp_moveobj;
            fieldpos2    : tsp_int4;
            fieldlength2 : tsp_int4;
            VAR l_result : tsp_lcomp_result);
 
BEGIN
s30luc (buf1, fieldpos1, fieldlength1,
      buf2, fieldpos2, fieldlength2, l_result)
END;
 
(*------------------------------*) 
 
PROCEDURE
      s30lcm (VAR buf1   : tsp_moveobj;
            fieldpos1    : tsp_int4;
            fieldlength1 : tsp_int4;
            VAR buf2     : tsp_moveobj;
            fieldpos2    : tsp_int4;
            fieldlength2 : tsp_int4;
            VAR l_result : tsp_lcomp_result);
 
VAR
      prefix_length  : tsp_int4;
      i              : tsp_int4;
      char_detected  : boolean;
      prefix_compare : tsp_lcomp_result;
 
BEGIN
(* buf1 field > buf2 field  =>  l_result = l_greater *)
l_result := l_equal;
IF  fieldlength1 <= 0
THEN
    BEGIN
    IF  fieldlength2 <= 0
    THEN
        l_result := l_equal
    ELSE (* fieldlength2 > 0 *)
        BEGIN
        i := 0;
        REPEAT
            char_detected := (buf2[ fieldpos2+i ] <> chr(0));
            i := i + 1
        UNTIL
            (i >= fieldlength2) OR char_detected;
        (*ENDREPEAT*) 
        IF  char_detected
        THEN
            l_result := l_less
        ELSE
            l_result := l_equal
        (*ENDIF*) 
        END
    (*ENDIF*) 
    END
ELSE (* fieldlength1 > 0 *)
    IF  fieldlength2 <= 0
    THEN
        BEGIN
        i := 0;
        REPEAT
            char_detected := (buf1[ fieldpos1+i ] <> chr(0));
            i := i + 1
        UNTIL
            (i >= fieldlength1) OR char_detected;
        (*ENDREPEAT*) 
        IF  char_detected
        THEN
            l_result := l_greater
        ELSE
            l_result := l_equal
        (*ENDIF*) 
        END
    ELSE (* fieldlength1 > 0 AND fieldlength2 > 0 *)
        BEGIN
        IF  fieldlength1 > fieldlength2
        THEN
            prefix_length := fieldlength2
        ELSE
            prefix_length := fieldlength1;
        (*ENDIF*) 
        i := 0;
        prefix_compare := l_equal;
        REPEAT
            IF  buf1[ fieldpos1+i ] <> buf2[ fieldpos2+i ]
            THEN
                BEGIN
                IF  buf1[ fieldpos1+i ] > buf2[ fieldpos2+i ]
                THEN
                    prefix_compare := l_greater
                ELSE
                    prefix_compare := l_less
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            i := i + 1
        UNTIL
            (prefix_compare <> l_equal) OR (i >= prefix_length);
        (*ENDREPEAT*) 
        CASE prefix_compare OF
            l_greater:
                l_result := l_greater;
            l_less:
                l_result := l_less;
            l_equal:
                BEGIN
                IF  fieldlength1 = fieldlength2
                THEN
                    l_result := l_equal
                ELSE
                    IF  fieldlength1 > fieldlength2
                    THEN
                        BEGIN
                        i := prefix_length;
                        REPEAT
                            char_detected :=
                                  (buf1[ fieldpos1+i ]
                                  <> chr(0));
                            i := i + 1
                        UNTIL
                            (i >= fieldlength1) OR char_detected;
                        (*ENDREPEAT*) 
                        IF  char_detected
                        THEN
                            l_result := l_greater
                        ELSE
                            l_result := l_equal
                        (*ENDIF*) 
                        END
                    ELSE (* fieldlength1 < fieldlength2 *)
                        BEGIN
                        i := prefix_length;
                        REPEAT
                            char_detected :=
                                  (buf2[ fieldpos2+i ]
                                  <> chr(0));
                            i := i + 1
                        UNTIL
                            (i >= fieldlength2) OR char_detected;
                        (*ENDREPEAT*) 
                        IF  char_detected
                        THEN
                            l_result := l_less
                        ELSE
                            l_result := l_equal
                        (*ENDIF*) 
                        END
                    (*ENDIF*) 
                (*ENDIF*) 
                END
            END
        (*ENDCASE*) 
        END
    (*ENDIF*) 
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      s30lcm1 (VAR buf1  : tsp_moveobj;
            fieldpos1    : tsp_int4;
            fieldlength1 : tsp_int4;
            VAR buf2     : tsp_moveobj;
            fieldpos2    : tsp_int4;
            fieldlength2 : tsp_int4;
            VAR l_result : tsp_lcomp_result);
 
VAR
      prefix_length  : tsp_int4;
      i              : tsp_int4;
      char_detected  : boolean;
      prefix_compare : tsp_lcomp_result;
 
BEGIN
(* buf1 field > buf2 field  =>  l_result = l_greater *)
l_result := l_equal;
IF  fieldlength1 <= 0
THEN
    BEGIN
    IF  fieldlength2 <= 0
    THEN
        l_result := l_equal
    ELSE (* fieldlength2 > 0 *)
        BEGIN
        i := 0;
        REPEAT
            char_detected := (buf2[ fieldpos2+i ] <> chr(0));
            i := i + 1
        UNTIL
            (i >= fieldlength2) OR char_detected;
        (*ENDREPEAT*) 
        IF  char_detected
        THEN
            l_result := l_less
        ELSE
            l_result := l_equal
        (*ENDIF*) 
        END
    (*ENDIF*) 
    END
ELSE (* fieldlength1 > 0 *)
    IF  fieldlength2 <= 0
    THEN
        BEGIN
        i := 0;
        REPEAT
            char_detected := (buf1[ fieldpos1+i ] <> chr(0));
            i := i + 1
        UNTIL
            (i >= fieldlength1) OR char_detected;
        (*ENDREPEAT*) 
        IF  char_detected
        THEN
            l_result := l_greater
        ELSE
            l_result := l_equal
        (*ENDIF*) 
        END
    ELSE (* fieldlength1 > 0 AND fieldlength2 > 0 *)
        BEGIN
        IF  fieldlength1 > fieldlength2
        THEN
            prefix_length := fieldlength2
        ELSE
            prefix_length := fieldlength1;
        (*ENDIF*) 
        i := 0;
        prefix_compare := l_equal;
        REPEAT
            IF  buf1[ fieldpos1+i ] <> buf2[ fieldpos2+i ]
            THEN
                BEGIN
                IF  buf1[ fieldpos1+i ] > buf2[ fieldpos2+i ]
                THEN
                    prefix_compare := l_greater
                ELSE
                    prefix_compare := l_less
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            i := i + 1
        UNTIL
            (prefix_compare <> l_equal) OR (i >= prefix_length);
        (*ENDREPEAT*) 
        CASE prefix_compare OF
            l_greater:
                l_result := l_greater;
            l_less:
                l_result := l_less;
            l_equal:
                BEGIN
                IF  fieldlength1 = fieldlength2
                THEN
                    l_result := l_equal
                ELSE
                    IF  fieldlength1 > fieldlength2
                    THEN
                        BEGIN
                        i := prefix_length;
                        REPEAT
                            char_detected :=
                                  (buf1[ fieldpos1+i ]
                                  <> chr(0));
                            i := i + 1
                        UNTIL
                            (i >= fieldlength1) OR char_detected;
                        (*ENDREPEAT*) 
                        IF  char_detected
                        THEN
                            l_result := l_greater
                        ELSE
                            l_result := l_equal
                        (*ENDIF*) 
                        END
                    ELSE (* fieldlength1 < fieldlength2 *)
                        BEGIN
                        i := prefix_length;
                        REPEAT
                            char_detected :=
                                  (buf2[ fieldpos2+i ]
                                  <> chr(0));
                            i := i + 1
                        UNTIL
                            (i >= fieldlength2) OR char_detected;
                        (*ENDREPEAT*) 
                        IF  char_detected
                        THEN
                            l_result := l_less
                        ELSE
                            l_result := l_equal
                        (*ENDIF*) 
                        END
                    (*ENDIF*) 
                (*ENDIF*) 
                END
            END
        (*ENDCASE*) 
        END
    (*ENDIF*) 
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      s30lcm2 (VAR buf1  : tsp_moveobj;
            fieldpos1    : tsp_int4;
            fieldlength1 : tsp_int4;
            VAR buf2     : tsp_moveobj;
            fieldpos2    : tsp_int4;
            fieldlength2 : tsp_int4;
            VAR l_result : tsp_lcomp_result);
 
VAR
      prefix_length  : tsp_int4;
      i              : tsp_int4;
      char_detected  : boolean;
      prefix_compare : tsp_lcomp_result;
 
BEGIN
(* buf1 field > buf2 field  =>  l_result = l_greater *)
l_result := l_equal;
IF  fieldlength1 <= 0
THEN
    BEGIN
    IF  fieldlength2 <= 0
    THEN
        l_result := l_equal
    ELSE (* fieldlength2 > 0 *)
        BEGIN
        i := 0;
        REPEAT
            char_detected := (buf2[ fieldpos2+i ] <> chr(0));
            i := i + 1
        UNTIL
            (i >= fieldlength2) OR char_detected;
        (*ENDREPEAT*) 
        IF  char_detected
        THEN
            l_result := l_less
        ELSE
            l_result := l_equal
        (*ENDIF*) 
        END
    (*ENDIF*) 
    END
ELSE (* fieldlength1 > 0 *)
    IF  fieldlength2 <= 0
    THEN
        BEGIN
        i := 0;
        REPEAT
            char_detected := (buf1[ fieldpos1+i ] <> chr(0));
            i := i + 1
        UNTIL
            (i >= fieldlength1) OR char_detected;
        (*ENDREPEAT*) 
        IF  char_detected
        THEN
            l_result := l_greater
        ELSE
            l_result := l_equal
        (*ENDIF*) 
        END
    ELSE (* fieldlength1 > 0 AND fieldlength2 > 0 *)
        BEGIN
        IF  fieldlength1 > fieldlength2
        THEN
            prefix_length := fieldlength2
        ELSE
            prefix_length := fieldlength1;
        (*ENDIF*) 
        i := 0;
        prefix_compare := l_equal;
        REPEAT
            IF  buf1[ fieldpos1+i ] <> buf2[ fieldpos2+i ]
            THEN
                BEGIN
                IF  buf1[ fieldpos1+i ] > buf2[ fieldpos2+i ]
                THEN
                    prefix_compare := l_greater
                ELSE
                    prefix_compare := l_less
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            i := i + 1
        UNTIL
            (prefix_compare <> l_equal) OR (i >= prefix_length);
        (*ENDREPEAT*) 
        CASE prefix_compare OF
            l_greater:
                l_result := l_greater;
            l_less:
                l_result := l_less;
            l_equal:
                BEGIN
                IF  fieldlength1 = fieldlength2
                THEN
                    l_result := l_equal
                ELSE
                    IF  fieldlength1 > fieldlength2
                    THEN
                        BEGIN
                        i := prefix_length;
                        REPEAT
                            char_detected :=
                                  (buf1[ fieldpos1+i ]
                                  <> chr(0));
                            i := i + 1
                        UNTIL
                            (i >= fieldlength1) OR char_detected;
                        (*ENDREPEAT*) 
                        IF  char_detected
                        THEN
                            l_result := l_greater
                        ELSE
                            l_result := l_equal
                        (*ENDIF*) 
                        END
                    ELSE (* fieldlength1 < fieldlength2 *)
                        BEGIN
                        i := prefix_length;
                        REPEAT
                            char_detected :=
                                  (buf2[ fieldpos2+i ]
                                  <> chr(0));
                            i := i + 1
                        UNTIL
                            (i >= fieldlength2) OR char_detected;
                        (*ENDREPEAT*) 
                        IF  char_detected
                        THEN
                            l_result := l_less
                        ELSE
                            l_result := l_equal
                        (*ENDIF*) 
                        END
                    (*ENDIF*) 
                (*ENDIF*) 
                END
            END
        (*ENDCASE*) 
        END
    (*ENDIF*) 
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      s30lcm3 (VAR buf1  : tsp_moveobj;
            fieldpos1    : tsp_int4;
            fieldlength1 : tsp_int4;
            VAR buf2     : tsp_moveobj;
            fieldpos2    : tsp_int4;
            fieldlength2 : tsp_int4;
            VAR l_result : tsp_lcomp_result);
 
VAR
      prefix_length  : tsp_int4;
      i              : tsp_int4;
      char_detected  : boolean;
      prefix_compare : tsp_lcomp_result;
 
BEGIN
(* buf1 field > buf2 field  =>  l_result = l_greater *)
l_result := l_equal;
IF  fieldlength1 <= 0
THEN
    BEGIN
    IF  fieldlength2 <= 0
    THEN
        l_result := l_equal
    ELSE (* fieldlength2 > 0 *)
        BEGIN
        i := 0;
        REPEAT
            char_detected := (buf2[ fieldpos2+i ] <> chr(0));
            i := i + 1
        UNTIL
            (i >= fieldlength2) OR char_detected;
        (*ENDREPEAT*) 
        IF  char_detected
        THEN
            l_result := l_less
        ELSE
            l_result := l_equal
        (*ENDIF*) 
        END
    (*ENDIF*) 
    END
ELSE (* fieldlength1 > 0 *)
    IF  fieldlength2 <= 0
    THEN
        BEGIN
        i := 0;
        REPEAT
            char_detected := (buf1[ fieldpos1+i ] <> chr(0));
            i := i + 1
        UNTIL
            (i >= fieldlength1) OR char_detected;
        (*ENDREPEAT*) 
        IF  char_detected
        THEN
            l_result := l_greater
        ELSE
            l_result := l_equal
        (*ENDIF*) 
        END
    ELSE (* fieldlength1 > 0 AND fieldlength2 > 0 *)
        BEGIN
        IF  fieldlength1 > fieldlength2
        THEN
            prefix_length := fieldlength2
        ELSE
            prefix_length := fieldlength1;
        (*ENDIF*) 
        i := 0;
        prefix_compare := l_equal;
        REPEAT
            IF  buf1[ fieldpos1+i ] <> buf2[ fieldpos2+i ]
            THEN
                BEGIN
                IF  buf1[ fieldpos1+i ] > buf2[ fieldpos2+i ]
                THEN
                    prefix_compare := l_greater
                ELSE
                    prefix_compare := l_less
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            i := i + 1
        UNTIL
            (prefix_compare <> l_equal) OR (i >= prefix_length);
        (*ENDREPEAT*) 
        CASE prefix_compare OF
            l_greater:
                l_result := l_greater;
            l_less:
                l_result := l_less;
            l_equal:
                BEGIN
                IF  fieldlength1 = fieldlength2
                THEN
                    l_result := l_equal
                ELSE
                    IF  fieldlength1 > fieldlength2
                    THEN
                        BEGIN
                        i := prefix_length;
                        REPEAT
                            char_detected :=
                                  (buf1[ fieldpos1+i ]
                                  <> chr(0));
                            i := i + 1
                        UNTIL
                            (i >= fieldlength1) OR char_detected;
                        (*ENDREPEAT*) 
                        IF  char_detected
                        THEN
                            l_result := l_greater
                        ELSE
                            l_result := l_equal
                        (*ENDIF*) 
                        END
                    ELSE (* fieldlength1 < fieldlength2 *)
                        BEGIN
                        i := prefix_length;
                        REPEAT
                            char_detected :=
                                  (buf2[ fieldpos2+i ]
                                  <> chr(0));
                            i := i + 1
                        UNTIL
                            (i >= fieldlength2) OR char_detected;
                        (*ENDREPEAT*) 
                        IF  char_detected
                        THEN
                            l_result := l_less
                        ELSE
                            l_result := l_equal
                        (*ENDIF*) 
                        END
                    (*ENDIF*) 
                (*ENDIF*) 
                END
            END
        (*ENDCASE*) 
        END
    (*ENDIF*) 
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      s30lenl (VAR str : tsp_moveobj;
            val   : char;
            start : tsp_int4;
            cnt   : tsp_int4) : tsp_int4;
 
VAR
      finish : boolean;
      i : tsp_int4;
 
BEGIN
i := start;
finish := false;
WHILE (i < start + cnt) AND (NOT finish) DO
    IF  str[ i ] = val
    THEN
        BEGIN
        s30lenl := i - start;
        finish := true
        END
    ELSE
        i := i + 1;
    (*ENDIF*) 
(*ENDWHILE*) 
IF  NOT finish
THEN
    s30lenl := cnt
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      s30gad (VAR b : tsp_moveobj) : tsp_addr;
 
BEGIN
s30gad := @b;
END;
 
(*------------------------------*) 
 
FUNCTION
      s30gad1 (VAR b : tsp_moveobj) : tsp_addr;
 
BEGIN
s30gad1:= @b;
END;
 
(*------------------------------*) 
 
FUNCTION
      s30gad2 (VAR b : tsp_moveobj) : tsp_addr;
 
BEGIN
s30gad2:= @b;
END;
 
(*------------------------------*) 
 
FUNCTION
      s30gad3 (VAR b : tsp_moveobj) : tsp_addr;
 
BEGIN
s30gad3:= @b;
END;
 
(*------------------------------*) 
 
FUNCTION
      s30gad4 (VAR b : tsp_moveobj) : tsp_addr;
 
BEGIN
s30gad4:= @b;
END;
 
(*------------------------------*) 
 
FUNCTION
      s30gad5 (VAR b : tsp_moveobj) : tsp_addr;
 
BEGIN
s30gad5:= @b;
END;
 
(*------------------------------*) 
 
FUNCTION
      s30gad6 (VAR b : tsp_moveobj) : tsp_addr;
 
BEGIN
s30gad6:= @b;
END;
 
(*------------------------------*) 
 
FUNCTION
      s30gad7 (VAR b : tsp_moveobj) : tsp_addr;
 
BEGIN
s30gad7:= @b;
END;
 
(*------------------------------*) 
 
FUNCTION
      s30unilnr (str  : tsp_moveobj_ptr;
            skip_val  : tsp_c2;
            start_pos : tsp_int4;
            length    : tsp_int4) : tsp_int4;
 
VAR
      i      : tsp_int4;
      finish : boolean;
 
BEGIN
i      := start_pos + length - 1;
finish := false;
WHILE (i >= start_pos) AND NOT finish DO
    IF  (str^[i-1] <> skip_val[1]) OR (str^[i] <> skip_val[2])
    THEN
        BEGIN
        s30unilnr := i - start_pos + 1;
        finish := true;
        END
    ELSE
        i := i-2;
    (*ENDIF*) 
(*ENDWHILE*) 
IF  NOT finish
THEN
    s30unilnr := 0
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      s30xorc4 (c4_1     : tsp_c4;
            c4_2          : tsp_c4;
            VAR c4_target : tsp_c4);
 
TYPE
      four_byte_range = 0..31;
      four_byte_set   = PACKED SET OF four_byte_range;
 
      set_map_c4 = RECORD
            CASE boolean OF
                true :
                    (map_set : four_byte_set);
                false :
                    (map_c4  : tsp_c4);
                END;
            (*ENDCASE*) 
 
 
VAR
      xor_map  : set_map_c4;
      set_map  : set_map_c4;
 
BEGIN
xor_map.map_c4 := c4_1;
set_map.map_c4 := c4_2;
xor_map.map_set := (xor_map.map_set + set_map.map_set) -
      (xor_map.map_set * set_map.map_set);
c4_target:= xor_map.map_c4
END;
 
(*------------------------------*) 
 
PROCEDURE
      s30surrogate_incr (VAR surrogate : tsp_c8);
 
CONST
      mx_site = 2;
 
VAR
      i     : integer;
      found : boolean;
 
BEGIN
found := false;
i     := sizeof(surrogate);
REPEAT
    IF  ord (surrogate[ i ]) < 255
    THEN
        BEGIN
        found := true;
        surrogate [ i ] := succ (surrogate[ i ])
        END
    ELSE
        BEGIN
        IF  i = sizeof(surrogate)
        THEN
            surrogate [ i ] := chr(1)
        ELSE
            surrogate [ i ] := chr(0);
        (*ENDIF*) 
        i := i - 1
        END
    (*ENDIF*) 
UNTIL
    found OR (i <= mx_site)
(*ENDREPEAT*) 
END;
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
*-PRETTY-*  statements    :        484
*-PRETTY-*  lines of code :       1668        PRETTYX 3.10 
*-PRETTY-*  lines in file :       2120         1997-12-10 
.PA 
