.mv2CM  SCRIPT , Version - 1.1 , last edited by B.Morgeneyer
.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$VSP82$
.tt 2 $$$
.tt 3 $$RTE-Extension-82$1998-12-15$
***********************************************************
.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  : RTE-Extension-82
=========
.sp
Purpose : National Language Support (NLS)
          Load mapping tables from any charset to UNICODE
          into client-memory (intended to be used by client
          utilities like LOAD, CI, QUERY, VT).
 
.CM *-END-* purpose -------------------------------------
.sp
.cp 3
Define  :
 
        PROCEDURE
              s82uni_fload (VAR encodings_ptr : tsp8_encodings_ptr;
                    VAR encoding_cnt   : tsp00_Int2;
                    read_dblang_flag   : boolean;
                    VAR iso_locale_str : tsp00_KnlIdentifier;
                    VAR codeset        : tsp00_Int2;
                    VAR rc             : tsp8_uni_load_error);
 
        PROCEDURE
              s82uni_free (VAR encodings_ptr : tsp8_encodings_ptr;
                    VAR encoding_cnt   : tsp00_Int2;
                    VAR rc             : tsp8_uni_load_error);
 
        PROCEDURE
              s82uni_load_error (
                    rc      : tsp8_uni_load_error;
                    VAR msg : tsp00_C40);
 
.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :
 
        FROM
              RTE_driver : VEN102;
 
        PROCEDURE
              sqlgetenv
                    (VAR envname   : tsp00_VFilename;
                    VAR envvalue   : tsp00_VFilename;
                    VAR envfound   : boolean);
 
        PROCEDURE
              sqlallocat
                    (length       : tsp00_Int4;
                    VAR p         : tsp00_ObjAddr;
                    VAR ok        : boolean);
 
        PROCEDURE
              sqlfree
                    (p            : tsp00_ObjAddr);
 
        PROCEDURE
              sqlfopenp (
                    VAR fname   : tsp00_VFilename;
                    datakind    : tsp05_RteDataKind;
                    filemode    : tsp05_RteFileMode;
                    buffering   : tsp05_RteBufferingKind;
                    VAR fhandle : tsp00_Int4;
                    VAR err     : tsp05_RteFileError);
 
        PROCEDURE
              sqlfreadp (
                    fhandle    : tsp00_Int4;
                    VAR buf    : tsp00_Buf;
                    bufsize    : tsp00_Longint;
                    VAR outlen : tsp00_Longint;
                    VAR err    : tsp05_RteFileError);
 
        PROCEDURE
              sqlfclosep (
                    fhandle : tsp00_Int4;
                    option  : tsp05_RteCloseOption;
                    VAR err : tsp05_RteFileError);
 
      ------------------------------ 
 
        FROM
              Kernel_move_and_fill : VGG101;
 
        PROCEDURE
              SAPDB_PascalForcedFill (
                    size        : tsp00_Int4;
                    m           : tsp00_MoveObjPtr;
                    pos         : tsp00_Int4;
                    len         : tsp00_Int4;
                    fillchar    : char);
 
        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;
 
        FUNCTION
              s30gad1 (VAR b : tsp00_KnlIdentifier) : tsp00_MoveObjPtr;
 
        FUNCTION
              s30gad2 (VAR b : tsp00_Buf) : tsp00_MoveObjPtr;
 
        FUNCTION
              s30eq (VAR a : tsp00_KnlIdentifier;
                    VAR b  : tsp00_Buf;
                    b_pos  : tsp00_Int4;
                    length : tsp00_Int4) : boolean;
 
      ------------------------------ 
 
        FROM
              PUT-Conversions : VSP41;
 
        PROCEDURE
              s41pbyte (
                    VAR buf   : tsp00_KnlIdentifier;
                    pos       : tsp00_Int4;
                    VAR len   : integer;
                    VAR source: tsp00_Buf;
                    spos      : tsp00_Int4;
                    slen      : integer;
                    VAR invalid : boolean);
&       ifdef TRACE
 
      ------------------------------ 
 
        FROM
              C-Type-Checker-Module  : VPR102;
 
        PROCEDURE
              m90sname (
                    layer : tsp00_ToolLayer;
                    nam   : tsp00_Sname);
 
        PROCEDURE
              m90filename (
                    layer : tsp00_ToolLayer;
                    fn    : tsp00_VFilename);
 
        PROCEDURE
              m90addr (
                    layer : tsp00_ToolLayer;
                    nam   : tsp00_Sname;
                    bufaddr : tsp00_ObjAddr);
 
        PROCEDURE
              m90buf (
                    layer   : tsp00_ToolLayer;
                    VAR buf : tsp00_Buf;
                    pos_anf : integer;
                    pos_end : integer);
 
        PROCEDURE
              m90c30 (
                    layer   : tsp00_ToolLayer;
                    str30   : tsp00_C30);
 
        PROCEDURE
              m90c40 (
                    layer   : tsp00_ToolLayer;
                    str30   : tsp00_ErrText);
 
        PROCEDURE
              m90int (
                    layer : tsp00_ToolLayer;
                    nam   : tsp00_Sname;
                    int   : integer);
 
        PROCEDURE
              m90str (
                    layer   : tsp00_ToolLayer;
                    VAR str : tsp00_KnlIdentifier;
                    pos_anf : integer;
                    pos_end : integer);
&       endif
 
.CM *-END-* use -----------------------------------------
.sp;.cp 3
Synonym :
 
        PROCEDURE
              sqlfreadp;
 
              tsp00_MoveObj tsp00_Buf
 
        PROCEDURE
              sqlfree;
 
              tsp00_BufAddr tsp00_ObjAddr;
 
        FUNCTION
              s30gad1;
 
              tsp00_MoveObj tsp00_KnlIdentifier
              tsp00_Addr tsp00_MoveObjPtr
 
        FUNCTION
              s30gad2;
 
              tsp00_MoveObj tsp00_Buf
              tsp00_Addr tsp00_MoveObjPtr
 
        PROCEDURE
              s30eq;
 
              tsp00_MoveObj tsp00_KnlIdentifier
              tsp00_MoveObj tsp00_Buf
 
        PROCEDURE
              s41pbyte;
 
              tsp00_MoveObj tsp00_KnlIdentifier;
              tsp00_MoveObj tsp00_Buf;
 
        PROCEDURE
              m90c40;
 
              tsp00_C40 tsp00_ErrText
 
        PROCEDURE
              m90str;
 
              tsp00_Buf tsp00_KnlIdentifier;
 
        PROCEDURE
              m90addr;
 
              tsp00_BufAddr tsp00_ObjAddr;
 
.CM *-END-* synonym -------------------------------------
.sp;.cp 3
Author  :
.sp
.cp 3
Created : 1995-08-14
.sp
.cp 3
.sp
.cp 3
Release :      Date : 1998-12-15
.sp
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Specification:
 
.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    :
 
 
VAR
      s82blankfilename : tsp00_VFilename;
 
 
(*------------------------------*) 
 
PROCEDURE
      s82uni_fload (VAR encodings_ptr : tsp8_encodings_ptr;
            VAR encoding_cnt   : tsp00_Int2;
            read_dblang_flag   : boolean;
            VAR iso_locale_str : tsp00_KnlIdentifier;
            VAR codeset        : tsp00_Int2;
            VAR rc             : tsp8_uni_load_error);
 
CONST
      load_comment_char = '/';
      cunicode          =
            'UCS_2                                                           ';
      ciso8859_1        =
            'ISO8859_1                                                       ';
      infofilename      = 'nls.inf                 ';
&     if $os in [ OS2, WIN32 ]
      path              = '%DBROOT%\\env\\           ';
      path_len          = 13;
&     else
      path              = '${DBROOT}/env/          ';
      path_len          = 14;
&     endif
 
VAR
      unicode           : tsp00_KnlIdentifier;
      i, k              : integer;
      is_ok             : boolean;
      pathstr           : tsp00_C24;
      infofilenamestr   : tsp00_C24;
      locale_filename   : tsp00_VFilename;
      lcol_filename     : tsp00_VFilename;
      locale_fileid     : tsp00_Int4;
      localefile_open_flag : boolean;
      encoding_key      : tsp00_Int2;
      obj_ptr           : tsp00_ObjAddr;
      src_locale_str    : tsp00_KnlIdentifier;
      subcode_cnt1      : tsp00_Int2;
      src_lcol_len      : tsp00_Int4;
      src_lcol_start    : tsp00_Int4;
      src_lcol_end      : tsp00_Int4;
      src_value_typ     : tsp8_value_typ;
      src_value_len     : tsp00_Int2;
      subcode_cnt2      : tsp00_Int2;
      dest_lcol_len     : tsp00_Int4;
      dest_lcol_start   : tsp00_Int4;
      dest_lcol_end     : tsp00_Int4;
      dest_value_typ    : tsp8_value_typ;
      dest_value_len    : tsp00_Int2;
      start_pos         : tsp00_Int2;
      toklen            : tsp00_Int2;
      buf               : tsp00_Buf;
      len               : tsp00_Int4;
 
BEGIN
FOR i := 1 TO sizeof(s82blankfilename) DO
    s82blankfilename[i] := ' ';
(*ENDFOR*) 
&ifdef TRACE
m90c30 (qu, 's82uni_fload:-----------------');
&endif
localefile_open_flag := false;
pathstr              := path;
infofilenamestr      := infofilename;
rc                   := uni_load_ok;
unicode              := cunicode;
(* *)
IF  read_dblang_flag
THEN
    sp82_read_dblang (iso_locale_str, rc);
(*ENDIF*) 
IF  rc = uni_load_ok
THEN
    sp82_uppercase (s30gad1(iso_locale_str), 1, sizeof(iso_locale_str));
(**)
(**)
(**************************************************)
(* return encoding_key of "iso_locale_str" if it  *)
(* was loaded previously                          *)
(**************************************************)
(*ENDIF*) 
IF  iso_locale_str = ciso8859_1
THEN
    codeset := csp_ascii
ELSE
    BEGIN
    IF  ( encoding_cnt > 0 ) AND ( rc = uni_load_ok )
    THEN
        BEGIN
        (**)
        (* check if "iso locale str" has been already *)
        (* loaded                                     *)
        i := 1;
        WHILE (i < encoding_cnt) AND
              (encodings_ptr^ [ i ].iso_locale_str <> iso_locale_str) DO
            i := i + 2;
        (*ENDWHILE*) 
        IF  encodings_ptr^ [ i ].iso_locale_str = iso_locale_str
        THEN
            BEGIN
            encoding_key  := i;
            rc := uni_encoding_already_loaded
            END
        ELSE
            encoding_key  := succ( encoding_cnt );
        (*ENDIF*) 
        END
    ELSE
        IF  (rc = uni_load_ok )
        THEN
            encoding_key  := succ( encoding_cnt );
        (*ENDIF*) 
    (*ENDIF*) 
    IF  rc = uni_load_ok
    THEN
        BEGIN
        (**)
        (**)
        (**************************************************)
        (* search infofile for "src_locale" and get       *)
        (* respective filename of locale-definition-file  *)
        (**************************************************)
        sp82_read_infofile (iso_locale_str, infofilenamestr, pathstr, path_len,
              locale_filename, lcol_filename, rc);
        IF  rc = uni_load_ok
        THEN
            BEGIN
            sp82_open_localefile (locale_filename, pathstr, path_len,
                  locale_fileid, rc);
            IF  rc = uni_load_ok
            THEN
                localefile_open_flag := true;
            (*ENDIF*) 
            END
        (*ENDIF*) 
        END;
    (**)
    (**************************************************)
    (* create encoding-DSTRUCT                        *)
    (**************************************************)
    (*ENDIF*) 
    IF  (encoding_cnt = 0) AND (rc = uni_load_ok)
    THEN
        BEGIN
        sqlallocat (sizeof(tsp8_encodings), obj_ptr, is_ok);
        IF  is_ok
        THEN
            BEGIN
&           ifdef TRACE
            m90addr (qu, 'ALLOC encodi', obj_ptr);
&           endif
            encodings_ptr := @(obj_ptr^);
            END
        ELSE
            rc := uni_memory_alloc_failed;
        (*ENDIF*) 
        END;
    (**)
    (**)
    (**************************************************)
    (* read encoding-parameters (descr, vendor etc.)  *)
    (* from locale-definition_file                    *)
    (**************************************************)
    (*ENDIF*) 
    IF  rc = uni_load_ok
    THEN
        WITH encodings_ptr^ [ encoding_key ] DO
            BEGIN
            max_codewidth  := 0;
            sp82_read_localefile (locale_fileid, buf, len, rc);
            IF  rc = uni_load_ok
            THEN
                sp82_read_encoding (encodings_ptr, encoding_key, buf, len,
                      src_locale_str, subcode_cnt1, subcode_cnt2);
            (**)
            (**)
            (**************************************************)
            (* read subcode-parameters (descr, flags  etc.)   *)
            (* from locale-definition_file                    *)
            (**************************************************)
            (*ENDIF*) 
            sp82_read_localefile (locale_fileid, buf, len, rc);
            sp82_read_localefile (locale_fileid, buf, len, rc);
            (**)
            IF  rc = uni_load_ok
            THEN
                BEGIN
                sp82_subcode_allocate (@subcode1 [ 1 ], subcode_cnt1, rc);
                IF  rc = uni_load_ok
                THEN
                    sp82_subcode_allocate (@subcode2 [ 1 ], subcode_cnt2, rc);
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            i := 0;
            k := 0;
            WHILE ((buf [ 1 ] <> load_comment_char) AND
                  (i <= subcode_cnt1) AND
                  (k <= subcode_cnt2) AND
                  (rc = uni_load_ok)) DO
                BEGIN
                sp82_get_token (2, start_pos, toklen, buf, len, is_ok);
                IF  is_ok
                THEN
                    BEGIN
                    IF  s30eq (src_locale_str, buf, start_pos, toklen)
                    THEN
                        BEGIN
                        i := succ(i);
                        sp82_read_subcode (subcode1 [ i ], buf, len);
                        END
                    ELSE
                        IF  s30eq (unicode, buf, start_pos, toklen)
                        THEN
                            BEGIN
                            k := succ(k);
                            sp82_read_subcode (subcode2 [ k ], buf, len)
                            END
                        ELSE
                            rc := uni_bad_localefile;
                        (*ENDIF*) 
                    (*ENDIF*) 
                    sp82_read_localefile (locale_fileid, buf, len, rc);
                    END
                ELSE
                    rc := uni_bad_localefile;
                (*ENDIF*) 
                END;
            (*ENDWHILE*) 
            IF  (rc = uni_load_ok) AND
                ((i > subcode_cnt1) OR (k > subcode_cnt2))
            THEN
                rc := uni_bad_localefile;
            (**)
            (**)
            (**)
            (**************************************************)
            (* read subspace-parameters (byteranges etc.)     *)
            (* from locale-definition_file                    *)
            (**************************************************)
            (* skip LOAD-comment line *)
            (*ENDIF*) 
            sp82_read_localefile (locale_fileid, buf, len, rc);
            WHILE (buf [ 1 ] <> load_comment_char) AND
                  (rc = uni_load_ok) DO
                BEGIN
                sp82_get_token (2,  start_pos, toklen, buf, len, is_ok);
                IF  is_ok
                THEN
                    BEGIN
                    IF  s30eq (src_locale_str, buf, start_pos, toklen)
                    THEN
                        sp82_read_subspace (@subcode1 [ 1 ], subcode_cnt1,
                              buf, len, max_codewidth, rc )
                    ELSE
                        IF  s30eq (unicode, buf, start_pos, toklen)
                        THEN
                            sp82_read_subspace (@subcode2 [ 1 ], subcode_cnt2,
                                  buf, len, max_codewidth, rc )
                        ELSE
                            rc := uni_bad_localefile;
                        (*ENDIF*) 
                    (*ENDIF*) 
                    sp82_read_localefile (locale_fileid, buf, len, rc);
                    END
                ELSE
                    rc := uni_bad_localefile;
                (*ENDIF*) 
                END;
            (*ENDWHILE*) 
            (**)
            (**)
            (**************************************************)
            (* read mapping-table-parameter (value_typ etc.)  *)
            (* from locale-definition_file                    *)
            (**************************************************)
            i := 1;
            WHILE (i <= 2) AND (rc = uni_load_ok) DO
                BEGIN
                sp82_read_localefile (locale_fileid, buf, len, rc);
                sp82_get_token (2,  start_pos, toklen, buf, len, is_ok);
                IF  is_ok
                THEN
                    IF  s30eq (src_locale_str, buf, start_pos, toklen)
                    THEN
                        sp82_read_mapping ( buf, len,
                              src_lcol_len, src_lcol_start, src_lcol_end,
                              src_value_typ, src_value_len,
                              rc)
                    ELSE
                        IF  s30eq (unicode, buf, start_pos, toklen)
                        THEN
                            sp82_read_mapping ( buf, len,
                                  dest_lcol_len, dest_lcol_start, dest_lcol_end,
                                  dest_value_typ, dest_value_len,
                                  rc)
                        ELSE
                            rc := uni_bad_localefile
                        (*ENDIF*) 
                    (*ENDIF*) 
                ELSE
                    rc := uni_bad_localefile;
                (*ENDIF*) 
                i := succ(i)
                END;
            (*ENDWHILE*) 
            (**)
            (**)
            (**************************************************)
            (* read the actual mapping-binary-data from the   *)
            (* respective binary-file (longcolfile)           *)
            (**************************************************)
            IF  rc = uni_load_ok
            THEN
                sp82_read_longcolfile (
                      lcol_filename, pathstr, path_len,
                      mapping1, mapping2,
                      src_lcol_len, src_lcol_end,
                      src_value_typ, src_value_len,
                      dest_lcol_len, dest_lcol_start,
                      dest_value_typ, dest_value_len,
                      rc);
            (*ENDIF*) 
            END;
        (*ENDWITH*) 
    (**)
    (**)
    (**************************************************)
    (* finish, close and exit                         *)
    (**************************************************)
    (*ENDIF*) 
    IF  rc in [uni_load_ok, uni_encoding_already_loaded]
    THEN
        BEGIN
        codeset  := csp_unicode + encoding_key;
        IF  rc = uni_load_ok
        THEN
            encoding_cnt := succ (encoding_cnt)
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  localefile_open_flag
    THEN
        sp82_close_localefile   (locale_fileid, rc);
    (*ENDIF*) 
    END;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      sp82_read_dblang (
            VAR str        : tsp00_KnlIdentifier;
            VAR rc         : tsp8_uni_load_error);
 
CONST
      dbl_str     = 'DBLANG                  ';
 
VAR
      env_name        : tsp00_VFilename;
      env_value       : tsp00_VFilename;
      env_found       : boolean;
      cstr            : tsp00_C24;
 
BEGIN
IF  rc = uni_load_ok
THEN
    BEGIN
&   ifdef TRACE
    m90c30 (qu, '>>>>sp82_read_dblang:         ');
&   endif
    cstr     := dbl_str;
    env_name := s82blankfilename;
    s10mv  (sizeof(cstr), sizeof(env_name), @cstr, 1, @env_name, 1,
          sizeof(cstr));
    sqlgetenv(
          env_name, env_value, env_found);
    IF  env_found AND (env_value <> s82blankfilename)
    THEN
        BEGIN
        s10mv (sizeof(env_value), sizeof(str), @env_value, 1, @str, 1,
              sizeof(str));
&       ifdef TRACE
        m90sname    (qu, 'DBLANG      ');
        m90filename (qu, env_value);
&       endif
        (* *)
        END
    ELSE
        BEGIN
        rc := uni_no_dblang_found;
&       ifdef TRACE
        m90sname    (qu, 'err no DBLAN');
&       endif
        END
    (*ENDIF*) 
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      sp82_read_infofile (
            VAR iso_locale_str       : tsp00_KnlIdentifier;
            VAR infofilename         : tsp00_C24;
            VAR path                 : tsp00_C24;
            path_len                 : tsp00_Int2;
            VAR locale_filename       : tsp00_VFilename;
            VAR longcol_filename     : tsp00_VFilename;
            VAR rc                   : tsp8_uni_load_error);
 
CONST
      load_comment_char = '/';
 
VAR
      i               : integer;
      found_flag      : boolean;
      (* get_token             *)
      buf             : tsp00_Buf;
      read_len        : tsp00_Longint;
      len             : tsp00_Int4;
      start_pos       : tsp00_Int2;
      toklen          : tsp00_Int2;
      is_ok           : boolean;
      (* sqlfopen              *)
      fn              : tsp00_VFilename;
      fileid          : tsp00_Int4;
      error           : tsp05_RteFileError;
 
BEGIN
&ifdef TRACE
m90c30 (qu, '>>>>sp82_read_infofile:       ');
m90str  (qu, iso_locale_str, 1, sizeof(iso_locale_str));
&endif
(* init *)
fn               := s82blankfilename;
locale_filename  := s82blankfilename;
longcol_filename := s82blankfilename;
(* assemble PATH/infofilename *)
s10mv  (sizeof(path), sizeof(fn), @path, 1, @fn, 1, path_len);
s10mv  (sizeof(infofilename), sizeof(fn), @infofilename, 1,
      @fn, path_len + 1, 24);
(*                              *)
(* open infofile "infofilename" *)
(*                              *)
sqlfopenp (fn, sp5vf_text, sp5vf_read, sp5bk_buffered, fileid, error);
&ifdef TRACE
m90filename (qu, fn);
m90int (qu, 'open infofil', ord(error.sp5fe_result));
m90c40 (qu, error.sp5fe_text);
&endif
IF  error.sp5fe_result = vf_ok
THEN
    BEGIN
    (*                                                         *)
    (* search entries of infofile for "iso_locale"             *)
    (* The entry-layout is:                                    *)
    (*  <iso_locale_str>, <locale_filename>, <longcol_filename> *)
    (*                                                         *)
    i          := 0;
    found_flag := false;
    WHILE (error.sp5fe_result = vf_ok) AND
          (found_flag = false) AND (rc = uni_load_ok) DO
        BEGIN
        sqlfreadp (fileid, buf, sizeof (buf), read_len, error);
        IF  (error.sp5fe_result = vf_ok) AND
            (buf [ 1 ] <> load_comment_char)
        THEN
            BEGIN
            len := read_len;
            sp82_get_token (1, start_pos, toklen, buf, len, is_ok);
            IF  is_ok
            THEN
                BEGIN
                sp82_uppercase (s30gad2(buf), start_pos, toklen);
&               ifdef TRACE
                m90sname (qu, 'INFOFILE    ');
                m90buf   (qu, buf, start_pos, start_pos + toklen - 1);
&               endif
                IF  s30eq (iso_locale_str, buf, start_pos, toklen)
                THEN
                    BEGIN
                    found_flag := true;
                    sp82_get_token (2,  start_pos, toklen, buf, len, is_ok);
                    IF  is_ok
                    THEN
                        BEGIN
                        s10mv (sizeof(buf), sizeof(locale_filename),
                              @buf, start_pos, @locale_filename, 1, toklen);
                        sp82_get_token (3,  start_pos, toklen, buf, len, is_ok);
                        IF  is_ok
                        THEN
                            s10mv (sizeof(buf), sizeof(longcol_filename),
                                  @buf, start_pos, @longcol_filename, 1, toklen)
                        ELSE
                            rc := uni_bad_infofile;
                        (*ENDIF*) 
&                       ifdef TRACE
                        m90c30      (qu, 'Longcol-file:                 ');
                        m90filename (qu, longcol_filename);
&                       endif
                        END
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
                i := succ(i)
                END
            ELSE
                rc := uni_bad_infofile;
            (*ENDIF*) 
            END
        (*ENDIF*) 
        END;
    (*ENDWHILE*) 
    IF  (found_flag = false) AND (rc = uni_load_ok)
    THEN
        rc := uni_encoding_not_found;
    (*ENDIF*) 
    sqlfclosep (fileid, sp5vf_close_normal, error)
    END
ELSE
    rc := uni_cannot_open_infofile
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      sp82_open_localefile (
            VAR filename        : tsp00_VFilename;
            VAR path            : tsp00_C24;
            path_len            : tsp00_Int2;
            VAR fileid          : tsp00_Int4;
            VAR rc              : tsp8_uni_load_error);
 
VAR
      full_filename   : tsp00_VFilename;
      (* sqlfread              *)
      buf             : tsp00_Buf;
      buflen          : tsp00_Longint;
      (* sqlfopen              *)
      error           : tsp05_RteFileError;
 
BEGIN
&ifdef TRACE
m90c30 (qu, '>>>>sp82_open_localefile      ');
&endif
(*                           *)
(* construct PATH/filename   *)
(*                           *)
full_filename := s82blankfilename;
s10mv  (sizeof(path), sizeof(full_filename), @path, 1, @full_filename,
      1, path_len);
s10mv (sizeof(filename), sizeof(full_filename), @filename, 1,
      @full_filename, succ(path_len), 24);
&ifdef TRACE
m90sname    (qu, 'DESCR-fname ');
m90filename (qu,  full_filename);
&endif
(*      *)
(* open *)
(*      *)
sqlfopenp (full_filename, sp5vf_text, sp5vf_read, sp5bk_buffered,
      fileid, error);
&ifdef TRACE
m90int (qu, 'file-id desc', fileid);
m90int (qu, 'open desc rc', ord(error.sp5fe_result));
m90c40 (qu, error.sp5fe_text);
&endif
IF  error.sp5fe_result = vf_ok
THEN
    sqlfreadp (fileid, buf, sizeof (buf), buflen, error)
ELSE
    rc := uni_cannot_open_localefile
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      sp82_read_localefile (
            fileid              : tsp00_Int4;
            VAR buf             : tsp00_Buf;
            VAR buflen          : tsp00_Int4;
            VAR rc              : tsp8_uni_load_error);
 
VAR
      read_len : tsp00_Longint;
      error    : tsp05_RteFileError;
 
BEGIN
&ifdef TRACE
m90c30 (qu, '>>>>sp82_read_localefile      ');
&endif
IF  rc = uni_load_ok
THEN
    BEGIN
    sqlfreadp (fileid, buf, sizeof (buf), read_len, error);
    IF  error.sp5fe_result <> vf_ok
    THEN
        BEGIN
        buflen := 0;
        rc     := uni_file_error_localefile
        END
    ELSE
        buflen := read_len
    (*ENDIF*) 
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      sp82_close_localefile (
            fileid              : tsp00_Int4;
            VAR rc              : tsp8_uni_load_error);
 
VAR
      error : tsp05_RteFileError;
 
BEGIN
&ifdef TRACE
m90c30 (qu, '>>>>sp82_close_localefile     ');
&endif
sqlfclosep (fileid, sp5vf_close_normal, error);
IF  error.sp5fe_result <> vf_ok
THEN
    rc := uni_file_error_localefile
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      sp82_close_longcolfile (
            fileid              : tsp00_Int4;
            VAR rc              : tsp8_uni_load_error);
 
VAR
      error : tsp05_RteFileError;
 
BEGIN
&ifdef TRACE
m90c30 (qu, '>>>>sp82_close_longcolfile:   ');
&endif
sqlfclosep (fileid, sp5vf_close_normal, error);
IF  error.sp5fe_result <> vf_ok
THEN
    rc := uni_file_error_longcolfile
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      sp82_subcode_allocate (
            subcode_ptr         : tsp8_subcodes_ptr;
            subcode_cnt         : tsp00_Int2;
            VAR rc              : tsp8_uni_load_error);
 
VAR
      i            : integer;
      obj_ptr      : tsp00_ObjAddr;
      is_ok        : boolean;
 
BEGIN
&ifdef TRACE
m90c30 (qu, '>>>>sp82_subcode_allocate:    ');
&endif
sqlallocat(subcode_cnt * sizeof(tsp8_subcode), obj_ptr, is_ok);
&ifdef TRACE
m90addr (qu, 'ALLOC SCODE ', obj_ptr);
&endif
IF  is_ok
THEN
    FOR i:=1 TO subcode_cnt DO
        subcode_ptr^ [ i ] :=
              @obj_ptr^ [ (i - 1) * sizeof(tsp8_subcode) + 1]
    (*ENDFOR*) 
ELSE
    rc := uni_memory_alloc_failed
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      sp82_allocate_table (
            VAR mapping_ptr    : tsp8_mapping_table_ptr;
            longcol_len        : tsp00_Int4;
            valuetyp           : tsp8_value_typ;
            valuelen           : tsp00_Int2;
            VAR swap_flag      : boolean;
            VAR rc             : tsp8_uni_load_error);
 
VAR
      obj_ptr      : tsp00_ObjAddr;
      is_ok        : boolean;
 
BEGIN
IF  rc = uni_load_ok
THEN
    BEGIN
&   ifdef TRACE
    m90c30 (qu, '>>>>sp82_allocate_table:      ');
&   endif
    swap_flag := false;
    sqlallocat (sizeof(tsp8_mapping_table), obj_ptr, is_ok);
    IF  is_ok
    THEN
        BEGIN
&       ifdef TRACE
        m90addr (qu, 'ALLOC mappin', obj_ptr);
&       endif
        mapping_ptr := @obj_ptr^ [ 1 ];
        sqlallocat (longcol_len, obj_ptr, is_ok);
        IF  is_ok
        THEN
            BEGIN
&           ifdef TRACE
            m90addr (qu, 'ALLOC longco', obj_ptr);
&           endif
            mapping_ptr^.values    := @obj_ptr^ [ 1 ];
            mapping_ptr^.value_typ := valuetyp;
            mapping_ptr^.value_len := valuelen;
            (*                       *)
            (*  determine swap-kind  *)
            (*                       *)
            mapping_ptr^.indexes^ [ 0 ] := 1;
            IF  mapping_ptr^.values^ [ 0 ] [ 2 ] <> chr(1)
            THEN
                swap_flag := true;
&           ifdef TRACE
            (*ENDIF*) 
            m90int (qu, 'ALLOC MAPTAB', longcol_len);
&           endif
            END
        ELSE
            rc := uni_memory_alloc_failed
        (*ENDIF*) 
        END
    ELSE
        rc := uni_memory_alloc_failed;
    (*ENDIF*) 
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      sp82_anystr_into_int (VAR source_str : tsp00_KnlIdentifier;
            source_len   : integer;
            VAR overflow : boolean) : tsp00_Int4;
 
TYPE
      sign_type = (not_found, no_sign, plus_sign, minus_sign);
      (* it is the same function as i35any_str_into_int       *)
      (* but we did not want to include vin35 into the kernel *)
 
VAR
      sign    : sign_type;
      i       : integer;
      start   : integer;
      digit   : integer;
      number  : real;
      result  : tsp00_Int4;
 
BEGIN
overflow := false;
number := 0.0;
IF  source_len > sizeof (source_str)
THEN
    source_len := sizeof (source_str);
(*ENDIF*) 
start := 1;
sign := not_found;
REPEAT
    CASE source_str [start] OF
        bsp_c1 :
            start := start + 1;
        '-' :
            sign := minus_sign;
        '+' :
            sign := plus_sign;
        '0', '1', '2', '3', '4', '5', '6', '7', '8', '9' :
            sign := no_sign;
        OTHERWISE
            start := source_len + 1;
        END;
    (*ENDCASE*) 
UNTIL
    (start > source_len) OR (sign <> not_found);
(*ENDREPEAT*) 
IF  (sign = minus_sign) OR (sign = plus_sign)
THEN
    start := start + 1;
(*ENDIF*) 
FOR i := start TO source_len DO
    IF  source_str [i] in ['0'..'9']
    THEN
        BEGIN
        digit := ord (source_str [i] ) - ord ('0');
        number := number * 10 + digit;
        END;
    (*ENDIF*) 
(*ENDFOR*) 
IF  number > csp_maxint4
THEN
    BEGIN
    result := csp_maxint4;
    overflow := true;
    END
ELSE
    result := round (number);
(*ENDIF*) 
IF  sign = minus_sign
THEN
    sp82_anystr_into_int := - result
ELSE
    sp82_anystr_into_int := result;
(*ENDIF*) 
END; (* sp82_anystr_into_int *)
 
(*------------------------------*) 
 
PROCEDURE
      sp82_read_encoding (encodings_ptr : tsp8_encodings_ptr;
            encoding_key       : tsp00_Int2;
            VAR buf            : tsp00_Buf;
            len                : tsp00_Int4;
            VAR locale_str     : tsp00_KnlIdentifier;
            VAR scode_cnt1     : tsp00_Int2;
            VAR scode_cnt2     : tsp00_Int2);
 
CONST
      (* encoding-type *)
      cfixed       =
            'FIXED                                                           ';
      cmodal       =
            'MODAL                                                           ';
 
VAR
      i            : integer;
      int          : integer;
      j            : integer;
      c            : char;
      is_ok        : boolean;
      str          : tsp00_KnlIdentifier;
      start_pos    : tsp00_Int2;
      toklen       : tsp00_Int2;
      int4         : tsp00_Int4;
 
BEGIN
&ifdef TRACE
m90c30 (qu, '>>>>sp82_read_encoding:       ');
&endif
WITH encodings_ptr^ [ encoding_key ] DO
    BEGIN
    (* init *)
    SAPDB_PascalForcedFill (sizeof(iso_locale_str), @iso_locale_str, 1,
          sizeof(iso_locale_str),            bsp_c1);
    SAPDB_PascalForcedFill (sizeof(tsp8_descr_string),  @descr,     1,
          sizeof(tsp8_descr_string),  bsp_c1);
    SAPDB_PascalForcedFill (sizeof(tsp8_vendor_string), @vendor,    1,
          sizeof(tsp8_vendor_string), bsp_c1);
    (*** token 1 currently not used ***)
    (*** L O C A L E        ***)
    sp82_get_token (2, start_pos, toklen, buf, len, is_ok);
    s10mv (sizeof(buf), sizeof(iso_locale_str), @buf, start_pos,
          @iso_locale_str, 1, toklen);
    locale_str := iso_locale_str;
    (*** D E S C R          ***)
    sp82_get_token (3,  start_pos, toklen, buf, len, is_ok);
    s10mv (sizeof(buf), sizeof(descr), @buf, start_pos, @descr, 1,
          toklen);
    (*** V E N D O R        ***)
    sp82_get_token (4,  start_pos, toklen, buf, len, is_ok);
    s10mv (sizeof(buf), sizeof(vendor), @buf, start_pos, @vendor, 1,
          toklen);
    (*** T Y P E            ***)
    sp82_get_token (5,  start_pos, toklen, buf, len, is_ok);
    str := cfixed;
    IF  s30eq (str, buf, start_pos, toklen)
    THEN
        typ := uni_fixed
    ELSE
        BEGIN
        str := cmodal;
        IF  s30eq (str, buf, start_pos, toklen)
        THEN
            typ := uni_modal;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    (**)
    (*** S R C- S C O D E - C O U N T ***)
    sp82_get_token (6,  start_pos, toklen, buf, len, is_ok);
    s10mv (sizeof(buf), sizeof(str), @buf, start_pos, @str, 1, toklen);
    scode_cnt1   := sp82_anystr_into_int (str,  toklen, is_ok);
    subcode_cnt1 := scode_cnt1;
    (**)
    (*** D E S T - S C O D E - C O U N T ***)
    sp82_get_token (7,  start_pos, toklen, buf, len, is_ok);
    s10mv (sizeof(buf), sizeof(str), @buf, start_pos, @str, 1, toklen);
    scode_cnt2   := sp82_anystr_into_int (str,  toklen, is_ok);
    subcode_cnt2 := scode_cnt2;
    (*** F I L L C H A R      ***)
    sp82_get_token (8,  start_pos, toklen, buf, len, is_ok);
    s10mv (sizeof(buf), sizeof(str), @buf, start_pos, @str, 1, toklen);
    i := 0;
    WHILE i*2+2 <= toklen DO
        BEGIN
        FOR j := 1 TO 2 DO
            BEGIN
            c := str[ i*2 + j ];
            IF  c >= 'A'
            THEN
                int := ord(c) - ord('A') + 10
            ELSE
                int := ord(c) - ord('0');
            (*ENDIF*) 
            IF  j = 1
            THEN
                fillcharacter[ i+1 ] := chr(int * 16)
            ELSE
                fillcharacter[ i+1 ] := chr(ord(fillcharacter[ i+1 ]) + int);
            (*ENDIF*) 
            END;
        (*ENDFOR*) 
        i := succ(i)
        END;
    (*ENDWHILE*) 
    (*** F C H A R L E N      ***)
    sp82_get_token (9,  start_pos, toklen, buf, len, is_ok);
    s10mv (sizeof(buf), sizeof(str), @buf, start_pos, @str, 1, toklen);
    int4         := sp82_anystr_into_int (str,  toklen, is_ok);
    fillchar_len := int4;
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      sp82_read_subcode (
            subcode_ptr : tsp8_subcode_ptr;
            VAR buf     : tsp00_Buf;
            len         : tsp00_Int4);
 
VAR
      start_pos    : tsp00_Int2;
      toklen       : tsp00_Int2;
      is_ok        : boolean;
 
BEGIN
&ifdef TRACE
m90c30 (qu, '>>>>sp82_read_subcode:        ');
&endif
(* *)
SAPDB_PascalForcedFill (sizeof(tsp8_descr_string), @subcode_ptr^.descr, 1, sizeof(
      tsp8_descr_string), bsp_c1);
(**)
(*** D E S C R     ***)
sp82_get_token (4,  start_pos, toklen, buf, len, is_ok);
s10mv (sizeof(buf), sizeof(tsp8_descr_string), @buf, start_pos,
      @subcode_ptr^.descr, 1, toklen);
(**)
(*** F L A G S     ***)
(* flags are currently not implemented *)
(**)
(*** S U B S P A C E - C N T ***)
subcode_ptr^.subspace_cnt := 0;
END;
 
(*------------------------------*) 
 
PROCEDURE
      sp82_read_subspace (
            subcodes_ptr    : tsp8_subcodes_ptr;
            subcode_cnt     : tsp00_Int2;
            VAR buf         : tsp00_Buf;
            len             : tsp00_Int4;
            VAR max_bytelen : tsp00_Uint1;
            VAR rc          : tsp8_uni_load_error);
 
CONST
      nullbyte = '\00';
 
VAR
      i, k, m      : integer;
      subcode_ptr  : tsp8_subcode_ptr;
      str          : tsp00_KnlIdentifier;
      start_pos    : tsp00_Int2;
      toklen       : tsp00_Int2;
      subcode_match_flag: boolean;
      (* s41pbyte               *)
      tlen         : tsp00_Int4;
      is_ok        : boolean;
 
BEGIN
&ifdef TRACE
m90c30 (qu, '>>>>sp82_read_subspace:       ');
&endif
sp82_get_token (4,  start_pos, toklen, buf, len, is_ok);
(**)
i := 1;
subcode_match_flag := false;
WHILE (i <= subcode_cnt)
      AND (NOT subcode_match_flag) DO
    BEGIN
    subcode_ptr := subcodes_ptr^ [ i ];
    IF  s30eq (subcode_ptr^.descr, buf, start_pos, toklen)
    THEN
        BEGIN
        subcode_match_flag := true;
        subcode_ptr^.subspace_cnt := succ(subcode_ptr^.subspace_cnt);
        WITH subcode_ptr^.subspace[ subcode_ptr^.subspace_cnt ] DO
            BEGIN
            (*** S U B S P A C E ***)
            (* used by NLSLOAD.ins only *)
            (*** S T A R T - I X ***)
            sp82_get_token (6, start_pos, toklen, buf, len, is_ok);
            s10mv (sizeof(buf),sizeof(str), @buf,start_pos,
                  @str, 1, toklen);
            start_ix := sp82_anystr_into_int (str, toklen, is_ok);
            (**)
            (*** E N D - I X     ***)
            sp82_get_token (7, start_pos, toklen, buf, len, is_ok);
            s10mv (sizeof(buf),sizeof(str),@buf,start_pos,
                  @str, 1, toklen);
            end_ix := sp82_anystr_into_int (str, toklen, is_ok);
            (**)
            (*** D I M E N S I O N ***)
            sp82_get_token (8, start_pos, toklen, buf, len, is_ok);
            s10mv (sizeof(buf),sizeof(str),@buf,start_pos,
                  @str,1,toklen);
            dimension := sp82_anystr_into_int (str, toklen, is_ok);
            IF  dimension > max_bytelen
            THEN
                max_bytelen := dimension;
            (*ENDIF*) 
            m := 9;
            FOR k:= 1 TO dimension DO
                BEGIN
                (**)
                (*** B Y T E R A N G E - L O W ***)
                sp82_get_token (m,  start_pos, toklen,
                      buf, len, is_ok);
                IF  toklen > 0
                THEN
                    BEGIN
                    s41pbyte(str, 1, tlen, buf, start_pos, toklen,
                          is_ok);
                    byteranges[ k ].low := str[ 1 ]
                    END
                ELSE
                    byteranges[ k ].low := nullbyte;
                (*ENDIF*) 
                (*** B Y T E R A N G E - H I G H ***)
                sp82_get_token (m+1,  start_pos, toklen, buf, len, is_ok);
                IF  toklen > 0
                THEN
                    BEGIN
                    s41pbyte(str, 1, tlen, buf, start_pos, toklen,
                          is_ok);
                    byteranges[ k ].high := str[ 1 ]
                    END
                ELSE
                    byteranges[ k ].high := nullbyte;
                (*ENDIF*) 
                (*** B Y T E R A N G E - D E L T A ***)
                sp82_get_token (m+2,  start_pos, toklen, buf, len, is_ok);
                IF  toklen > 0
                THEN
                    BEGIN
                    s10mv (sizeof(buf),sizeof(str),@buf,start_pos,@str,1,
                          toklen);
                    byteranges[ k ].delta := sp82_anystr_into_int (str,
                          toklen, is_ok)
                    END
                ELSE
                    byteranges[ k ].delta := 0;
                (*ENDIF*) 
                m := m + 3
                END
            (*ENDFOR*) 
            END
        (*ENDWITH*) 
        END;
    (*ENDIF*) 
    i := succ( i )
    END;
(*ENDWHILE*) 
IF  NOT subcode_match_flag
THEN
    rc := uni_bad_localefile
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      sp82_read_mapping (
            VAR buf           : tsp00_Buf;
            len               : tsp00_Int4;
            VAR longcol_len   : tsp00_Int4;
            VAR longcol_start : tsp00_Int4;
            VAR longcol_end   : tsp00_Int4;
            VAR value_typ     : tsp8_value_typ;
            VAR value_len     : tsp00_Int2;
            VAR rc             : tsp8_uni_load_error);
 
CONST
      cvalue       =
            'VALUE                                                           ';
      cindex       =
            'INDEX                                                           ';
      ascii_minus  = '-';
 
VAR
      i            : integer;
      str          : tsp00_KnlIdentifier;
      str1         : tsp00_KnlIdentifier;
      str2         : tsp00_KnlIdentifier;
      (* get_token *)
      start_pos    : tsp00_Int2;
      toklen       : tsp00_Int2;
      is_ok        : boolean;
 
BEGIN
&ifdef TRACE
m90c30 (qu, '>>>>sp82_read_mapping:        ');
&endif
(*** T Y P E ***)
sp82_get_token  (4,  start_pos, toklen, buf, len, is_ok);
str1 := cvalue;
str2 := cindex;
IF  s30eq (str1, buf, start_pos, toklen)
THEN
    value_typ := uni_value
ELSE
    IF  s30eq (str2, buf, start_pos, toklen)
    THEN
        value_typ := uni_index
    ELSE
        rc := uni_bad_localefile;
    (*ENDIF*) 
(*ENDIF*) 
(*** V A L U E - L E N ***)
sp82_get_token  (5,  start_pos, toklen, buf, len, is_ok);
s10mv (sizeof(buf), sizeof(str), @buf, start_pos, @str, 1, toklen);
value_len := sp82_anystr_into_int (str,  toklen, is_ok);
(**)
(*** T A B - L E N ***)
sp82_get_token  (6,  start_pos, toklen, buf, len, is_ok);
s10mv (sizeof(buf), sizeof(str), @buf, start_pos, @str, 1, toklen);
longcol_len := sp82_anystr_into_int (str, toklen, is_ok);
(**)
(*** L O N G C O L-file ***)
sp82_get_token (7, start_pos, toklen, buf, len, is_ok);
IF  (buf [ start_pos ]   = '-') AND
    (buf [ start_pos+1 ] = '>')
THEN
    BEGIN
    start_pos := start_pos + 2;
    toklen    := toklen - 2;
    END;
(*ENDIF*) 
i := start_pos;
WHILE (buf [ i ] <> ascii_minus) AND (i < start_pos + toklen) DO
    i := succ(i);
(*ENDWHILE*) 
IF  buf [ i ] = ascii_minus
THEN
    BEGIN
    s10mv (sizeof(buf), sizeof(str), @buf, start_pos, @str, 1,
          i - start_pos);
    longcol_start := sp82_anystr_into_int (str, i - start_pos, is_ok);
    s10mv (sizeof(buf), sizeof(str), @buf, succ(i), @str, 1,
          start_pos + toklen - i - 1);
    longcol_end   := sp82_anystr_into_int (str,
          start_pos + toklen - i - 1, is_ok);
&   ifdef TRACE
    m90int (qu, 'longcolstart', longcol_start);
    m90int (qu, 'longcolend  ', longcol_end);
&   endif
    END
ELSE
    rc := uni_bad_localefile
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      sp82_open_longcolfile (
            VAR filename        : tsp00_VFilename;
            VAR path            : tsp00_C24;
            path_len            : tsp00_Int2;
            VAR fileid          : tsp00_Int4;
            VAR rc              : tsp8_uni_load_error);
 
VAR
      str           : tsp00_C24;
      full_filename : tsp00_VFilename;
      error         : tsp05_RteFileError;
 
BEGIN
&ifdef TRACE
m90c30 (qu, '>>>>sp82_open_longcolfile     ');
&endif
(*                           *)
(* construct PATH/filename   *)
(*                           *)
str           := path;
full_filename := s82blankfilename;
s10mv  (sizeof(path), sizeof(full_filename), @path, 1, @full_filename,
      1, path_len);
s10mv (sizeof(filename), sizeof(full_filename), @filename, 1,
      @full_filename, succ(path_len), 24);
sqlfopenp (full_filename, sp5vf_binary, sp5vf_read, sp5bk_unbuffered,
      fileid, error);
&ifdef TRACE
m90filename (qu, full_filename);
m90int (qu, 'open lcol rc', ord(error.sp5fe_result));
m90c40 (qu, error.sp5fe_text);
&endif
IF  error.sp5fe_result <> vf_ok
THEN
    rc := uni_cannot_open_longcolfile
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      sp82_read_longcolfile (
            VAR filename      : tsp00_VFilename;
            VAR path          : tsp00_C24;
            path_len          : tsp00_Int2;
            VAR mapping1      : tsp8_mapping_table_ptr;
            VAR mapping2      : tsp8_mapping_table_ptr;
            src_lcol_len      : tsp00_Int4;
            src_lcol_end      : tsp00_Int4;
            src_value_typ     : tsp8_value_typ;
            src_value_len     : tsp00_Int2;
            dest_lcol_len     : tsp00_Int4;
            dest_lcol_start   : tsp00_Int4;
            dest_value_typ    : tsp8_value_typ;
            dest_value_len    : tsp00_Int2;
            VAR rc            : tsp8_uni_load_error);
 
VAR
      i               : tsp00_Int4;
      filled_len      : tsp00_Int4;
      src_filled_len  : tsp00_Int4;
      dest_filled_len : tsp00_Int4;
      x               : char;
      fileid          : tsp00_Int4;
      src_swap_flag   : boolean;
      dest_swap_flag  : boolean;
      src_overlap     : integer;
      dest_overlap    : integer;
      buf             : tsp00_Buf;
      read_len        : tsp00_Longint;
      buflen          : tsp00_Int4;
      error           : tsp05_RteFileError;
 
BEGIN
&ifdef TRACE
m90c30 (qu, '>>>>sp82_read_localefile      ');
&endif
sp82_open_longcolfile (filename, path, path_len, fileid, rc);
IF  rc = uni_load_ok
THEN
    BEGIN
    sp82_allocate_table (mapping1,
          src_lcol_len, src_value_typ, src_value_len, src_swap_flag,
          rc);
    IF  rc = uni_load_ok
    THEN
        BEGIN
        sp82_allocate_table (mapping2,
              dest_lcol_len, dest_value_typ, dest_value_len, dest_swap_flag,
              rc);
        error.sp5fe_result := vf_ok;
        filled_len         := 0;
        src_filled_len     := 0;
        dest_filled_len    := 0;
        WHILE (error.sp5fe_result = vf_ok) AND (rc = uni_load_ok) DO
            BEGIN
            sqlfreadp (fileid, buf, sizeof (buf), read_len, error);
            IF  error.sp5fe_result <> vf_eof
            THEN
                BEGIN
                buflen := read_len;
                IF  filled_len + buflen <= src_lcol_end
                THEN
                    BEGIN
                    s10mv (sizeof(buf), src_lcol_len,
                          @buf, 1,
                          @mapping1^.values^, src_filled_len + 1,
                          buflen);
&                   ifdef TRACE
                    m90int (qu, 'src fillfrom', filled_len);
                    m90int (qu, 'filling len ', buflen);
&                   endif
                    src_filled_len := src_filled_len + buflen
                    END
                ELSE
                    IF  filled_len >= dest_lcol_start
                    THEN
                        BEGIN
                        s10mv (sizeof(buf), dest_lcol_len,
                              @buf, 1,
                              @mapping2^.values^, dest_filled_len + 1,
                              buflen);
                        dest_filled_len := dest_filled_len + buflen;
&                       ifdef TRACE
                        m90int (qu, 'destfillfrom', filled_len);
                        m90int (qu, 'filling len ', buflen);
&                       endif
                        END
                    ELSE
                        BEGIN
                        (* "buf" overlaps *)
                        src_overlap := src_lcol_end - filled_len;
                        s10mv (sizeof(buf), src_lcol_len,
                              @buf, 1,
                              @mapping1^.values^, src_filled_len + 1,
                              src_overlap);
                        src_filled_len := src_filled_len + src_overlap;
&                       ifdef TRACE
                        m90int (qu, 'src ovl from', filled_len + 1);
                        m90int (qu, 'filling len ', src_overlap);
&                       endif
                        dest_overlap := buflen - src_overlap;
                        s10mv (sizeof(buf), dest_lcol_len,
                              @buf, src_overlap + 1,
                              @mapping2^.values^, dest_filled_len + 1,
                              dest_overlap);
&                       ifdef TRACE
                        m90int (qu, 'destovl from', src_overlap + 1);
                        m90int (qu, 'filling len ', dest_overlap);
&                       endif
                        dest_filled_len := dest_filled_len + dest_overlap
                        END;
                    (*ENDIF*) 
                (*ENDIF*) 
                filled_len := filled_len + buflen
                END;
            (*ENDIF*) 
            END;
        (*ENDWHILE*) 
        IF  (mapping1^.value_typ = uni_index) AND (src_swap_flag)
        THEN
            BEGIN
            src_filled_len := src_filled_len DIV 2 - 1;
            FOR i := 0 TO src_filled_len DO
                BEGIN
                x                         := mapping1^.values^ [i] [1];
                mapping1^.values^ [i] [1] := mapping1^.values^ [i] [2];
                mapping1^.values^ [i] [2] := x
                END
            (*ENDFOR*) 
            END;
        (*ENDIF*) 
        IF  (mapping2^.value_typ = uni_index) AND (dest_swap_flag)
        THEN
            BEGIN
            dest_filled_len := dest_filled_len DIV 2 - 1;
            FOR i := 0 TO dest_filled_len DO
                BEGIN
                x                         := mapping2^.values^ [i] [1];
                mapping2^.values^ [i] [1] := mapping2^.values^ [i] [2];
                mapping2^.values^ [i] [2] := x
                END
            (*ENDFOR*) 
            END
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    sp82_close_longcolfile (fileid, rc)
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      sp82_uppercase (
            str : tsp00_MoveObjPtr;
            start   : tsp00_Int2;
            num     : tsp00_Int2);
 
VAR
      i     : integer;
 
BEGIN
FOR i:= start TO start + num - 1 DO
    IF  str^ [ i ] in [ 'a'..'z' ]
    THEN
        str^ [ i ] := chr(ord(str^ [ i ]) - (ord('a')-ord('A')));
    (*ENDIF*) 
(*ENDFOR*) 
END;
 
(*****************************************************)
(* Locate string number "number" in "buf". "buf" is  *)
(* expected to be delimited by ','. If found         *)
(* return position in "start_pos" and length in      *)
(* "len". Otherwise return "len" = 0                 *)
(*****************************************************)
(*------------------------------*) 
 
PROCEDURE
      sp82_get_token (number : tsp00_Int2;
            VAR start_pos  : tsp00_Int2;
            VAR len        : tsp00_Int2;
            buf            : tsp00_Buf;
            buflen         : tsp00_Int2;
            VAR is_ok      : boolean);
 
CONST
      delim = ',';
      space = ' ';
 
VAR
      i, pos : tsp00_Int2;
 
BEGIN
is_ok := true;
i := 1;
pos := 1;
start_pos := 1;
WHILE (i <= number) AND (pos < buflen) DO
    BEGIN
    IF  i > 1
    THEN
        BEGIN
        pos := succ(pos);
        start_pos := pos
        END;
    (*ENDIF*) 
    WHILE (buf [ pos ] <> delim) AND (pos < buflen) DO
        pos := succ(pos);
    (*ENDWHILE*) 
    i := succ(i);
    END;
(*ENDWHILE*) 
IF  i <= number (* wanted number not found *)
THEN
    len := 0
ELSE
    BEGIN
    IF  pos < buflen
    THEN
        (* token in the middle *)
        pos := pred (pos);
    (*ENDIF*) 
    WHILE (buf [ start_pos ] = space) AND (start_pos < pos) DO
        start_pos := succ (start_pos);
    (*ENDWHILE*) 
    WHILE (buf [ pos       ] = space) AND (pos > start_pos) DO
        pos       := pred (pos);
    (*ENDWHILE*) 
    len := pos - start_pos + 1
    END;
(*ENDIF*) 
IF  len > 0
THEN
    BEGIN
&   ifdef TRACE
    m90buf (qu, buf, start_pos, start_pos + len - 1);
&   endif
    IF  len > 120
    THEN
        is_ok := false;
    (*ENDIF*) 
    END
ELSE
    BEGIN
    is_ok := false;
&   ifdef TRACE
    m90c30 (qu, 'get_tok field empty           ');
&   endif
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      s82uni_free (VAR encodings_ptr : tsp8_encodings_ptr;
            VAR encoding_cnt   : tsp00_Int2;
            VAR rc             : tsp8_uni_load_error);
 
VAR
      obj_ptr           : tsp00_ObjAddr;
 
BEGIN
&ifdef TRACE
m90c30 (qu, 's82uni_free:------------------');
&endif
rc := uni_load_ok;
IF  encoding_cnt > 0
THEN
    WITH encodings_ptr^ [ encoding_cnt ] DO
        BEGIN
        (*********************************)
        (* remove subcode arrays         *)
        (*********************************)
        obj_ptr := @(subcode1 [ 1 ]^);
&       ifdef TRACE
        m90addr (qu, 'FREE scode 1', obj_ptr);
&       endif
        sqlfree (obj_ptr);
        obj_ptr := @(subcode2 [ 1 ]^);
&       ifdef TRACE
        m90addr (qu, 'FREE scode 2', obj_ptr);
&       endif
        sqlfree (obj_ptr);
        (**************************************)
        (* remove mapping tables and longcols *)
        (**************************************)
        obj_ptr := @(mapping1^.values^);
&       ifdef TRACE
        m90addr (qu, 'FREE values1', obj_ptr);
&       endif
        sqlfree (obj_ptr);
        obj_ptr := @mapping1^;
&       ifdef TRACE
        m90addr (qu, 'FREE map   1', obj_ptr);
&       endif
        sqlfree (obj_ptr);
        obj_ptr := @(mapping2^.values^);
&       ifdef TRACE
        m90addr (qu, 'FREE values2', obj_ptr);
&       endif
        sqlfree (obj_ptr);
        obj_ptr := @mapping2^;
&       ifdef TRACE
        m90addr (qu, 'FREE map   2', obj_ptr);
&       endif
        sqlfree (obj_ptr);
        IF  encoding_cnt = 1
        THEN
            BEGIN
            (***************************************)
            (* remove entire encoding record array *)
            (***************************************)
            obj_ptr := @encodings_ptr^;
&           ifdef TRACE
            m90addr (qu, 'FREE encodin', obj_ptr);
&           endif
            sqlfree (obj_ptr)
            END;
        (*ENDIF*) 
        encoding_cnt := pred ( encoding_cnt)
        END
    (*ENDWITH*) 
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      s82uni_load_error (
            rc      : tsp8_uni_load_error;
            VAR msg : tsp00_C40);
 
BEGIN
CASE rc OF
    uni_load_ok:
        msg := 'uni_fload: OK                           ';
    uni_encoding_not_found:
        msg := 'uni_fload: encoding not found           ';
    uni_no_dblang_found:
        msg := 'uni_fload: DBLANG not set               ';
    uni_cannot_open_infofile:
        msg := 'uni_fload: cant open infofile           ';
    uni_cannot_open_localefile:
        msg := 'uni_fload: cant open localefile         ';
    uni_cannot_open_longcolfile:
        msg := 'uni_fload: cant open longcolfile        ';
    uni_file_error_localefile:
        msg := 'uni_fload: file error localefile        ';
    uni_file_error_longcolfile:
        msg := 'uni_fload: file error longcolfile       ';
    uni_memory_alloc_failed:
        msg := 'uni_fload: memory alloc failed          ';
    uni_encoding_already_loaded:
        msg := 'uni_fload: encoding already loaded      ';
    uni_bad_localefile:
        msg := 'uni_fload: bad localefile               ';
    uni_bad_infofile:
        msg := 'uni_fload: bad infofile                 ';
    OTHERWISE
        msg := 'uni_fload: Unknown uni_load_error       '
    END
(*ENDCASE*) 
END;
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
.PA 
