.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$VAK07$
.tt 2 $$$
.TT 3 $ElkeZ$AK_error_handling$2000-11-21$
***********************************************************
.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
.nf
.sp
MODULE  : AK_error_handling
=========
.sp
Purpose : Schreibt Fehlermeldungen in error Puffer.
.CM *-END-* purpose -------------------------------------
.sp
.cp 3
Define  :
 
        PROCEDURE
              a07ClientLayoutParam (
                    VAR acv    : tak_all_command_glob;
                    param_no   : integer;
                    param_addr : tsp00_MoveObjPtr;
                    param_len  : integer);
 
        PROCEDURE
              a07_const_b_put_error (
                    VAR acv    : tak_all_command_glob;
                    b_err      : tgg00_BasisError;
                    err_code   : tsp00_Int4;
                    param_addr : tsp00_MoveObjPtr;
                    const_len  : integer);
 
        PROCEDURE
              a07_error (
                    VAR acv  : tak_all_command_glob;
                    err      : tgg00_BasisError;
                    VAR nod1 : tsp00_Int2;
                    VAR nod2 : tsp00_Int2);
 
        PROCEDURE
              a07_b_put_error (
                    VAR acv  : tak_all_command_glob;
                    b_err    : tgg00_BasisError;
                    err_code : tsp00_Int4);
 
        PROCEDURE
              a07_kw_put_error (
                    VAR acv  : tak_all_command_glob;
                    b_err    : tgg00_BasisError;
                    err_code : tsp00_Int4;
                    kw       : integer);
 
        PROCEDURE
              a07_nb_put_error (
                    VAR acv  : tak_all_command_glob;
                    b_err    : tgg00_BasisError;
                    err_code : tsp00_Int4;
                    VAR n    : tsp00_KnlIdentifier);
 
        PROCEDURE
              a07_sb_put_error (
                    VAR acv  : tak_all_command_glob;
                    b_err    : tgg00_BasisError;
                    err_code : tsp00_Int4;
                    VAR err  : tgg04_Err);
 
        PROCEDURE
              a07_tb_put_error (
                    VAR acv     : tak_all_command_glob;
                    b_err       : tgg00_BasisError;
                    err_code    : tsp00_Int4;
                    VAR tab_id  : tgg00_Surrogate);
 
        PROCEDURE
              a07_intern_error_put (VAR acv : tak_all_command_glob);
 
        PROCEDURE
              a07ak_system_error (
                    VAR acv  : tak_all_command_glob;
                    modul_no : integer;
                    id       : integer);
 
        PROCEDURE
              a07const_param (
                    VAR acv    : tak_all_command_glob;
                    param_no   : integer;
                    param_addr : tsp00_MoveObjPtr;
                    param_len  : integer);
 
        PROCEDURE
              a07msg_kernelsink_get (
                    VAR acv        : tak_all_command_glob;
                    msgno          : tsp00_Int2;
                    VAR err_text   : tak_order_errortext;
                    VAR msglen     : integer);
 
        PROCEDURE
              a07_uni_error (
                    VAR acv  : tak_all_command_glob;
                    uni_err  : tsp8_uni_error;
                    err_code : tsp00_Int4);
 
        PROCEDURE
              a07_hex_uni_error (
                    VAR acv     : tak_all_command_glob;
                    uni_err     : tsp8_uni_error;
                    err_code    : tsp00_Int4;
                    to_unicode  : boolean;
                    bytestr     : tsp00_MoveObjPtr;
                    len         : tsp00_Int4 );
 
        PROCEDURE
              a07parm3_put_error (
                    VAR acv     : tak_all_command_glob;
                    b_err       : tgg00_BasisError;
                    err_code    : tsp00_Int4;
                    VAR param1  : tsp00_KnlIdentifier;
                    VAR param2  : tsp00_KnlIdentifier;
                    VAR param3  : tsp00_KnlIdentifier);
 
        PROCEDURE
              a07put_error_pos (
                    VAR acv : tak_all_command_glob;
                    err_pos : tsp00_Int4);
 
.CM *-END-* define --------------------------------------
.sp
.cp 3
Use     :
 
        FROM
              Scanner : VAK01;
 
        VAR
              a01char_size       : integer;
              a01sysnullkey      : tgg00_SysInfoKey;
              a01defaultkey      : tgg00_SysInfoKey;
              a01kw              : tak_keywordtab;
              a01_il_b_identifier : tsp00_KnlIdentifier;
 
        PROCEDURE
              a01_next_symbol (VAR acv : tak_all_command_glob);
 
      ------------------------------ 
 
        FROM
              AK_universal_semantic_tools : VAK06;
 
        PROCEDURE
              a06determine_username (
                    VAR acv       : tak_all_command_glob;
                    VAR userid    : tgg00_Surrogate;
                    VAR user_name : tsp00_KnlIdentifier);
 
        PROCEDURE
              a06_get_priv  (
                    VAR acv     : tak_all_command_glob;
                    VAR brec    : tak_sysbufferaddress;
                    VAR priv    : tak_privilege);
 
        PROCEDURE
              a06_systable_get (
                    VAR acv     : tak_all_command_glob;
                    dstate      : tak_directory_state;
                    VAR tableid : tgg00_Surrogate;
                    VAR base_ptr: tak_sysbufferaddress;
                    get_all     : boolean;
                    VAR ok      : boolean);
 
        PROCEDURE
              a06retpart_move (
                    VAR acv     : tak_all_command_glob;
                    moveobj_ptr : tsp00_MoveObjPtr;
                    move_len    : tsp00_Int4);
 
        PROCEDURE
              a06reset_retpart (VAR acv : tak_all_command_glob);
 
        PROCEDURE
              a06finish_curr_retpart (
                    VAR acv   : tak_all_command_glob;
                    part_kind : tsp1_part_kind;
                    arg_count : tsp00_Int2);
 
      ------------------------------ 
 
        FROM
              AK_Identifier_Handling : VAK061;
 
        PROCEDURE
              a061get_colname (
                    VAR col_info : tak00_columninfo;
                    VAR colname  : tsp00_KnlIdentifier);
 
      ------------------------------ 
 
        FROM
              AK_error_handling : VAK071;
 
        FUNCTION
              a07_return_code (
                    b_err   : tgg00_BasisError;
                    sqlmode : tsp00_SqlMode) : tsp00_Int2;
 
        PROCEDURE
              a071_getmessagetext (
                    msgno          : tsp00_Int2;
                    VAR msgbuf     : tsp00_MoveObj;
                    VAR msglen     : tsp00_Int2;
                    VAR found      : boolean);
 
      ------------------------------ 
 
        FROM
              Systeminfo_cache : VAK10;
 
        PROCEDURE
              a10get_sysinfo (
                    VAR acv    : tak_all_command_glob;
                    VAR syskey : tgg00_SysInfoKey;
                    dstate     : tak_directory_state;
                    VAR syspoint : tak_sysbufferaddress;
                    VAR b_err    : tgg00_BasisError);
 
      ------------------------------ 
 
        FROM
              AK_Table : VAK11;
 
        PROCEDURE
              a11getconstraintname (
                    VAR constraint_rec  : tak_constraintrecord;
                    VAR constraint_name : tsp00_KnlIdentifier);
 
      ------------------------------ 
 
        FROM
              AK_Index : VAK24;
 
        PROCEDURE
              a24get_indexname (
                    VAR acv        : tak_all_command_glob;
                    indexbuf       : tak_sysbufferaddress;
                    index          : integer;
                    VAR index_name : tsp00_KnlIdentifier);
 
        PROCEDURE
              a24init_index_scan (
                    VAR acv            : tak_all_command_glob;
                    VAR tabid          : tgg00_Surrogate;
                    VAR index_scan_rec : tak_index_scan_record);
 
        PROCEDURE
              a24finish_index_scan (
                    VAR acv            : tak_all_command_glob;
                    VAR index_scan_rec : tak_index_scan_record);
 
        FUNCTION
              a24next_named_index (
                    VAR acv            : tak_all_command_glob;
                    VAR index_scan_rec : tak_index_scan_record) : boolean;
 
      ------------------------------ 
 
        FROM
              AK_distributor : VAK35;
 
        PROCEDURE
              a35_asql_statement (VAR acv : tak_all_command_glob);
 
      ------------------------------ 
 
        FROM
              AK_Connect : VAK51;
 
        PROCEDURE
              a51session_init (VAR acv : tak_all_command_glob);
 
        PROCEDURE
              a51get_date_format (
                    VAR acv       : tak_all_command_glob;
                    VAR format    : tsp00_C120;
                    has_to_be_uni : boolean);
 
      ------------------------------ 
 
        FROM
              DML_Help_Procedures : VAK542;
 
        PROCEDURE
              a542internal_packet (
                    VAR acv                 : tak_all_command_glob;
                    release_internal_packet : boolean;
                    required_len            : tsp00_Int4);
 
        PROCEDURE
              a542pop_packet (VAR acv : tak_all_command_glob);
 
      ------------------------------ 
 
        FROM
              KB_locklist : VKB51;
 
        PROCEDURE
              k51del_transentry_from_locklist (
                    TaskId         : tsp00_TaskId;
                    VAR TransIndex : tgg00_TransIndex);
 
        PROCEDURE
              k51remove_locks (
                    TaskId            : tsp00_TaskId;
                    TransIndex        : tgg00_TransIndex;
                    VAR TransState    : tgg00_TransState);
 
        FUNCTION
              k51shutdown_wanted (TaskId : tsp00_TaskId) : boolean;
 
      ------------------------------ 
 
        FROM
              error_text_handling : VBD06;
 
        PROCEDURE
              b06get_errtxt (
                    VAR t          : tgg00_TransContext;
                    VAR errlen     : integer;
                    VAR err_type   : tgg00_ErrorText;
                    VAR b_error    : tgg00_BasisError;
                    VAR errtxt     : tsp00_C256);
 
      ------------------------------ 
 
        FROM
              Configuration_Parameter : VGG01;
 
        VAR
              g01unicode        : boolean;
 
        PROCEDURE
              g01optextmsg (
                    msg_prio  : tsp3_priority;
                    msg_type  : tsp3_msg_type;
                    msg_no    : tsp00_Int4;
                    msg_label : tsp00_C8;
                    msg_text  : tsp00_C40);
 
      ------------------------------ 
 
        FROM
              GG_edit_routines : VGG17;
 
        PROCEDURE
              g17hexto_line (
                    c          : char;
                    VAR ln_len : integer;
                    VAR ln     : tsp00_KnlIdentifier);
 
        PROCEDURE
              g17int4to_line (
                    int       : tsp00_Int4;
                    with_zero : boolean;
                    int_len   : integer;
                    ln_pos    : integer;
                    VAR ln    : tsp00_C40);
 
      ------------------------------ 
 
        FROM
              Unicode-Utilities : VGG20;
 
        PROCEDURE
              g20unifill (
                    size      : tsp00_Int4;
                    m         : tsp00_MoveObjPtr;
                    pos       : tsp00_Int4;
                    len       : tsp00_Int4;
                    filluchar : tsp00_C2);
 
      ------------------------------ 
 
        FROM
              Kernel_move_and_fill : VGG101;
 
        PROCEDURE
              SAPDB_PascalFill (
                    mod_id      : tsp00_C6;
                    mod_num     : tsp00_Int4;
                    obj_upb     : tsp00_Int4;
                    obj         : tsp00_MoveObjPtr;
                    obj_pos     : tsp00_Int4;
                    length      : tsp00_Int4;
                    fillchar    : char;
                    VAR e       : tgg00_BasisError);
 
        PROCEDURE
              SAPDB_PascalUnicodeFill (
                    mod_id      : tsp00_C6;
                    mod_num     : tsp00_Int4;
                    obj_upb     : tsp00_Int4;
                    obj         : tsp00_MoveObjPtr;
                    obj_pos     : tsp00_Int4;
                    length      : tsp00_Int4;
                    fillchar    : tsp00_C2;
                    VAR e       : tgg00_BasisError);
 
        PROCEDURE
              SAPDB_PascalForcedUnicodeFill (
                    obj_upb     : tsp00_Int4;
                    obj         : tsp00_MoveObjPtr;
                    obj_pos     : tsp00_Int4;
                    length      : tsp00_Int4;
                    fillchar    : tsp00_C2 );
 
        PROCEDURE
              SAPDB_PascalMove (
                    mod_id      : tsp00_C6;
                    mod_num     : tsp00_Int4;
                    source_upb  : tsp00_Int4;
                    dest_upb    : tsp00_Int4;
                    source      : tsp00_MoveObjPtr;
                    src_pos     : tsp00_Int4;
                    destin      : tsp00_MoveObjPtr;
                    dest_pos    : tsp00_Int4;
                    length      : tsp00_Int4;
                    VAR e       : tgg00_BasisError);
 
        PROCEDURE
              SAPDB_PascalOverlappingMove (
                    mod_id      : tsp00_C6;
                    mod_num     : tsp00_Int4;
                    source_upb  : tsp00_Int4;
                    dest_upb    : tsp00_Int4;
                    source      : tsp00_MoveObjPtr;
                    src_pos     : tsp00_Int4;
                    destin      : tsp00_MoveObjPtr;
                    dest_pos    : tsp00_Int4;
                    length      : tsp00_Int4;
                    VAR e       : tgg00_BasisError);
 
        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
              SAPDB_PascalForcedOverlappingMove (
                    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
              g10mv (
                    mod_id      : tsp00_C6;            
                    mod_num     : tsp00_Int4;
                    source_upb  : tsp00_Int4;          
                    dest_upb    : tsp00_Int4;
                    source      : tsp00_MoveObjPtr;       
                    src_pos     : tsp00_Int4;
                    destin      : tsp00_MoveObjPtr;       
                    dest_pos    : tsp00_Int4;
                    length      : tsp00_Int4;
                    VAR e       : tgg00_BasisError);
 
        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
              KernelAdministration_Interface : VGG999;
 
        FUNCTION
              gg999KernelStateIsOnline : boolean;
 
      ------------------------------ 
 
        FROM
              RTE-Extension-30 : VSP30;
 
        FUNCTION
              s30lnr (
                    VAR str : tsp00_KnlIdentifier;
                    val   : char;
                    start : tsp00_Int4;
                    cnt   : tsp00_Int4) : tsp00_Int4;
 
        FUNCTION
              s30unilnr (
                    str       : tsp00_MoveObjPtr;
                    skip_val  : tsp00_C2;
                    start_pos : tsp00_Int4;
                    length    : tsp00_Int4) : tsp00_Int4;
 
      ------------------------------ 
 
        FROM
              GET-Conversions : VSP40;
 
        PROCEDURE
              s40gbyte (
                    VAR buf        : tgg00_Syskey;
                    pos            : tsp00_Int4;
                    len            : integer;
                    VAR dest       : tsp00_C120;
                    dpos           : tsp00_Int4;
                    dlen           : integer;
                    VAR truncated  : boolean);
 
      ------------------------------ 
 
        FROM
              RTE-Extension-80 : VSP80;
 
        PROCEDURE
              s80uni_trans
                    (src_ptr        : tsp00_MoveObjPtr;
                    src_len         : tsp00_Int4;
                    src_codeset     : tsp00_Int2;
                    dest_ptr        : tsp00_MoveObjPtr;
                    VAR dest_len    : tsp00_Int4;
                    dest_codeset    : tsp00_Int2;
                    trans_options   : tsp8_uni_opt_set;
                    VAR rc          : tsp8_uni_error;
                    VAR err_char_no : tsp00_Int4);
 
      ------------------------------ 
 
        FROM
              RTE_kernel : VEN101;
 
        PROCEDURE
              vabort (write_core : boolean);
 
        PROCEDURE
              vmessage (
                    prio         : tsp3_priority;
                    msg_type     : tsp3_msg_type;
                    msg_no       : tsp00_Int4;
                    msg_label    : tsp00_C8;
                    VAR msg_line : tsp00_C40);
 
        PROCEDURE
              vmessageUnicode(source_encoding : tsp00_Int4;
                    prio         : tsp3_priority;
                    msg_type     : tsp3_msg_type;
                    msg_no       : tsp00_Int4;
                    msg_label    : tsp00_C8;
                    VAR msg_line : tsp00_C80);
 
        PROCEDURE
              vsleep (pid : tsp00_TaskId;
                    limit : tsp00_Int2);
&       ifdef trace
 
      ------------------------------ 
 
        FROM
              Test_Procedures : VTA01;
 
        PROCEDURE
              t01basis_error (
                    debug : tgg00_Debug;
                    nam   : tsp00_Sname;
                    b_err : tgg00_BasisError);
 
        PROCEDURE
              t01int4 (
                    debug    : tgg00_Debug;
                    nam      : tsp00_Sname;
                    int      : tsp00_Int4);
 
        PROCEDURE
              t01name (
                    debug    : tgg00_Debug;
                    nam      : tak_keyword);
 
        PROCEDURE
              t01moveobj (
                    debug       : tgg00_Debug;
                    VAR moveobj : tsp00_MoveObj;
                    startpos    : tsp00_Int4;
                    endpos      : tsp00_Int4);
&       endif
 
.CM *-END-* use -----------------------------------------
***********************************************************
 
Synonym :
 
        PROCEDURE
              s40gbyte;
 
              tsp00_MoveObj tgg00_Syskey
              tsp00_MoveObj tsp00_C120
 
        PROCEDURE
              g17int4to_line;
 
              tsp00_Line tsp00_C40
 
        PROCEDURE
              g17hexto_line;
 
              tsp00_Line tsp00_KnlIdentifier
 
        FUNCTION
              s30lnr;
 
              tsp00_MoveObj tsp00_KnlIdentifier
&             ifdef TRACE
 
        PROCEDURE
              t01name;
 
              tsp00_Name tak_keyword
&             endif
 
.CM *-END-* synonym -------------------------------------
.sp;.cp 3
Author  : ElkeZ
.sp
.cp 3
Created : 1987-09-22
.sp
.cp 3
.sp
.cp 3
Release :      Date : 2000-11-08
.sp
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Specification:
 
 
.CM *-END-* specification -------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Description:
 
Das Modul geht von folgender Annahme aus :
.nf
create table public.sysmessages
    (language  char  (3)   key,
     msgno     fixed (5,0) key,
     msgtext   char  (160))
 
6.2 change requests and errors included here:
 
CR 1000053 UH
 
.CM *-END-* description ---------------------------------
***********************************************************
.CM -lll-
Code    :
 
 
CONST
      c_with_zero         = true  (* g17 *);
 
 
(*------------------------------*) 
 
PROCEDURE
      a07ClientLayoutParam (
            VAR acv    : tak_all_command_glob;
            param_no   : integer;
            param_addr : tsp00_MoveObjPtr;
            param_len  : integer);
 
VAR
      ix    : integer;
      jx    : integer;
      c80   : tsp00_C80;
      b_err : tgg00_BasisError;
 
BEGIN
(* parameter is already in client layout *)
IF  acv.a_out_packet^.sp1_header.sp1h_mess_code = csp_unicode_swap
THEN
    BEGIN
    (* transform to kernel internal format, required for following parameter handling *)
    IF  param_len > sizeof (c80)
    THEN
        param_len := sizeof (c80);
    (*ENDIF*) 
    param_len := param_len DIV 2;
    jx := 1;
    FOR ix := 1 TO param_len DO
        BEGIN
        c80[jx  ] := param_addr^[jx+1];
        c80[jx+1] := param_addr^[jx];
        jx := jx + 2
        END;
    (*ENDFOR*) 
    param_len := param_len*2
    END
ELSE
    BEGIN
    IF  param_len > sizeof (c80)
    THEN
        param_len := sizeof (c80);
    (*ENDIF*) 
    b_err := e_ok;
    g10mv ('VAK07 ',   1,    
          param_len, sizeof (c80), @param_addr^, 1, @c80, 1,
          param_len, b_err)
    END;
(*ENDIF*) 
ak07put_param (acv, param_no, @c80, param_len)
END;
 
(*------------------------------*) 
 
PROCEDURE
      a07_const_b_put_error (
            VAR acv    : tak_all_command_glob;
            b_err      : tgg00_BasisError;
            err_code   : tsp00_Int4;
            param_addr : tsp00_MoveObjPtr;
            const_len  : integer);
 
BEGIN
WITH acv DO
    IF  acv.a_returncode = 0
    THEN
        BEGIN
&       ifdef trace
        t01basis_error (td_always, 'throw error ', b_err);
&       endif
        IF  b_err = e_cancelled
        THEN
            acv.a_transinf.tri_trans.trRteCommPtr_gg00^.to_cancel:= false;
        (*ENDIF*) 
        acv.a_returncode :=
              a07_return_code (b_err, acv.a_sqlmode);
        a07put_error_pos (acv, err_code);
        a07const_param   (acv, 1, param_addr, const_len)
        END;
    (*ENDIF*) 
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a07_error (
            VAR acv  : tak_all_command_glob;
            err      : tgg00_BasisError;
            VAR nod1 : tsp00_Int2;
            VAR nod2 : tsp00_Int2);
 
BEGIN
WITH  acv, a_scv DO
    BEGIN
    (*initialize nodes*)
    nod1 := 0;
    nod2 := 0;
    IF  a_returncode = 0
    THEN
        BEGIN
        IF  (sc_symb = s_eof           ) AND
            (err <> e_wanted_keyword   ) AND
            (err <> e_missing_delimiter) AND
            (err <> e_expr_in_insert_value_list)
        THEN
            err := e_invalid_end_of_command;
        (*ENDIF*) 
        a07_b_put_error (acv, err, sc_sypos);
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a07msg_kernelsink_get (
            VAR acv        : tak_all_command_glob;
            msgno          : tsp00_Int2;
            VAR err_text   : tak_order_errortext;
            VAR msglen     : integer);
 
VAR
      found        : boolean;
      errlen       : tsp00_Int2;
      b_err        : tgg00_BasisError;
      e            : tsp8_uni_error;
      err_char_no  : tsp00_Int4;
      char_size    : integer;
 
BEGIN
msglen := 0;
WITH acv DO
    IF  a_in_packet <> NIL
    THEN (* may be nil in case of remote dbfunc call *)
        BEGIN
        IF  a_out_packet^.sp1_header.sp1h_mess_code = csp_unicode
        THEN
            char_size := 2
        ELSE
            char_size := 1;
        (*ENDIF*) 
        a071_getmessagetext (msgno, a_mblock.mb_data^.mbp_buf, errlen, found);
        IF  found
        THEN
            BEGIN
            b_err := e_ok;
            IF  a_out_packet^.sp1_header.sp1h_mess_code = csp_ascii
            THEN
                BEGIN
                msglen := errlen;
                g10mv ('VAK07 ',   2,    
                      a_mblock.mb_data_size, sizeof (err_text),
                      @a_mblock.mb_data^.mbp_buf, 1, @err_text, 1,
                      msglen, b_err)
                END
            ELSE
                BEGIN
                msglen := sizeof (err_text);
                s80uni_trans (@a_mblock.mb_data^.mbp_buf[ 1 ], errlen,
                      csp_ascii, @err_text, msglen,
                      a_out_packet^.sp1_header.sp1h_mess_code, [ ],
                      e, err_char_no);
                END;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a07_b_put_error (
            VAR acv  : tak_all_command_glob;
            b_err    : tgg00_BasisError;
            err_code : tsp00_Int4);
 
VAR
      errlen       : integer;
      kw           : integer;
      format_buf   : tsp00_C120;
 
      err       : RECORD
            CASE boolean OF
                true :
                    (error_no : tsp00_Int2);
                false :
                    (errtext  : tsp00_C256);
                END;
            (*ENDCASE*) 
 
 
BEGIN
WITH acv DO
    IF  a_returncode = 0
    THEN
        BEGIN
&       ifdef trace
        t01basis_error (td_always, 'throw error ', b_err);
&       endif
        IF  b_err = e_cancelled
        THEN
            a_transinf.tri_trans.trRteCommPtr_gg00^.to_cancel:= false
                  (* PTS 1120377 E.Z. *)
        ELSE
            IF  b_err = e_unknown_user_password_pair
            THEN
                vsleep (a_transinf.tri_trans.trTaskId_gg00, 1);
            (*ENDIF*) 
        (*ENDIF*) 
        a_returncode := a07_return_code ( b_err, a_sqlmode);
        IF  (a_returncode = cak_e_table_or_file_dropped)
            AND
            (acv.a_init_ex_kind = only_executing)
        THEN
            a_returncode :=
                  a07_return_code (e_old_fileversion, a_sqlmode);
        (*ENDIF*) 
        a07put_error_pos (acv, err_code);
        a_err_parm_cnt  := 0;
        IF  (b_err = e_invalid_date) OR
            (b_err = e_invalid_time) OR
            (b_err = e_invalid_timestamp)
        THEN
            BEGIN
            kw := cak_i_no_keyword;
            CASE a_dt_format OF
                dtf_normal :
                    kw := cak_i_internal;
                dtf_iso    :
                    kw := cak_i_iso;
                dtf_usa    :
                    kw := cak_i_usa;
                dtf_eur, dtf_ts_eur :
                    kw := cak_i_eur;
                dtf_jis    :
                    kw := cak_i_jis;
                dtf_oracle_date :
                    BEGIN
                    a51get_date_format (acv, format_buf, g01unicode);
                    errlen := (mxsp_c50-csp_attr_byte) * a01char_size;
                    ak07put_param (acv, 1, @format_buf[ 2 ], errlen)
                    END;
                (* PTS 1112472 E.Z. *)
                OTHERWISE
                END;
            (*ENDCASE*) 
            IF  kw <> cak_i_no_keyword
            THEN
                a07const_param (acv,
                      1, @a01kw[kw], sizeof (a01kw[kw]))
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        a_ak_b_err := b_err
        END;
    (*ENDIF*) 
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak07modul_to_text (
            modul_pos    : tsp00_Int4;
            VAR modulstr : tsp00_C10);
 
VAR
      modul_nr     : integer;
      pos_in_modul : integer;
      modul_nr_wid : integer;
      j            : integer;
 
BEGIN
modulstr     := bsp_c10;
modul_nr     := modul_pos DIV 10;
pos_in_modul := modul_pos MOD 10;
modulstr [1] := ':';
modulstr [2] := ' ';
modulstr [3] := 'V';
modulstr [4] := 'A';
modulstr [5] := 'K';
IF  modul_nr > 99
THEN
    modul_nr_wid := 3
ELSE
    modul_nr_wid := 2;
(*ENDIF*) 
j := modul_nr_wid;
WHILE (j > 0) DO
    BEGIN
    modulstr [ 5 + j ] := chr (modul_nr MOD 10 + ord ('0'));
    modul_nr := modul_nr DIV 10;
    j  := pred(j)
    END;
(*ENDWHILE*) 
modulstr [6 + modul_nr_wid] := bsp_c1;
modulstr [7 + modul_nr_wid] := chr (pos_in_modul + ord ('0'));
END;
 
(*------------------------------*) 
 
PROCEDURE
      a07_intern_error_put (VAR acv : tak_all_command_glob);
 
CONST
      system_error_len = 14;
 
VAR
      found               : boolean;
      truncated           : boolean;
      b_error             : tgg00_BasisError;
      move_err            : tgg00_BasisError;
      etexttype           : tgg00_ErrorText;
      aux_ret_code        : tsp00_Int2;
      aux_err_code        : tsp00_Int4;
      errorlen            : tsp00_Int2;
      errlen              : integer;
      i                   : integer;
      ix                  : integer;
      pos                 : integer;
      msglen              : integer;
      textlen             : integer;
      hnamelen            : integer;
      move_len            : integer;
      s30                 : tsp00_C30;
      err_text            : tak_order_errortext;
      e                   : tsp8_uni_error;
      err_char_no         : tsp00_Int4;
      char_size           : integer;
      modulstr            : tsp00_C10;
      err                 : tgg04_Err;
      err_p               : ^tsp00_C256;
      msg_line            : tsp00_C40;
      (* PTS 1107617 E.Z. *)
      msg_uni             : tsp00_C80;
      help_session        : tsp00_C4;
 
      syskey_hex          : RECORD
            CASE boolean OF
                true :
                    (c120 : tsp00_C120);
                false :
                    (c40array : ARRAY[1..3] OF tsp00_C40);
                END;
            (*ENDCASE*) 
 
      m_trBdTcachePtr_gg00: tgg00_TempDataCachePtr;
 
BEGIN
WITH acv DO
    BEGIN
    IF  a_out_packet^.sp1_header.sp1h_mess_code in
        [ csp_unicode, csp_unicode_swap ]
    THEN
        char_size := 2
    ELSE
        char_size := 1;
    (*ENDIF*) 
    move_err         := e_ok;
    a_retpart_locked := false;
    a06reset_retpart (acv);
    IF  (a_returncode = 100)        AND
        (a_len_row_not_found_text > 0) AND
        (a_session_mess_code = a_mess_code)
    THEN
        a06retpart_move (acv, @a_row_not_found_text,
              a_len_row_not_found_text)
    ELSE
        BEGIN
        IF  (a_returncode =
            a07_return_code (e_unknown_tablename, a_sqlmode)) AND
            (warn10_some_serverdbs_down in
            a_transinf.tri_trans.trWarning_gg00)
        THEN
            a_returncode := -8043
        ELSE
            IF  ((a_sqlmode = sqlm_oracle)
                AND
                (a_returncode =
                a07_return_code (e_duplicate_invkey, a_sqlmode))
                AND
                ((a_return_segm^.sp1r_function_code = csp1_alter_table_fc) OR
                ( a_return_segm^.sp1r_function_code = csp1_create_index_fc)))
            THEN
                a_returncode := -1452
            ELSE
                (* PTS 1116801 E.Z. *)
                IF  a_returncode = cak00_old_parsid
                THEN
                    a_returncode := csp_old_fileversion;
                (*ENDIF*) 
            (*ENDIF*) 
        (*ENDIF*) 
        msglen := 0;
        a071_getmessagetext (a_returncode, a_mblock.mb_data^.mbp_buf, errorlen, found);
        errlen := errorlen;
        IF  found
        THEN
            BEGIN
            move_err := e_ok;
            IF  a_out_packet^.sp1_header.sp1h_mess_code = csp_ascii
            THEN
                BEGIN
                msglen := errlen;
                g10mv ('VAK07 ',   3,    
                      a_mblock.mb_data_size, sizeof (err_text),
                      @a_mblock.mb_data^.mbp_buf, 1, @err_text, 1,
                      msglen, move_err)
                END
            ELSE
                BEGIN
                msglen := sizeof (err_text);
                s80uni_trans (@a_mblock.mb_data^.mbp_buf[ 1 ], errlen,
                      csp_ascii, @err_text, msglen,
                      a_out_packet^.sp1_header.sp1h_mess_code, [ ],
                      e, err_char_no);
                END;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        IF  a_err_parm_cnt > 0
        THEN
            ak07substitute_parameters (acv,
                  char_size, err_text, msglen)
        ELSE
            IF  tsErrTextExist_egg00 in a_transinf.tri_trans.trState_gg00
            THEN
                BEGIN
                (*IF  (a_returncode = cak_e_kb_net_line_down) OR
                      (a_returncode = cak_e_kb_ansi_net_line_down) OR
                      (a_returncode = 650)
                      THEN
                      b_error := e_work_rolled_back
                      ELSE*)
                b_error := a_ak_b_err;
                err_p := @err;
                b06get_errtxt (a_transinf.tri_trans, errlen,
                      etexttype, b_error, err_p^);
                a_transinf.tri_trans.trState_gg00 :=
                      a_transinf.tri_trans.trState_gg00 - [ tsErrTextExist_egg00 ];
                IF  ((a_transinf.tri_trans.trError_gg00 = e_ok) AND (errlen > 0))
                THEN
                    BEGIN
                    (* Find valid return code (ref.b06put_errtxt) *)
                    aux_ret_code    := a_returncode;
                    aux_err_code    := a_errorpos;
                    a_returncode := 0;
                    (* error_code := 1; by a07_b_put_error *)
                    a07_b_put_error (acv, b_error, 1);
                    IF  ((aux_ret_code = a_returncode) OR
                        ( aux_ret_code = -912)) (* kb_net_line_down *)
                    THEN
                        BEGIN
                        a_returncode := aux_ret_code;
                        a_errorpos   := aux_err_code
                        END;
                    (* Now process error text : *)
                    (*ENDIF*) 
                    IF  (a_returncode <> 100)
                    THEN
                        CASE etexttype OF
                            errtext_char :
                                BEGIN
                                textlen := sizeof (err_text) - msglen - 2;
                                IF  textlen > 0
                                THEN
                                    BEGIN
                                    IF  char_size = 2
                                    THEN
                                        BEGIN
                                        (* Funktioniert nur wenn err.errt *)
                                        (* immer ASCII ist !!             *)
                                        IF  a_out_packet^.sp1_header.sp1h_mess_code = csp_unicode
                                        THEN
                                            BEGIN
                                            err_text[msglen+1] := csp_unicode_mark;
                                            err_text[msglen+2] := ',';
                                            END
                                        ELSE
                                            BEGIN
                                            err_text[msglen+2] := csp_unicode_mark;
                                            err_text[msglen+1] := ',';
                                            END;
                                        (*ENDIF*) 
                                        msglen := msglen + 2;
                                        s80uni_trans (@err.errt, errlen, csp_ascii,
                                              @err_text [msglen +1], textlen,
                                              a_out_packet^.sp1_header.sp1h_mess_code, [ ],
                                              e, err_char_no);
                                        msglen := msglen + textlen;
                                        END
                                    ELSE
                                        BEGIN
                                        IF  textlen > errlen
                                        THEN
                                            textlen:= errlen;
                                        (*ENDIF*) 
                                        err_text[msglen+1] := ',';
                                        msglen := msglen + 1;
                                        g10mv ('VAK07 ',   4,    
                                              sizeof (err.errt),
                                              sizeof (err_text),
                                              @err.errt, 1, @err_text, msglen + 1,
                                              textlen, move_err);
                                        msglen := msglen + textlen;
                                        END;
                                    (*ENDIF*) 
                                    END;
                                (*ENDIF*) 
                                END;
                            errtext_surrogate,
                            errtext_stack :
                                BEGIN
                                (* PTS 1110096 E.Z. *)
                                IF  (a_returncode = a07_return_code (
                                    e_sequence_overflow, a_sqlmode))
                                    OR
                                    (a_returncode = a07_return_code (
                                    e_currval_without_nextval, a_sqlmode))
                                THEN
                                    ak07get_sequence_name (acv, err)
                                ELSE
                                    ak07err_col_index_name (acv, err,
                                          etexttype);
                                (*ENDIF*) 
                                IF  a_err_parm_cnt > 0
                                THEN
                                    ak07substitute_parameters (acv,
                                          char_size, err_text, msglen)
                                (*ENDIF*) 
                                END;
                            END
                        (*ENDCASE*) 
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
                END
            ELSE
                IF  (a_returncode =
                    a07_return_code (e_wanted_keyword, a_sqlmode))
                    AND
                    (a_err_parm_cnt = 0)
                THEN
                    ak07find_keywords (acv, err_text, msglen);
                (*ENDIF*) 
            (*ENDIF*) 
        (*ENDIF*) 
        IF  (a_returncode =
            a07_return_code (e_ak_system_error, a_sqlmode))
        THEN
            BEGIN
            ak07modul_to_text (a_errorpos, modulstr);
            a_errorpos := 1;
            IF  char_size = 2
            THEN
                BEGIN
                hnamelen := sizeof(err_text) - msglen;
                s80uni_trans (@modulstr, sizeof(modulstr), csp_ascii,
                      @err_text [msglen + 1], hnamelen,
                      a_out_packet^.sp1_header.sp1h_mess_code,
                      [ ], e, err_char_no);
                msglen := msglen + hnamelen;
                END
            ELSE
                BEGIN
                g10mv ('VAK07 ',   5,    
                      sizeof (modulstr), sizeof (err_text),
                      @modulstr, 1, @err_text, msglen + 1,
                      sizeof (modulstr), move_err);
                msglen := msglen + sizeof (modulstr);
                END;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        IF  (a_returncode =
            a07_return_code (e_sysinfo_not_found, a_sqlmode))
            OR
            (a_returncode =
            a07_return_code (e_duplicate_sysinfo, a_sqlmode))
        THEN
            BEGIN
            s40gbyte (a_error_key_ptr^.syskey.all, 1,
                  a_error_key_ptr^.syskey.skeylen, syskey_hex.c120, 1,
                  sizeof (syskey_hex), truncated);
            i       := 2 * a_error_key_ptr^.syskey.skeylen;
            IF  i > sizeof (syskey_hex)
            THEN
                i := sizeof (syskey_hex);
            (*ENDIF*) 
            ix  := 1;
            pos := 1;
            WHILE pos < i DO
                BEGIN
                g01optextmsg (sp3p_console, sp3m_error, csp3_a10_cache_dump,
                      csp3_n_akcache, syskey_hex.c40array[ix]);
                pos := pos + sizeof (syskey_hex.c40array[ix]);
                ix  := ix + 1
                END;
            (*ENDWHILE*) 
            IF  (sizeof(err_text) - msglen) >= char_size
            THEN
                IF  char_size = 2
                THEN
                    IF  a_out_packet^.sp1_header.sp1h_mess_code
                        = csp_unicode_swap
                    THEN
                        BEGIN
                        err_text[msglen + 1] := ':';
                        err_text[msglen + 2] := csp_unicode_mark;
                        msglen := msglen + 2
                        END
                    ELSE
                        BEGIN
                        err_text[msglen + 1] := csp_unicode_mark;
                        err_text[msglen + 2] := ':';
                        msglen := msglen + 2
                        END
                    (*ENDIF*) 
                ELSE
                    BEGIN
                    err_text[msglen + 1] := ':';
                    msglen := msglen + 1
                    END;
                (*ENDIF*) 
            (*ENDIF*) 
            move_len := sizeof(err_text) - msglen;
            IF  char_size = 2
            THEN
                s80uni_trans (@syskey_hex, sizeof(syskey_hex), csp_ascii,
                      @err_text [msglen + 1], move_len,
                      csp_unicode, [ ], e, err_char_no)
            ELSE
                BEGIN
                IF  a_error_key_ptr^.syskey.skeylen * 2 < move_len
                THEN
                    move_len := a_error_key_ptr^.syskey.skeylen * 2;
                (*ENDIF*) 
                IF  move_len > sizeof (syskey_hex.c120)
                THEN
                    move_len := sizeof (syskey_hex.c120);
                (*ENDIF*) 
                g10mv ('VAK07 ',   6,    
                      sizeof (syskey_hex.c120), sizeof (err_text),
                      @syskey_hex.c120, 1, @err_text, msglen + 1,
                      move_len, move_err)
                END;
            (*ENDIF*) 
            msglen := msglen + move_len
            END;
        (*ENDIF*) 
        IF  (a_returncode < -9000) AND
            (* 9000 itself should not turn to -602 *)
            (a_returncode > -10000)
        THEN
            BEGIN
            msg_line := bsp_c40;
            g17int4to_line (a_returncode, NOT c_with_zero, 5, 1, msg_line);
            move_len := sizeof(msg_line) - 6;
            IF  found
            THEN
                errlen := system_error_len * char_size
            ELSE
                errlen := 0;
            (*ENDIF*) 
            (* PTS 1107617 E.Z. *)
            IF  char_size = 2
            THEN
                BEGIN
                (* errtext is (swap-)unicode *)
                s80uni_trans (@msg_line, 6, csp_ascii,
                      @msg_uni, textlen,
                      a_out_packet^.sp1_header.sp1h_mess_code,
                      [ ], e, err_char_no);
                move_len := sizeof(msg_uni) - textlen;
                IF  move_len > msglen - errlen
                THEN
                    move_len := msglen - errlen;
                (*ENDIF*) 
                g10mv ('VAK07 ',   7,    
                      sizeof (err_text), sizeof (msg_uni),
                      @err_text, errlen+1, @msg_uni, textlen+1,
                      move_len, move_err);
                textlen := textlen + move_len;
                WHILE textlen < sizeof (msg_uni) DO
                    BEGIN
                    move_len := sizeof (msg_uni) - textlen;
                    s80uni_trans (@bsp_c64, 64, csp_ascii,
                          @msg_uni[textlen+1], move_len,
                          a_out_packet^.sp1_header.sp1h_mess_code,
                          [ ], e, err_char_no);
                    textlen := textlen + move_len
                    END;
                (*ENDWHILE*) 
                vmessageUnicode (a_out_packet^.sp1_header.sp1h_mess_code,
                      sp3p_knldiag, sp3m_error,
                      csp3_a07_system_error, csp3_n_syserror, msg_uni);
                END
            ELSE
                BEGIN
                IF  move_len > msglen - errlen
                THEN
                    move_len := msglen - errlen;
                (*ENDIF*) 
                g10mv ('VAK07 ',   8,    
                      sizeof (err_text), sizeof (msg_line),
                      @err_text, errlen+1, @msg_line, 7,
                      move_len, move_err);
                vmessage (sp3p_knldiag, sp3m_error,
                      csp3_a07_system_error, csp3_n_syserror, msg_line);
                END;
            (*ENDIF*) 
            IF  a_sqlmode = sqlm_oracle (* PTS 1109929 *)
            THEN
                a_returncode := - 602;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        WITH a_return_segm^ DO
            BEGIN
            sp1r_returncode := a_returncode;
            sp1r_errorpos   := a_errorpos;
            END;
        (*ENDWITH*) 
        a06retpart_move (acv, @err_text, msglen);
        END;
    (*ENDIF*) 
    a06finish_curr_retpart (acv, sp1pk_errortext, 1);
    a_transinf.tri_trans.trWarning_gg00 := [ ];
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak07get_sequence_name (
            VAR acv      : tak_all_command_glob;
            VAR err      : tgg04_Err);
 
VAR
      b_err          : tgg00_BasisError;
      aux_returncode : tsp00_Int2;
      aux_errorpos   : tsp00_Int4;
      seq_buf        : tak_sysbufferaddress;
      sysk           : tgg00_SysInfoKey;
 
BEGIN
WITH acv DO
    BEGIN
    aux_returncode := a_returncode;
    aux_errorpos   := a_errorpos;
    a_returncode := 0;
    a_errorpos   := 0;
    sysk           := a01defaultkey;
    sysk.stableid  := err.errtableid;
    sysk.sentrytyp := cak_esequence;
    a10get_sysinfo (acv, sysk, d_release,
          seq_buf, b_err);
    IF  b_err = e_ok
    THEN
        ak07identifier_param (acv, 1, seq_buf^.ssequence.seq_name);
    (*ENDIF*) 
    a_returncode := aux_returncode;
    a_errorpos   := aux_errorpos
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak07err_col_index_name (
            VAR acv      : tak_all_command_glob;
            VAR err      : tgg04_Err;
            etexttype    : tgg00_ErrorText);
 
VAR
      f_ok           : boolean;
      found          : boolean;
      b_err          : tgg00_BasisError;
      base_ptr       : tak_sysbufferaddress;
      aux_returncode : tsp00_Int2;
      aux_errorpos   : tsp00_Int4;
      index          : integer;
      constr_buf     : tak_sysbufferaddress;
      owner          : tsp00_KnlIdentifier;
      constraint_n   : tsp00_KnlIdentifier;
      index_n        : tsp00_KnlIdentifier;
      colname        : tsp00_KnlIdentifier;
      sysk           : tgg00_SysInfoKey;
      priv           : tak_privilege;
      index_scan_rec : tak_index_scan_record;
 
BEGIN
WITH acv DO
    BEGIN
    aux_returncode := a_returncode;
    aux_errorpos   := a_errorpos;
    a_returncode := 0;
    a_errorpos  := 0;
    IF  (etexttype = errtext_surrogate)
        OR
        ((etexttype = errtext_stack)    AND
        (err.errstacktype <> tfnMulti_egg00))
    THEN
        BEGIN (* Find column stack entry *)
        a06_systable_get (acv, d_release, err.errtableid,
              base_ptr, true, f_ok);
        IF  f_ok
        THEN
            BEGIN
            a06_get_priv (acv, base_ptr, priv);
            IF  (priv.priv_all_set   = []) AND
                (priv.priv_col_exist = [])
            THEN
                f_ok := false
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        IF  f_ok
        THEN
            BEGIN
            IF  (etexttype = errtext_stack)
                AND
                (err.errstack.etype in [st_dummy, st_jump_false])
            THEN
                BEGIN
                (* stack entry containing violated constraint id *)
                sysk := base_ptr^.syskey;
                IF  base_ptr^.syskey.sentrytyp < cak_etemp
                THEN
                    sysk.sentrytyp := cak_econstraint
                ELSE
                    sysk.sentrytyp := cak_etempconstraint;
                (*ENDIF*) 
                sysk.slinkage[1] := err.errstack.ecol_tab[1];
                sysk.slinkage[2] := err.errstack.ecol_tab[2];
                a10get_sysinfo (acv, sysk, d_release,
                      constr_buf, b_err);
                IF  b_err = e_ok
                THEN
                    BEGIN
                    a11getconstraintname (constr_buf^.sconstraint,
                          constraint_n);
                    ak07identifier_param (acv, 1, constraint_n)
                    END;
                (*ENDIF*) 
                END
            ELSE
                BEGIN
                index := base_ptr^.sbase.bfirstcolind;
                WHILE index <> 0 DO
                    WITH base_ptr^.sbase.bcolumn[ index ]^,
                         ccolstack DO
                        IF  ((etype     = err.errstack.etype) AND
                            ((creccolno = ord (err.errstack.ecol_tab[ 1 ])) OR
                            ((epos      = err.errstack.epos) AND
                            (elen_var   = err.errstack.elen_var))))
                        THEN
                            BEGIN
                            a061get_colname (base_ptr^.sbase.bcolumn[index]^,
                                  colname);
                            index := 0;
                            ak07identifier_param (acv, 1, colname)
                            END
                        ELSE
                            index := cnextind;
                        (*ENDIF*) 
                    (*ENDWITH*) 
                (*ENDWHILE*) 
                END;
            (*ENDIF*) 
            ak07identifier_param (acv, -1, base_ptr^.sbase.btablen^);
            a06determine_username (acv,
                  base_ptr^.sbase.bauthid, owner);
            ak07identifier_param (acv, -1, owner)
            END;
        (*ENDIF*) 
        END
    ELSE
        WITH index_scan_rec DO
            BEGIN
            a24init_index_scan (acv, err.errtableid,
                  index_scan_rec);
            found := false;
            WHILE NOT found AND a24next_named_index (acv, index_scan_rec) DO
                WITH isr_buf^.smindex.indexdef[isr_index] DO
                    BEGIN
                    found := ord (err.errstack.ecol_tab[1]) = indexno;
                    IF  found
                    THEN
                        BEGIN
                        a24get_indexname (acv, isr_buf, isr_index,
                              index_n);
                        ak07identifier_param (acv, 1, index_n);
                        END;
                    (* PTS 1114312, T.A. removed code for unnamed indexes *)
                    (*ENDIF*) 
                    END;
                (*ENDWITH*) 
            (*ENDWHILE*) 
            a24finish_index_scan (acv, index_scan_rec)
            END;
        (*ENDWITH*) 
    (*ENDIF*) 
    a_returncode := aux_returncode;
    a_errorpos   := aux_errorpos;
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak07find_keywords (
            VAR acv      : tak_all_command_glob;
            VAR err_text : tak_order_errortext;
            VAR msglen   : integer);
 
CONST
      c_release_packet = true;
      c_max_kw         = 33;
 
VAR
      exit_loop         : boolean;
      found             : boolean;
      aux_ret_code      : tsp00_Int2;
      aux_errorpos      : tsp00_Int4;
      aux_function_code : tsp00_Int2;
      curr_kw           : integer;
      kw_len            : integer;
      kw_size           : integer;
      ix                : integer;
      jx                : integer;
      wrong_kw_len      : integer;
      pos               : tsp00_Int4;
      move_err          : tgg00_BasisError;
      e                 : tsp8_uni_error;
      err_char_no       : tsp00_Int4;
      c                 : char;
      old_cmd_segm      : tsp1_segment_ptr;
      kw_cnt            : integer;
      prev_pos          : integer;
      char_size         : integer;
      swap_offset       : integer;
      wrong_kw_pos      : tsp00_Int4;
      wrong_kw          : tsp00_C40;
 
      keywords : ARRAY[1..c_max_kw] OF RECORD
            kw : integer;
            p  : integer;
      END;
 
 
BEGIN
IF  g01unicode
THEN
    char_size := 2
ELSE
    char_size := 1;
(*ENDIF*) 
&ifdef trace
t01int4 (ak_sem, 'errorpos    ', acv.a_errorpos);
&endif
WITH acv DO
    IF  (a_errorpos > 0) AND
        (a_errorpos <= a_cmd_part^.sp1p_buf_len + 1)
    THEN
        BEGIN
        a_compact_varpart := false;
        aux_ret_code      := a_returncode;
        aux_errorpos      := a_errorpos;
        aux_function_code := a_return_segm^.sp1r_function_code;
        a_returncode   := 0;
        move_err          := e_ok;
        old_cmd_segm      := acv.a_cmd_segm;
        kw_size           := char_size * (sizeof (a01kw[1]) + 1);
        IF  g01unicode AND
            (a_out_packet^.sp1_header.sp1h_mess_code >= csp_unicode_swap)
        THEN
            a542internal_packet (acv, NOT c_release_packet,
                  acv.a_cmd_part^.sp1p_buf_len             +
                  kw_size + char_size + 4)
        ELSE
            a542internal_packet (acv, NOT c_release_packet,
                  acv.a_cmd_part^.sp1p_buf_len * char_size +
                  kw_size + char_size + 4);
        (*ENDIF*) 
        IF  a_returncode = 0
        THEN
            BEGIN
            IF  g01unicode
            THEN      (* We can't access the already to unicode transformed *)
                BEGIN (* cmd_part, because it was already disposed in vak93 *)
                (* but we use the unicode_swap --> unicode transformed part *)
                (* PTS 1109070 E.Z. *)
                IF  a_out_packet^.sp1_header.sp1h_mess_code >= csp_unicode_swap
                THEN
                    BEGIN
                    jx := old_cmd_segm^.sp1p_buf_len;
                    g10mv ('VAK07 ',   9,    
                          old_cmd_segm^.sp1p_buf_size,
                          a_cmd_part^.sp1p_buf_size,
                          @old_cmd_segm^.sp1p_buf, 1,
                          @a_cmd_part^.sp1p_buf, 1,
                          old_cmd_segm^.sp1p_buf_len, move_err);
                    a_cmd_part^.sp1p_buf_len := old_cmd_segm^.sp1p_buf_len
                          + kw_size + char_size;
                    END
                ELSE
                    BEGIN
                    jx := a_cmd_part^.sp1p_buf_size;
                    s80uni_trans (@old_cmd_segm^.sp1p_buf, old_cmd_segm^.sp1p_buf_len,
                          a_out_packet^.sp1_header.sp1h_mess_code,
                          @a_cmd_part^.sp1p_buf, jx,
                          csp_unicode, [ ], e, err_char_no);
                    a_cmd_part^.sp1p_buf_len := jx + kw_size + char_size;
                    END;
                (*ENDIF*) 
&               ifdef trace
                t01int4    (ak_sem, 'messcode ORG',
                      a_out_packet^.sp1_header.sp1h_mess_code);
                t01moveobj (ak_sem, old_cmd_segm^.sp1p_buf,
                      1, old_cmd_segm^.sp1p_buf_len);
                t01int4    (ak_sem, 'messcode NEW',
                      a_cmd_packet_header.sp1h_mess_code);
                t01moveobj (ak_sem, a_cmd_part^.sp1p_buf, 1, jx);
                t01int4    (ak_sem, 'uni_err     ', ord (e));
&               endif
                SAPDB_PascalOverlappingMove ('VAK07 ',  10,    
                      a_cmd_part^.sp1p_buf_size, a_cmd_part^.sp1p_buf_size,
                      @a_cmd_part^.sp1p_buf, 2*a_errorpos-1,
                      @a_cmd_part^.sp1p_buf,
                      2*a_errorpos+kw_size+char_size-1,
                      jx - 2*a_errorpos +2, move_err);
                a_cmd_part^.sp1p_buf[(a_errorpos-1)*2+1] :=
                      csp_unicode_mark;
                a_cmd_part^.sp1p_buf[a_errorpos*2] := bsp_c1;
                pos := a_errorpos * 2 + 1;
                END
            ELSE
                BEGIN
                g10mv ('VAK07 ',  11,    
                      old_cmd_segm^.sp1p_buf_size,
                      a_cmd_part^.sp1p_buf_size,
                      @old_cmd_segm^.sp1p_buf, 1,
                      @a_cmd_part^.sp1p_buf, 1,
                      a_errorpos - 1, move_err);
                g10mv ('VAK07 ',  12,    
                      old_cmd_segm^.sp1p_buf_size,
                      a_cmd_part^.sp1p_buf_size,
                      @old_cmd_segm^.sp1p_buf, a_errorpos,
                      @a_cmd_part^.sp1p_buf,
                      a_errorpos + kw_size + char_size,
                      old_cmd_segm^.sp1p_buf_len - a_errorpos + 1,
                      move_err);
                a_cmd_part^.sp1p_buf_len := old_cmd_segm^.sp1p_buf_len
                      + kw_size + char_size;
                a_cmd_part^.sp1p_buf[a_errorpos] := bsp_c1;
                pos := a_errorpos + 1
                END;
            (*ENDIF*) 
            a_scv.sc_missing_kw_pos  := pos;
            IF  g01unicode
            THEN
                BEGIN
                a_cmd_part^.sp1p_buf[pos+kw_size-2] := csp_unicode_mark;
                a_cmd_part^.sp1p_buf[pos+kw_size-1] := bsp_c1;
                END
            ELSE
                a_cmd_part^.sp1p_buf[pos + kw_size - 1] := bsp_c1;
            (*ENDIF*) 
            wrong_kw_pos    := pos + kw_size;
            wrong_kw_len    := cak_is_undefined;
            a_scv.sc_newpos := wrong_kw_pos;
            a01_next_symbol (acv);
            IF  a_scv.sc_symb = s_identifier
            THEN
                IF  a_scv.sc_sylength <= kw_size
                THEN
                    BEGIN
                    wrong_kw_len := a_scv.sc_sylength;
                    wrong_kw_pos := a_scv.sc_sypos;
                    jx           := wrong_kw_pos;
                    FOR ix := 1 TO wrong_kw_len DO
                        BEGIN
                        wrong_kw [ix] := a_cmd_part^.sp1p_buf[jx];
                        jx := jx + 1
                        END;
                    (*ENDFOR*) 
                    END;
&               ifdef trace
                (*ENDIF*) 
            (*ENDIF*) 
            t01int4 (ak_sem, 'wrong_kw_pos', wrong_kw_pos);
&           endif
            c              := ':';
            exit_loop      := false;
            kw_cnt         := 0;
            curr_kw        := cak_i_no_keyword;
            REPEAT
                curr_kw := curr_kw + 1;
                IF  curr_kw = cak_maxkeyword
                THEN
                    exit_loop := true
                ELSE
                    BEGIN
                    IF  g01unicode
                    THEN
                        BEGIN
                        jx := kw_size;
                        s80uni_trans (@a01kw[curr_kw], sizeof (a01kw[curr_kw]),
                              csp_ascii, @a_cmd_part^.sp1p_buf[pos],
                              jx, csp_unicode, [ ], e, err_char_no)
                        END
                    ELSE
                        g10mv ('VAK07 ',  13,    
                              sizeof (a01kw[curr_kw]),
                              a_cmd_part^.sp1p_buf_size,
                              @a01kw[curr_kw], 1,
                              @a_cmd_part^.sp1p_buf, pos,
                              sizeof (a01kw[curr_kw]), move_err);
                    (*ENDIF*) 
                    a_ex_kind       := only_syntax;
                    a_init_ex_kind  := only_syntax;
                    a_returncode := 0;
                    a_errorpos   := 0;
                    a35_asql_statement (acv);
&                   ifdef trace
                    t01name (ak_sem, a01kw[curr_kw]);
                    t01int4 (ak_sem, 'sp1r_errorps', a_errorpos);
                    t01int4 (ak_sem, 'pos         ', pos);
                    t01int4 (ak_sem, 'returncode  ',
                          a_returncode);
&                   endif
                    IF  a_returncode = 0
                    THEN
                        a_errorpos := csp_maxint4
                    ELSE
                        BEGIN
                        IF  (a_errorpos > aux_errorpos + 1) AND
                            (a_errorpos <= aux_errorpos +
                            1 + sizeof (a01kw[curr_kw]))
                        THEN
                            a_errorpos :=
                                  aux_errorpos + 1 + sizeof (a01kw[curr_kw]);
                        (*ENDIF*) 
                        IF  (a_errorpos > aux_errorpos + 1) AND
                            (wrong_kw_len  > 0  )
                        THEN
                            BEGIN (* matching keyword *)
                            ix := a_errorpos;
                            a_returncode := 0;
                            a_errorpos   := 0;
                            IF  g01unicode
                            THEN
                                g20unifill (a_cmd_part^.sp1p_buf_size,
                                      @a_cmd_part^.sp1p_buf,
                                      wrong_kw_pos,
                                      wrong_kw_len, csp_unicode_blank)
                            ELSE
                                FOR jx := 0 TO wrong_kw_len  - 1 DO
                                    a_cmd_part^.sp1p_buf[wrong_kw_pos + jx] := bsp_c1;
                                (*ENDFOR*) 
                            (*ENDIF*) 
                            a35_asql_statement (acv);
                            FOR jx := 1 TO wrong_kw_len DO
                                a_cmd_part^.sp1p_buf[wrong_kw_pos + jx - 1] :=
                                      wrong_kw[jx];
                            (*ENDFOR*) 
                            IF  a_returncode = 0
                            THEN
                                a_errorpos := csp_maxint4
                            ELSE
                                IF  a_errorpos < ix
                                THEN
                                    a_errorpos := ix
                                (*ENDIF*) 
                            (*ENDIF*) 
                            END;
                        (*ENDIF*) 
                        END;
                    (*ENDIF*) 
                    IF  a_errorpos > aux_errorpos + 1
                    THEN
                        BEGIN
                        ix    := 1;
                        found := false;
                        WHILE (ix <= kw_cnt) AND NOT found DO
                            IF  keywords[ix].p > a_errorpos
                            THEN
                                ix := ix + 1
                            ELSE
                                found := true;
                            (*ENDIF*) 
                        (*ENDWHILE*) 
                        FOR jx := kw_cnt DOWNTO ix DO
                            keywords[jx + 1] := keywords[jx];
                        (*ENDFOR*) 
                        keywords[ix].kw  := curr_kw;
                        keywords[ix].p   := a_errorpos;
                        IF  kw_cnt < c_max_kw - 1
                        THEN
                            kw_cnt := kw_cnt + 1;
                        (*ENDIF*) 
                        END;
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
            UNTIL
                exit_loop;
            (*ENDREPEAT*) 
&           ifdef trace
            FOR ix := 1 TO kw_cnt DO
                BEGIN
                t01name (ak_sem, a01kw[keywords[ix].kw]);
                t01int4 (ak_sem, 'error_pos   ', keywords[ix].p);
                END;
            (*ENDFOR*) 
&           endif
            CASE  a_out_packet^.sp1_header.sp1h_mess_code OF
                csp_unicode:
                    BEGIN
                    char_size   := 2;
                    swap_offset := 0
                    END;
                csp_unicode_swap:
                    BEGIN
                    char_size   := 2;
                    swap_offset := 1
                    END;
                OTHERWISE
                    BEGIN
                    char_size   := 1;
                    swap_offset := 0
                    END
                END;
            (*ENDCASE*) 
            ix    := 1;
            WHILE ix <= kw_cnt DO
                BEGIN
                curr_kw := keywords[ix].kw;
                kw_len  := sizeof (a01kw[curr_kw]);
                WHILE a01kw[curr_kw, kw_len] = bsp_c1 DO
                    kw_len := kw_len - 1;
                (*ENDWHILE*) 
                kw_len := kw_len * char_size;
                IF  msglen + kw_len + char_size > mxak_order_errortext
                THEN (* exit loop *)
                    BEGIN
                    ix := kw_cnt + 1;
                    IF  msglen + 4 * char_size > mxak_order_errortext
                    THEN (* remove last keyword *)
                        msglen := prev_pos;
                    (*ENDIF*) 
                    FOR jx := 1 TO (4 * char_size) DO
                        err_text [msglen + jx] := csp_unicode_mark;
                    (*ENDFOR*) 
                    err_text [msglen + 1 * char_size - swap_offset] := bsp_c1;
                    err_text [msglen + 2 * char_size - swap_offset] := '.';
                    err_text [msglen + 3 * char_size - swap_offset] := '.';
                    err_text [msglen + 4 * char_size - swap_offset] := '.';
                    msglen := msglen + 4 * char_size;
                    END
                ELSE
                    BEGIN
                    IF  msglen + 4*char_size <= mxak_order_errortext
                    THEN (* There is still enough room for ' ...'. *)
                        prev_pos := msglen;
                    (*ENDIF*) 
                    FOR jx := 1 TO (kw_len + char_size) DO
                        err_text [msglen + jx] := csp_unicode_mark;
                    (*ENDFOR*) 
                    err_text[msglen + char_size - swap_offset] := c;
                    msglen := msglen + char_size;
                    c      := ',';
                    FOR jx := 1 TO kw_len DIV char_size DO
                        err_text[msglen + jx*char_size - swap_offset]
                              := a01kw[curr_kw][jx];
                    (*ENDFOR*) 
                    msglen := msglen + kw_len;
                    ix     := ix + 1
                    END;
                (*ENDIF*) 
                END;
            (*ENDWHILE*) 
            END;
        (*ENDIF*) 
        a542pop_packet (acv);
        a_scv.sc_missing_kw_pos  := cak_is_undefined;
        a_returncode          := aux_ret_code;
        a_errorpos            := aux_errorpos;
        a_return_segm^.sp1r_function_code       := aux_function_code
        END;
    (*ENDIF*) 
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak07substitute_parameters (
            VAR acv             : tak_all_command_glob;
            char_size           : integer;
            VAR err_text        : tak_order_errortext;
            VAR msglen          : integer);
 
VAR
      placeholder_found : boolean;
      param_found       : boolean;
      delimiter         : char;
      param_char_size   : integer;
      param_char_diff   : integer;
      ix                : integer;
      param_no          : integer;
      diff              : integer;
      pos               : integer;
      param_pos         : integer;
      param_len         : integer;
      inamelen          : integer;
      markoffset        : integer;
      charoffset        : integer;
      move_err          : tgg00_BasisError;
      e                 : tsp8_uni_error;
      err_char_no       : tsp00_Int4;
 
BEGIN
param_char_diff := 1 (* param_char_size = char_size*);
IF  g01unicode
THEN
    BEGIN
    param_char_size := 2;
    IF  acv.a_out_packet^.sp1_header.sp1h_mess_code <
        csp_unicode_swap
    THEN
        param_char_diff := 2
    (*ENDIF*) 
    END
ELSE
    param_char_size := 1;
(*ENDIF*) 
param_found := false;
pos         := 1 - char_size;
move_err    := e_ok;
WHILE (pos <= msglen) AND (move_err = e_ok) DO
    BEGIN
&   ifdef trace
    t01int4 (ak_sem, 'msglen      ', msglen);
&   endif
    placeholder_found := false;
    REPEAT
        pos := pos + char_size;
        IF  pos + 2 * char_size - 1 <= msglen
        THEN
            IF  acv.a_out_packet^.sp1_header.sp1h_mess_code in
                [ csp_unicode, csp_unicode_swap ]
            THEN
                BEGIN
                IF  acv.a_out_packet^.sp1_header.sp1h_mess_code = csp_unicode
                THEN
                    BEGIN
                    markoffset := 0;
                    charoffset := 1;
                    END
                ELSE
                    BEGIN
                    markoffset := 1;
                    charoffset := 0;
                    END;
                (*ENDIF*) 
                IF  (err_text[pos + markoffset] = csp_unicode_mark) AND
                    (err_text[pos + charoffset] = '$'             ) AND
                    (err_text[pos + markoffset + 2] = csp_unicode_mark) AND
                    (err_text[pos + charoffset + 2] in ['1'..'9'])
                THEN
                    BEGIN
                    placeholder_found := true;
                    param_no := ord (err_text[pos + charoffset + 2])
                          - ord ('0');
                    END;
                (*ENDIF*) 
                END
            ELSE
                IF  (err_text[pos] = '$') AND
                    (err_text[pos+1] in ['1'..'9'])
                THEN
                    BEGIN
                    placeholder_found := true;
                    param_no := ord (err_text[pos+1]) - ord ('0');
                    END;
                (*ENDIF*) 
            (*ENDIF*) 
        (*ENDIF*) 
    UNTIL
        placeholder_found OR (pos > sizeof (err_text));
    (*ENDREPEAT*) 
    IF  placeholder_found AND (param_no <= acv.a_err_parm_cnt)
    THEN
        BEGIN
        (* substitute placeholder by parameter *)
&       ifdef trace
        t01int4 (ak_sem, 'param_no    ', param_no);
&       endif
        param_pos := 1;
        WHILE param_no > 1 DO
            BEGIN
            param_no  := param_no - 1;
            param_pos := param_pos +
                  ord (acv.a_error_params[param_pos]) + 1
            END;
        (*ENDWHILE*) 
        inamelen := ord (acv.a_error_params[param_pos]);
        diff     := (inamelen - 2 * param_char_size) DIV param_char_diff;
        IF  msglen + diff > sizeof (err_text)
        THEN
            BEGIN
            diff     := sizeof (err_text) - msglen;
            inamelen := (diff + 2 * param_char_size) * param_char_diff
            END;
        (*ENDIF*) 
        IF  diff > 0
        THEN
            FOR ix := msglen DOWNTO pos + 2 * char_size DO
                err_text[ix + diff] := err_text[ix]
            (*ENDFOR*) 
        ELSE
            IF  diff < 0
            THEN
                FOR ix := pos + 2 * char_size TO msglen DO
                    err_text[ix - 1 * char_size] := err_text[ix];
                (*ENDFOR*) 
&           ifdef trace
            (*ENDIF*) 
        (*ENDIF*) 
        t01int4 (ak_sem, 'param_pos   ', param_pos);
        t01int4 (ak_sem, 'param_len   ', inamelen);
&       endif
        IF  g01unicode AND
            (acv.a_out_packet^.sp1_header.sp1h_mess_code <> csp_unicode)
        THEN
            BEGIN
            s80uni_trans (@acv.a_error_params[ param_pos+1 ], inamelen,
                  csp_unicode, @err_text[pos], inamelen,
                  acv.a_out_packet^.sp1_header.sp1h_mess_code, [ ],
                  e, err_char_no);
            diff := inamelen - 2 * char_size;
            END
        ELSE
            g10mv ('VAK07 ',  14,    
                  sizeof (acv.a_error_params), sizeof (err_text),
                  @acv.a_error_params, param_pos+1,
                  @err_text, pos, inamelen, move_err);
        (*ENDIF*) 
        msglen := msglen + diff;
        pos := pos + inamelen;
        param_found := true;
        END
    ELSE
        pos := sizeof (err_text) + 1 (* exit loop *)
    (*ENDIF*) 
    END;
(*ENDWHILE*) 
IF  NOT param_found AND (msglen + char_size < sizeof (err_text)) AND
    (move_err = e_ok)
THEN
    BEGIN
    (* old parameter behavior *)
    param_no  := 0;
    pos       := 1;
    delimiter := ':';
    REPEAT
        param_no  := param_no + 1;
        param_len := ord (acv.a_error_params[pos]);
        IF  msglen + char_size + (param_len DIV param_char_diff) > sizeof (err_text)
        THEN
            BEGIN
            param_len := (sizeof (err_text) - char_size - msglen) * param_char_diff;
            param_no  := acv.a_err_parm_cnt;
            END;
        (*ENDIF*) 
        IF  param_len > 0
        THEN
            BEGIN
            IF  char_size = 2
            THEN
                IF  acv.a_out_packet^.sp1_header.sp1h_mess_code
                    = csp_unicode_swap
                THEN
                    BEGIN
                    err_text[ msglen + 1 ] := delimiter;
                    err_text[ msglen + 2 ] := csp_unicode_mark
                    END
                ELSE
                    BEGIN
                    err_text[ msglen + 1 ] := csp_unicode_mark;
                    err_text[ msglen + 2 ] := delimiter
                    END
                (*ENDIF*) 
            ELSE
                err_text[ msglen + 1 ] := delimiter;
            (*ENDIF*) 
            IF  g01unicode AND
                (acv.a_out_packet^.sp1_header.sp1h_mess_code <> csp_unicode)
            THEN
                s80uni_trans (@acv.a_error_params[ pos+1 ], param_len,
                      csp_unicode, @err_text[msglen + char_size + 1], param_len,
                      acv.a_out_packet^.sp1_header.sp1h_mess_code, [ ],
                      e, err_char_no)
            ELSE
                g10mv ('VAK07 ',  15,    
                      sizeof (acv.a_error_params), sizeof (err_text),
                      @acv.a_error_params, pos + 1,
                      @err_text, msglen + char_size + 1,
                      param_len, move_err);
            (*ENDIF*) 
            msglen := msglen + char_size + param_len;
            pos    := pos + 1 + ord (acv.a_error_params[pos]);
            ;
            END;
        (*ENDIF*) 
        delimiter := ',';
    UNTIL
        (param_no = acv.a_err_parm_cnt) OR (move_err <> e_ok);
    (*ENDREPEAT*) 
    END;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a07_kw_put_error (
            VAR acv  : tak_all_command_glob;
            b_err    : tgg00_BasisError;
            err_code : tsp00_Int4;
            kw       : integer);
 
VAR
      kw_id : tak_keyword;
 
BEGIN
WITH acv DO
    IF  a_returncode = 0
    THEN
        BEGIN
&       ifdef trace
        t01basis_error (td_always, 'throw error ', b_err);
&       endif
        IF  b_err = e_cancelled
        THEN
            a_transinf.tri_trans.trRteCommPtr_gg00^.to_cancel:= false;
        (*ENDIF*) 
        a_returncode :=
              a07_return_code ( b_err, a_sqlmode);
        a07put_error_pos (acv, err_code);
        IF  kw <> cak_i_no_keyword
        THEN
            BEGIN
            IF  kw = cak_i_userid
            THEN
                kw_id := 'OWNER             '
            ELSE
                kw_id := a01kw[kw];
            (*ENDIF*) 
            a07const_param (acv, 1, @kw_id, sizeof (kw_id))
            END
        (*ENDIF*) 
        END;
    (*ENDIF*) 
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a07_nb_put_error (
            VAR acv  : tak_all_command_glob;
            b_err    : tgg00_BasisError;
            err_code : tsp00_Int4;
            VAR n    : tsp00_KnlIdentifier);
 
BEGIN
WITH acv DO
    IF  a_returncode = 0
    THEN
        BEGIN
&       ifdef trace
        t01basis_error (td_always, 'throw error ', b_err);
&       endif
        IF  b_err = e_cancelled
        THEN
            a_transinf.tri_trans.trRteCommPtr_gg00^.to_cancel:= false;
        (*ENDIF*) 
        a_returncode :=
              a07_return_code ( b_err, a_sqlmode);
        a07put_error_pos (acv, err_code);
        (* PTS 1122898 E.Z. *)
        IF  n <> a01_il_b_identifier
        THEN
            ak07identifier_param (acv, 1, n)
        (*ENDIF*) 
        END;
    (*ENDIF*) 
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a07_sb_put_error (
            VAR acv  : tak_all_command_glob;
            b_err    : tgg00_BasisError;
            err_code : tsp00_Int4;
            VAR err  : tgg04_Err);
 
BEGIN
a07_b_put_error (acv, b_err, err_code);
ak07err_col_index_name (acv, err, errtext_stack)
END;
 
(*------------------------------*) 
 
PROCEDURE
      a07_tb_put_error (
            VAR acv     : tak_all_command_glob;
            b_err       : tgg00_BasisError;
            err_code    : tsp00_Int4;
            VAR tab_id  : tgg00_Surrogate);
 
VAR
      b_intern_err : tgg00_BasisError;
      n            : tsp00_KnlIdentifier;
      buf          : tak_sysbufferaddress;
      sysk         : tgg00_SysInfoKey;
 
BEGIN
WITH acv DO
    IF  a_returncode = 0
    THEN
        BEGIN
        sysk           := a01sysnullkey;
        sysk.stableid  := tab_id;
        n              := a01_il_b_identifier;
        a10get_sysinfo (acv, sysk, d_release, buf,
              b_intern_err);
        IF  b_intern_err = e_ok
        THEN
            n:= buf^.sbase.btablen^;
        (*ENDIF*) 
        a07_nb_put_error (acv, b_err, err_code, n);
        END;
    (*ENDIF*) 
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a07ak_system_error (
            VAR acv  : tak_all_command_glob;
            modul_no : integer;
            id       : integer);
 
BEGIN
IF  (modul_no > 0) AND (modul_no < 3200) AND (id > 0) AND (id < 10)
THEN
    id := modul_no * 10 + id
ELSE
    id := 0;
(*ENDIF*) 
a07_b_put_error (acv, e_ak_system_error, -id);
END;
 
(*------------------------------*) 
 
PROCEDURE
      a07const_param (
            VAR acv    : tak_all_command_glob;
            param_no   : integer;
            param_addr : tsp00_MoveObjPtr;
            param_len  : integer);
 
VAR
      ix    : integer;
      jx    : integer;
      c80   : tsp00_C80;
      b_err : tgg00_BasisError;
 
BEGIN
WHILE (param_len > 1) AND (param_addr^[param_len] = bsp_c1) DO (* PTS 1119709 *)
    param_len := param_len - 1;
(*ENDWHILE*) 
IF  g01unicode
THEN
    BEGIN
    IF  param_len > sizeof (c80) DIV 2
    THEN
        param_len := sizeof (c80) DIV 2;
    (*ENDIF*) 
    jx := 1;
    FOR ix := 1 TO param_len DO
        BEGIN
        c80[jx]   := csp_unicode_mark;
        c80[jx+1] := param_addr^[ix];
        jx := jx + 2
        END;
    (*ENDFOR*) 
    param_len := param_len*2
    END
ELSE
    BEGIN
    IF  param_len > sizeof (c80)
    THEN
        param_len := sizeof (c80);
    (*ENDIF*) 
    b_err := e_ok;
    g10mv ('VAK07 ',  16,    
          param_len, sizeof (c80), @param_addr^, 1, @c80, 1,
          param_len, b_err)
    END;
(*ENDIF*) 
ak07put_param (acv, param_no, @c80, param_len)
END;
 
(*------------------------------*) 
 
PROCEDURE
      a07parm3_put_error (
            VAR acv     : tak_all_command_glob;
            b_err       : tgg00_BasisError;
            err_code    : tsp00_Int4;
            VAR param1  : tsp00_KnlIdentifier;
            VAR param2  : tsp00_KnlIdentifier;
            VAR param3  : tsp00_KnlIdentifier);
 
BEGIN
IF  acv.a_returncode = 0
THEN
    BEGIN
&   ifdef trace
    t01basis_error (td_always, 'throw error ', b_err);
&   endif
    IF  b_err = e_cancelled
    THEN
        acv.a_transinf.tri_trans.trRteCommPtr_gg00^.to_cancel:= false;
    (*ENDIF*) 
    acv.a_returncode :=
          a07_return_code ( b_err, acv.a_sqlmode);
    a07put_error_pos (acv, err_code);
    ak07identifier_param (acv,  1, param1);
    ak07identifier_param (acv, -1, param2);
    ak07identifier_param (acv, -1, param3)
    END;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak07identifier_param (
            VAR acv  : tak_all_command_glob;
            param_no : integer;
            VAR id   : tsp00_KnlIdentifier);
 
VAR
      id_len      : integer;
 
BEGIN
IF  g01unicode
THEN
    BEGIN
    id_len := s30unilnr (@id, csp_unicode_blank, 1, sizeof(id));
    ak07put_param (acv, param_no, @id, id_len);
    END
ELSE
    BEGIN
    id_len := s30lnr (id, bsp_c1, 1, sizeof (id));
    ak07put_param (acv, param_no, @id, id_len)
    END;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak07put_param (
            VAR acv   : tak_all_command_glob;
            param_no  : integer;
            param_ptr : tsp00_MoveObjPtr;
            param_len : integer);
 
VAR
      pos   : integer;
      b_err : tgg00_BasisError;
&     ifdef trace
      p     : tsp00_MoveObjPtr;
&     endif
 
BEGIN
IF  param_no = 1
THEN
    BEGIN
    acv.a_err_parm_cnt := 0;
    pos                := 1
    END
ELSE
    BEGIN
    param_no := acv.a_err_parm_cnt;
    pos      := 1;
    WHILE param_no > 0 DO
        BEGIN
        param_no := param_no - 1;
        pos      := pos + ord (acv.a_error_params[pos]) + 1
        END;
    (*ENDWHILE*) 
    END;
(*ENDIF*) 
IF  pos + param_len + 1 > sizeof (acv.a_error_params)
THEN
    BEGIN
    param_len := sizeof (acv.a_error_params) - pos;
    IF  param_len MOD a01char_size <> 0
    THEN (* Be shure to have room for complete unicode chars. *)
        param_len := param_len - 1
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  param_len > 0
THEN
    BEGIN
    b_err := e_ok;
    acv.a_error_params[pos] := chr(param_len);
    acv.a_err_parm_cnt      := acv.a_err_parm_cnt + 1;
    g10mv ('VAK07 ',  17,    
          param_len, sizeof (acv.a_error_params),
          @param_ptr^, 1, @acv.a_error_params, pos + 1,
          param_len, b_err);
&   ifdef trace
    p := @acv.a_error_params;
    t01moveobj (ak_sem, p^, 1, pos + param_len);
&   endif
    END;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a07put_error_pos (
            VAR acv : tak_all_command_glob;
            err_pos : tsp00_Int4);
 
VAR
      ti        : integer;
      isunipos  : boolean;
      len       : tsp00_Int4;
      ierr_pos  : tsp00_Int4;
 
BEGIN
WITH acv DO
    BEGIN
&   ifdef trace
    t01int4 (ak_sem, 'err_pos     ', err_pos);
    IF  a_ap_tree <> NIL
    THEN
        IF  a_ap_tree^[0].n_sa_level > 0
        THEN
            BEGIN
            ti := a_ap_tree^[0].n_sa_level;
            REPEAT
                WITH a_ap_tree^[ti] DO
                    BEGIN
                    ti := n_sa_level;
                    t01int4 (ak_sem, 'pos         ', n_pos);
                    t01int4 (ak_sem, 'len         ',
                          n_subproc * csp_maxint2 + n_length)
                    END;
                (*ENDWITH*) 
            UNTIL
                ti = 0;
            (*ENDREPEAT*) 
            END;
&       endif
        (*ENDIF*) 
    (*ENDIF*) 
    isunipos := g01unicode AND (err_pos > 0);
    ierr_pos := abs (err_pos);
    a_errorpos := ierr_pos;
    IF  (ierr_pos > 1) AND (err_pos > 0)
    THEN
        BEGIN
        a_errorpos  := a_errorpos +
              a_errpos_offset;
        IF  a_ap_tree <> NIL
        THEN
            IF  a_ap_tree^[0].n_sa_level > 0
            THEN
                BEGIN
                ti := a_ap_tree^[0].n_sa_level;
                REPEAT
                    WITH a_ap_tree^[ti] DO
                        BEGIN
                        ti := n_sa_level;
                        IF  n_pos <= ierr_pos
                        THEN
                            BEGIN
                            len := n_subproc * csp_maxint2 + n_length;
                            a_errorpos :=
                                  a_errorpos + len;
                            END
                        ELSE
                            ti := 0;
                        (*ENDIF*) 
                        END;
                    (*ENDWITH*) 
                UNTIL
                    ti = 0;
                (*ENDREPEAT*) 
                END;
            (*ENDIF*) 
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  isunipos
    THEN
        a_errorpos :=
              (a_errorpos - 1) DIV 2 + 1;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a07_uni_error (
            VAR acv  : tak_all_command_glob;
            uni_err  : tsp8_uni_error;
            err_code : tsp00_Int4);
 
VAR
      e : tgg00_BasisError;
 
BEGIN
&ifdef TRACE
t01int4 (ak_sem, 'uni_err     ', ord(uni_err));
&endif
CASE uni_err OF
    uni_no_such_encoding :
        e := e_unknown_multibyte_set;
    (* PTS 1117236 E.Z. *)
    uni_not_translatable, uni_translate_warning :
        e := e_not_translatable;
    uni_dest_too_short :
        e := e_unitrans_dest_too_short;
    uni_src_too_short :
        e := e_unitrans_src_too_short;
    OTHERWISE
        e := e_invalid_command;
    END;
(*ENDCASE*) 
a07_b_put_error (acv, e, err_code);
END;
 
(*------------------------------*) 
 
PROCEDURE
      a07_hex_uni_error (
            VAR acv     : tak_all_command_glob;
            uni_err     : tsp8_uni_error;
            err_code    : tsp00_Int4;
            to_unicode  : boolean;
            bytestr     : tsp00_MoveObjPtr;
            len         : tsp00_Int4 );
 
VAR
      e     : tgg00_BasisError;
      uerr  : tsp8_uni_error;
      uepos : tsp00_Int4;
      n     : tsp00_KnlIdentifier;
      nu    : tsp00_KnlIdentifier;
      nl    : integer;
      nul   : integer;
      ix    : integer;
 
BEGIN
&ifdef TRACE
t01int4 (ak_sem, 'uni_err     ', ord(uni_err));
&endif
CASE uni_err OF
    uni_no_such_encoding :
        e := e_unknown_multibyte_set;
    uni_dest_too_short :
        e := e_unitrans_dest_too_short;
    (* PTS 1107986 E.Z. *)
    uni_src_too_short,
    uni_is_incomplete :
        e := e_unitrans_src_too_short;
    uni_not_translatable,
    uni_translate_warning :
        IF  to_unicode
        THEN
            e := e_not_trans_to_uni
        ELSE
            e := e_not_trans_from_uni;
        (*ENDIF*) 
    OTHERWISE
        e := e_invalid_command;
    END;
(*ENDCASE*) 
IF  uni_err in [ uni_not_translatable, uni_translate_warning ]
THEN
    BEGIN
    n          := bsp_knl_identifier;
    nl         := 1;
    IF  len > sizeof (n) - 1
    THEN
        len := sizeof (n) - 1;
    (*ENDIF*) 
    FOR ix := 1 TO len DO
        g17hexto_line (bytestr^[ix], nl, n);
    (*ENDFOR*) 
    IF  g01unicode
    THEN
        BEGIN
        nul        := sizeof (nu);
        s80uni_trans (@n, nl, csp_ascii,
              @nu, nul, csp_unicode,
              [ ], uerr, uepos);
        IF  nul < sizeof (nu)
        THEN
            g20unifill (sizeof (nu), @nu, nul + 1,
                  sizeof (nu) - nul, csp_unicode_blank)
        (*ENDIF*) 
        END
    ELSE
        nu := n;
    (*ENDIF*) 
    a07_nb_put_error (acv, e, err_code, nu)
    END
ELSE
    a07_b_put_error (acv, e, err_code);
(*ENDIF*) 
END;
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
.PA 
