.CM  SCRIPT , Version - 1.1 , last edited by holger
.ad 8
.bm 8
.fm 4
.bt $Copyright (c) 2000-2005 SAP AG$$Page %$
.tm 12
.hm 6
.hs 3
.tt 1 $SQL$Project Distributed Database System$VSP32$
.tt 2 $$$
.tt 3 $$RTE-Extension-32$1998-09-07$
***********************************************************
.nf
 
 .nf

.nf

    ========== licence begin  GPL
    Copyright (c) 2000-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  : RTE-Extension-32
=========
.sp
Purpose : Pufferroutinen und Vergleichsroutinen
          VSP32 und VSP32A zusammen ergeben VSP30
.CM *-END-* purpose -------------------------------------
.sp
.cp 3
Define  :
 
        PROCEDURE
              s30gkey (VAR buf : tsp00_Buf;
                    pos        : integer;
                    length     : integer;
                    VAR k : tsp00_Key);
 
        FUNCTION
              s30eq (VAR a : tsp00_MoveObj;
                    VAR b  : tsp00_MoveObj;
                    bi        : tsp00_Int4;
                    cnt       : integer) : boolean;
 
        FUNCTION
              s30eq1 (VAR a : tsp00_MoveObj;
                    VAR b   : tsp00_MoveObj;
                    bi        : tsp00_Int4;
                    cnt       : integer) : boolean;
 
        FUNCTION
              s30eqkey (VAR a : tsp00_Sname;
                    VAR b     : tsp00_MoveObj;
                    bi        : tsp00_Int4;
                    cnt       : integer) : boolean;
 
        FUNCTION
              s30klen (VAR str : tsp00_MoveObj;
                    val : char;
                    cnt : tsp00_Int4) : tsp00_Int4;
 
        FUNCTION
              s30lnr (VAR str : tsp00_MoveObj;
                    val : char;
                    start : tsp00_Int4;
                    cnt : tsp00_Int4) : tsp00_Int4;
 
        FUNCTION
              s30lnr1 (VAR str : tsp00_MoveObj;
                    val : char;
                    start : tsp00_Int4;
                    cnt : tsp00_Int4) : tsp00_Int4;
 
        FUNCTION
              s30lnr_defbyte (str : tsp00_MoveObjPtr;
                    defbyte   : char;
                    start_pos : tsp00_Int4;
                    length    : tsp00_Int4) : tsp00_Int4;
 
        FUNCTION
              s30nlen (VAR str : tsp00_MoveObj;
                    val   : char;
                    start : tsp00_Int4;
                    cnt   : tsp00_Int4) : tsp00_Int4;
 
        FUNCTION
              s30len (VAR str : tsp00_MoveObj;
                    val : char;
                    cnt : tsp00_Int4) : tsp00_Int4;
 
        FUNCTION
              s30len1 (VAR str : tsp00_MoveObj;
                    val : char;
                    cnt : tsp00_Int4) : tsp00_Int4;
 
        FUNCTION
              s30len2 (VAR str : tsp00_MoveObj;
                    val : char;
                    cnt : tsp00_Int4) : tsp00_Int4;
 
        FUNCTION
              s30len3 (VAR str : tsp00_MoveObj;
                    val : char;
                    cnt : tsp00_Int4) : tsp00_Int4;
 
        FUNCTION
              s30len4 (VAR str : tsp00_MoveObj;
                    val : char;
                    cnt : tsp00_Int4) : tsp00_Int4;
 
        PROCEDURE
              s30luc (VAR buf1         : tsp00_MoveObj;
                    fieldpos1    : tsp00_Int4;
                    fieldlength1 : tsp00_Int4;
                    VAR buf2         : tsp00_MoveObj;
                    fieldpos2    : tsp00_Int4;
                    fieldlength2 : tsp00_Int4;
                    VAR l_result     : tsp00_LcompResult);
 
        PROCEDURE
              s30luc1     (VAR buf1     : tsp00_MoveObj;
                    fieldpos1    : tsp00_Int4;
                    fieldlength1 : tsp00_Int4;
                    VAR buf2     : tsp00_MoveObj;
                    fieldpos2    : tsp00_Int4;
                    fieldlength2 : tsp00_Int4;
                    VAR l_result : tsp00_LcompResult);
 
        FUNCTION
              s30unilnr (str  : tsp00_MoveObjPtr;
                    skip_val  : tsp00_C2;
                    start_pos : tsp00_Int4;
                    length    : tsp00_Int4) : tsp00_Int4;
&       if $MACH not in [ I386 ]
 
        FUNCTION
              s30lenl (VAR str : tsp00_MoveObj;
                    val : char;
                    start : tsp00_Int4;
                    cnt : tsp00_Int4) : tsp00_Int4;
&       endif
 
        PROCEDURE
              s30gpnt (pstart : tsp00_Int4;
                    pos : tsp00_Int4;
                    VAR point : tsp00_Int4);
 
        PROCEDURE
              s30gbuf (pstart  : tsp00_Int4;
                    pos       : tsp00_Int4;
                    VAR point : tsp00_Int4);
 
        FUNCTION
              s30gad (VAR b : tsp00_MoveObj) : tsp00_Addr;
 
        FUNCTION
              s30gad1 (VAR b : tsp00_MoveObj) : tsp00_Addr;
 
        FUNCTION
              s30gad2 (VAR b : tsp00_MoveObj) : tsp00_Addr;
 
        FUNCTION
              s30gad3 (VAR b : tsp00_MoveObj) : tsp00_Addr;
 
        FUNCTION
              s30gad4 (VAR b : tsp00_MoveObj) : tsp00_Addr;
 
        FUNCTION
              s30gad5 (VAR b : tsp00_MoveObj) : tsp00_Addr;
 
        FUNCTION
              s30gad6 (VAR b : tsp00_MoveObj) : tsp00_Addr;
 
        FUNCTION
              s30gad7 (VAR b : tsp00_MoveObj) : tsp00_Addr;
 
        PROCEDURE
              s30surrogate_incr (VAR surrogate : tsp00_C8);
 
        FUNCTION
              sp3024 : tsp00_Int4;
 
.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :
 
        FROM
              Kernel_move_and_fill : VGG101;
 
        PROCEDURE
              s10mv (
                    source_upb  : tsp00_Int4;
                    destin_upb  : tsp00_Int4;
                    source      : tsp00_MoveObjPtr;
                    source_pos  : tsp00_Int4;
                    destin      : tsp00_MoveObjPtr;
                    destin_pos  : tsp00_Int4;
                    length      : tsp00_Int4);
 
        PROCEDURE
              s10mv (
                    source_upb  : tsp00_Int4;
                    destin_upb  : tsp00_Int4;
                    source      : tsp00_MoveObjPtr;
                    source_pos  : tsp00_Int4;
                    destin      : tsp00_MoveObjPtr;
                    destin_pos  : tsp00_Int4;
                    length      : tsp00_Int4);
 
        PROCEDURE
              s10mv (
                    source_upb  : tsp00_Int4;       
                    destin_upb  : tsp00_Int4;
                    source      : tsp00_MoveObjPtr;    
                    source_pos  : tsp00_Int4;
                    destin      : tsp00_MoveObjPtr;    
                    destin_pos  : tsp00_Int4;
                    length      : tsp00_Int4);
 
.CM *-END-* use -----------------------------------------
.sp;.cp 3
Synonym :
 
.CM *-END-* synonym -------------------------------------
.sp;.cp 3
Author  :
.sp
.cp 3
Created : 1979-06-07
.sp
.cp 3
.sp
.cp 3
Release :      Date : 1998-09-07
.sp
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Specification:
 
Die Positionsangabe POS gibt das erste Byte des betroffenen Feldes an.
Das erste Byte im Puffer ist durch POS = 1 ansprechbar.
 
 
Prozedur PUTKEY
 
Die Prozedur ?ubertr?agt einen Scl?ussel aus K in der L?ange LENGTH ab
POS in den Puffer BUF.
 
.cp 5
.cp 5
Prozedur GETKEY
 
Die Prozedur ?ubertr?agt einen Schl?ussel nach K in der L?ange LENGTH
ab POS aus dem Puffer BUF. Der Schl?ussel in K wird nicht mit
Bin?arnull  aufgef?ullt.
Die ?ubrigen Parameter k?onnen beliebig belegt sein,
sie werden nicht ver?andert.
.sp 2
FUNCTION   S30EQ:
.sp
Vergleicht cnt Bytes des Strings a mit dem Pufferinhalt b
ab der Position bi.
Sind alle Bytes identisch wird der Functionswert true
zur?uckgeliefert.
.sp 4
FUNCTION   S30EQ1:
.sp
Vergleicht cnt Bytes des Strings a mit dem Pufferinhalt b
ab der Position bi.
Sind alle Bytes identisch wird der Functionswert true
zur?uckgeliefert.
.sp 4
FUNCTION   S30EQKEY:
.sp
Vergleicht einen Shortnamen a  mit dem Pufferinhalt b
ab der Position bi cnt bytes lang,
und pr?uft ob der Name nicht l?anger als cnt ist.
Bei ja wird der Functionswert true
zur?uckgeliefert.
.sp 4
FUNCTION   S30KLEN:
.sp
Berechnet die exakte L?ange des Strings str der L?ange cnt
r?uckw?arts bis ein Byte ungleich val auftritt.
.sp 4
FUNCTION   S30LNR:
.sp
Berechnet die exakte L?ange des Strings str
im Puffer ab der Position start und der L?ange cnt
r?uckw?arts bis ein Byte ungleich val auftritt.
.sp 4
FUNCTION   LENGTH:
.sp
Berechnet die exakte L?ange des Strings str
der L?ange cnt
vorw?arts  bis das n?achste  Byte gleich val auftritt.
.sp 4
FUNCTION   S30LENL:
.sp
Berechnet die exakte L?ange des Strings str
im Puffer ab der Position start und der L?ange cnt
vorw?arts  bis das n?achste  Byte gleich val auftritt.
.sp 4
PROCEDURE  S30MAP:
.sp
?Ubersetzt ein Sourceobject source ab der Position  spos mit
der Code_tabelle code_t nach Destobject dest ab der Position dpos
von der L?ange length.
.sp 4
PROCEDURE  S30LCM:
.sp
Vergleicht zwei Strings in Puffern buf1, buf2 an den Positonen
fieldpos1, fieldpos2 der L?angen fieldlength1, fieldlength2.
Der K?urzer String wird mit Bin?arnullen aufgef?ullt.
l_result kann drei Werte annehmen:
   1. wenn  1 > 2  ::=  l_greater
   2. wenn  1 < 2  ::=  l_less
   3. wenn  1 = 2  ::=  l_equal.
.sp 4
PROCEDURE  S30LCM1:
.sp
Vergleicht zwei Strings in Puffern buf1, buf2 an den Positonen
fieldpos1, fieldpos2 der L?angen fieldlength1, fieldlength2.
Der K?urzer String wird mit Bin?arnullen aufgef?ullt.
l_result kann drei Werte annehmen:
   1. wenn  1 > 2  ::=  l_greater
   2. wenn  1 < 2  ::=  l_less
   3. wenn  1 = 2  ::=  l_equal.
.sp 4
PROCEDURE  S30LUC:
.sp
Vergleicht zwei Strings in Puffern buf1, buf2 an den Positonen
fieldpos1, fieldpos2 der L?angen fieldlength1, fieldlength2.
Der K?urzer String wird mit Undefbyte (in buf1 an fieldpos1)
aufgef?ullt.
l_result kann drei Werte annehmen:
   1. wenn  1 > 2  ::=  l_greater
   2. wenn  1 < 2  ::=  l_less
   3. wenn  1 = 2  ::=  l_equal.
   4. wenn  1 or 2 undef  ::=  l_undef,
      oder  l1 or l2 = 0  ::=  l_undef.
.sp 4
PROCEDURE  S30GPNT:
.sp
Berchnet einen neuen Pointer point an der Position in einem
Speicherplatzbereich mit dem Anfangspointer pstart.
.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    :
 
 
(*------------------------------*) 
 
FUNCTION
      sp3024 : tsp00_Int4;
 
BEGIN
(* linkcheck function *)
sp3024 := 917990621;
END;
 
(*------------------------------*) 
 
PROCEDURE
      s30gkey (VAR buf : tsp00_Buf;
            pos        : integer;
            length     : integer;
            VAR k : tsp00_Key);
 
BEGIN
s10mv (mxsp_buf, KEY_MXSP00, @buf, pos, @k, 1, length);
END;
 
(*------------------------------*) 
 
FUNCTION
      s30eq (VAR a : tsp00_MoveObj;
            VAR b  : tsp00_MoveObj;
            bi        : tsp00_Int4;
            cnt       : integer) : boolean;
 
VAR
      equal : boolean;
      i : tsp00_Int4;
 
BEGIN
i:=1;
equal:=true;
WHILE (i<=cnt) AND equal DO
    BEGIN
    equal :=  (a [i]  = b [bi-1+i] );
    i:=i+1;
    END;
(*ENDWHILE*) 
s30eq := equal;
END;
 
(*------------------------------*) 
 
FUNCTION
      s30eq1 (VAR a : tsp00_MoveObj;
            VAR b  : tsp00_MoveObj;
            bi        : tsp00_Int4;
            cnt       : integer) : boolean;
 
VAR
      equal : boolean;
      i : tsp00_Int4;
 
BEGIN
i:=1;
equal:=true;
WHILE (i<=cnt) AND (equal=true) DO
    BEGIN
    equal :=  (a [i]  = b [bi-1+i] );
    i:=i+1;
    END;
(*ENDWHILE*) 
s30eq1:= equal;
END;
 
(*------------------------------*) 
 
FUNCTION
      s30eqkey (VAR a : tsp00_Sname;
            VAR b     : tsp00_MoveObj;
            bi        : tsp00_Int4;
            cnt       : integer) : boolean;
 
VAR
      equal : boolean;
      i : tsp00_Int4;
 
BEGIN
IF   cnt > SNAME_MXSP00
THEN
    equal := false
ELSE
    BEGIN
    i:=1;
    equal:=true;
    WHILE (i<=cnt) AND (equal=true) DO
        BEGIN
        equal :=  (a [i]  = b [bi-1+i] );
        i:=i+1;
        END;
    (*ENDWHILE*) 
    IF   equal AND (i <= SNAME_MXSP00)
    THEN
        IF   a [i]  <> bsp_c1
        THEN
            equal := false;
        (*ENDIF*) 
    (*ENDIF*) 
    END;
(*ENDIF*) 
s30eqkey := equal;
END;
 
(*------------------------------*) 
 
FUNCTION
      s30klen (VAR str : tsp00_MoveObj; val : char; cnt : tsp00_Int4) : tsp00_Int4;
 
VAR
      i : tsp00_Int4;
      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 : tsp00_MoveObj;
            val : char;
            start : tsp00_Int4;
            cnt : tsp00_Int4) : tsp00_Int4;
 
VAR
      i : tsp00_Int4;
      finish : boolean;
 
BEGIN
i := start + cnt - 1;
finish := false;
WHILE  (i >= start) AND NOT finish DO
    IF   str  [i]  <> val
    THEN
        BEGIN
        s30lnr := i - start + 1;
        finish := true;
        END
    ELSE
        i := i-1;
    (*ENDIF*) 
(*ENDWHILE*) 
IF   NOT finish
THEN
    s30lnr := 0;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      s30lnr1 (VAR str : tsp00_MoveObj;
            val : char;
            start : tsp00_Int4;
            cnt : tsp00_Int4) : tsp00_Int4;
 
VAR
      i : tsp00_Int4;
      finish : boolean;
 
BEGIN
i := start + cnt - 1;
finish := false;
WHILE  (i >= start) AND NOT finish DO
    IF  str  [i]  <> val
    THEN
        BEGIN
        s30lnr1 := i - start + 1;
        finish := true;
        END
    ELSE
        i := i-1;
    (*ENDIF*) 
(*ENDWHILE*) 
IF  NOT finish
THEN
    s30lnr1 := 0;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      s30lnr_defbyte (str : tsp00_MoveObjPtr;
            defbyte   : char;
            start_pos : tsp00_Int4;
            length    : tsp00_Int4) : tsp00_Int4;
 
VAR
      i      : tsp00_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 : tsp00_MoveObj;
            val   : char;
            start : tsp00_Int4;
            cnt   : tsp00_Int4) : tsp00_Int4;
 
VAR
      finish : boolean;
      i      : tsp00_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 : tsp00_MoveObj; val : char; cnt : tsp00_Int4) : tsp00_Int4;
 
VAR
      i : tsp00_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 : tsp00_MoveObj; val : char;
            cnt : tsp00_Int4) : tsp00_Int4;
 
BEGIN
s30len1 := s30len (str, val, cnt);
END;
 
(*------------------------------*) 
 
FUNCTION
      s30len2 (VAR str : tsp00_MoveObj; val : char;
            cnt : tsp00_Int4) : tsp00_Int4;
 
BEGIN
s30len2 := s30len (str, val, cnt);
END;
 
(*------------------------------*) 
 
FUNCTION
      s30len3 (VAR str : tsp00_MoveObj; val : char;
            cnt : tsp00_Int4) : tsp00_Int4;
 
BEGIN
s30len3 := s30len (str, val, cnt);
END;
 
(*------------------------------*) 
 
FUNCTION
      s30len4 (VAR str : tsp00_MoveObj; val : char;
            cnt : tsp00_Int4) : tsp00_Int4;
 
BEGIN
s30len4 := s30len (str, val, cnt);
END;
 
(*------------------------------*) 
 
PROCEDURE
      s30luc (VAR buf1   : tsp00_MoveObj;
            fieldpos1    : tsp00_Int4;
            fieldlength1 : tsp00_Int4;
            VAR buf2     : tsp00_MoveObj;
            fieldpos2    : tsp00_Int4;
            fieldlength2 : tsp00_Int4;
            VAR l_result : tsp00_LcompResult);
 
VAR
      check_trailing_defbyte : boolean;
      prefix_compare         : tsp00_LcompResult;
      def_byte               : char;
      prefix_length          : tsp00_Int4;
      i                      : tsp00_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     : tsp00_MoveObj;
            fieldpos1    : tsp00_Int4;
            fieldlength1 : tsp00_Int4;
            VAR buf2     : tsp00_MoveObj;
            fieldpos2    : tsp00_Int4;
            fieldlength2 : tsp00_Int4;
            VAR l_result : tsp00_LcompResult);
 
BEGIN
s30luc (buf1, fieldpos1, fieldlength1,
      buf2, fieldpos2, fieldlength2, l_result)
END;
 
(*------------------------------*) 
 
FUNCTION
      s30unilnr (str  : tsp00_MoveObjPtr;
            skip_val  : tsp00_C2;
            start_pos : tsp00_Int4;
            length    : tsp00_Int4) : tsp00_Int4;
 
VAR
      i      : tsp00_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;
 
&if $MACH not in [ I386 ] or $OS in [ OS2, WIN32 ]
(*------------------------------*) 
 
FUNCTION
      s30lenl (VAR str : tsp00_MoveObj;
            val : char;
            start : tsp00_Int4;
            cnt : tsp00_Int4) : tsp00_Int4;
 
VAR
      finish : boolean;
      i : tsp00_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;
 
&endif not in [ I386 ]
(*------------------------------*) 
 
PROCEDURE
      s30gpnt (pstart : tsp00_Int4;
            pos : tsp00_Int4;
            VAR point : tsp00_Int4);
 
BEGIN
point := pstart + pos - 1;
END;
 
(*------------------------------*) 
 
PROCEDURE
      s30gbuf (pstart  : tsp00_Int4;
            pos       : tsp00_Int4;
            VAR point : tsp00_Int4);
 
BEGIN
point := pstart + pos - 1;
END;
 
(*------------------------------*) 
 
FUNCTION
      s30gad (VAR b : tsp00_MoveObj) : tsp00_Addr;
 
BEGIN
s30gad := @b
END;
 
(*------------------------------*) 
 
FUNCTION
      s30gad1 (VAR b : tsp00_MoveObj) : tsp00_Addr;
 
BEGIN
s30gad1 := @b
END;
 
(*------------------------------*) 
 
FUNCTION
      s30gad2 (VAR b : tsp00_MoveObj) : tsp00_Addr;
 
BEGIN
s30gad2 :=  @b
END;
 
(*------------------------------*) 
 
FUNCTION
      s30gad3 (VAR b : tsp00_MoveObj) : tsp00_Addr;
 
BEGIN
s30gad3 := @b
END;
 
(*------------------------------*) 
 
FUNCTION
      s30gad4 (VAR b : tsp00_MoveObj) : tsp00_Addr;
 
BEGIN
s30gad4 := @b
END;
 
(*------------------------------*) 
 
FUNCTION
      s30gad5 (VAR b : tsp00_MoveObj) : tsp00_Addr;
 
BEGIN
s30gad5 := @b
END;
 
(*------------------------------*) 
 
FUNCTION
      s30gad6 (VAR b : tsp00_MoveObj) : tsp00_Addr;
 
BEGIN
s30gad6 := @b
END;
 
(*------------------------------*) 
 
FUNCTION
      s30gad7 (VAR b : tsp00_MoveObj) : tsp00_Addr;
 
BEGIN
s30gad7 := @b
END;
 
(*------------------------------*) 
 
PROCEDURE
      s30surrogate_incr (VAR surrogate : tsp00_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 
***********************************************************
.PA 
