.mv2CM  SCRIPT , Version - 1.1 , last edited by B.Morgeneyer
.ad 8
.bm 8
.fm 4
.bt $Copyright by SAP AG, 2002$$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
 
 
    ========== licence begin LGPL
    Copyright (C) 2000 SAP AG
 
    This library is free software; you can redistribute it and/or
    modify it under the terms of the GNU Lesser General Public
    License as published by the Free Software Foundation; either
    version 2.1 of the License, or (at your option) any later version.
 
    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
    Lesser General Public License for more details.
 
    You should have received a copy of the GNU Lesser General Public
    License along with this library; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
    ========== licence end
 
.fo
.nf
.sp
Module  : RTE-Extension-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   : tsp_int2;
                    read_dblang_flag   : boolean;
                    VAR iso_locale_str : tsp_knl_identifier;
                    VAR codeset        : tsp_int2;
                    VAR rc             : tsp8_uni_load_error);
 
        PROCEDURE
              s82uni_free (VAR encodings_ptr : tsp8_encodings_ptr;
                    VAR encoding_cnt   : tsp_int2;
                    VAR rc             : tsp8_uni_load_error);
 
        PROCEDURE
              s82uni_load_error (
                    rc      : tsp8_uni_load_error;
                    VAR msg : tsp_c40);
 
.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :
 
        FROM
              RTE_driver : VEN102;
 
        PROCEDURE
              sqlgetenv
                    (VAR envname   : tsp_vfilename;
                    VAR envvalue   : tsp_vfilename;
                    VAR envfound   : boolean);
 
        PROCEDURE
              sqlallocat
                    (length       : tsp_int4;
                    VAR p         : tsp_objaddr;
                    VAR ok        : boolean);
 
        PROCEDURE
              sqlfree
                    (p            : tsp_objaddr);
 
        PROCEDURE
              sqlfopenp (
                    VAR fname   : tsp_vfilename;
                    datakind    : tsp5_rte_datakind;
                    filemode    : tsp5_rte_filemode;
                    buffering   : tsp5_rte_buffering_kind;
                    VAR fhandle : tsp_int4;
                    VAR err     : tsp5_rte_fileerror);
 
        PROCEDURE
              sqlfreadp (
                    fhandle    : tsp_int4;
                    VAR buf    : tsp_buf;
                    bufsize    : tsp_longint;
                    VAR outlen : tsp_longint;
                    VAR err    : tsp5_rte_fileerror);
 
        PROCEDURE
              sqlfclosep (
                    fhandle : tsp_int4;
                    option  : tsp5_rte_closeoption;
                    VAR err : tsp5_rte_fileerror);
 
      ------------------------------ 
 
        FROM
              RTE-Extension-10 : VSP10;
 
        PROCEDURE
              s10fil1 (size  : tsp_int4;
                    VAR m   : tsp_knl_identifier;
                    pos     : tsp_int4;
                    len     : tsp_int4;
                    fillchar: char);
 
        PROCEDURE
              s10fil2 (size  : tsp_int4;
                    VAR m   : tsp8_descr_string;
                    pos     : tsp_int4;
                    len     : tsp_int4;
                    fillchar: char);
 
        PROCEDURE
              s10fil3 (size  : tsp_int4;
                    VAR m   : tsp8_vendor_string;
                    pos     : tsp_int4;
                    len     : tsp_int4;
                    fillchar: char);
 
        PROCEDURE
              s10mv (source_upb : tsp_int4;       destin_upb : tsp_int4;
                    VAR source  : tsp_c24;        source_pos : tsp_int4;
                    VAR destin  : tsp_vfilename;  destin_pos : tsp_int4;
                    length      : tsp_int4);
 
        PROCEDURE
              s10mv1(source_upb : tsp_int4;       destin_upb : tsp_int4;
                    VAR source  : tsp_buf;        source_pos : tsp_int4;
                    VAR destin  : tsp_knl_identifier;destin_pos : tsp_int4;
                    length      : tsp_int4);
 
        PROCEDURE
              s10mv2(source_upb : tsp_int4;       destin_upb : tsp_int4;
                    VAR source  : tsp_buf;        source_pos : tsp_int4;
                    VAR destin  : tsp8_descr_string;  destin_pos : tsp_int4;
                    length      : tsp_int4);
 
        PROCEDURE
              s10mv3(source_upb : tsp_int4;       destin_upb : tsp_int4;
                    VAR source  : tsp_buf;        source_pos : tsp_int4;
                    VAR destin  : tsp8_vendor_string; destin_pos : tsp_int4;
                    length      : tsp_int4);
 
        PROCEDURE
              s10mv4 (source_upb : tsp_int4;       destin_upb : tsp_int4;
                    VAR source  : tsp_vfilename;   source_pos : tsp_int4;
                    VAR destin  : tsp_knl_identifier;destin_pos : tsp_int4;
                    length      : tsp_int4);
 
        PROCEDURE
              s10mv5 (source_upb : tsp_int4;       destin_upb : tsp_int4;
                    VAR source  : tsp_buf;         source_pos : tsp_int4;
                    VAR destin  : tsp_vfilename;   destin_pos : tsp_int4;
                    length      : tsp_int4);
 
        PROCEDURE
              s10mv6 (source_upb : tsp_int4;       destin_upb : tsp_int4;
                    VAR source  : tsp_vfilename;  source_pos : tsp_int4;
                    VAR destin  : tsp_vfilename;  destin_pos : tsp_int4;
                    length      : tsp_int4);
 
        PROCEDURE
              s10mv7 (source_upb : tsp_int4;       destin_upb : tsp_int4;
                    VAR source  : tsp_buf;        source_pos : tsp_int4;
                    VAR destin  : tsp8_mapvalues; destin_pos : tsp_int4;
                    length      : tsp_int4);
 
      ------------------------------ 
 
        FROM
              RTE-Extension-30 : VSP30;
 
        FUNCTION
              s30gad1 (VAR b : tsp_knl_identifier) : tsp_moveobj_ptr;
 
        FUNCTION
              s30gad2 (VAR b : tsp_buf) : tsp_moveobj_ptr;
 
        FUNCTION
              s30eq (VAR a : tsp_knl_identifier;
                    VAR b  : tsp_buf;
                    b_pos  : tsp_int4;
                    length : tsp_int4) : boolean;
 
      ------------------------------ 
 
        FROM
              PUT-Conversions : VSP41;
 
        PROCEDURE
              s41pbyte (
                    VAR buf   : tsp_knl_identifier;
                    pos       : tsp_int4;
                    VAR len   : integer;
                    VAR source: tsp_buf;
                    spos      : tsp_int4;
                    slen      : integer;
                    VAR invalid : boolean);
&       ifdef TRACE
 
      ------------------------------ 
 
        FROM
              Test_Procedures : VMT90;
 
        PROCEDURE
              m90sname (
                    layer : tsp_layer;
                    nam   : tsp_sname);
 
        PROCEDURE
              m90filename (
                    layer : tsp_layer;
                    fn    : tsp_vfilename);
 
        PROCEDURE
              m90addr (
                    layer : tsp_layer;
                    nam   : tsp_sname;
                    bufaddr : tsp_objaddr);
 
        PROCEDURE
              m90buf (
                    layer   : tsp_layer;
                    VAR buf : tsp_buf;
                    pos_anf : integer;
                    pos_end : integer);
 
        PROCEDURE
              m90c30 (
                    layer   : tsp_layer;
                    str30   : tsp_c30);
 
        PROCEDURE
              m90c40 (
                    layer   : tsp_layer;
                    str30   : tsp_errtext);
 
        PROCEDURE
              m90int (
                    layer : tsp_layer;
                    nam   : tsp_sname;
                    int   : integer);
 
        PROCEDURE
              m90str (
                    layer   : tsp_layer;
                    VAR str : tsp_knl_identifier;
                    pos_anf : integer;
                    pos_end : integer);
&       endif
 
.CM *-END-* use -----------------------------------------
.sp;.cp 3
Synonym :
 
        PROCEDURE
              sqlgetenv;
 
              tsp00_VFilename tsp_vfilename;
 
        PROCEDURE
              sqlallocat;
 
              tsp00_Int4    tsp_int4
              tsp00_ObjAddr tsp_objaddr
 
        PROCEDURE
              sqlfopenp;
 
              tsp00_VFilename tsp_vfilename;
              tsp00_Int4      tsp_int4
 
        PROCEDURE
              sqlfreadp;
 
              tsp00_Int4    tsp_int4
              tsp00_MoveObj tsp_buf
              tsp00_Longint tsp_longint
 
        PROCEDURE
              sqlfree;
 
              tsp00_BufAddr tsp_objaddr;
 
        PROCEDURE
              sqlfclosep;
 
              tsp00_Int4 tsp_int4
 
        PROCEDURE
              s10fil1;
 
              tsp_moveobj tsp_knl_identifier
 
        PROCEDURE
              s10fil2;
 
              tsp_moveobj tsp8_descr_string
 
        PROCEDURE
              s10fil3;
 
              tsp_moveobj tsp8_vendor_string
 
        PROCEDURE
              s10mv;
 
              tsp_moveobj tsp_c24
              tsp_moveobj tsp_vfilename
 
        PROCEDURE
              s10mv1;
 
              tsp_moveobj tsp_buf
              tsp_moveobj tsp_knl_identifier
 
        PROCEDURE
              s10mv2;
 
              tsp_moveobj tsp_buf
              tsp_moveobj tsp8_descr_string
 
        PROCEDURE
              s10mv3;
 
              tsp_moveobj tsp_buf
              tsp_moveobj tsp8_vendor_string
 
        PROCEDURE
              s10mv4;
 
              tsp_moveobj          tsp_vfilename
              tsp_moveobj          tsp_knl_identifier
 
        PROCEDURE
              s10mv5;
 
              tsp_moveobj tsp_buf
              tsp_moveobj tsp_vfilename
 
        PROCEDURE
              s10mv6;
 
              tsp_moveobj tsp_vfilename
              tsp_moveobj tsp_vfilename
 
        PROCEDURE
              s10mv7;
 
              tsp_moveobj tsp_buf
              tsp_moveobj tsp8_mapvalues
 
        FUNCTION
              s30gad1;
 
              tsp_moveobj tsp_knl_identifier
              tsp_addr tsp_moveobj_ptr
 
        FUNCTION
              s30gad2;
 
              tsp_moveobj tsp_buf
              tsp_addr tsp_moveobj_ptr
 
        PROCEDURE
              s30eq;
 
              tsp_moveobj tsp_knl_identifier
              tsp_moveobj tsp_buf
 
        PROCEDURE
              s41pbyte;
 
              tsp_moveobj tsp_knl_identifier;
              tsp_moveobj tsp_buf;
 
        PROCEDURE
              m90c40;
 
              tsp_c40 tsp_errtext
 
        PROCEDURE
              m90str;
 
              tsp_buf tsp_knl_identifier;
 
        PROCEDURE
              m90addr;
 
              tsp_bufaddr tsp_objaddr;
 
.CM *-END-* synonym -------------------------------------
.sp;.cp 3
Author  :
.sp
.cp 3
Created : 1995-08-14
.sp
.cp 3
Version : 2002-03-14
.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 : tsp_vfilename;
 
 
(*------------------------------*) 
 
PROCEDURE
      s82uni_fload (VAR encodings_ptr : tsp8_encodings_ptr;
            VAR encoding_cnt   : tsp_int2;
            read_dblang_flag   : boolean;
            VAR iso_locale_str : tsp_knl_identifier;
            VAR codeset        : tsp_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           : tsp_knl_identifier;
      i, k              : integer;
      is_ok             : boolean;
      pathstr           : tsp_c24;
      infofilenamestr   : tsp_c24;
      locale_filename   : tsp_vfilename;
      lcol_filename     : tsp_vfilename;
      locale_fileid     : tsp_int4;
      localefile_open_flag : boolean;
      encoding_key      : tsp_int2;
      obj_ptr           : tsp_objaddr;
      src_locale_str    : tsp_knl_identifier;
      subcode_cnt1      : tsp_int2;
      src_lcol_len      : tsp_int4;
      src_lcol_start    : tsp_int4;
      src_lcol_end      : tsp_int4;
      src_value_typ     : tsp8_value_typ;
      src_value_len     : tsp_int2;
      subcode_cnt2      : tsp_int2;
      dest_lcol_len     : tsp_int4;
      dest_lcol_start   : tsp_int4;
      dest_lcol_end     : tsp_int4;
      dest_value_typ    : tsp8_value_typ;
      dest_value_len    : tsp_int2;
      start_pos         : tsp_int2;
      toklen            : tsp_int2;
      buf               : tsp_buf;
      len               : tsp_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        : tsp_knl_identifier;
            VAR rc         : tsp8_uni_load_error);
 
CONST
      dbl_str     = 'DBLANG                  ';
 
VAR
      env_name        : tsp_vfilename;
      env_value       : tsp_vfilename;
      env_found       : boolean;
      cstr            : tsp_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
        s10mv4 (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       : tsp_knl_identifier;
            VAR infofilename         : tsp_c24;
            VAR path                 : tsp_c24;
            path_len                 : tsp_int2;
            VAR locale_filename       : tsp_vfilename;
            VAR longcol_filename     : tsp_vfilename;
            VAR rc                   : tsp8_uni_load_error);
 
CONST
      load_comment_char = '/';
 
VAR
      i               : integer;
      found_flag      : boolean;
      (* get_token             *)
      buf             : tsp_buf;
      read_len        : tsp_longint;
      len             : tsp_int4;
      start_pos       : tsp_int2;
      toklen          : tsp_int2;
      is_ok           : boolean;
      (* sqlfopen              *)
      fn              : tsp_vfilename;
      fileid          : tsp_int4;
      error           : tsp5_rte_fileerror;
 
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
                        s10mv5 (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
                            s10mv5 (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        : tsp_vfilename;
            VAR path            : tsp_c24;
            path_len            : tsp_int2;
            VAR fileid          : tsp_int4;
            VAR rc              : tsp8_uni_load_error);
 
VAR
      full_filename   : tsp_vfilename;
      (* sqlfread              *)
      buf             : tsp_buf;
      buflen          : tsp_longint;
      (* sqlfopen              *)
      error           : tsp5_rte_fileerror;
 
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);
s10mv6 (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              : tsp_int4;
            VAR buf             : tsp_buf;
            VAR buflen          : tsp_int4;
            VAR rc              : tsp8_uni_load_error);
 
VAR
      read_len : tsp_longint;
      error    : tsp5_rte_fileerror;
 
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              : tsp_int4;
            VAR rc              : tsp8_uni_load_error);
 
VAR
      error : tsp5_rte_fileerror;
 
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              : tsp_int4;
            VAR rc              : tsp8_uni_load_error);
 
VAR
      error : tsp5_rte_fileerror;
 
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         : tsp_int2;
            VAR rc              : tsp8_uni_load_error);
 
VAR
      i            : integer;
      obj_ptr      : tsp_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        : tsp_int4;
            valuetyp           : tsp8_value_typ;
            valuelen           : tsp_int2;
            VAR swap_flag      : boolean;
            VAR rc             : tsp8_uni_load_error);
 
VAR
      obj_ptr      : tsp_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 : tsp_knl_identifier;
            source_len   : integer;
            VAR overflow : boolean) : tsp_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  : tsp_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       : tsp_int2;
            VAR buf            : tsp_buf;
            len                : tsp_int4;
            VAR locale_str     : tsp_knl_identifier;
            VAR scode_cnt1     : tsp_int2;
            VAR scode_cnt2     : tsp_int2);
 
CONST
      (* encoding-type *)
      cfixed       =
            'FIXED                                                           ';
      cmodal       =
            'MODAL                                                           ';
 
VAR
      i            : integer;
      int          : integer;
      j            : integer;
      c            : char;
      is_ok        : boolean;
      str          : tsp_knl_identifier;
      start_pos    : tsp_int2;
      toklen       : tsp_int2;
      int4         : tsp_int4;
 
BEGIN
&ifdef TRACE
m90c30 (qu, '>>>>sp82_read_encoding:       ');
&endif
WITH encodings_ptr^ [ encoding_key ] DO
    BEGIN
    (* init *)
    s10fil1 (sizeof(iso_locale_str), iso_locale_str, 1,
          sizeof(iso_locale_str),            bsp_c1);
    s10fil2 (sizeof(tsp8_descr_string),  descr,     1,
          sizeof(tsp8_descr_string),  bsp_c1);
    s10fil3 (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);
    s10mv1 (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);
    s10mv2 (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);
    s10mv3 (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);
    s10mv1 (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);
    s10mv1 (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);
    s10mv1 (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);
    s10mv1 (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     : tsp_buf;
            len         : tsp_int4);
 
VAR
      start_pos    : tsp_int2;
      toklen       : tsp_int2;
      is_ok        : boolean;
 
BEGIN
&ifdef TRACE
m90c30 (qu, '>>>>sp82_read_subcode:        ');
&endif
(* *)
s10fil1 (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);
s10mv1 (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     : tsp_int2;
            VAR buf         : tsp_buf;
            len             : tsp_int4;
            VAR max_bytelen : tsp_int1;
            VAR rc          : tsp8_uni_load_error);
 
CONST
      nullbyte = '\00';
 
VAR
      i, k, m      : integer;
      subcode_ptr  : tsp8_subcode_ptr;
      str          : tsp_knl_identifier;
      start_pos    : tsp_int2;
      toklen       : tsp_int2;
      subcode_match_flag: boolean;
      (* s41pbyte               *)
      tlen         : tsp_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);
            s10mv1 (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);
            s10mv1 (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);
            s10mv1 (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
                    s10mv1 (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           : tsp_buf;
            len               : tsp_int4;
            VAR longcol_len   : tsp_int4;
            VAR longcol_start : tsp_int4;
            VAR longcol_end   : tsp_int4;
            VAR value_typ     : tsp8_value_typ;
            VAR value_len     : tsp_int2;
            VAR rc             : tsp8_uni_load_error);
 
CONST
      cvalue       =
            'VALUE                                                           ';
      cindex       =
            'INDEX                                                           ';
      ascii_minus  = '-';
 
VAR
      i            : integer;
      str          : tsp_knl_identifier;
      str1         : tsp_knl_identifier;
      str2         : tsp_knl_identifier;
      (* get_token *)
      start_pos    : tsp_int2;
      toklen       : tsp_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);
s10mv1 (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);
s10mv1 (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
    s10mv1 (sizeof(buf), sizeof(str), buf, start_pos, str, 1,
          i - start_pos);
    longcol_start := sp82_anystr_into_int (str, i - start_pos, is_ok);
    s10mv1 (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        : tsp_vfilename;
            VAR path            : tsp_c24;
            path_len            : tsp_int2;
            VAR fileid          : tsp_int4;
            VAR rc              : tsp8_uni_load_error);
 
VAR
      str           : tsp_c24;
      full_filename : tsp_vfilename;
      error         : tsp5_rte_fileerror;
 
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);
s10mv6 (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      : tsp_vfilename;
            VAR path          : tsp_c24;
            path_len          : tsp_int2;
            VAR mapping1      : tsp8_mapping_table_ptr;
            VAR mapping2      : tsp8_mapping_table_ptr;
            src_lcol_len      : tsp_int4;
            src_lcol_end      : tsp_int4;
            src_value_typ     : tsp8_value_typ;
            src_value_len     : tsp_int2;
            dest_lcol_len     : tsp_int4;
            dest_lcol_start   : tsp_int4;
            dest_value_typ    : tsp8_value_typ;
            dest_value_len    : tsp_int2;
            VAR rc            : tsp8_uni_load_error);
 
VAR
      i               : tsp_int4;
      filled_len      : tsp_int4;
      src_filled_len  : tsp_int4;
      dest_filled_len : tsp_int4;
      x               : char;
      fileid          : tsp_int4;
      src_swap_flag   : boolean;
      dest_swap_flag  : boolean;
      src_overlap     : integer;
      dest_overlap    : integer;
      buf             : tsp_buf;
      read_len        : tsp_longint;
      buflen          : tsp_int4;
      error           : tsp5_rte_fileerror;
 
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
                    s10mv7 (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
                        s10mv7 (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;
                        s10mv7 (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;
                        s10mv7 (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 : tsp_moveobj_ptr;
            start   : tsp_int2;
            num     : tsp_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 : tsp_int2;
            VAR start_pos  : tsp_int2;
            VAR len        : tsp_int2;
            buf            : tsp_buf;
            buflen         : tsp_int2;
            VAR is_ok      : boolean);
 
CONST
      delim = ',';
      space = ' ';
 
VAR
      i, pos : tsp_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   : tsp_int2;
            VAR rc             : tsp8_uni_load_error);
 
VAR
      obj_ptr           : tsp_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 : tsp_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 
***********************************************************
*-PRETTY-*  statements    :        477
*-PRETTY-*  lines of code :       1611        PRETTYX 3.10 
*-PRETTY-*  lines in file :       2081         1997-12-10 
.PA 
