.CM  SCRIPT , Version - 1.1 , last edited by D.Dittmar
.ad 8
.bm 8
.fm 4
.bt $Copyright (c) 2000-2004 SAP AG$$Page %$
.tm 12
.hm 6
.hs 3
.tt 1 $SQL$Project Distributed Database System$VIN32$
.tt 2 $$$
.tt 3 $$Code Translation$1998-05-29$
***********************************************************
.nf
 
.nf
 
 
    ========== licence begin  GPL
    Copyright (c) 2000-2004 SAP AG
 
    This program is free software; you can redistribute it and/or
    modify it under the terms of the GNU General Public License
    as published by the Free Software Foundation; either version 2
    of the License, or (at your option) any later version.
 
    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.
 
    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
    ========== licence end
 
.fo
 
 
.fo
.nf
.sp
MODULE  : Code-Translation
=========
.sp
Purpose : Translation of strings ASCII <=> EBCDIC and
          binary to displayable-characters-only,
          appropriate truncation of KANJI strings
.CM *-END-* purpose -------------------------------------
.sp
.cp 3
Define  :
 
        FUNCTION
              i32machinecodetype : tsp00_Uint1;
 
        PROCEDURE
              i32t1translate (
                    source_code     : tsp00_Uint1;
                    dest_code       : tsp00_Uint1;
                    VAR source      : tsp00_MoveObj;
                    spos            : integer;
                    VAR destination : tsp00_MoveObj;
                    dpos            : integer;
                    len             : integer);
 
        PROCEDURE
              i32t2translate (
                    source_code     : tsp00_Uint1;
                    dest_code       : tsp00_Uint1;
                    VAR source      : tsp00_MoveObj;
                    spos            : integer;
                    VAR destination : tsp00_MoveObj;
                    dpos            : integer;
                    len             : integer);
 
        PROCEDURE
              i32t3translate (
                    source_code     : tsp00_Uint1;
                    dest_code       : tsp00_Uint1;
                    VAR source      : tsp00_MoveObj;
                    spos            : integer;
                    VAR destination : tsp00_MoveObj;
                    dpos            : integer;
                    len             : integer);
 
        PROCEDURE
              i32t4translate (
                    source_code     : tsp00_Uint1;
                    dest_code       : tsp00_Uint1;
                    VAR source      : tsp00_MoveObj;
                    spos            : integer;
                    VAR destination : tsp00_MoveObj;
                    dpos            : integer;
                    len             : integer);
 
        PROCEDURE
              i32t5translate (
                    source_code     : tsp00_Uint1;
                    dest_code       : tsp00_Uint1;
                    VAR source      : tsp00_MoveObj;
                    spos            : integer;
                    VAR destination : tsp00_MoveObj;
                    dpos            : integer;
                    len             : integer);
 
        PROCEDURE
              i32t6translate (
                    source_code     : tsp00_Uint1;
                    dest_code       : tsp00_Uint1;
                    VAR source      : tsp00_MoveObj;
                    spos            : integer;
                    VAR destination : tsp00_MoveObj;
                    dpos            : integer;
                    len             : integer);
 
        PROCEDURE
              i32t7translate (
                    source_code     : tsp00_Uint1;
                    dest_code       : tsp00_Uint1;
                    VAR source      : tsp00_MoveObj;
                    spos            : integer;
                    VAR destination : tsp00_MoveObj;
                    dpos            : integer;
                    len             : integer);
 
        PROCEDURE
              i32t8translate (
                    source_code     : tsp00_Uint1;
                    dest_code       : tsp00_Uint1;
                    VAR source      : tsp00_MoveObj;
                    spos            : integer;
                    VAR destination : tsp00_MoveObj;
                    dpos            : integer;
                    len             : integer);
 
        PROCEDURE
              i32t9translate (
                    source_code     : tsp00_Uint1;
                    dest_code       : tsp00_Uint1;
                    VAR source      : tsp00_MoveObj;
                    spos            : integer;
                    VAR destination : tsp00_MoveObj;
                    dpos            : integer;
                    len             : integer);
 
        PROCEDURE
              i32t10translate (
                    source_code     : tsp00_Uint1;
                    dest_code       : tsp00_Uint1;
                    VAR source      : tsp00_MoveObj;
                    spos            : integer;
                    VAR destination : tsp00_MoveObj;
                    dpos            : integer;
                    len             : integer);
 
        PROCEDURE
              i32ktrunc (
                    VAR line   : tsp00_MoveObj;
                    length     : integer);
 
        FUNCTION
              i32isidfirst (c : char) : boolean;
 
        FUNCTION
              i32islower (c : char) : boolean;
 
        FUNCTION
              i32isupper (c : char) : boolean;
 
        FUNCTION
              i32toupper (
                    c : char ) : char;
 
        FUNCTION
              i32tolower (
                    c : char ) : char;
 
        PROCEDURE
              i32upstring (
                    VAR source : tsp00_MoveObj;
                    spos       : integer;
                    VAR dest   : tsp00_MoveObj;
                    dpos       : integer;
                    len        : integer);
 
        PROCEDURE
              i32up1string (
                    VAR source : tsp00_MoveObj;
                    spos       : integer;
                    VAR dest   : tsp00_MoveObj;
                    dpos       : integer;
                    len        : integer);
 
        PROCEDURE
              i32lowerstring (
                    VAR source : tsp00_MoveObj;
                    spos       : integer;
                    VAR dest   : tsp00_MoveObj;
                    dpos       : integer;
                    len        : integer);
 
        PROCEDURE
              i32low1string (
                    VAR source : tsp00_MoveObj;
                    spos       : integer;
                    VAR dest   : tsp00_MoveObj;
                    dpos       : integer;
                    len        : integer);
 
        PROCEDURE
              i32deftranstables(
                    VAR ig : tin_global_in_record);
 
        PROCEDURE
              i32repltabs (
                    fcode       : tsp00_Uint1;
                    phys_buflen : integer;
                    VAR buf     : tsp00_Buf;
                    VAR buflen  : tsp00_Int4);
 
        FUNCTION
              in3230 : tsp00_Int4;
 
.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :
 
        FROM
              global_variable : VIN01;
 
        VAR
              i01g   : tin_global_in_vars;
 
      ------------------------------ 
 
        FROM
              RTE_driver : VEN102;
 
        PROCEDURE
              sqlabort;
 
      ------------------------------ 
 
        FROM
              Kernel_move_and_fill : VGG101;
 
        PROCEDURE
              SAPDB_PascalForcedMove (
                    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);
 
      ------------------------------ 
 
        FROM
              RTE-Extension-30 : VSP30;
 
        PROCEDURE
              s30map (
                    VAR code_table : tsp00_Ctable;
                    VAR source     : tsp00_MoveObj;
                    spos           : tsp00_Int4;
                    VAR dest       : tsp00_MoveObj;
                    dpos           : tsp00_Int4;
                    length         : tsp00_Int4);
 
        FUNCTION
              s30lenl (
                    VAR str : tsp00_MoveObj;
                    val     : char;
                    start   : tsp00_Int4;
                    cnt     : tsp00_Int4) : tsp00_Int4;
 
.CM *-END-* use -----------------------------------------
.sp;.cp 3
Synonym :
 
.CM *-END-* synonym -------------------------------------
.sp;.cp 3
Author  : BarbaraJ
.sp
.cp 3
Created : 1985-07-11
.sp
.cp 3
.sp
.cp 3
Release :      Date : 1998-05-29
.sp
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Specification:
 
i32INITTRANSLATTABLES:
.sp
Calls two procedures that initialize the two tables that are used for
translating ASCII code to EBCDIC code and vice versa.  The two tables
are structured in such a way that a character of the target code
is located at the nth position of the table if the nth character of
the source code is the original character.
.sp 2
Function i32MACHINECODETYPE : CHARACTER_SET;
.sp
Identifies the coding used by the computer by requesting the
ordinal value of a blank (ASCII 32, EBCDIC 64).
.sp 2
i32TxTRANSLATE (SOURCE_CODE,DEST_CODE,SOURCE,SPOS,DEST,DPOS,LEN) :
.sp
If SOURCE_CODE and DEST_CODE are not the same, SOURCE is
translated via S30MAP.  The result is contained in DEST; SOURCE remains
unchanged.  Otherwise, SOURCE is transferred to DEST with SAPDB_PascalForcedMove.
.sp 2
i32KMAP (CODETAB,SOURCE,SPOS,DEST,DPOS,LEN) :
.sp
Converts non-displayable characters to question marks
before output to the screen.  If Kanji-Shift_Characters are met,
no translation is done for the enclosed area.
.sp 2
Function i32MAP (SOURCE,DEST,LEN) : BOOLEAN;
.sp
Calls i32KMAP. I f a conversion has taken place,
supplies TRUE so that an appropriate warning message can be displayed.
.sp 2;.nf
FUNCTION
      i32isidfirst (c : char) : boolean;
.sp;.fo
returns TRUE, if C is allowed as first character of an SQL identifier
(see VAK01).
.sp 2;.nf
FUNCTION
      i32islower(c : char) : boolean;
.sp;.fo
returns TRUE, if C is a lowercase alphabetical character
(including umlauts).
.sp 2;.nf
FUNCTION
      i32isupper(c : char) : boolean;
.sp;.fo
returns TRUE, if C is an uppercase alphabetical character
(including umlauts).
.sp 2;.nf
FUNCTION
      i32toupper (
            c : char ) : char;
.sp;.fo
translates c to uppercase character (including umlauts)
.sp 2;.nf
FUNCTION
      i32tolower (
            c : char ) : char;
.sp;.fo
translates c to lowercase character (including umlauts)
.sp 2;.nf
PROCEDURE
      i32upstring (
            VAR source : tsp00_MoveObj;
            spos       : integer;
            VAR dest   : tsp00_MoveObj;
            dpos       : integer;
            len        : integer);
.sp;.fo
translates a string of length LEN, starting at SPOS in SOURCE to
uppercase characters (including umlauts)
The result will be returned in DEST, starting at DPOS.
.sp 2;.nf
PROCEDURE
      i32lowerstring (
            VAR source : tsp00_MoveObj;
            spos       : integer;
            VAR dest   : tsp00_MoveObj;
            dpos       : integer;
            len        : integer);
.sp;.fo
translates a string of length LEN, starting at SPOS in SOURCE to
lowercase characters (including umlauts)
The result will be returned in DEST, starting at DPOS.
.sp 2;.nf
PROCEDURE
      i32repltabs (
            fcode       : tsp00_Uint1;
            phys_buflen : integer;
            VAR buf     : tsp00_Buf;
            VAR buflen  : tsp00_Int4);
.sp;.fo
replaces each tabulator character found in BUF with
as many blanks that the next character starts at position
(n*8) + 1. Depending on the file code (FCODE) a tabulator is
HT=09 for csp_ascii, HT=05 for csp_ebcdic and not defined
for csp_codeneutral. PHYS(ical)_BUFLEN is needed for actual
BUFs with less than the formal sizeof (tsp00_Buf) characters.
 
.sp 2;.nf
.CM *-END-* specification -------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Description:
 
ASCII_EBCDIC (SOURCE,SPOS,DEST,DPOS,LEN) :
.sp
uses table [1]  for translating the source and writes the result
in dest.
.sp 2
EBCDIC_ASCII (SOURCE,SPOS,DEST,DPOS,LEN) :
.sp
uses table [2]  for translating the source and writes the result
in dest.
 
.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
      in3230 : tsp00_Int4;
 
BEGIN
(* linkcheck function *)
in3230 := 219120707;
END;
 
(*------------------------------*) 
 
FUNCTION
      i32machinecodetype : tsp00_Uint1;
 
BEGIN
IF  ord (bsp_c1) = 32
THEN
    i32machinecodetype := csp_ascii
ELSE
    i32machinecodetype := csp_ebcdic;
(*ENDIF*) 
END; (* i32machinecodetype *)
 
(*------------------------------*) 
 
PROCEDURE
      i32t1translate (
            source_code     : tsp00_Uint1;
            dest_code       : tsp00_Uint1;
            VAR source      : tsp00_MoveObj;
            spos            : integer;
            VAR destination : tsp00_MoveObj;
            dpos            : integer;
            len             : integer);
 
TYPE
      trans_action = (nothing,
            move,
            charset_standard,
            standard_charset,
            charset_trans,
            trans_charset,
            trans);
 
VAR
      action : trans_action;
 
BEGIN
action := nothing;
IF  (source_code = dest_code)
    OR (source_code = csp_codeneutral)
    OR (dest_code = csp_codeneutral)
    OR (source_code >= csp_unicode_swap)
    OR (dest_code >= csp_unicode_swap)
THEN
    action := move
ELSE
    IF  (source_code > csp_codeneutral)
        AND (dest_code = i32machinecodetype)
    THEN
        action := charset_standard
    ELSE
        IF  (source_code = i32machinecodetype)
            AND (dest_code > csp_codeneutral)
        THEN
            action := standard_charset
        ELSE
            IF  (source_code > csp_codeneutral)
                AND (dest_code <> i32machinecodetype)
                AND (dest_code in [ csp_ascii, csp_ebcdic] )
            THEN
                action := charset_trans
            ELSE
                IF  (source_code <> i32machinecodetype)
                    AND (source_code in [ csp_ascii, csp_ebcdic] )
                    AND (dest_code > csp_codeneutral)
                THEN
                    action := trans_charset
                ELSE
                    IF  (source_code in [ csp_ascii, csp_ebcdic] )
                        AND (dest_code in [ csp_ascii, csp_ebcdic] )
                    THEN
                        action := trans;
                    (*ENDIF*) 
                (*ENDIF*) 
            (*ENDIF*) 
        (*ENDIF*) 
    (*ENDIF*) 
(*ENDIF*) 
CASE action OF
    move :
        s10mv (sizeof (source),sizeof (destination),
              @source,spos,
              @destination,dpos,len);
    charset_standard :
        charset_to_standard (source, spos, destination, dpos, len);
    charset_trans :
        BEGIN
        charset_to_standard (source, spos, destination, dpos, len);
        IF  dest_code = csp_ascii
        THEN
            ebcdic_ascii (destination, dpos, destination, dpos, len)
        ELSE
            ascii_ebcdic (destination, dpos, destination, dpos, len);
        (*ENDIF*) 
        END;
    standard_charset :
        standard_to_charset (destination, dpos, destination, dpos, len);
    trans_charset :
        BEGIN
        IF  source_code = csp_ebcdic
        THEN
            ebcdic_ascii (source, spos, destination, dpos, len)
        ELSE
            ascii_ebcdic (source, spos, destination, dpos, len);
        (*ENDIF*) 
        standard_to_charset (destination, dpos, destination, dpos, len);
        END;
    trans :
        IF  source_code = csp_ebcdic
        THEN
            ebcdic_ascii (source, spos, destination, dpos, len)
        ELSE
            ascii_ebcdic (source, spos, destination, dpos, len);
        (*ENDIF*) 
    OTHERWISE:
    END;
(*ENDCASE*) 
END; (* i32t1translate *)
 
(*------------------------------*) 
 
PROCEDURE
      i32t2translate (
            source_code     : tsp00_Uint1;
            dest_code       : tsp00_Uint1;
            VAR source      : tsp00_MoveObj;
            spos            : integer;
            VAR destination : tsp00_MoveObj;
            dpos            : integer;
            len             : integer);
 
BEGIN
i32t1translate (source_code, dest_code,
      source, spos, destination, dpos, len);
END; (* i32t2translate *)
 
(*------------------------------*) 
 
PROCEDURE
      i32t3translate (
            source_code     : tsp00_Uint1;
            dest_code       : tsp00_Uint1;
            VAR source      : tsp00_MoveObj;
            spos            : integer;
            VAR destination : tsp00_MoveObj;
            dpos            : integer;
            len             : integer);
 
BEGIN
i32t1translate (source_code, dest_code,
      source, spos, destination, dpos, len);
END; (* i32t3translate *)
 
(*------------------------------*) 
 
PROCEDURE
      i32t4translate (
            source_code     : tsp00_Uint1;
            dest_code       : tsp00_Uint1;
            VAR source      : tsp00_MoveObj;
            spos            : integer;
            VAR destination : tsp00_MoveObj;
            dpos            : integer;
            len             : integer);
 
BEGIN
i32t1translate (source_code, dest_code,
      source, spos, destination, dpos, len);
END; (* i32t4translate *)
 
(*------------------------------*) 
 
PROCEDURE
      i32t5translate (
            source_code     : tsp00_Uint1;
            dest_code       : tsp00_Uint1;
            VAR source      : tsp00_MoveObj;
            spos            : integer;
            VAR destination : tsp00_MoveObj;
            dpos            : integer;
            len             : integer);
 
BEGIN
i32t1translate (source_code, dest_code,
      source, spos, destination, dpos, len);
END; (* i32t5translate *)
 
(*------------------------------*) 
 
PROCEDURE
      i32t6translate (
            source_code     : tsp00_Uint1;
            dest_code       : tsp00_Uint1;
            VAR source      : tsp00_MoveObj;
            spos            : integer;
            VAR destination : tsp00_MoveObj;
            dpos            : integer;
            len             : integer);
 
BEGIN
i32t1translate (source_code, dest_code,
      source, spos, destination, dpos, len);
END; (* i32t6translate *)
 
(*------------------------------*) 
 
PROCEDURE
      i32t7translate (
            source_code     : tsp00_Uint1;
            dest_code       : tsp00_Uint1;
            VAR source      : tsp00_MoveObj;
            spos            : integer;
            VAR destination : tsp00_MoveObj;
            dpos            : integer;
            len             : integer);
 
BEGIN
i32t1translate (source_code, dest_code,
      source, spos, destination, dpos, len);
END; (* i32t7translate *)
 
(*------------------------------*) 
 
PROCEDURE
      i32t8translate (
            source_code     : tsp00_Uint1;
            dest_code       : tsp00_Uint1;
            VAR source      : tsp00_MoveObj;
            spos            : integer;
            VAR destination : tsp00_MoveObj;
            dpos            : integer;
            len             : integer);
 
BEGIN
i32t1translate (source_code, dest_code,
      source, spos, destination, dpos, len);
END; (* i32t8translate *)
 
(*------------------------------*) 
 
PROCEDURE
      i32t9translate (
            source_code     : tsp00_Uint1;
            dest_code       : tsp00_Uint1;
            VAR source      : tsp00_MoveObj;
            spos            : integer;
            VAR destination : tsp00_MoveObj;
            dpos            : integer;
            len             : integer);
 
BEGIN
i32t1translate (source_code, dest_code,
      source, spos, destination, dpos, len);
END; (* i32t9translate *)
 
(*------------------------------*) 
 
PROCEDURE
      i32t10translate (
            source_code     : tsp00_Uint1;
            dest_code       : tsp00_Uint1;
            VAR source      : tsp00_MoveObj;
            spos            : integer;
            VAR destination : tsp00_MoveObj;
            dpos            : integer;
            len             : integer);
 
BEGIN
i32t1translate (source_code, dest_code,
      source, spos, destination, dpos, len);
END; (* i32t10translate *)
 
(*------------------------------*) 
 
PROCEDURE
      charset_to_standard (
            VAR source : tsp00_MoveObj;
            spos       : integer;
            VAR dest   : tsp00_MoveObj;
            dpos       : integer;
            len        : integer);
 
BEGIN
IF  (spos + len - 1 > sizeof (source)) OR
    (dpos + len - 1 > sizeof (dest)) OR
    (len < 0) OR (spos <= 0) OR (dpos <= 0)
THEN
    sqlabort
ELSE
    s30map (i01g^.i32.transtables [ cin_charset_to_std] ,
          source, spos, dest, dpos, len);
(*ENDIF*) 
END; (* charset_to_standard *)
 
(*------------------------------*) 
 
PROCEDURE
      standard_to_charset (
            VAR source : tsp00_MoveObj;
            spos       : integer;
            VAR dest   : tsp00_MoveObj;
            dpos       : integer;
            len        : integer);
 
BEGIN
IF  (spos + len - 1 > sizeof (source)) OR
    (dpos + len - 1 > sizeof (dest)) OR
    (len < 0) OR (spos <= 0) OR (dpos <= 0)
THEN
    sqlabort
ELSE
    s30map (i01g^.i32.transtables [ cin_std_to_charset] ,
          source, spos, dest, dpos, len);
(*ENDIF*) 
END; (* standard_to_charset *)
 
(*------------------------------*) 
 
PROCEDURE
      ascii_ebcdic (
            VAR source : tsp00_MoveObj;
            spos       : integer;
            VAR dest   : tsp00_MoveObj;
            dpos       : integer;
            len        : integer);
 
BEGIN
IF  (spos + len - 1 > sizeof (source)) OR
    (dpos + len - 1 > sizeof (dest)) OR
    (len < 0) OR (spos <= 0) OR (dpos <= 0)
THEN
    sqlabort
ELSE
    s30map (i01g^.i32.transtables [ cin_to_ebcdic] ,
          source, spos, dest, dpos, len)
(*ENDIF*) 
END; (* ascii_ebcdic *)
 
(*------------------------------*) 
 
PROCEDURE
      ebcdic_ascii (
            VAR source : tsp00_MoveObj;
            spos       : integer;
            VAR dest   : tsp00_MoveObj;
            dpos       : integer;
            len        : integer);
 
BEGIN
IF  (spos + len - 1 > sizeof (source)) OR
    (dpos + len - 1 > sizeof (dest)) OR
    (len < 0) OR (spos <= 0) OR (dpos <= 0)
THEN
    sqlabort
ELSE
    s30map (i01g^.i32.transtables [ cin_to_ascii] ,
          source, spos, dest, dpos, len)
(*ENDIF*) 
END; (* ebcdic_ascii *)
 
(*------------------------------*) 
 
PROCEDURE
      i32ktrunc (
            VAR line   : tsp00_MoveObj;
            length     : integer);
 
VAR
      pos_of_so  : integer;
      pos_of_si  : integer;
      scanned    : integer;
      left       : integer;
 
BEGIN
WITH i01g^.vt.desc DO
    BEGIN
    pos_of_si := 0;
    step_to_next_shifts (line, length, scanned, left,
          pos_of_so, pos_of_si);
    IF  pos_of_si < pos_of_so
    THEN
        BEGIN
        CASE pos_of_si OF
            1 :
                line  [1]  := bsp_c1;
            2 :
                line  [1]  := so_char [1] ;
            OTHERWISE:
                IF  odd (pos_of_si)
                THEN
                    BEGIN
                    line  [1]  := bsp_c1;
                    line  [2]  := so_char [1] ;
                    END
                ELSE
                    line  [1]  := so_char [1] ;
                (*ENDIF*) 
            END;
        (*ENDCASE*) 
        step_to_next_shifts (line, length, scanned, left,
              pos_of_so, pos_of_si);
        END;
    (*ENDIF*) 
    WHILE (pos_of_so <= length) AND (pos_of_si <= length) DO
        BEGIN
        step_to_next_shifts (line, length, scanned, left,
              pos_of_so, pos_of_si);
        END;
    (*ENDWHILE*) 
    IF  pos_of_so < pos_of_si
    THEN
        IF  pos_of_so = length
        THEN
            line [ length ] := bsp_c1
        ELSE
            IF  odd (length - pos_of_so)
            THEN
                line [ length ] := si_char [1]
            ELSE
                BEGIN
                line [ length - 1 ] := si_char [1] ;
                line [ length ]     := bsp_c1;
                END;
            (*ENDIF*) 
        (*ENDIF*) 
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END; (* i32ktrunc *)
 
(*------------------------------*) 
 
PROCEDURE
      step_to_next_shifts (
            VAR line      : tsp00_MoveObj;
            length        : integer;
            VAR scanned   : integer;
            VAR left      : integer;
            VAR pos_of_so : integer;
            VAR pos_of_si : integer);
 
BEGIN
WITH i01g^.vt.desc DO
    BEGIN
    scanned := pos_of_si;
    left    := length - scanned;
    pos_of_so := scanned + s30lenl (line, so_char [1] , scanned + 1,
          left) +
          1;
    pos_of_si := scanned + s30lenl (line, si_char [1] , scanned + 1,
          left) +
          1;
    END;
(*ENDWITH*) 
END; (* step_to_next_shifts *)
 
(*------------------------------*) 
 
FUNCTION
      i32isidfirst (c : char) : boolean;
 
VAR
      letter       : boolean;
      special_char : boolean;
      quoted       : boolean;
      kanji        : boolean;
 
BEGIN
letter := c IN [ 'A'..'I', 'J'..'R', 'S'..'Z'];
IF  i32machinecodetype = csp_ascii
THEN
    special_char := c in [
          chr(192).. chr(214), (* A grave .. O umlaut *)
          chr(216).. chr(222), (* O slash .. capital thorn *)
          '@', '#', '$' ]
ELSE
    special_char := c in [
          chr( 98) .. chr(105),
          chr(128),
          chr(158),
          chr(172) .. chr(174),
          chr(235) .. chr(239),
          chr(251) .. chr(254),
          '@', '#', '$' ];
(*ENDIF*) 
quoted := c = '"';
kanji := i01g^.multibyte.dblang <> bsp_c64;
i32isidfirst := letter OR special_char OR quoted OR kanji;
END; (* i32isidfirst *)
 
(*------------------------------*) 
 
FUNCTION
      i32islower (c : char) : boolean;
 
BEGIN
i32islower := (c <> i32toupper (c) );
END;
 
(*------------------------------*) 
 
FUNCTION
      i32isupper (c : char) : boolean;
 
BEGIN
i32isupper := (c <> i32tolower(c) );
END;
 
(*------------------------------*) 
 
FUNCTION
      i32toupper (
            c : char ) : char;
 
VAR
      c1 : char;
      c2 : char;
      c3 : char;
 
BEGIN
IF  i01g^.i20.code_type < csp_codeneutral
THEN
    c3 := i01g^.i32.transtables [cin_to_capital] [ord (c) + 1]
ELSE
    IF  i01g^.i20.code_type < csp_unicode_swap
    THEN
        BEGIN
        c1 := i01g^.i32.transtables [cin_charset_to_std] [ord (c) + 1];
        c2 := i01g^.i32.transtables [cin_to_capital] [ord (c1) + 1];
        c3 := i01g^.i32.transtables [cin_std_to_charset] [ord (c2) + 1];
        END
    ELSE
        c3 := c;
    (*ENDIF*) 
(*ENDIF*) 
i32toupper := c3;
END;
 
(*------------------------------*) 
 
FUNCTION
      i32tolower (
            c : char ) : char;
 
VAR
      c1 : char;
      c2 : char;
      c3 : char;
 
BEGIN
IF  i01g^.i20.code_type < csp_codeneutral
THEN
    c3 := i01g^.i32.transtables [cin_to_small] [ord (c) + 1]
ELSE
    IF  i01g^.i20.code_type < csp_unicode_swap
    THEN
        BEGIN
        c1 := i01g^.i32.transtables [cin_charset_to_std] [ord (c) + 1];
        c2 := i01g^.i32.transtables [cin_to_small] [ord (c1) + 1];
        c3 := i01g^.i32.transtables [cin_std_to_charset] [ord (c2) + 1];
        END
    ELSE
        c3 := c;
    (*ENDIF*) 
(*ENDIF*) 
i32tolower := c3;
END;
 
(*------------------------------*) 
 
PROCEDURE
      i32upstring (
            VAR source : tsp00_MoveObj;
            spos       : integer;
            VAR dest   : tsp00_MoveObj;
            dpos       : integer;
            len        : integer);
 
BEGIN
IF  (spos + len - 1 > sizeof (source)) OR
    (dpos + len - 1 > sizeof (dest)) OR
    (len < 0) OR (spos <= 0) OR (dpos <= 0)
THEN
    sqlabort
ELSE
    IF  i01g^.i20.code_type < csp_codeneutral
    THEN
        s30map (i01g^.i32.transtables [cin_to_capital] ,
              source, spos, dest, dpos, len)
    ELSE
        IF  i01g^.i20.code_type < csp_unicode_swap
        THEN
            BEGIN
            s30map (i01g^.i32.transtables [cin_charset_to_std],
                  source, spos, dest, dpos, len);
            s30map (i01g^.i32.transtables [cin_to_capital] ,
                  dest, dpos, dest, dpos, len);
            s30map (i01g^.i32.transtables [cin_std_to_charset] ,
                  dest, dpos, dest, dpos, len);
            END
        ELSE
            s10mv (sizeof (source),sizeof (dest),
                  @source,spos,
                  @dest,dpos,len);
        (*ENDIF*) 
    (*ENDIF*) 
(*ENDIF*) 
END; (* i32upstring *)
 
(*------------------------------*) 
 
PROCEDURE
      i32up1string (
            VAR source : tsp00_MoveObj;
            spos       : integer;
            VAR dest   : tsp00_MoveObj;
            dpos       : integer;
            len        : integer);
 
BEGIN
IF  (spos + len - 1 > sizeof (source)) OR
    (dpos + len - 1 > sizeof (dest)) OR
    (len < 0) OR (spos <= 0) OR (dpos <= 0)
THEN
    sqlabort
ELSE
    IF  i01g^.i20.code_type < csp_codeneutral
    THEN
        s30map (i01g^.i32.transtables [cin_to_capital] ,
              source, spos, dest, dpos, len)
    ELSE
        IF  i01g^.i20.code_type < csp_unicode_swap
        THEN
            BEGIN
            s30map (i01g^.i32.transtables [cin_charset_to_std],
                  source, spos, dest, dpos, len);
            s30map (i01g^.i32.transtables [cin_to_capital] ,
                  dest, dpos, dest, dpos, len);
            s30map (i01g^.i32.transtables [cin_std_to_charset] ,
                  dest, dpos, dest, dpos, len);
            END
        ELSE
            s10mv (sizeof (source),sizeof (dest),
                  @source,spos,
                  @dest,dpos,len);
        (*ENDIF*) 
    (*ENDIF*) 
(*ENDIF*) 
END; (* i32up1string *)
 
(*------------------------------*) 
 
PROCEDURE
      i32lowerstring (
            VAR source : tsp00_MoveObj;
            spos       : integer;
            VAR dest   : tsp00_MoveObj;
            dpos       : integer;
            len        : integer);
 
BEGIN
IF  (spos + len - 1 > sizeof (source)) OR
    (dpos + len - 1 > sizeof (dest)) OR
    (len < 0) OR (spos <= 0) OR (dpos <= 0)
THEN
    sqlabort
ELSE
    IF  i01g^.i20.code_type < csp_codeneutral
    THEN
        s30map (i01g^.i32.transtables [cin_to_small] ,
              source, spos, dest, dpos, len)
    ELSE
        IF  i01g^.i20.code_type < csp_unicode_swap
        THEN
            BEGIN
            s30map (i01g^.i32.transtables [cin_charset_to_std],
                  source, spos, dest, dpos, len);
            s30map (i01g^.i32.transtables [cin_to_small] ,
                  dest, dpos, dest, dpos, len);
            s30map (i01g^.i32.transtables [cin_std_to_charset] ,
                  dest, dpos, dest, dpos, len);
            END
        ELSE
            s10mv (sizeof (source),sizeof (dest),
                  @source,spos,
                  @dest,dpos,len);
        (*ENDIF*) 
    (*ENDIF*) 
(*ENDIF*) 
END; (* i32lowerstring *)
 
(*------------------------------*) 
 
PROCEDURE
      i32low1string (
            VAR source : tsp00_MoveObj;
            spos       : integer;
            VAR dest   : tsp00_MoveObj;
            dpos       : integer;
            len        : integer);
 
BEGIN
IF  (spos + len - 1 > sizeof (source)) OR
    (dpos + len - 1 > sizeof (dest)) OR
    (len < 0) OR (spos <= 0) OR (dpos <= 0)
THEN
    sqlabort
ELSE
    IF  i01g^.i20.code_type < csp_codeneutral
    THEN
        s30map (i01g^.i32.transtables [cin_to_small] ,
              source, spos, dest, dpos, len)
    ELSE
        IF  i01g^.i20.code_type < csp_unicode_swap
        THEN
            BEGIN
            s30map (i01g^.i32.transtables [cin_charset_to_std],
                  source, spos, dest, dpos, len);
            s30map (i01g^.i32.transtables [cin_to_small] ,
                  dest, dpos, dest, dpos, len);
            s30map (i01g^.i32.transtables [cin_std_to_charset] ,
                  dest, dpos, dest, dpos, len);
            END
        ELSE
            s10mv (sizeof (source),sizeof (dest),
                  @source,spos,
                  @dest,dpos,len);
        (*ENDIF*) 
    (*ENDIF*) 
(*ENDIF*) 
END; (* i32low1string *)
 
(*------------------------------*) 
 
PROCEDURE
      i32deftranstables(
            VAR ig : tin_global_in_record);
 
VAR
      i : integer;
      c : char;
 
BEGIN
WITH ig.i32 DO
    BEGIN
    FOR i := 1 TO CTABLE_MXSP00 DO
        BEGIN
        c := chr (i - 1);
        (* IF  c in [ 'a'..'i','j'..'r','s'..'z' ] *)
        IF  ((c >= 'a') (* B.M. 23.09.93 Release 3.1.3 *)
            AND (c <= 'i'))
            OR ((c >= 'j')
            AND (c <= 'r'))
            OR ((c>= 's')
            AND (c <= 'z'))
        THEN
            transtables [cin_to_capital] [i] :=
                  chr ( ord (c) + ord ('A') - ord ('a'))
        ELSE
            transtables [cin_to_capital] [i] := c;
        (*ENDIF*) 
        (*IF  c in [ 'A'..'I','J'..'R','S'..'Z' ]*)
        IF  ((c >= 'A') (* B.M. 23.09.93 Release 3.1.3 *)
            AND (c <= 'I'))
            OR ((c >= 'J')
            AND (c <= 'R'))
            OR ((c>= 'S')
            AND (c <= 'Z'))
        THEN
            transtables [cin_to_small] [i] :=
                  chr ( ord (c) + ord ('a') - ord ('A'))
        ELSE
            transtables [cin_to_small] [i] := c;
        (*ENDIF*) 
        END;
    (*ENDFOR*) 
    END;
(*ENDWITH*) 
END; (* i32deftranstables *)
 
(*------------------------------*) 
 
PROCEDURE
      i32repltabs (
            fcode       : tsp00_Uint1;
            phys_buflen : integer;
            VAR buf     : tsp00_Buf;
            VAR buflen  : tsp00_Int4);
 
VAR
      i   : integer;
      j   : integer;
      res : tsp00_Buf;
 
BEGIN
j := 0;
FOR i := 1 TO buflen DO
    IF  ( ( buf [i] = chr (9) ) AND ( fcode = csp_ascii ) )
        OR
        ( ( buf [i] = chr (5) ) AND ( fcode = csp_ebcdic ) )
    THEN
        BEGIN
        (* one TAB represents up to eight blanks *)
        (* next word starts at pos 9, 17 and so on *)
        REPEAT
            j := j + 1;
            IF  j <= mxsp_buf
            THEN
                res [j] := bsp_c1;
            (*ENDIF*) 
        UNTIL
            (j MOD 8) = 0;
        (*ENDREPEAT*) 
        END
    ELSE
        BEGIN
        j := j + 1;
        IF  j <= mxsp_buf
        THEN
            res [j] := buf [i];
        (*ENDIF*) 
        END;
    (*ENDIF*) 
(*ENDFOR*) 
IF  j > mxsp_buf
THEN
    buflen := mxsp_buf
ELSE
    buflen := j;
(*ENDIF*) 
IF  buflen > phys_buflen
THEN
    buflen := phys_buflen;
(*ENDIF*) 
s10mv (mxsp_buf,phys_buflen,
      @res,1,
      @buf,1,buflen);
END; (* i32repltabs *)
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
.PA 
