.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$VAK77$
.tt 2 $$$
.tt 3 $$AK_string_columns$$$1999-02-17$
***********************************************************
.nf
 
 
    ========== licence begin  GPL
    Copyright (C) 2000 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_string_columns
=========
.sp
Purpose : syntax and semantics analysis of string column opns
.CM *-END-* purpose -------------------------------------
.sp
.cp 3
Define  :
 
        PROCEDURE
              a77string_col_semantic (VAR acv : tak_all_command_glob);
 
        PROCEDURE
              a77efread_epilog (VAR acv : tak_all_command_glob;
                    VAR sysp_arr : tak_syspointerarr);
 
        PROCEDURE
              a77eopen_epilog (VAR acv : tak_all_command_glob;
                    VAR sysp_arr : tak_syspointerarr;
                    m2type       : tgg_message2_type);
 
        PROCEDURE
              a77get_and_close_descr (VAR acv : tak_all_command_glob);
 
        PROCEDURE
              a77eread_epilog (VAR acv : tak_all_command_glob;
                    VAR sysp_arr : tak_syspointerarr;
                    column_code  : tsp_code_type);
 
        PROCEDURE
              a77elength_epilog (VAR acv : tak_all_command_glob;
                    called_by_copy : boolean;
                    column_code    : tsp_code_type;
                    VAR sysp_arr   : tak_syspointerarr);
 
        PROCEDURE
              a77esearch_epilog (VAR acv : tak_all_command_glob;
                    VAR sysp_arr : tak_syspointerarr);
 
        PROCEDURE
              a77replace_descr (VAR acv : tak_all_command_glob;
                    VAR cfd         : tgg_string_filedescr;
                    VAR coldesc_id  : tgg_surrogate;
                    cpy_source      : boolean;
                    pos             : tsp_int4);
 
        PROCEDURE
              a77test_and_change_coldesc (VAR acv : tak_all_command_glob;
                    VAR coldesc_id : tgg_surrogate;
                    use_dest_col   : boolean;
                    m2type         : tgg_message2_type);
 
        PROCEDURE
              a77bget_buffer (VAR acv: tak_all_command_glob;
                    colcode : tsp_code_type;
                    pos     : tsp_int4);
 
        PROCEDURE
              a77pget_pattern (VAR acv : tak_all_command_glob;
                    VAR cfd    : tgg_string_filedescr;
                    VAR vppos  : tsp_int4;
                    is_pattern : boolean);
 
        PROCEDURE
              a77get_int4 (VAR acv  : tak_all_command_glob;
                    VAR val4        : tsp_int4;
                    cmd_varpart_pos : tsp_int4;
                    len             : tsp_int2);
 
        PROCEDURE
              a77lget_colpos (VAR acv: tak_all_command_glob;
                    cmd_varpart_pos : tsp_int4;
                    len             : tsp_int2;
                    cfd             : tgg_string_filedescr;
                    qual            : tak_fs_value_qual);
 
        PROCEDURE
              a77sget_length (VAR acv : tak_all_command_glob;
                    column_code     : tsp_code_type;
                    cmd_varpart_pos : tsp_int4;
                    len             : tsp_int2);
 
        PROCEDURE
              a77convert (VAR acv : tak_all_command_glob;
                    VAR buffer  : tsp_moveobj;
                    column_code : tsp_code_type;
                    pos         : tsp_int4;
                    len         : tsp_int4;
                    is_input    : boolean);
 
.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :
 
        FROM
              AK_semantic_scanner_tools : VAK05;
 
        PROCEDURE
              a05identifier_get (VAR acv : tak_all_command_glob;
                    tree_index  : integer;
                    obj_len     : integer;
                    VAR moveobj : tsp_knl_identifier);
 
      ------------------------------ 
 
        FROM
              AK_universal_semantic_tools : VAK06;
 
        PROCEDURE
              a06a_mblock_init (VAR acv : tak_all_command_glob;
                    mtype    : tgg_message_type;
                    m2type   : tgg_message2_type;
                    VAR tree : tgg00_FileId);
 
        PROCEDURE
              a06retpart_move (VAR acv : tak_all_command_glob;
                    moveobj_ptr : tsp_moveobj_ptr;
                    move_len    : tsp_int4);
 
        PROCEDURE
              a06finish_curr_retpart (VAR acv : tak_all_command_glob;
                    part_kind : tsp1_part_kind;
                    arg_count : tsp_int2);
 
      ------------------------------ 
 
        FROM
              AK_Identifier_Handling : VAK061;
 
        PROCEDURE
              a061assign_colname (value : tsp_c18;
                    VAR colname : tsp_knl_identifier);
 
        FUNCTION
              a061exist_columnname (VAR base_rec : tak_baserecord;
                    VAR column      : tsp_knl_identifier;
                    VAR colinfo_ptr : tak00_colinfo_ptr) : boolean;
 
      ------------------------------ 
 
        FROM
              AK_error_handling : VAK07;
 
        PROCEDURE
              a07_uni_error (VAR acv : tak_all_command_glob;
                    uni_err  : tsp8_uni_error;
                    err_code : tsp_int4);
 
        PROCEDURE
              a07_b_put_error (VAR acv : tak_all_command_glob;
                    b_err   : tgg_basis_error;
                    err_code : tsp_int4);
 
        PROCEDURE
              a07_nb_put_error (VAR acv : tak_all_command_glob;
                    b_err   : tgg_basis_error;
                    err_code : tsp_int4;
                    VAR n    : tsp_knl_identifier);
 
      ------------------------------ 
 
        FROM
              Scanner   : VAK01;
 
        VAR
              a01sysnullkey         : tgg_sysinfokey;
              a01_il_b_identifier   : tsp_knl_identifier;
 
        FUNCTION
              a01aligned_cmd_len (len : tsp_int4) : tsp_int4;
 
      ------------------------------ 
 
        FROM
              Systeminfo_cache : VAK10;
 
        PROCEDURE
              a10_nil_get_sysinfo (VAR acv : tak_all_command_glob;
                    VAR syskey   : tgg_sysinfokey;
                    dstate       : tak_directory_state;
                    syslen       : tsp_int2;
                    VAR syspoint : tak_sysbufferaddress;
                    VAR b_err    : tgg_basis_error);
 
        PROCEDURE
              a10add_sysinfo (VAR acv : tak_all_command_glob;
                    VAR syspoint : tak_sysbufferaddress;
                    VAR b_err    : tgg_basis_error);
 
        PROCEDURE
              a10repl_sysinfo (VAR acv : tak_all_command_glob;
                    VAR syspoint : tak_sysbufferaddress;
                    VAR b_err    : tgg_basis_error);
 
        PROCEDURE
              a10get_sysinfo (VAR acv : tak_all_command_glob;
                    VAR syskey   : tgg_sysinfokey;
                    dstate       : tak_directory_state;
                    VAR syspoint : tak_sysbufferaddress;
                    VAR b_err    : tgg_basis_error);
 
        PROCEDURE
              a10del_sysinfo (VAR acv : tak_all_command_glob;
                    VAR syskey : tgg_sysinfokey;
                    VAR b_err  : tgg_basis_error);
 
      ------------------------------ 
 
        FROM
              AK_data_dictionary : VAK38;
 
        PROCEDURE
              a38_add_progusage (VAR acv : tak_all_command_glob;
                    progtyp   : tak_progusagetyp;
                    VAR authn : tsp_knl_identifier;
                    VAR tabln : tsp_knl_identifier;
                    VAR coln  : tsp_knl_identifier);
 
      ------------------------------ 
 
        FROM
              Long-Support-Getval: VAK508;
 
        PROCEDURE
              a508_unlock_lock_lcolumnid (VAR acv : tak_all_command_glob;
                    ld_descriptor  : tgg_surrogate;
                    mtype          : tgg_message_type;
                    lock_excl      : boolean);
 
      ------------------------------ 
 
        FROM
              DML_Help_Procedures : VAK54;
 
        PROCEDURE
              a54_fixedpos (VAR acv : tak_all_command_glob;
                    VAR dmli : tak_dml_info);
 
        PROCEDURE
              a54_shortinfo_to_varpart (VAR acv : tak_all_command_glob;
                    store_cmd : boolean;
                    VAR infop : tak_sysbufferaddress);
 
        PROCEDURE
              a54_dml_init (VAR dmli : tak_dml_info;
                    in_union         : boolean);
 
        PROCEDURE
              a54_view_put_into (VAR acv : tak_all_command_glob;
                    VAR dmli             : tak_dml_info);
 
        PROCEDURE
              a54_store_parsinfo (VAR acv : tak_all_command_glob;
                    VAR sysp_arr : tak_syspointerarr);
 
        PROCEDURE
              a54_last_part (VAR acv : tak_all_command_glob;
                    VAR sysp_arr     : tak_syspointerarr;
                    last_pars_part   : boolean);
 
        PROCEDURE
              a54_get_pparsp_pinfop (VAR acv : tak_all_command_glob;
                    VAR sysp_arr : tak_syspointerarr;
                    mtype        : tgg_message_type);
 
      ------------------------------ 
 
        FROM
              DML_Help_Procedures : VAK542;
 
        FUNCTION
              a542initial_cmd_segm (VAR acv : tak_all_command_glob)
                    :
                    tsp1_segment_ptr;
 
      ------------------------------ 
 
        FROM
              DML_Parts : VAK55;
 
        PROCEDURE
              a55_build_key (VAR acv : tak_all_command_glob;
                    VAR dmli : tak_dml_info;
                    VAR dfa  : tak_dfarr;
                    keynode  : integer);
 
        PROCEDURE
              a55_describe_value (VAR acv : tak_all_command_glob;
                    VAR dmli      : tak_dml_info;
                    VAR colinfo   : tak00_columninfo;
                    nodenr        : integer;
                    res_buf_index : integer);
 
      ------------------------------ 
 
        FROM
              Select_Syntax : VAK60;
 
        PROCEDURE
              a60_p_info_output (VAR acv : tak_all_command_glob;
                    VAR sysp_arr : tak_syspointerarr);
 
        PROCEDURE
              a60_get_longinfobuffer (VAR acv : tak_all_command_glob;
                    VAR sysp_arr : tak_syspointerarr;
                    col_cnt      : integer;
                    resultno     : tsp_int4);
 
      ------------------------------ 
 
        FROM
              Select_List : VAK61;
 
        PROCEDURE
              a61_p_long_info (VAR acv : tak_all_command_glob;
                    VAR dmli   : tak_dml_info;
                    VAR colinf : tak00_columninfo);
 
      ------------------------------ 
 
        FROM
              Execute_Select_Expression: VAK660;
 
        PROCEDURE
              a660_search_one_table (VAR acv : tak_all_command_glob;
                    VAR dmli          : tak_dml_info;
                    table_node        : integer;
                    all               : boolean;
                    check_teresult    : boolean;
                    lock_spec         : tak_lockenum;
                    wanted_priv       : tgg_priv_r);
 
      ------------------------------ 
 
        FROM
              filesysteminterface_1 : VBD01;
 
        VAR
              b01niltree_id     : tgg00_FileId;
 
      ------------------------------ 
 
        FROM
              Configuration_Parameter : VGG01;
 
        VAR
              g01code          : tgg_code_globals;
              g01nil_long_qual : tgg_long_qual;
              g01unicode       : boolean;
 
      ------------------------------ 
 
        FROM
              Codetransformation_and_Coding : VGG02;
 
        VAR
              g02codetables : tgg_code_tables;
 
        PROCEDURE
              g02fromtermchar (
                    messcode   : tsp_code_type;
                    VAR object : tsp_moveobj;
                    pos        : tsp_int4;
                    length     : tsp_int4);
 
        PROCEDURE
              g02totermchar (
                    messcode   : tsp_code_type;
                    VAR object : tsp_moveobj;
                    pos        : tsp_int4;
                    length     : tsp_int4);
 
      ------------------------------ 
 
        FROM
              Kernel_move_and_fill : VGG10;
 
        PROCEDURE
              g10fil  (mod_id      : tsp_c6;
                    mod_intern_num : tsp_int4;
                    source_upb     : tsp_int4;
                    VAR source     : tsp_moveobj;
                    source_pos     : tsp_int4;
                    length         : tsp_int4;
                    fill_char      : char;
                    VAR e          : tgg_basis_error);
 
        PROCEDURE
              g10mv  (mod_id      : tsp_c6;
                    mod_intern_num : tsp_int4;
                    source_upb     : tsp_int4;    destin_upb : tsp_int4;
                    VAR source     : tsp_key;     source_pos : tsp_int4;
                    VAR destin     : tsp_moveobj; destin_pos : tsp_int4;
                    length         : tsp_int4;
                    VAR e          : tgg_basis_error);
 
        PROCEDURE
              g10mv3 (mod_id      : tsp_c6;
                    mod_intern_num : tsp_int4;
                    source_upb     : tsp_int4;    destin_upb : tsp_int4;
                    VAR source     : tsp_number;     source_pos : tsp_int4;
                    VAR destin     : tsp_moveobj; destin_pos : tsp_int4;
                    length         : tsp_int4;
                    VAR e          : tgg_basis_error);
 
        PROCEDURE
              g10mv5  (mod_id      : tsp_c6;
                    mod_intern_num : tsp_int4;
                    source_upb     : tsp_int4;        destin_upb : tsp_int4;
                    VAR source     : tsp_moveobj;     source_pos : tsp_int4;
                    VAR destin     : tgg_string_filedescr; d_pos : tsp_int4;
                    length         : tsp_int4;
                    VAR e          : tgg_basis_error);
 
        PROCEDURE
              g10mv6  (mod_id      : tsp_c6;
                    mod_intern_num : tsp_int4;
                    source_upb     : tsp_int4;    destin_upb : tsp_int4;
                    VAR source     : tsp_moveobj; source_pos : tsp_int4;
                    VAR destin     : tsp_moveobj; destin_pos : tsp_int4;
                    length         : tsp_int4;
                    VAR e          : tgg_basis_error);
 
        PROCEDURE
              g10mv10 (mod_id      : tsp_c6;
                    mod_intern_num : tsp_int4;
                    source_upb     : tsp_int4;    destin_upb : tsp_int4;
                    VAR source     : tsp_moveobj; source_pos : tsp_int4;
                    VAR destin     : tgg00_Lock;    destin_pos : tsp_int4;
                    length         : tsp_int4;
                    VAR e          : tgg_basis_error);
 
        PROCEDURE
              g10mv12 (mod_id      : tsp_c6;
                    mod_intern_num : tsp_int4;
                    source_upb     : tsp_int4;    destin_upb : tsp_int4;
                    VAR source     : tsp_moveobj; source_pos : tsp_int4;
                    VAR destin     : tsp_key;     destin_pos : tsp_int4;
                    length         : tsp_int4;
                    VAR e          : tgg_basis_error);
 
        PROCEDURE
              g10mv13 (mod_id      : tsp_c6;
                    mod_intern_num : tsp_int4;
                    source_upb     : tsp_int4;    destin_upb : tsp_int4;
                    VAR source     : tgg00_Lock;    source_pos : tsp_int4;
                    VAR destin     : tsp_moveobj; destin_pos : tsp_int4;
                    length         : tsp_int4;
                    VAR e          : tgg_basis_error);
 
      ------------------------------ 
 
        FROM
              Packet_handling : VSP26;
 
        FUNCTION
              s26size_new_part (packet_ptr : tsp1_packet_ptr;
                    VAR segm : tsp1_segment) : tsp_int4;
 
      ------------------------------ 
 
        FROM
              RTE-Extension-30 : VSP30;
 
        PROCEDURE
              s30map (VAR code_t : tsp_ctable;
                    VAR source   : tsp_moveobj;
                    spos         : tsp_int4;
                    VAR dest     : tsp_moveobj;
                    dpos         : tsp_int4;
                    length       : tsp_int4);
 
        FUNCTION
              s30lnr (VAR str : tsp_moveobj;
                    val       : char;
                    start     : tsp_int4;
                    cnt       : tsp_int4) : tsp_int4;
 
      ------------------------------ 
 
        FROM
              GET-Conversions : VSP40;
 
        PROCEDURE
              s40gsint (VAR buf : tsp_moveobj;
                    pos      : tsp_int4;
                    len      : integer;
                    VAR dest : tsp_int2;
                    VAR res  : tsp_num_error);
 
        PROCEDURE
              s40glint (VAR buf : tsp_moveobj;
                    pos      : tsp_int4;
                    len      : integer;
                    VAR dest : tsp_int4;
                    VAR res  : tsp_num_error);
 
      ------------------------------ 
 
        FROM
              PUT-Conversions : VSP41;
 
        PROCEDURE
              s41psint ( VAR buf : tsp_number;
                    pos     : tsp_int4;
                    len     : integer;
                    frac    : integer;
                    source  : tsp_int2;
                    VAR res : tsp_num_error);
 
        PROCEDURE
              s41plint ( VAR buf : tsp_number;
                    pos     : tsp_int4;
                    len     : integer;
                    frac    : integer;
                    source  : tsp_int4;
                    VAR res : tsp_num_error);
 
      ------------------------------ 
 
        FROM
              Patterns : VSP49;
 
        PROCEDURE
              s49build_pattern (VAR pat_buffer : tsp_moveobj;
                    ct_is_ascii : boolean;
                    start       : tsp_int4;
                    stop        : tsp_int4;
                    escape_char : char;
                    escape      : boolean;
                    string      : boolean;
                    sqlmode     : tsp_sqlmode;
                    VAR ok      : boolean);
 
      ------------------------------ 
 
        FROM
              RTE-Extension-80: VSP80;
 
        PROCEDURE
              s80uni_trans
                    (src_ptr        : tsp_moveobj_ptr;
                    src_len         : tsp_int4;
                    src_codeset     : tsp_int2;
                    dest_ptr        : tsp_moveobj_ptr;
                    VAR dest_len    : tsp_int4;
                    dest_codeset    : tsp_int2;
                    trans_options   : tsp8_uni_opt_set;
                    VAR rc          : tsp8_uni_error;
                    VAR err_char_no : tsp_int4);
&       ifdef TRACE
 
      ------------------------------ 
 
        FROM
              Test_Procedures : VTA01;
 
        PROCEDURE
              t01moveobj (layer  : tgg00_Debug;
                    VAR buf  : tsp00_MoveObj;
                    startpos : tsp00_Int4;
                    endpos   : tsp00_Int4);
 
        PROCEDURE
              t01sname (schicht : tgg00_Debug; nam : tsp00_Sname);
 
        PROCEDURE
              t01lidentifier (schicht : tgg00_Debug;
                    identifier : tsp00_KnlIdentifier);
 
        PROCEDURE
              t01int4 (debug : tgg00_Debug;
                    nam      : tsp00_Sname;
                    int      : tsp00_Int4);
&       endif
 
.CM *-END-* use -----------------------------------------
.sp;.cp 3
Synonym :
 
        PROCEDURE
              a05identifier_get;
 
              tsp_moveobj tsp_knl_identifier
 
        PROCEDURE
              g10mv;
 
              tsp_moveobj tsp_key
 
        PROCEDURE
              g10mv3;
 
              tsp_moveobj tsp_number
 
        PROCEDURE
              g10mv5;
 
              tsp_moveobj tgg_string_filedescr
 
        PROCEDURE
              g10mv10;
 
              tsp_moveobj tgg00_Lock
 
        PROCEDURE
              g10mv12;
 
              tsp_moveobj tsp_key
 
        PROCEDURE
              g10mv13;
 
              tsp_moveobj tgg00_Lock
 
        PROCEDURE
              s41psint;
 
              tsp_moveobj tsp_number
 
        PROCEDURE
              s41plint;
 
              tsp_moveobj tsp_number
 
.CM *-END-* synonym -------------------------------------
.sp;.cp 3
Author  :
.sp
.cp 3
Created : 1986-06-06
.sp
.cp 3
Version : 2002-08-02
.sp
.cp 3
Release :      Date : 1999-02-17
.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    :
 
 
CONST
      c_in_union        = true (* a54_dml_init *);
      c_last_pars_part  = true (* a54_last_part *);
      c_all             = true (* a660_search_one_table *);
      c_check_teresult  = true (* a660_search_one_table *);
      c_is_input        = true (* ak77col_short_info *);
      (*                          ak77loc_and_descr_val *)
      (*                          a77convert *)
      c_cpy_source      = true (* a77replace_descr *);
      c_escape          = true (* s49build_pattern *);
      c_string          = true (* s49build_pattern *);
      c_max_fixed_5     = 99999;
      c_max_pattern_len =   256;
 
VAR
      a77infop_exists : boolean;
 
 
(*------------------------------*) 
 
PROCEDURE
      a77string_col_semantic (VAR acv : tak_all_command_glob);
 
CONST
      c_called_by_copy = true;
      c_use_dest_col   = true;
 
VAR
      b_err         : tgg_basis_error;
      with_epilog   : boolean;
      old_m2_type   : tgg_message2_type;
      lcl_retcode   : tsp_int2;
      lcl_col_ptr   : tak00_colinfo_ptr;
      lcl_b_version : tsp_c2;
      lcl_b_tabart  : tgg_tablekind;
      column_code   : tsp_code_type;
      src_code      : tsp_code_type;
      dst_code      : tsp_code_type;
      coldesc_id    : tgg_surrogate;
      coldesc2_id   : tgg_surrogate;
      dmli          : tak_dml_info;
 
BEGIN
b_err      := e_ok;
(* PTS 1112770 E.Z. *)
IF  acv.a_ex_kind = only_parsing
THEN
    acv.a_info_output := false;
(*ENDIF*) 
a77infop_exists := false;
a54_dml_init (dmli, NOT c_in_union);
IF  acv.a_return_segm^.sp1r_returncode = 0
THEN
    CASE acv.a_ap_tree^ [ acv.a_ap_tree^[ 0 ].n_lo_level ].n_subproc OF
        cak_i_open:
            open_column (acv, dmli, lcl_col_ptr);
        cak_i_fread:
            fread_column (acv, dmli, lcl_col_ptr);
        cak_i_fnull:
            fnull_column (acv, dmli, lcl_col_ptr, with_epilog);
        cak_i_fwrite:
            fwrite_column (acv, dmli, lcl_col_ptr);
        cak_i_close:
            close_column (acv, dmli);
        cak_i_read:
            read_column (acv, dmli, column_code, coldesc_id);
        cak_i_write:
            write_column (acv, dmli, coldesc_id);
        cak_i_trunc:
            trunc_column (acv, dmli, coldesc_id);
        cak_i_length:
            length_column (acv, dmli, column_code, coldesc_id);
        cak_i_search:
            search_column (acv, dmli, coldesc_id);
        cak_i_expand:
            expand_column (acv, dmli, coldesc_id);
        cak_i_copy:
            copy_column (acv, dmli,
                  src_code, dst_code, coldesc_id, coldesc2_id);
        OTHERWISE
            BEGIN
            END
        END;
    (*ENDCASE*) 
(*ENDIF*) 
old_m2_type := acv.a_mblock.mb_type2;
WITH acv DO
    BEGIN
    IF  (a_return_segm^.sp1r_returncode = 0) AND
        (a_ap_tree^ [ a_ap_tree^[ 0 ].n_lo_level ].n_subproc <> cak_i_close)
    THEN
        CASE acv.a_ap_tree^ [ a_ap_tree^[ 0 ].n_lo_level ].n_subproc OF
            cak_i_fwrite,
            cak_i_fread,
            cak_i_fnull,
            cak_i_open :
                WITH dmli.d_sparr.pbasep^.sbase DO
                    a54_last_part (acv, dmli.d_sparr, c_last_pars_part);
                (*ENDWITH*) 
            cak_i_copy :
                BEGIN
                lcl_b_version := cgg_dummy_file_version;
                lcl_b_tabart  := twithoutkey;
                IF  (a_ex_kind <> only_parsing)
                    AND
                    (src_code <> dst_code)
                THEN
                    BEGIN
                    a07_b_put_error (acv, e_not_implemented, 1)
                    END
                ELSE
                    a54_last_part (acv, dmli.d_sparr,
                          c_last_pars_part);
                (*ENDIF*) 
                END;
            OTHERWISE
                BEGIN
                lcl_b_version := cgg_dummy_file_version;
                lcl_b_tabart  := twithoutkey;
                a54_last_part (acv, dmli.d_sparr,
                      c_last_pars_part);
                END
            END;
        (*ENDCASE*) 
    (*ENDIF*) 
    IF  (a_return_segm^.sp1r_returncode = 0) AND (a_ex_kind <> only_parsing)
    THEN
        BEGIN
        CASE acv.a_ap_tree^ [ a_ap_tree^[ 0 ].n_lo_level ].n_subproc OF
            cak_i_fread :
                a77efread_epilog (acv, dmli.d_sparr);
            cak_i_fnull :
                BEGIN
                END;
            cak_i_fwrite:
                a77eopen_epilog (acv, dmli.d_sparr, mm_fwrite);
            cak_i_open:
                a77eopen_epilog (acv, dmli.d_sparr, mm_open);
            cak_i_read:
                a77eread_epilog  (acv, dmli.d_sparr, column_code);
            cak_i_write, cak_i_expand, cak_i_trunc :
                BEGIN
                END;
            cak_i_length:
                a77elength_epilog (acv, NOT c_called_by_copy,
                      column_code, dmli.d_sparr);
            cak_i_copy:
                BEGIN
                (* copy returns copied length in lcq_long_size *)
                a77elength_epilog (acv, c_called_by_copy,
                      dst_code, dmli.d_sparr);
                END;
            cak_i_search:
                a77esearch_epilog (acv, dmli.d_sparr);
            OTHERWISE
                BEGIN
                END
            END;
        (*ENDCASE*) 
        (*====== update if column status has changed ===========*)
        IF  acv.a_return_segm^.sp1r_returncode = 0
        THEN
            BEGIN
            a77test_and_change_coldesc (acv, coldesc_id,
                  NOT c_use_dest_col, old_m2_type);
            END;
        (*ENDIF*) 
        IF  (acv.a_return_segm^.sp1r_returncode = 0)
            AND (old_m2_type = mm_copy)
        THEN
            BEGIN
            a77test_and_change_coldesc (acv, coldesc2_id,
                  c_use_dest_col, old_m2_type)
            END
        (*ENDIF*) 
        END
    ELSE
        WITH acv.a_ap_tree^ [ a_ap_tree^[ 0 ].n_lo_level ] DO
            IF  a77infop_exists
                AND ((n_subproc = cak_i_copy) OR
                (n_subproc = cak_i_fread)  OR
                (n_subproc = cak_i_fwrite) OR
                (n_subproc = cak_i_length) OR
                (n_subproc = cak_i_open)   OR
                (n_subproc = cak_i_read)   OR
                (n_subproc = cak_i_search))
            THEN
                WITH dmli.d_sparr.pinfop^ DO
                    BEGIN
&                   ifdef TRACE
                    t01sname (ak_sem, 'chckpoint 2 ');
                    t01int4 (ak_sem, 'return code:', a_return_segm^.sp1r_returncode);
&                   endif
                    lcl_retcode := a_return_segm^.sp1r_returncode;
                    a_return_segm^.sp1r_returncode := 0;
                    a10del_sysinfo (acv, syskey, b_err);
                    a10del_sysinfo (acv,
                          dmli.d_sparr.pcolnamep^.syskey, b_err);
                    a_return_segm^.sp1r_returncode := lcl_retcode;
                    END
                (*ENDWITH*) 
            (*ENDIF*) 
        (*ENDWITH*) 
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      open_column (VAR acv  : tak_all_command_glob;
            VAR dmli        : tak_dml_info;
            VAR lcl_col_ptr : tak00_colinfo_ptr);
 
VAR
      curr_n       : tsp_int2;
      key_node     : tsp_int2;
      write_req    : boolean;
      max_req      : boolean;
      wanted_priv  : tgg_priv_r;
 
BEGIN
write_req := false;
max_req   := false;
WITH acv DO
    BEGIN
    wanted_priv := r_sel;
    write_req   :=
          a_ap_tree^ [ a_ap_tree^ [ a_ap_tree^[ 0 ].
          n_lo_level ].n_sa_level ].n_subproc = cak_i_update;
    max_req   :=
          a_ap_tree^ [ a_ap_tree^ [ a_ap_tree^[ 0 ].
          n_lo_level ].n_sa_level ].n_length = cak_i_max;
    IF  write_req
    THEN
        wanted_priv := r_upd;
    (*ENDIF*) 
    key_node :=
          a_ap_tree^[ a_ap_tree^ [ a_ap_tree^[ 0 ].
          n_lo_level ].n_sa_level ].n_lo_level;
    dmli.d_acttabindex := 1;
    dmli.d_cntfromtab  := 1;
    open_column_table_check ( acv, dmli,
          lcl_col_ptr, key_node, mm_open, wanted_priv, write_req);
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        open_column_output_parms (acv, dmli, key_node,
              curr_n, max_req);
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      fnull_column (VAR acv : tak_all_command_glob;
            VAR dmli        : tak_dml_info;
            VAR lcl_col_ptr : tak00_colinfo_ptr;
            VAR with_epilog : boolean);
 
VAR
      curr_n      : tsp_int2;
      key_node    : tsp_int2;
      lcl_colinfo : tak00_columninfo;
      write_req   : boolean;
      wanted_priv : tgg_priv_r;
 
BEGIN
with_epilog := false;
write_req   := true;
WITH acv DO
    BEGIN
    wanted_priv := r_upd;
    key_node := a_ap_tree^ [ a_ap_tree^[ 0 ].n_lo_level ].n_sa_level;
    dmli.d_acttabindex := 1;
    dmli.d_cntfromtab  := 1;
    open_column_table_check ( acv, dmli,
          lcl_col_ptr, key_node,
          mm_fnull, wanted_priv, write_req);
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        BEGIN
        lcl_colinfo.ccolumnn := a01_il_b_identifier;
        curr_n := a_ap_tree^ [ key_node ].n_sa_level;
        IF  a_ap_tree^ [ curr_n ].n_symb = s_parameter_name
        THEN
            BEGIN
            with_epilog := true;
            ak77init_colinfo (dmli, lcl_colinfo, dchb, 0, 9,
                  8, [  ], fp_val_all_with_len);
            ak77loc_and_descr_val (acv, dmli, lcl_colinfo,
                  curr_n, c_is_input);
            END;
        (*ENDIF*) 
        END
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      fread_column (VAR acv : tak_all_command_glob;
            VAR dmli        : tak_dml_info;
            VAR lcl_col_ptr : tak00_colinfo_ptr);
 
CONST
      ldoffset_for_fread   = 30;
      (* h.b. 07.09.1995 i have to think about that *)
      no_of_out_cols       = 5;
 
VAR
      write_req        : boolean;
      max_req          : boolean;
      curr_n           : tsp_int2;
      key_node         : tsp_int2;
      lcl_colinfo      : tak00_columninfo;
      wanted_priv      : tgg_priv_r;
 
BEGIN
write_req := false;
max_req   := false;
WITH acv DO
    BEGIN
    wanted_priv := r_sel;
    write_req   :=
          a_ap_tree^ [ a_ap_tree^ [ a_ap_tree^[ 0 ].
          n_lo_level ].n_sa_level ].n_subproc = cak_i_update;
    max_req   :=
          a_ap_tree^ [ a_ap_tree^ [ a_ap_tree^[ 0 ].
          n_lo_level ].n_sa_level ].n_length = cak_i_max;
    IF  write_req
    THEN
        wanted_priv := r_upd;
    (*ENDIF*) 
    key_node :=
          a_ap_tree^[ a_ap_tree^ [ a_ap_tree^[ 0 ].
          n_lo_level ].n_sa_level ].n_lo_level;
    dmli.d_acttabindex := 1;
    dmli.d_cntfromtab  := 1;
    open_column_table_check ( acv, dmli,
          lcl_col_ptr, key_node,
          mm_fread, wanted_priv, write_req);
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        open_column_output_parms (acv, dmli, key_node,
              curr_n, max_req);
    (*ENDIF*) 
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        BEGIN
        curr_n := a_ap_tree^ [ curr_n ].n_sa_level;
        IF  a_ap_tree^ [ curr_n ].n_symb = s_parameter_name
        THEN
            BEGIN
            ak77init_colinfo (dmli, lcl_colinfo, dfixed, 0,
                  5, 5, [  ], fp_val_all_with_len);
            IF  a_ex_kind = only_parsing
            THEN
                BEGIN
                ak77col_short_info (acv, dmli.d_sparr, lcl_colinfo,
                      a_ap_tree^ [ curr_n ].n_length);
                END
            ELSE
                IF  a_info_output
                THEN
                    BEGIN
                    dmli.d_keylen := 0;
                    a061assign_colname ('NO OF BYTES READ  ',
                          lcl_colinfo.ccolumnn);
                    lcl_colinfo.ccolumnn_len := chr(16);
                    IF  a77infop_exists
                    THEN
                        ak77col_long_info (acv, dmli, lcl_colinfo);
                    (*ENDIF*) 
                    dmli.d_inoutpos :=
                          dmli.d_inoutpos + lcl_colinfo.cinoutlen;
                    END;
                (*ENDIF*) 
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        curr_n := a_ap_tree^ [ curr_n ].n_sa_level;
        IF  a_ap_tree^ [ curr_n ].n_symb = s_parameter_name
        THEN
            BEGIN
            ak77init_colinfo (dmli, lcl_colinfo, dfixed, 0,
                  7, 10, [  ], fp_val_all_with_len);
            IF  a_ex_kind = only_parsing
            THEN
                BEGIN
                ak77col_short_info (acv, dmli.d_sparr, lcl_colinfo,
                      a_ap_tree^ [ curr_n ].n_length);
                END
            ELSE
                IF  a_info_output
                THEN
                    BEGIN
                    dmli.d_keylen := 0;
                    a061assign_colname ('TOTAL LENGTH      ',
                          lcl_colinfo.ccolumnn);
                    lcl_colinfo.ccolumnn_len := chr(12);
                    IF  a77infop_exists
                    THEN
                        ak77col_long_info (acv, dmli, lcl_colinfo);
                    (*ENDIF*) 
                    dmli.d_inoutpos :=
                          dmli.d_inoutpos + lcl_colinfo.cinoutlen;
                    END;
                (*ENDIF*) 
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        curr_n := a_ap_tree^ [ curr_n ].n_sa_level;
        IF  a_ap_tree^ [ curr_n ].n_symb = s_parameter_name
        THEN
            BEGIN
            ak77init_colinfo (dmli, lcl_colinfo,
                  lcl_col_ptr^.cdatatyp,
                  0, 0, 0, [  ], fp_val_all_with_len);
            IF  a_ap_tree^ [ curr_n ].n_symb = s_parameter_name
            THEN
                IF  a_ex_kind = only_parsing
                THEN
                    ak77col_short_info (acv, dmli.d_sparr,
                          lcl_colinfo,
                          a_ap_tree^ [ curr_n ].n_length)
                ELSE
                    IF  a_info_output
                    THEN
                        BEGIN
                        dmli.d_keylen := 0;
                        a061assign_colname ('BUFFER            ',
                              lcl_colinfo.ccolumnn);
                        lcl_colinfo.ccolumnn_len := chr(6);
                        IF  a77infop_exists
                        THEN
                            ak77col_long_info (acv, dmli, lcl_colinfo);
                        (*ENDIF*) 
                        END;
                    (*ENDIF*) 
                (*ENDIF*) 
            (*ENDIF*) 
            END
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        WITH a_mblock, mb_qual^.ml_long_qual DO
            BEGIN
            lq_len         := ak77max_read_len (acv, dmli,
                  ldoffset_for_fread, no_of_out_cols);
            lq_data_offset := mb_data_len
            END;
        (*ENDWITH*) 
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      fwrite_column (VAR acv : tak_all_command_glob;
            VAR dmli        : tak_dml_info;
            VAR lcl_col_ptr : tak00_colinfo_ptr);
 
VAR
      curr_n      : tsp_int2;
      key_node    : tsp_int2;
      lcl_colinfo : tak00_columninfo;
      write_req   : boolean;
      max_req     : boolean;
      trunc_req   : boolean;
      column_code : tsp_code_type;
      wanted_priv : tgg_priv_r;
 
BEGIN
write_req   := true;
max_req     := false;
trunc_req   := false;
wanted_priv := r_upd;
WITH acv DO
    BEGIN
    max_req   :=
          a_ap_tree^[ a_ap_tree^ [ a_ap_tree^[ 0 ].
          n_lo_level ].n_sa_level ].n_length = cak_i_max;
    trunc_req :=
          a_ap_tree^[ a_ap_tree^ [ a_ap_tree^[ 0 ].
          n_lo_level ].n_sa_level ].n_subproc = cak_i_trunc;
    key_node :=
          a_ap_tree^[ a_ap_tree^ [ a_ap_tree^[ 0 ].
          n_lo_level ].n_sa_level ].n_lo_level;
    dmli.d_acttabindex  := 1;
    dmli.d_cntfromtab  := 1;
    open_column_table_check (acv, dmli,
          lcl_col_ptr, key_node,
          mm_fwrite, wanted_priv, write_req);
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        open_column_output_parms (acv, dmli, key_node,
              curr_n, max_req);
    (*==========*)
    (*ENDIF*) 
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        BEGIN
        CASE (ord(a_mblock.mb_st^[ 1 ].ecol_tab [ 1 ]))
              OF
            0:
                column_code := csp_ebcdic;
            1:
                column_code := csp_ascii;
            2:
                column_code := csp_codeneutral;
            4:
                column_code := csp_unicode;
            OTHERWISE
                column_code := csp_codeneutral;
            END;
        (*ENDCASE*) 
        curr_n := a_ap_tree^ [ curr_n ].n_sa_level;
        IF  (a_ap_tree^ [ curr_n ].n_symb = s_parameter_name)
        THEN
            BEGIN
            ak77init_colinfo (dmli, lcl_colinfo, dfixed, 0, 5,
                  5, [  ], fp_val_all_with_len);
            ak77loc_and_descr_val (acv, dmli, lcl_colinfo,
                  curr_n, c_is_input);
            IF  a_ex_kind <> only_parsing
            THEN
                BEGIN
                a77sget_length (acv, column_code, a_input_data_pos, 5);
                a_input_data_pos := a_input_data_pos + 5;
                END
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        IF  a_return_segm^.sp1r_returncode = 0
        THEN
            BEGIN
            curr_n := a_ap_tree^ [ curr_n ].n_sa_level;
            IF  a_ap_tree^ [ curr_n ].n_symb = s_parameter_name
            THEN
                BEGIN
                ak77init_colinfo (dmli, lcl_colinfo,
                      lcl_col_ptr^.cdatatyp,
                      0, 0, 0, [  ], fp_val_all_with_len);
                ak77loc_and_descr_val (acv, dmli,
                      lcl_colinfo, curr_n, c_is_input);
                IF  a_ex_kind <> only_parsing
                THEN
                    a77bget_buffer (acv, column_code, a_input_data_pos);
                (*ENDIF*) 
                END
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        IF  a_return_segm^.sp1r_returncode = 0
        THEN
            WITH a_mblock.mb_qual^.ml_long_qual DO
                BEGIN
                lq_pos       := 1;
                lq_trunc_req := trunc_req
                END
            (*ENDWITH*) 
        (*ENDIF*) 
        END
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      open_column_table_check (VAR acv : tak_all_command_glob;
            VAR dmli        : tak_dml_info;
            VAR lcl_col_ptr : tak00_colinfo_ptr;
            key_node        : tsp_int2;
            m2_type         : tgg_message2_type;
            wanted_priv     : tgg_priv_r;
            write_req       : boolean);
 
VAR
      lcl_colinfo : tak00_columninfo;
      column_node : tsp_int2;
 
BEGIN
WITH acv, a_mblock DO
    BEGIN
    a660_search_one_table (acv, dmli, a_ap_tree^ [ a_ap_tree^[ 0 ].
          n_lo_level ].n_lo_level,
          c_all, NOT c_check_teresult, no_lock_string, wanted_priv);
&   ifdef TRACE
    t01lidentifier (ak_sem, dmli.d_tabarr [ 1 ].ouser);
    t01lidentifier (ak_sem, dmli.d_tabarr [ 1 ].otable);
&   endif
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        BEGIN
        a06a_mblock_init (acv, m_column, m2_type,
              dmli.d_tabarr [1].otreeid);
        IF  dmli.d_sparr.pbasep^.sbase.bsegmentid = cgg_public_segment_id
        THEN
            mb_replicated := rpl_full;
        (*ENDIF*) 
        mb_qual_len := mb_qual_len + sizeof (mb_qual^.ml_long_qual);
        mb_qual^.ml_long_qual := g01nil_long_qual;
        column_node := a_ap_tree^ [ a_ap_tree^[ 0 ].n_lo_level ].n_lo_level;
        IF  a_ap_tree^[ column_node ].n_symb = s_authid
        THEN
            column_node := a_ap_tree^[ column_node ].n_sa_level;
        (*ENDIF*) 
        IF  a_ap_tree^[ column_node ].n_symb = s_tablename
        THEN
            column_node := a_ap_tree^[ column_node ].n_sa_level;
        (*ENDIF*) 
        WITH a_ap_tree^ [ column_node ] DO
            IF  n_symb = s_columnname
            THEN
                BEGIN
                a05identifier_get (acv, column_node,
                      sizeof (dmli.d_column), dmli.d_column);
&               ifdef TRACE
                t01lidentifier (ak_sem, dmli.d_column);
&               endif
                IF  NOT a061exist_columnname (dmli.d_sparr.pbasep^.sbase,
                    dmli.d_column, lcl_col_ptr)
                THEN
                    a07_nb_put_error (acv, e_unknown_columnname, n_pos,
                          dmli.d_column)
                ELSE
                    WITH lcl_col_ptr^ DO
                        BEGIN
                        IF  cdatatyp in [ dstra, dstre, dstruni,
                            dstrb, dstrdb ]
                        THEN
                            BEGIN
                            lcl_colinfo.creccolno := creccolno;
                            lcl_colinfo.cextcolno := cextcolno;
                            lcl_colinfo.ccolumnn  := ccolumnn;
                            mb_qual^.mcol_cnt := 1;
                            mb_qual^.mcol_pos := 1;
                            mb_qual^.mfirst_free := 2;
                            mb_st^[ 1 ] := ccolstack;
                            (* code is determined by first stackentry *)
                            IF  ctinvisible in ccolpropset
                            THEN
                                a07_nb_put_error (acv, e_unknown_columnname,
                                      n_pos, dmli.d_column)
                            ELSE
                                IF  NOT dmli.d_tabarr [ 1 ].oall_priv
                                THEN
                                    IF  ((wanted_priv = r_sel) AND NOT
                                        ((creccolno in dmli.d_upd_set)
                                        OR
                                        (creccolno in
                                        dmli.d_tabarr [ 1 ].oprivset)))
                                        OR ((wanted_priv = r_upd) AND NOT
                                        ((creccolno in dmli.d_upd_set)
                                        OR
                                        (creccolno in
                                        dmli.d_tabarr [ 1 ].oprivset)))
                                    THEN
                                        BEGIN
&                                       ifdef TRACE
                                        t01sname (ak_sem, 'a77 privchck');
&                                       endif
                                        a07_nb_put_error (acv,
                                              e_missing_privilege,
                                              n_pos, dmli.d_column);
                                        END;
                                    (*ENDIF*) 
                                (*ENDIF*) 
                            (*ENDIF*) 
                            END
                        ELSE
                            a07_nb_put_error (acv,
                                  e_incompatible_datatypes,
                                  n_pos, dmli.d_column);
                        (*ENDIF*) 
                        END
                    (*ENDWITH*) 
                (*ENDIF*) 
                END
            (*ENDIF*) 
        (*ENDWITH*) 
        END;
    (*ENDIF*) 
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        a38_add_progusage (acv, p_column, dmli.d_tabarr [ 1 ].ouser,
              dmli.d_tabarr [ 1 ].otable, dmli.d_column);
    (*ENDIF*) 
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        BEGIN
        WITH mb_qual^ DO
            BEGIN
            mtree.fileHandling_gg00 := a_transinf.tri_global_state;
            IF  write_req  AND (hsWithoutLock_egg00 in mtree.fileHandling_gg00)
            THEN
                mtree.fileHandling_gg00 := mtree.fileHandling_gg00 -
                      [ hsWithoutLock_egg00 ];
            (*ENDIF*) 
            mbool := false;
            IF  write_req
            THEN
                mbool := true;
            (*ENDIF*) 
            END;
        (*ENDWITH*) 
        IF  a_ex_kind = only_parsing
        THEN
            a54_get_pparsp_pinfop (acv, dmli.d_sparr, m_column);
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        WITH a_ap_tree^ [ key_node ] DO
            IF  (n_proc = a55) AND (n_subproc = cak_x_keyspec_list)
            THEN
                WITH mb_data^ DO
                    BEGIN
                    dmli.d_pars_kind := fp_val_varcol_with_len;
                    build_key (acv, dmli, key_node);
&                   ifdef TRACE
                    t01int4 (ak_sem, 'bld ky datal', mb_data_len);
                    t01int4 (ak_sem, 'bld ky  recl', mbp_reclen);
                    t01int4 (ak_sem, 'bld ky  keyl', mbp_keylen);
                    t01moveobj (ak_sem, mbp_buf, 1, mb_data_len);
&                   endif
                    mbp_keylen  := mb_data_len - cgg_rec_key_offset;
                    END;
                (*ENDWITH*) 
            (*ENDIF*) 
        (*ENDWITH*) 
    (*ENDIF*) 
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        BEGIN
&       ifdef TRACE
        t01int4 (ak_sem, 'ctc 1stfree ', mb_qual^.mfirst_free);
        t01int4 (ak_sem, 'd_maxlen    ', dmli.d_maxlen);
&       endif
        (* h.b. 29.09.1995
              if there is any qualification then we put it behind
              the max_keylen *)
        mb_data_len := MAX_KEYLEN_GG00;
        dmli.d_maxlen := 0;
        IF  a_ex_kind = only_parsing
        THEN
            a54_fixedpos (acv, dmli);
        (*ENDIF*) 
        IF  dmli.d_sparr.pbasep^.sbase.btablekind = tonebase
        THEN
            a54_view_put_into (acv, dmli);
&       ifdef TRACE
        (*ENDIF*) 
        t01int4 (ak_sem, 'ctc 1stfree ', mb_qual^.mfirst_free);
&       endif
        END;
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      build_key (VAR acv : tak_all_command_glob;
            VAR dmli : tak_dml_info;
            keynode  : integer);
 
VAR
      dfa : tak_dfarr;
 
BEGIN
a55_build_key (acv, dmli, dfa, keynode);
END;
 
(*------------------------------*) 
 
PROCEDURE
      open_column_output_parms (VAR acv : tak_all_command_glob;
            VAR dmli   : tak_dml_info;
            key_node   : tsp_int2;
            VAR curr_n : tsp_int2;
            max_req    : boolean);
 
VAR
      lcl_colinfo  : tak00_columninfo;
 
BEGIN
WITH acv DO
    BEGIN
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        BEGIN
        curr_n := a_ap_tree^ [ key_node ].n_sa_level;
        IF  a_ap_tree^ [ curr_n ].n_symb = s_parameter_name
        THEN
            BEGIN
            ak77init_colinfo (dmli, lcl_colinfo, dchb, 0, 9, 8,
                  [  ], fp_val_all_with_len);
            IF  a_ex_kind = only_parsing
            THEN
                ak77col_short_info (acv, dmli.d_sparr, lcl_colinfo,
                      a_ap_tree^ [ curr_n ].n_length)
            ELSE
                IF  a_info_output
                THEN
                    BEGIN
                    a60_get_longinfobuffer (acv, dmli.d_sparr,
                          MAX_COL_PER_TAB_GG00, cak_into_res_fid);
                    IF  a_return_segm^.sp1r_returncode = 0
                    THEN
                        a77infop_exists := true;
                    (*ENDIF*) 
                    dmli.d_inoutpos := cgg_rec_key_offset + 1;
                    dmli.d_keylen := 0;
                    a061assign_colname ('COLUMN ID         ',
                          lcl_colinfo.ccolumnn);
                    lcl_colinfo.ccolumnn_len := chr (9);
                    IF  a77infop_exists
                    THEN
                        ak77col_long_info (acv, dmli, lcl_colinfo);
                    (*ENDIF*) 
                    dmli.d_inoutpos :=
                          dmli.d_inoutpos + lcl_colinfo.cinoutlen;
                    END;
                (*ENDIF*) 
            (*ENDIF*) 
            END
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  (a_return_segm^.sp1r_returncode = 0) AND max_req
    THEN
        BEGIN
        curr_n := a_ap_tree^ [ curr_n ].n_sa_level;
        IF  a_ex_kind = only_parsing
        THEN
            dmli.d_sparr.pparsp^.sparsinfo.p_reuse := true;
        (*===== p_reuse used as max_req_flag for execution =====*)
        (*ENDIF*) 
        IF  a_ap_tree^ [ curr_n ].n_symb = s_parameter_name
        THEN
            BEGIN
            ak77init_colinfo (dmli, lcl_colinfo, dfixed, 0,
                  5, 5, [  ], fp_val_all_with_len);
            IF  a_ex_kind = only_parsing
            THEN
                ak77col_short_info (acv, dmli.d_sparr, lcl_colinfo,
                      a_ap_tree^ [ curr_n ].n_length)
            ELSE
                IF  a_info_output
                THEN
                    BEGIN
                    dmli.d_keylen := 0;
                    a061assign_colname ('MAX WRITE LENGTH  ',
                          lcl_colinfo.ccolumnn);
                    lcl_colinfo.ccolumnn_len := chr (16);
                    IF  a77infop_exists
                    THEN
                        ak77col_long_info (acv, dmli, lcl_colinfo);
                    (*ENDIF*) 
                    dmli.d_inoutpos :=
                          dmli.d_inoutpos + lcl_colinfo.cinoutlen;
                    END;
                (*ENDIF*) 
            (*ENDIF*) 
            END
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a77eopen_epilog (VAR acv : tak_all_command_glob;
            VAR sysp_arr : tak_syspointerarr;
            m2type       : tgg_message2_type);
 
CONST
      of_buf_in_old_varpart = 22;
      (*======== id + fix 10 + fix 5 + def by  = 22 Byte *)
 
VAR
      b_err          : tgg_basis_error;
      res            : tsp_num_error;
      c              : tsp_c1;
      aux_int4       : tsp_int4;
      max_write_len  : tsp_int4;
      output_cnt     : integer;
      num            : tsp_number;
      coldesc_ptr    : tak_sysbufferaddress;
      coldesc_key    : tgg_sysinfokey;
 
BEGIN
b_err := e_ok;
WITH acv, a_mblock DO
    BEGIN
    coldesc_key           := a01sysnullkey;
    coldesc_key.sentrytyp := cak_etempscoldesc;
    coldesc_key.skeylen   := mxak_standard_sysk;
    ak77generate_external_descr (acv, coldesc_key);
    a10_nil_get_sysinfo (acv, coldesc_key, d_release,
          mxak_standard_sysk + 4 +
          mxgg_stringfd + mxgg_lock + mxsp_key,
          coldesc_ptr, b_err);
    IF  b_err = e_ok
    THEN
        BEGIN
        a_dbproc_cache.dbc_ptr := coldesc_ptr;
        coldesc_ptr^.sscoldesc.scd_reclen :=
              mxak_standard_sysk + 4 +
              mxgg_stringfd + mxgg_lock + mxsp_key ;
        g10mv5  ('VAK77 ',   1,    
              mb_data_size,
              sizeof (coldesc_ptr^.sscoldesc.scd_stringfd),
              mb_data^.mbp_buf, cgg_rec_key_offset + 1,
              coldesc_ptr^.sscoldesc.scd_stringfd, 1,
              sizeof (coldesc_ptr^.sscoldesc.scd_stringfd), b_err);
        END;
    (*ENDIF*) 
    IF  b_err = e_ok
    THEN
        g10mv10 ('VAK77 ',   2,    
              mb_data_size, sizeof (coldesc_ptr^.sscoldesc.scd_lock),
              mb_data^.mbp_buf,
              cgg_rec_key_offset + mxgg_stringfd + 1,
              coldesc_ptr^.sscoldesc.scd_lock, 1,
              sizeof (coldesc_ptr^.sscoldesc.scd_lock), b_err);
    (*ENDIF*) 
    IF  b_err = e_ok
    THEN
        g10mv12 ('VAK77 ',   3,    
              mb_data_size,
              sizeof (coldesc_ptr^.sscoldesc.scd_key),
              mb_data^.mbp_buf, cgg_rec_key_offset +
              mxgg_stringfd + mxgg_lock + 1,
              coldesc_ptr^.sscoldesc.scd_key, 1,
              coldesc_ptr^.sscoldesc.scd_lock.lockKeyLen_gg00, b_err);
    (*ENDIF*) 
    IF  (b_err = e_ok) AND (m2type <> mm_nil)
    THEN
        BEGIN
        a_pars_curr.fileHandling_gg00 :=
              a_pars_curr.fileHandling_gg00 - [ hsNoLog_egg00 ];
        a10add_sysinfo (acv, coldesc_ptr, b_err);
        a_pars_curr.fileHandling_gg00 :=
              a_pars_curr.fileHandling_gg00 + [ hsNoLog_egg00 ]
        END;
    (*ENDIF*) 
    IF  (b_err = e_ok) AND (m2type <> mm_nil)
    THEN
        BEGIN
        IF  a_info_output
        THEN
            ak77info_output (acv, sysp_arr, output_cnt)
        ELSE
            BEGIN
            output_cnt := 0;
            IF  (a_ex_kind = only_executing)
            THEN
                IF  (sysp_arr.px[1]^.sparsinfo.p_reuse)
                THEN
                    output_cnt := -1
                (*ENDIF*) 
            (*ENDIF*) 
            END;
        (*ENDIF*) 
&       ifdef TRACE
        t01int4 (ak_sem , 'epi outputs ', output_cnt);
&       endif
        c[1] := csp_defined_byte;
        a06retpart_move (acv, @c[1], 1);
        a06retpart_move (acv, @coldesc_key.stableid,
              sizeof (coldesc_key.stableid));
        IF  b_err = e_ok
        THEN
            BEGIN
            IF  ((a_ex_kind = only_executing)
                AND (output_cnt = -1))
                OR
                ((a_ex_kind <> only_executing)
                AND (((output_cnt = 5) AND (m2type = mm_fread))
                OR ((output_cnt = 2) AND (m2type <> mm_fread))))
            THEN
                BEGIN
                max_write_len := mb_data_size - sizeof (tgg00_Lock) -
                      coldesc_ptr^.sscoldesc.scd_lock.lockKeyLen_gg00 -
                      cgg_rec_key_offset;
                IF  ((a_comp_type = at_unknown) OR
                    (a_comp_vers < csp1_first_sp1_version))
                THEN
                    BEGIN
                    aux_int4 := csp1_old_varpart_size -
                          of_buf_in_old_varpart;
                    IF  aux_int4 < max_write_len
                    THEN
                        max_write_len := aux_int4;
                    (*ENDIF*) 
                    END;
&               ifdef TRACE
                (*ENDIF*) 
                t01int4 (ak_sem , 'max_writelen', max_write_len);
&               endif
                s41psint (num, 1, 5, 0, max_write_len, res);
                IF  res = num_ok
                THEN
                    BEGIN
                    a06retpart_move (acv, @c[1], 1);
                    a06retpart_move (acv, @num, 4);
                    END
                ELSE
                    a77sel_res_err (acv, res);
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            IF  m2type <> mm_fread
            THEN
                a06finish_curr_retpart (acv, sp1pk_data, 1);
            (*ENDIF*) 
            END
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  b_err <> e_ok
    THEN
        a07_b_put_error (acv, b_err, 1);
    (*ENDIF*) 
    IF  a_return_segm^.sp1r_returncode <> 0
    THEN
        a_part_rollback := true;
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a77efread_epilog (VAR acv : tak_all_command_glob;
            VAR sysp_arr : tak_syspointerarr);
 
CONST
      of_l_keylen_in_tgg_lock = 13;
 
VAR
      c                : tsp_c1;
      lock_offset      : tsp_int4;
      column_code      : tsp_code_type;
      num              : tsp_number;
      ic               : tsp_int_map_c2;
      res              : tsp_num_error;
      save_lq_len_pos  : tsp_int4;
      e                : tsp8_uni_error;
      err_char_no      : tsp_int4;
      outlen           : tsp_int4;
 
BEGIN
WITH acv, a_mblock, mb_qual^ DO
    BEGIN
    lock_offset  := cgg_rec_key_offset + mxgg_stringfd;
    ic.map_c2 [1] := mb_data^.mbp_buf
          [lock_offset + of_l_keylen_in_tgg_lock];
    ic.map_c2 [2] := mb_data^.mbp_buf
          [lock_offset + of_l_keylen_in_tgg_lock + 1];
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        a77eopen_epilog (acv, sysp_arr, mm_fread);
    (*ENDIF*) 
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        BEGIN
        IF  mb_trns^.trError_gg00 = e_ok
        THEN
            BEGIN
            c[1] := csp_defined_byte;
            s41psint (num, 1, 5, 0, ml_long_qual.lq_len, res);
            IF  res = num_ok
            THEN
                BEGIN
                a06retpart_move (acv, @c[1], 1);
                save_lq_len_pos := a_curr_retpart^.sp1p_buf_len + 1;
                a06retpart_move (acv, @num, 4);
                END
            ELSE
                a77sel_res_err (acv, res);
            (*ENDIF*) 
            IF  a_return_segm^.sp1r_returncode = 0
            THEN
                BEGIN
                s41plint (num, 1, 10, 0, ml_long_qual.lq_long_size, res);
                IF  res = num_ok
                THEN
                    BEGIN
                    a06retpart_move (acv, @c[1], 1);
                    a06retpart_move (acv, @num, 6);
                    END
                ELSE
                    a77sel_res_err (acv, res);
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            IF  a_return_segm^.sp1r_returncode = 0
            THEN
                BEGIN
                column_code := ml_long_qual.lq_code;
                a06retpart_move (acv, @c[1], 1);
                IF  mb_data_len > ml_long_qual.lq_data_offset
                THEN
                    IF  (column_code = csp_unicode)
                        AND (a_out_packet^.sp1_header.sp1h_mess_swap <> sw_normal)
                        AND (a_out_packet^.sp1_header.sp1h_mess_code <> csp_unicode)
                    THEN
                        WITH a_curr_retpart^ DO
                            BEGIN
                            outlen :=  sp1p_buf_size - sp1p_buf_len;
                            s80uni_trans (@mb_data^.mbp_buf [ml_long_qual.lq_data_offset + 1],
                                  ml_long_qual.lq_len, csp_unicode,
                                  @(sp1p_buf[sp1p_buf_len+1]), outlen,
                                  csp_unicode_swap,
                                  [ ], e, err_char_no);
                            IF  e = uni_dest_too_short
                            THEN
                                BEGIN
                                ml_long_qual.lq_len := err_char_no;
                                e := uni_ok;
                                END;
                            (*ENDIF*) 
                            IF  e <> uni_ok
                            THEN
                                a07_uni_error (acv, e, err_char_no)
                            ELSE
                                BEGIN
                                s41psint (num, 1, 5, 0,
                                      ml_long_qual.lq_len DIV 2, res);
                                g10mv3 ('VAK77 ',   4,    
                                      sizeof (num), sp1p_buf_size,
                                      num, 1, sp1p_buf, save_lq_len_pos, 4,
                                      a_return_segm^.sp1r_returncode);
                                sp1p_buf_len := sp1p_buf_len + outlen;
                                END;
                            (*ENDIF*) 
                            END
                        (*ENDWITH*) 
                    ELSE
                        IF  (column_code in [csp_ascii, csp_ebcdic]) AND
                            (a_out_packet^.sp1_header.sp1h_mess_code in
                            [csp_unicode, csp_unicode_swap])
                        THEN
                            WITH a_curr_retpart^ DO
                                BEGIN
                                IF  column_code = csp_ebcdic
                                THEN
                                    s30map (g02codetables.tables[ cgg_to_ascii ],
                                          mb_data^.mbp_buf,
                                          ml_long_qual.lq_data_offset + 1,
                                          mb_data^.mbp_buf,
                                          ml_long_qual.lq_data_offset + 1,
                                          ml_long_qual.lq_len);
                                (*ENDIF*) 
                                outlen :=  sp1p_buf_size - sp1p_buf_len;
                                s80uni_trans (@mb_data^.mbp_buf [ml_long_qual.lq_data_offset + 1],
                                      ml_long_qual.lq_len, csp_ascii,
                                      @(sp1p_buf[sp1p_buf_len+1]), outlen,
                                      a_out_packet^.sp1_header.sp1h_mess_code,
                                      [ ], e, err_char_no);
                                IF  e = uni_dest_too_short
                                THEN
                                    BEGIN
                                    ml_long_qual.lq_len := err_char_no;
                                    e := uni_ok;
                                    END;
                                (*ENDIF*) 
                                IF  e <> uni_ok
                                THEN
                                    a07_uni_error (acv, e, err_char_no)
                                ELSE
                                    BEGIN
                                    s41psint (num, 1, 5, 0,
                                          ml_long_qual.lq_len, res);
                                    g10mv3 ('VAK77 ',   5,    
                                          sizeof (num), sp1p_buf_size,
                                          num, 1, sp1p_buf, save_lq_len_pos, 4,
                                          a_return_segm^.sp1r_returncode);
                                    sp1p_buf_len := sp1p_buf_len + outlen;
                                    END;
                                (*ENDIF*) 
                                END
                            (*ENDWITH*) 
                        ELSE
                            BEGIN
                            a06retpart_move (acv,
                                  @mb_data^.mbp_buf [ml_long_qual.lq_data_offset + 1],
                                  ml_long_qual.lq_len);
                            IF  column_code = csp_unicode
                            THEN
                                WITH a_curr_retpart^ DO
                                    BEGIN
                                    s41psint (num, 1, 5, 0,
                                          ml_long_qual.lq_len DIV 2, res);
                                    g10mv3 ('VAK77 ',   6,    
                                          sizeof (num), sp1p_buf_size,
                                          num, 1, sp1p_buf, save_lq_len_pos, 4,
                                          a_return_segm^.sp1r_returncode);
                                    END;
                                (*ENDWITH*) 
                            (*ENDIF*) 
                            IF  a_return_segm^.sp1r_returncode = 0
                            THEN
                                a77convert (acv, a_curr_retpart^.sp1p_buf, column_code,
                                      a_curr_retpart^.sp1p_buf_len + 1 - ml_long_qual.lq_len,
                                      ml_long_qual.lq_len, NOT c_is_input);
                            (*ENDIF*) 
                            END;
                        (*ENDIF*) 
                    (*ENDIF*) 
                (*ENDIF*) 
                IF  a_return_segm^.sp1r_returncode = 0
                THEN
                    a06finish_curr_retpart (acv, sp1pk_data, 1);
                (*ENDIF*) 
                END
            (*ENDIF*) 
            END
        ELSE
            a07_b_put_error (acv, mb_trns^.trError_gg00, 1)
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
&ifdef TRACE
t01sname (ak_sem, 'fread ep end');
&endif
END;
 
(*------------------------------*) 
 
PROCEDURE
      close_column (VAR acv : tak_all_command_glob;
            VAR dmli : tak_dml_info);
 
VAR
      lcl_colinfo      : tak00_columninfo;
      curr_n           : tsp_int2;
 
BEGIN
WITH acv DO
    BEGIN
    a06a_mblock_init (acv, m_column, mm_close, b01niltree_id);
    WITH a_mblock DO
        BEGIN
        mb_qual_len := mb_qual_len + sizeof (mb_qual^.ml_long_qual);
        mb_qual^.ml_long_qual := g01nil_long_qual;
        END;
    (*ENDWITH*) 
    IF  a_ex_kind = only_parsing
    THEN
        a54_get_pparsp_pinfop (acv, dmli.d_sparr, m_column);
    (*ENDIF*) 
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        BEGIN
        curr_n := a_ap_tree^ [ a_ap_tree^[ 0 ].n_lo_level ].n_sa_level;
        ak77init_colinfo (dmli, lcl_colinfo, dchb, 0, 9, 8,
              [  ], fp_val_all_with_len);
        ak77loc_and_descr_val (acv, dmli, lcl_colinfo,
              curr_n, c_is_input);
        IF  a_ex_kind = only_parsing
        THEN
            BEGIN
            dmli.d_sparr.pparsp^.sparsinfo.p_select := false;
            a54_store_parsinfo       (acv, dmli.d_sparr);
            a54_shortinfo_to_varpart (acv,
                  a542initial_cmd_segm(acv)^.sp1c_prepare,
                  dmli.d_sparr.pinfop);
            END
        ELSE
            a77get_and_close_descr (acv)
        (*ENDIF*) 
        END
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a77get_and_close_descr (VAR acv : tak_all_command_glob);
 
VAR
      b_err          : tgg_basis_error;
      coldesc_ptr    : tak_sysbufferaddress;
      coldesc_key    : tgg_sysinfokey;
      tableid_ptr    : ^tgg_surrogate;
 
BEGIN
b_err := e_ok;
WITH acv DO
    IF  a_ex_kind <> only_parsing
    THEN
        BEGIN
        IF  a_data_ptr^[ 1 ] = csp_undef_byte
        THEN
            a07_b_put_error (acv, e_st_col_not_open, 1)
        ELSE
            BEGIN
            coldesc_key           := a01sysnullkey;
            coldesc_key.sentrytyp := cak_etempscoldesc;
            coldesc_key.skeylen   := mxak_standard_sysk;
            tableid_ptr           := @(a_data_ptr^[2]);
            coldesc_key.stableid  := tableid_ptr^;
            a10get_sysinfo (acv, coldesc_key, d_release, coldesc_ptr, b_err);
            IF  b_err <> e_ok
            THEN
                IF  b_err = e_sysinfo_not_found
                THEN
                    a07_b_put_error (acv, e_st_col_not_open, 1)
                ELSE
                    a07_b_put_error (acv, b_err, 1)
                (*ENDIF*) 
            ELSE
                BEGIN
                ak77unlock_colid (acv,
                      coldesc_ptr^.sscoldesc.scd_stringfd,
                      coldesc_ptr^.sscoldesc.scd_lock);
                a_pars_curr.fileHandling_gg00 :=
                      a_pars_curr.fileHandling_gg00 - [ hsNoLog_egg00 ];
                a10del_sysinfo (acv, coldesc_key, b_err);
                a_pars_curr.fileHandling_gg00 :=
                      a_pars_curr.fileHandling_gg00 + [ hsNoLog_egg00 ];
                IF  (b_err <> e_ok)
                THEN
                    a07_b_put_error (acv, b_err, 1)
                (*ENDIF*) 
                END
            (*ENDIF*) 
            END
        (*ENDIF*) 
        END
    (*ENDIF*) 
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      read_column (VAR acv  : tak_all_command_glob;
            VAR dmli        : tak_dml_info;
            VAR column_code : tsp_code_type;
            VAR coldesc_id  : tgg_surrogate);
 
CONST
      ldoffset_for_read   = 6;
      no_of_out_cols      = 2;
 
VAR
      curr_n           : tsp_int2;
      cfd              : tgg_string_filedescr;
      lcl_colinfo      : tak00_columninfo;
      dtyp             : tsp_data_type;
 
BEGIN
WITH acv, a_mblock DO
    BEGIN
    a06a_mblock_init (acv, m_column, mm_read, b01niltree_id);
    mb_qual_len := mb_qual_len + sizeof (mb_qual^.ml_long_qual);
    mb_qual^.ml_long_qual := g01nil_long_qual;
    IF  a_ex_kind = only_parsing
    THEN
        a54_get_pparsp_pinfop (acv, dmli.d_sparr, m_column);
    (*ENDIF*) 
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        BEGIN
        curr_n := a_ap_tree^ [ a_ap_tree^[ 0 ].n_lo_level ].n_sa_level;
        rw_loc_input_params (acv, curr_n, dmli, lcl_colinfo,
              cfd, coldesc_id);
        IF  a_ex_kind <> only_parsing
        THEN
            CASE cfd.codespec OF
                csp_ascii :
                    dtyp := dstra;
                csp_ebcdic :
                    dtyp := dstre;
                csp_unicode :
                    dtyp := dstruni;
                OTHERWISE :
                    dtyp := dstrb;
                END
            (*ENDCASE*) 
        ELSE
            dtyp := dstrb;
        (*ENDIF*) 
        IF  a_return_segm^.sp1r_returncode = 0
        THEN
            BEGIN
            IF  a_ex_kind <> only_parsing
            THEN
                column_code := cfd.codespec;
            (*ENDIF*) 
            IF  a_ap_tree^ [ curr_n ].n_symb = s_parameter_name
            THEN
                BEGIN
                ak77init_colinfo (dmli, lcl_colinfo, dfixed, 0,
                      5, 5, [  ], fp_val_all_with_len);
                IF  a_ex_kind = only_parsing
                THEN
                    BEGIN
                    ak77col_short_info (acv, dmli.d_sparr, lcl_colinfo,
                          a_ap_tree^ [ curr_n ].n_length);
                    END
                ELSE
                    IF  a_info_output
                    THEN
                        BEGIN
                        a60_get_longinfobuffer (acv, dmli.d_sparr, 2,
                              cak_into_res_fid);
                        IF  a_return_segm^.sp1r_returncode = 0
                        THEN
                            a77infop_exists := true;
                        (*ENDIF*) 
                        dmli.d_inoutpos := cgg_rec_key_offset + 1;
                        dmli.d_keylen := 0;
                        a061assign_colname ('NO OF BYTES READ  ',
                              lcl_colinfo.ccolumnn);
                        lcl_colinfo.ccolumnn_len := chr (16);
                        IF  a77infop_exists
                        THEN
                            ak77col_long_info (acv, dmli, lcl_colinfo)
                        (*ENDIF*) 
                        END;
                    (*ENDIF*) 
                (*ENDIF*) 
                curr_n := a_ap_tree^ [ curr_n ].n_sa_level;
                ak77init_colinfo (dmli, lcl_colinfo, dtyp,
                      0, 0, 0, [  ], fp_val_all_with_len);
                IF  a_ap_tree^ [ curr_n ].n_symb = s_parameter_name
                THEN
                    IF  a_ex_kind = only_parsing
                    THEN
                        ak77col_short_info (acv, dmli.d_sparr,
                              lcl_colinfo,
                              a_ap_tree^ [ curr_n ].n_length)
                    ELSE
                        IF  a_info_output
                        THEN
                            BEGIN
                            dmli.d_inoutpos := cgg_rec_key_offset + 1 + 5;
                            dmli.d_keylen := 0;
                            a061assign_colname ('BUFFER            ',
                                  lcl_colinfo.ccolumnn);
                            lcl_colinfo.ccolumnn_len := chr (6);
                            IF  a77infop_exists
                            THEN
                                ak77col_long_info (acv, dmli, lcl_colinfo);
                            (*ENDIF*) 
                            END;
                        (*ENDIF*) 
                    (*ENDIF*) 
                (*ENDIF*) 
                END
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        IF  a_return_segm^.sp1r_returncode = 0
        THEN
            BEGIN
            WITH mb_qual^.ml_long_qual DO
                BEGIN
                IF  lq_len = -1
                THEN
                    BEGIN
                    lq_len       := ak77max_read_len (acv, dmli,
                          ldoffset_for_read, no_of_out_cols );
                    lq_trunc_req := true;
                    END;
                (*ENDIF*) 
                lq_data_offset := mb_data_len
                END
            (*ENDWITH*) 
            END
        (*ENDIF*) 
        END
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a77eread_epilog (VAR acv : tak_all_command_glob;
            VAR sysp_arr : tak_syspointerarr;
            column_code  : tsp_code_type);
 
VAR
      c                : tsp_c1;
      res              : tsp_num_error;
      num              : tsp_number;
      dummy            : integer;
      save_lq_len_pos  : tsp_int4;
      e                : tsp8_uni_error;
      err_char_no      : tsp_int4;
      outlen           : tsp_int4;
 
BEGIN
WITH acv, a_mblock, mb_qual^ DO
    BEGIN
    IF  mb_trns^.trError_gg00 = e_ok
    THEN
        BEGIN
        IF  a_info_output
        THEN
            ak77info_output (acv, sysp_arr, dummy);
        (*ENDIF*) 
        c[1]     := csp_defined_byte;
        s41psint (num, 1, 5, 0, ml_long_qual.lq_len, res);
        IF  res = num_ok
        THEN
            BEGIN
            a06retpart_move (acv, @c[1], 1);
            save_lq_len_pos := a_curr_retpart^.sp1p_buf_len + 1;
            a06retpart_move (acv, @num, 4);
            a06retpart_move (acv, @c[1], 1);
            END;
&       ifdef TRACE
        (*ENDIF*) 
        t01int4 (ak_sem, 'column_code ', column_code);
        t01int4 (ak_sem, 'mess_code   ',
              a_out_packet^.sp1_header.sp1h_mess_code);
&       endif
        IF  ml_long_qual.lq_len > 0
        THEN
            IF  (column_code = csp_unicode) AND
                (a_out_packet^.sp1_header.sp1h_mess_swap <> sw_normal) AND
                (a_out_packet^.sp1_header.sp1h_mess_code <> csp_unicode)
            THEN
                WITH a_curr_retpart^ DO
                    BEGIN
                    outlen :=  sp1p_buf_size - sp1p_buf_len;
                    s80uni_trans (@mb_data^.mbp_buf [ml_long_qual.lq_data_offset + 1],
                          ml_long_qual.lq_len, csp_unicode,
                          @(sp1p_buf[sp1p_buf_len+1]), outlen,
                          csp_unicode_swap, [ ], e, err_char_no);
                    IF  e = uni_dest_too_short
                    THEN
                        BEGIN
                        ml_long_qual.lq_len := err_char_no;
                        e := uni_ok;
                        END;
                    (*ENDIF*) 
                    IF  e <> uni_ok
                    THEN
                        a07_uni_error (acv, e, err_char_no)
                    ELSE
                        BEGIN
                        s41psint (num, 1, 5, 0,
                              ml_long_qual.lq_len DIV 2, res);
                        g10mv3 ('VAK77 ',   7,    
                              sizeof (num), sp1p_buf_size,
                              num, 1, sp1p_buf, save_lq_len_pos, 4,
                              a_return_segm^.sp1r_returncode);
                        sp1p_buf_len := sp1p_buf_len + outlen;
                        END;
                    (*ENDIF*) 
                    END
                (*ENDWITH*) 
            ELSE
                IF  (column_code in [csp_ascii, csp_ebcdic]) AND
                    (a_out_packet^.sp1_header.sp1h_mess_code in
                    [csp_unicode, csp_unicode_swap])
                THEN
                    WITH a_curr_retpart^ DO
                        BEGIN
                        IF  column_code = csp_ebcdic
                        THEN
                            s30map (g02codetables.tables[ cgg_to_ascii ],
                                  mb_data^.mbp_buf,
                                  ml_long_qual.lq_data_offset + 1,
                                  mb_data^.mbp_buf,
                                  ml_long_qual.lq_data_offset + 1,
                                  ml_long_qual.lq_len);
                        (*ENDIF*) 
                        outlen :=  sp1p_buf_size - sp1p_buf_len;
                        s80uni_trans (@mb_data^.mbp_buf [ml_long_qual.lq_data_offset + 1],
                              ml_long_qual.lq_len, csp_ascii,
                              @(sp1p_buf[sp1p_buf_len+1]), outlen,
                              a_out_packet^.sp1_header.sp1h_mess_code,
                              [ ], e, err_char_no);
                        IF  e = uni_dest_too_short
                        THEN
                            BEGIN
                            ml_long_qual.lq_len := err_char_no;
                            e := uni_ok;
                            END;
                        (*ENDIF*) 
                        IF  e <> uni_ok
                        THEN
                            a07_uni_error (acv, e, err_char_no)
                        ELSE
                            BEGIN
                            s41psint (num, 1, 5, 0,
                                  ml_long_qual.lq_len, res);
                            g10mv3 ('VAK77 ',   8,    
                                  sizeof (num), sp1p_buf_size,
                                  num, 1, sp1p_buf, save_lq_len_pos, 4,
                                  a_return_segm^.sp1r_returncode);
                            sp1p_buf_len := sp1p_buf_len + outlen;
                            END;
                        (*ENDIF*) 
                        END
                    (*ENDWITH*) 
                ELSE
                    BEGIN
                    a06retpart_move (acv,
                          @mb_data^.mbp_buf [ml_long_qual.lq_data_offset + 1],
                          ml_long_qual.lq_len);
                    IF  column_code = csp_unicode
                    THEN
                        WITH a_curr_retpart^ DO
                            BEGIN
                            s41psint (num, 1, 5, 0,
                                  ml_long_qual.lq_len DIV 2, res);
                            g10mv3 ('VAK77 ',   9,    
                                  sizeof (num), sp1p_buf_size,
                                  num, 1, sp1p_buf, save_lq_len_pos, 4,
                                  a_return_segm^.sp1r_returncode);
                            END;
                        (*ENDWITH*) 
                    (*ENDIF*) 
                    IF  a_return_segm^.sp1r_returncode = 0
                    THEN
                        a77convert (acv, a_curr_retpart^.sp1p_buf, column_code, 7,
                              a_curr_retpart^.sp1p_buf_len + 1 - 7, NOT c_is_input);
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
            (*ENDIF*) 
&       ifdef TRACE
        (*ENDIF*) 
        t01int4 (ak_sem, 'read_len    ', ml_long_qual.lq_len);
&       endif
        IF  a_return_segm^.sp1r_returncode = 0
        THEN
            a06finish_curr_retpart (acv, sp1pk_data, 1)
        (*ENDIF*) 
        END
    ELSE
        a07_b_put_error (acv, mb_trns^.trError_gg00, 1)
    (*ENDIF*) 
    END;
(*ENDWITH*) 
&ifdef TRACE
t01sname (ak_sem, 'read epi end');
&endif
END;
 
(*------------------------------*) 
 
PROCEDURE
      write_column (VAR acv : tak_all_command_glob;
            VAR dmli        : tak_dml_info;
            VAR coldesc_id  : tgg_surrogate);
 
VAR
      curr_n           : tsp_int2;
      vppos            : tsp_int4;
      cfd              : tgg_string_filedescr;
      lcl_colinfo      : tak00_columninfo;
      dtyp             : tsp_data_type;
 
BEGIN
WITH acv DO
    BEGIN
    a06a_mblock_init (acv, m_column, mm_write, b01niltree_id);
    WITH a_mblock DO
        BEGIN
        mb_data^.mbp_reclen := 0;
        mb_data^.mbp_keylen := 0;
        mb_qual_len := mb_qual_len + sizeof (mb_qual^.ml_long_qual);
        mb_qual^.ml_long_qual := g01nil_long_qual;
        END;
    (*ENDWITH*) 
    IF  a_ex_kind = only_parsing
    THEN
        a54_get_pparsp_pinfop (acv, dmli.d_sparr, m_column);
    (*ENDIF*) 
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        BEGIN
        curr_n := a_ap_tree^ [ a_ap_tree^[ 0 ].n_lo_level ].n_sa_level;
        rw_loc_input_params (acv, curr_n, dmli, lcl_colinfo,
              cfd, coldesc_id);
        CASE cfd.codespec OF
            csp_ascii :
                dtyp := dstra;
            csp_ebcdic :
                dtyp := dstre;
            csp_unicode :
                dtyp := dstruni;
            OTHERWISE :
                dtyp := dstrb;
            END;
        (*ENDCASE*) 
        IF  a_return_segm^.sp1r_returncode = 0
        THEN
            BEGIN
            IF  a_ap_tree^ [ curr_n ].n_symb = s_parameter_name
            THEN
                BEGIN
                ak77init_colinfo (dmli, lcl_colinfo, dtyp,
                      0, 0, 0, [  ], fp_val_all_with_len);
                ak77loc_and_descr_val (acv, dmli,
                      lcl_colinfo, curr_n, c_is_input);
                curr_n := a_ap_tree^ [ curr_n ].n_sa_level;
                vppos := 9 + 7 + 5 + 1;
                IF  a_ex_kind <> only_parsing
                THEN
                    a77bget_buffer (acv, cfd.codespec, vppos);
                (*ENDIF*) 
                END
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        IF  a_return_segm^.sp1r_returncode = 0
        THEN
            IF  a_ap_tree^ [ curr_n ].n_subproc = cak_i_trunc
            THEN
                BEGIN
                a_mblock.mb_qual^.ml_long_qual.lq_trunc_req := true;
                IF  a_ex_kind = only_parsing
                THEN
                    a_mblock.mb_qual^.mfirst_free := 2
                (*ENDIF*) 
                END
            (*ENDIF*) 
        (*ENDIF*) 
        END
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      trunc_column (VAR acv : tak_all_command_glob;
            VAR dmli        : tak_dml_info;
            VAR coldesc_id  : tgg_surrogate);
 
VAR
      vppos            : tsp_int4;
      curr_n           : tsp_int2;
      cfd              : tgg_string_filedescr;
      lcl_colinfo      : tak00_columninfo;
 
BEGIN
WITH acv DO
    BEGIN
    a06a_mblock_init (acv, m_column, mm_trunc, b01niltree_id);
    WITH a_mblock DO
        BEGIN
        mb_qual_len := mb_qual_len + sizeof (mb_qual^.ml_long_qual);
        mb_qual^.ml_long_qual := g01nil_long_qual;
        END;
    (*ENDWITH*) 
    IF  a_ex_kind = only_parsing
    THEN
        a54_get_pparsp_pinfop (acv, dmli.d_sparr, m_column);
    (*ENDIF*) 
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        BEGIN
        curr_n := a_ap_tree^ [ a_ap_tree^[ 0 ].n_lo_level ].n_sa_level;
        vppos := 1;
        lcl_colinfo.ccolumnn := a01_il_b_identifier;
        IF  a_ap_tree^ [ curr_n ].n_symb = s_parameter_name
        THEN
            BEGIN
            ak77init_colinfo (dmli, lcl_colinfo, dchb, 0, 9,
                  8, [  ], fp_val_all_with_len);
            ak77loc_and_descr_val (acv, dmli, lcl_colinfo,
                  curr_n, c_is_input);
            curr_n := a_ap_tree^ [ curr_n ].n_sa_level;
            IF  a_ex_kind <> only_parsing
            THEN
                a77replace_descr (acv, cfd,
                      coldesc_id, NOT c_cpy_source, vppos);
            (*ENDIF*) 
            vppos := vppos + 9;
            END
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        BEGIN
        IF  a_ap_tree^ [ curr_n ].n_symb = s_parameter_name
        THEN
            BEGIN
            ak77init_colinfo (dmli, lcl_colinfo, dfixed, 0, 7,
                  10, [  ], fp_val_all_with_len);
            ak77loc_and_descr_val (acv, dmli, lcl_colinfo,
                  curr_n, c_is_input);
            curr_n := a_ap_tree^ [ curr_n ].n_sa_level;
            IF  a_ex_kind <> only_parsing
            THEN
                a77lget_colpos (acv, vppos, 10, cfd, c_length4);
            (*ENDIF*) 
            vppos := vppos + 11;
            END;
        (*ENDIF*) 
        WITH a_mblock, mb_qual^.ml_long_qual DO
            lq_data_offset := mb_data_len
        (*ENDWITH*) 
        END
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      length_column (VAR acv : tak_all_command_glob;
            VAR dmli        : tak_dml_info;
            VAR column_code : tsp_code_type;
            VAR coldesc_id  : tgg_surrogate);
 
VAR
      vppos            : tsp_int4;
      curr_n           : tsp_int2;
      cfd              : tgg_string_filedescr;
      lcl_colinfo      : tak00_columninfo;
 
BEGIN
WITH acv DO
    BEGIN
    a06a_mblock_init (acv, m_column, mm_length, b01niltree_id);
    WITH a_mblock DO
        BEGIN
        mb_qual_len := mb_qual_len + sizeof (mb_qual^.ml_long_qual);
        mb_qual^.ml_long_qual := g01nil_long_qual;
        END;
    (*ENDWITH*) 
    IF  a_ex_kind = only_parsing
    THEN
        a54_get_pparsp_pinfop (acv, dmli.d_sparr, m_column);
    (*ENDIF*) 
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        BEGIN
        curr_n := a_ap_tree^ [ a_ap_tree^[ 0 ].n_lo_level ].n_sa_level;
        vppos := 1;
        lcl_colinfo.ccolumnn := a01_il_b_identifier;
        IF  a_ap_tree^ [ curr_n ].n_symb = s_parameter_name
        THEN
            BEGIN
            ak77init_colinfo (dmli, lcl_colinfo, dchb, 0, 9,
                  8, [  ], fp_val_all_with_len);
            ak77loc_and_descr_val (acv, dmli, lcl_colinfo,
                  curr_n, c_is_input);
            curr_n := a_ap_tree^ [ curr_n ].n_sa_level;
            IF  a_ex_kind <> only_parsing
            THEN
                BEGIN
                a77replace_descr (acv, cfd,
                      coldesc_id, NOT c_cpy_source, vppos);
                END;
            (*ENDIF*) 
            vppos := vppos + 9;
            END;
        (*ENDIF*) 
        IF  a_return_segm^.sp1r_returncode = 0
        THEN
            BEGIN
            IF  a_ex_kind <> only_parsing
            THEN
                column_code := cfd.codespec
            ELSE
                column_code := csp_codeneutral;
            (*ENDIF*) 
            IF  a_ap_tree^ [ curr_n ].n_symb = s_parameter_name
            THEN
                BEGIN
                IF  a_ex_kind <> only_parsing
                THEN
                    a_mblock.mb_qual^.ml_long_qual.lq_long_in_file :=
                          cfd.str_treeid.fileTfn_gg00 <> tfnShortScol_egg00;
                (*ENDIF*) 
                ak77init_colinfo (dmli, lcl_colinfo,
                      dfixed, 0, 7, 10, [  ],
                      fp_val_all_with_len);
                IF  a_ex_kind = only_parsing
                THEN
                    ak77col_short_info (acv, dmli.d_sparr, lcl_colinfo,
                          a_ap_tree^ [ curr_n ].n_length)
                ELSE
                    IF  a_info_output
                    THEN
                        BEGIN
                        a60_get_longinfobuffer (acv, dmli.d_sparr, 1,
                              cak_into_res_fid);
                        IF  a_return_segm^.sp1r_returncode = 0
                        THEN
                            a77infop_exists := true;
                        (*ENDIF*) 
                        dmli.d_inoutpos := cgg_rec_key_offset + 1;
                        dmli.d_keylen   := 0;
                        a061assign_colname ('LENGTH            ',
                              lcl_colinfo.ccolumnn);
                        lcl_colinfo.ccolumnn_len := chr (6);
                        IF  a77infop_exists
                        THEN
                            ak77col_long_info (acv, dmli, lcl_colinfo)
                        (*ENDIF*) 
                        END;
                    (*ENDIF*) 
                (*ENDIF*) 
                END
            (*ENDIF*) 
            END
        (*ENDIF*) 
        END
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a77elength_epilog (VAR acv : tak_all_command_glob;
            called_by_copy : boolean;
            column_code    : tsp_code_type;
            VAR sysp_arr   : tak_syspointerarr);
 
VAR
      c          : tsp_c1;
      len        : tsp_int4;
      dummy      : integer;
      num        : tsp_number;
      res        : tsp_num_error;
 
BEGIN
res   := num_ok;
WITH acv DO
    IF  a_mblock.mb_trns^.trError_gg00 = e_ok
    THEN
        BEGIN
        IF  a_info_output
        THEN
            ak77info_output (acv, sysp_arr, dummy);
        (*ENDIF*) 
        IF  called_by_copy
        THEN
            len := a_mblock.mb_qual^.mcl_copy_long.lcq_len
        ELSE
            len := a_mblock.mb_qual^.ml_long_qual.lq_long_size;
        (*ENDIF*) 
        IF  column_code = csp_unicode
        THEN
            len := len DIV 2;
        (*ENDIF*) 
        s41plint (num, 1, 10, 0, len, res);
        IF  res = num_ok
        THEN
            BEGIN
            c[1] := csp_defined_byte;
            a06retpart_move (acv, @c[1], 1);
            a06retpart_move (acv, @num, 6);
            a06finish_curr_retpart (acv, sp1pk_data, 1);
            END
        ELSE
            a77sel_res_err (acv, res);
        (*ENDIF*) 
        END
    ELSE
        a07_b_put_error (acv, a_mblock.mb_trns^.trError_gg00, 1)
    (*ENDIF*) 
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      search_column (VAR acv : tak_all_command_glob;
            VAR dmli         : tak_dml_info;
            VAR coldesc_id   : tgg_surrogate);
 
VAR
      vppos            : tsp_int4;
      is_pattern       : boolean;
      curr_n           : tsp_int2;
      cfd              : tgg_string_filedescr;
      lcl_colinfo      : tak00_columninfo;
 
BEGIN
WITH acv DO
    BEGIN
    a06a_mblock_init (acv, m_column, mm_search, b01niltree_id);
    WITH a_mblock DO
        BEGIN
        mb_qual_len := mb_qual_len + sizeof (mb_qual^.ml_long_qual);
        mb_qual^.ml_long_qual := g01nil_long_qual;
        END;
    (*ENDWITH*) 
    IF  a_ex_kind = only_parsing
    THEN
        a54_get_pparsp_pinfop (acv, dmli.d_sparr, m_column);
    (*ENDIF*) 
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        BEGIN
        is_pattern := false;
        curr_n     := a_ap_tree^ [ a_ap_tree^[ 0 ].n_lo_level ].n_sa_level;
        vppos      := 1;
        lcl_colinfo.ccolumnn := a01_il_b_identifier;
        IF  a_ap_tree^ [ curr_n ].n_symb = s_parameter_name
        THEN
            BEGIN
            ak77init_colinfo (dmli, lcl_colinfo, dchb, 0, 9,
                  8, [  ], fp_val_all_with_len);
            ak77loc_and_descr_val (acv, dmli, lcl_colinfo,
                  curr_n, c_is_input);
            curr_n := a_ap_tree^ [ curr_n ].n_sa_level;
            IF  a_ex_kind <> only_parsing
            THEN
                BEGIN
                a77replace_descr (acv, cfd,
                      coldesc_id, NOT c_cpy_source, vppos);
                END;
            (*ENDIF*) 
            vppos := vppos + lcl_colinfo.cinoutlen;
            END;
        (*ENDIF*) 
        IF  a_return_segm^.sp1r_returncode = 0
        THEN
            IF  a_ap_tree^ [ curr_n ].n_symb = s_parameter_name
            THEN
                BEGIN
                ak77init_colinfo (dmli, lcl_colinfo, dfixed,
                      0, 7, 10, [  ], fp_val_all_with_len);
                ak77loc_and_descr_val (acv, dmli, lcl_colinfo,
                      curr_n, c_is_input);
                curr_n := a_ap_tree^ [ curr_n ].n_sa_level;
                IF  a_ex_kind <> only_parsing
                THEN
                    a77lget_colpos (acv, vppos, 10, cfd, c_startpos);
                (*ENDIF*) 
                vppos := vppos + lcl_colinfo.cinoutlen
                END;
            (*ENDIF*) 
        (*ENDIF*) 
        IF  a_return_segm^.sp1r_returncode = 0
        THEN
            IF  a_ap_tree^ [ curr_n ].n_symb = s_parameter_name
            THEN
                BEGIN
                ak77init_colinfo (dmli, lcl_colinfo, dfixed,
                      0, 7, 10, [  ], fp_val_all_with_len);
                ak77loc_and_descr_val (acv, dmli, lcl_colinfo,
                      curr_n, c_is_input);
                curr_n := a_ap_tree^ [ curr_n ].n_lo_level;
                IF  a_ex_kind <> only_parsing
                THEN
                    a77lget_colpos (acv, vppos, 10, cfd, c_endpos);
                (*ENDIF*) 
                vppos := vppos + lcl_colinfo.cinoutlen
                END;
            (*ENDIF*) 
        (*ENDIF*) 
        IF  (a_ap_tree^ [ curr_n ].n_proc = a77) AND
            (a_ap_tree^ [ curr_n ].n_subproc = cak_i_pattern)
        THEN
            BEGIN
            is_pattern := true;
            a_mblock.mb_qual^.ml_long_qual.lq_is_pattern := true;
            dmli.d_like          := true;
            dmli.d_like_optimize := false;
            curr_n := a_ap_tree^ [ curr_n ].n_sa_level
            END;
        (*ENDIF*) 
        IF  a_ex_kind = only_parsing
        THEN
            a_mblock.mb_qual^.mfirst_free := 2;
        (*ENDIF*) 
        IF  a_return_segm^.sp1r_returncode = 0
        THEN
            IF  a_ap_tree^ [ curr_n ].n_symb = s_parameter_name
            THEN
                BEGIN
                ak77init_colinfo (dmli, lcl_colinfo, dchb, 0,
                      c_max_pattern_len-1, c_max_pattern_len-2, [  ],
                      fp_val_all_with_len);
                ak77loc_and_descr_val (acv, dmli, lcl_colinfo, curr_n,
                      c_is_input);
                curr_n := a_ap_tree^ [ curr_n ].n_sa_level;
                IF  a_ex_kind <> only_parsing
                THEN
                    a77pget_pattern (acv, cfd, vppos, is_pattern)
                (*ENDIF*) 
                END;
            (*ENDIF*) 
        (*ENDIF*) 
        IF  a_return_segm^.sp1r_returncode = 0
        THEN
            BEGIN
            IF  a_ap_tree^ [ curr_n ].n_symb = s_parameter_name
            THEN
                BEGIN
                ak77init_colinfo (dmli, lcl_colinfo, dfixed, 0,
                      7, 10, [  ], fp_val_all_with_len);
                IF  a_ex_kind = only_parsing
                THEN
                    BEGIN
                    ak77col_short_info (acv, dmli.d_sparr, lcl_colinfo,
                          a_ap_tree^ [ curr_n ].n_length);
                    END
                ELSE
                    BEGIN
                    IF  a_info_output
                    THEN
                        BEGIN
                        a60_get_longinfobuffer (acv, dmli.d_sparr, 2,
                              cak_into_res_fid);
                        IF  a_return_segm^.sp1r_returncode = 0
                        THEN
                            a77infop_exists := true;
                        (*ENDIF*) 
                        dmli.d_inoutpos      := cgg_rec_key_offset + 1;
                        dmli.d_keylen        := 0;
                        a061assign_colname ('FIRSTPOS          ',
                              lcl_colinfo.ccolumnn);
                        lcl_colinfo.ccolumnn_len := chr (8);
                        IF  a77infop_exists
                        THEN
                            ak77col_long_info (acv, dmli, lcl_colinfo)
                        (*ENDIF*) 
                        END;
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
                curr_n := a_ap_tree^ [ curr_n ].n_sa_level;
                IF  a_ap_tree^ [ curr_n ].n_symb = s_parameter_name
                THEN
                    BEGIN
                    ak77init_colinfo (dmli, lcl_colinfo, dfixed,
                          0, 7, 10, [  ], fp_val_all_with_len);
                    IF  a_ex_kind = only_parsing
                    THEN
                        ak77col_short_info (acv, dmli.d_sparr,
                              lcl_colinfo,
                              a_ap_tree^ [ curr_n ].n_length)
                    ELSE
                        IF  a_info_output
                        THEN
                            BEGIN
                            dmli.d_inoutpos := dmli.d_inoutpos +
                                  lcl_colinfo.cinoutlen;
                            dmli.d_keylen := 0;
                            a061assign_colname ('LASTPOS           ',
                                  lcl_colinfo.ccolumnn);
                            lcl_colinfo.ccolumnn_len := chr (7);
                            IF  a77infop_exists
                            THEN
                                ak77col_long_info (acv, dmli, lcl_colinfo)
                            (*ENDIF*) 
                            END;
                        (*ENDIF*) 
                    (*ENDIF*) 
                    END
                (*ENDIF*) 
                END
            (*ENDIF*) 
            END
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a77esearch_epilog (VAR acv : tak_all_command_glob;
            VAR sysp_arr : tak_syspointerarr);
 
VAR
      c     : tsp_c1;
      dummy : integer;
      num   : tsp_number;
      res   : tsp_num_error;
 
BEGIN
WITH acv, a_mblock, mb_qual^ DO
    IF  mb_trns^.trError_gg00 = e_ok
    THEN
        BEGIN
        IF  a_info_output
        THEN
            ak77info_output (acv, sysp_arr, dummy);
        (*ENDIF*) 
        s41plint (num, 1, 10, 0,
              ml_long_qual.lq_pos, res);
        IF  res = num_ok
        THEN
            BEGIN
            c[1] := csp_defined_byte;
            a06retpart_move (acv, @c[1], 1);
            a06retpart_move (acv, @num, 6);
            END
        ELSE
            a77sel_res_err (acv, res);
        (*ENDIF*) 
        IF  a_return_segm^.sp1r_returncode = 0
        THEN
            BEGIN
            (* lq_len instead of endpos is returned *)
            s41plint (num, 1, 10, 0,
                  ml_long_qual.lq_pos + ml_long_qual.lq_len - 1, res);
            IF  res = num_ok
            THEN
                BEGIN
                c[1] := csp_defined_byte;
                a06retpart_move (acv, @c[1], 1);
                a06retpart_move (acv, @num, 6);
                a06finish_curr_retpart (acv, sp1pk_data, 1);
                END
            ELSE
                a77sel_res_err (acv, res);
            (*ENDIF*) 
            END
        ELSE
            a07_b_put_error (acv, mb_trns^.trError_gg00, 1)
        (*ENDIF*) 
        END;
    (*ENDIF*) 
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      expand_column (VAR acv : tak_all_command_glob;
            VAR dmli         : tak_dml_info;
            VAR coldesc_id   : tgg_surrogate);
 
VAR
      vppos            : tsp_int4;
      curr_n           : tsp_int2;
      cfd              : tgg_string_filedescr;
      lcl_colinfo      : tak00_columninfo;
      exp_pos          : integer;
      mark_pos         : integer;
 
BEGIN
WITH acv DO
    BEGIN
    a06a_mblock_init (acv, m_column, mm_expand, b01niltree_id);
    WITH a_mblock DO
        BEGIN
        mb_qual_len := mb_qual_len + sizeof (mb_qual^.ml_long_qual);
        mb_qual^.ml_long_qual := g01nil_long_qual;
        END;
    (*ENDWITH*) 
    IF  a_ex_kind = only_parsing
    THEN
        a54_get_pparsp_pinfop (acv, dmli.d_sparr, m_column);
    (*ENDIF*) 
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        BEGIN
        curr_n := a_ap_tree^ [ a_ap_tree^[ 0 ].n_lo_level ].n_sa_level;
        vppos  := 1;
        lcl_colinfo.ccolumnn := a01_il_b_identifier;
        ak77init_colinfo (dmli, lcl_colinfo, dchb, 0, 9,
              8, [  ], fp_val_all_with_len);
        ak77loc_and_descr_val (acv, dmli, lcl_colinfo,
              curr_n, c_is_input);
        curr_n := a_ap_tree^ [ curr_n ].n_sa_level;
        IF  a_ex_kind <> only_parsing
        THEN
            a77replace_descr (acv, cfd,
                  coldesc_id, NOT c_cpy_source, vppos);
        (*ENDIF*) 
        vppos := vppos + lcl_colinfo.cinoutlen
        END;
    (*ENDIF*) 
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        BEGIN
        ak77init_colinfo (dmli, lcl_colinfo, dfixed, 0, 7,
              10, [  ], fp_val_all_with_len);
        ak77loc_and_descr_val (acv, dmli, lcl_colinfo,
              curr_n, c_is_input);
        curr_n := a_ap_tree^ [ curr_n ].n_sa_level;
        IF  a_ex_kind <> only_parsing
        THEN
            WITH a_mblock, mb_qual^ DO
                BEGIN
                mb_qual^.ml_long_qual.lq_long_in_file :=
                      cfd.str_treeid.fileTfn_gg00 <> tfnShortScol_egg00;
                a77get_int4 (acv, ml_long_qual.lq_long_size,
                      vppos, 10);
                IF  cfd.codespec = csp_unicode
                THEN
                    ml_long_qual.lq_long_size :=
                          ml_long_qual.lq_long_size * 2;
                (*ENDIF*) 
                IF  ml_long_qual.lq_long_size < 1
                THEN
                    a07_b_put_error (acv, e_st_invalid_length, 1)
                (*ENDIF*) 
                END;
            (*ENDWITH*) 
        (*ENDIF*) 
        vppos := vppos + lcl_colinfo.cinoutlen
        END;
    (*ENDIF*) 
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        BEGIN
        (* h.b. 08.03.1996
              Because of missing information the kernel
              gives allways a CHAR (1) BYTE shortinfo
              for the expand character.
              Also for UNICODE components !!!! *)
        ak77init_colinfo (dmli, lcl_colinfo, dchb, 0, 2,
              1, [  ], fp_val_all_with_len);
        ak77loc_and_descr_val (acv, dmli, lcl_colinfo,
              curr_n, c_is_input);
        curr_n := a_ap_tree^ [ curr_n ].n_sa_level;
        IF  a_ex_kind <> only_parsing
        THEN
            BEGIN
            WITH a_mblock DO
                BEGIN
&               ifdef TRACE
                t01int4 (ak_sem, 'vppos       ', vppos);
&               endif
                IF  cfd.codespec = csp_unicode
                THEN
                    a07_b_put_error (acv, e_not_implemented, 1)
                ELSE
                    IF  (cfd.codespec in [ csp_ascii, csp_ebcdic ])
                        AND (a_out_packet^.sp1_header.sp1h_mess_code in
                        [csp_unicode, csp_unicode_swap])
                    THEN
                        BEGIN
                        IF  (a_out_packet^.sp1_header.sp1h_mess_code
                            = csp_unicode)
                        THEN
                            BEGIN
                            mark_pos := vppos + 1;
                            exp_pos  := vppos + 2;
                            END
                        ELSE
                            BEGIN
                            mark_pos := vppos + 2;
                            exp_pos  := vppos + 1;
                            END;
                        (*ENDIF*) 
                        IF  a_data_ptr^ [mark_pos] <> csp_unicode_mark
                        THEN
                            a07_b_put_error (acv, e_not_implemented, 1)
                        ELSE
                            BEGIN
                            IF  cfd.codespec = csp_ebcdic
                            THEN
                                s30map (g02codetables.tables[ cgg_to_ebcdic ],
                                      a_data_ptr^, exp_pos,
                                      a_data_ptr^, exp_pos, 1);
                            (*ENDIF*) 
                            mb_qual^.ml_long_qual.lq_expand_char [1] :=
                                  a_data_ptr^ [exp_pos];
                            END;
                        (*ENDIF*) 
                        END
                    ELSE
                        BEGIN
                        a77convert (acv, a_data_ptr^, cfd.codespec,
                              vppos + 1, 1, c_is_input);
                        mb_qual^.ml_long_qual.lq_expand_char [1] :=
                              a_data_ptr^ [vppos + 1];
                        END;
                    (*ENDIF*) 
                (*ENDIF*) 
                END;
            (*ENDWITH*) 
            END
        (*ENDIF*) 
        END
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      copy_column (VAR acv : tak_all_command_glob;
            VAR dmli        : tak_dml_info;
            VAR src_code    : tsp_code_type;
            VAR dst_code    : tsp_code_type;
            VAR coldesc_id  : tgg_surrogate;
            VAR coldesc2_id : tgg_surrogate);
 
VAR
      vppos            : tsp_int4;
      curr_n           : tsp_int2;
      lcl_colinfo      : tak00_columninfo;
      src_cfd          : tgg_string_filedescr;
      dst_cfd          : tgg_string_filedescr;
 
BEGIN
WITH acv, a_mblock DO
    BEGIN
    a06a_mblock_init (acv, m_column, mm_copy, b01niltree_id);
    WITH mb_qual^, mcl_copy_long DO
        BEGIN
        mb_qual_len           := mb_qual_len + sizeof (mcl_copy_long);
        lcq_src_lock_tabid    := cgg_zero_id;
        lcq_src_pos           := 0;
        lcq_len               := 0;
        lcq_dest_pos          := 0;
        lcq_src_long_in_file  := false;
        lcq_dest_long_in_file := false;
        lcq_src_tabid         := cgg_zero_id;
        lcq_dest_lock_tabid   := cgg_zero_id
        END;
    (*ENDWITH*) 
    IF  a_ex_kind = only_parsing
    THEN
        a54_get_pparsp_pinfop (acv, dmli.d_sparr, m_column);
    (*ENDIF*) 
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        BEGIN
        curr_n := a_ap_tree^ [ a_ap_tree^[ 0 ].n_lo_level ].n_sa_level;
        vppos  := 1;
        lcl_colinfo.ccolumnn := a01_il_b_identifier;
        ak77init_colinfo (dmli, lcl_colinfo, dchb, 0, 9,
              8, [  ], fp_val_all_with_len);
        ak77loc_and_descr_val (acv, dmli, lcl_colinfo,
              curr_n, c_is_input);
        curr_n := a_ap_tree^ [ curr_n ].n_sa_level;
        IF  a_ex_kind <> only_parsing
        THEN
            BEGIN
            a77replace_descr (acv, src_cfd,
                  coldesc_id, c_cpy_source, vppos);
            src_code := src_cfd.codespec;
            WITH mb_qual^ DO
                mcl_copy_long.lcq_src_tabid := mtree.fileTabId_gg00;
            (*ENDWITH*) 
            END;
        (*ENDIF*) 
        vppos := vppos + lcl_colinfo.cinoutlen
        END;
    (*ENDIF*) 
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        BEGIN
        lcl_colinfo.ccolumnn := a01_il_b_identifier;
        ak77init_colinfo (dmli, lcl_colinfo, dchb, 0, 9,
              8, [  ], fp_val_all_with_len);
        ak77loc_and_descr_val (acv, dmli, lcl_colinfo,
              curr_n, c_is_input);
        curr_n := a_ap_tree^ [ curr_n ].n_sa_level;
        IF  a_ex_kind <> only_parsing
        THEN
            BEGIN
            a77replace_descr (acv, dst_cfd,
                  coldesc2_id, NOT c_cpy_source, vppos);
            dst_code := dst_cfd.codespec;
            END;
        (*ENDIF*) 
        vppos := vppos + lcl_colinfo.cinoutlen
        END;
    (*ENDIF*) 
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        BEGIN
        ak77init_colinfo (dmli, lcl_colinfo, dfixed, 0, 7,
              10, [  ], fp_val_all_with_len);
        ak77loc_and_descr_val (acv, dmli, lcl_colinfo,
              curr_n, c_is_input);
        curr_n := a_ap_tree^ [ curr_n ].n_sa_level;
        IF  a_ex_kind <> only_parsing
        THEN
            WITH mb_qual^.mcl_copy_long DO
                BEGIN
                lcq_src_long_in_file :=
                      (src_cfd.str_treeid.fileTfn_gg00 <> tfnShortScol_egg00);
                a77get_int4 (acv, lcq_src_pos, vppos, 10);
                IF  src_code = csp_unicode
                THEN
                    lcq_src_pos := (lcq_src_pos * 2) - 1;
                (*ENDIF*) 
                IF  lcq_src_pos <= 0
                THEN
                    a07_b_put_error (acv, e_st_invalid_startpos, 1)
                (*ENDIF*) 
                END;
            (*ENDWITH*) 
        (*ENDIF*) 
        vppos := vppos + lcl_colinfo.cinoutlen
        END;
    (*ENDIF*) 
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        BEGIN
        ak77init_colinfo (dmli, lcl_colinfo, dfixed, 0, 7,
              10, [  ], fp_val_all_with_len);
        ak77loc_and_descr_val (acv, dmli, lcl_colinfo,
              curr_n, c_is_input);
        curr_n := a_ap_tree^ [ curr_n ].n_sa_level;
        IF  a_ex_kind <> only_parsing
        THEN
            WITH mb_qual^.mcl_copy_long DO
                BEGIN
                lcq_dest_long_in_file :=
                      (dst_cfd.str_treeid.fileTfn_gg00 <> tfnShortScol_egg00);
                a77get_int4 (acv, lcq_dest_pos,
                      vppos, 10);
                IF  dst_code = csp_unicode
                THEN
                    lcq_dest_pos := (lcq_dest_pos * 2) - 1;
                (*ENDIF*) 
                IF  lcq_dest_pos < (-1)
                THEN
                    a07_b_put_error (acv, e_st_invalid_destpos, 1)
                (*ENDIF*) 
                END;
            (*ENDWITH*) 
        (*ENDIF*) 
        vppos := vppos + lcl_colinfo.cinoutlen
        END;
    (*ENDIF*) 
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        BEGIN
        ak77init_colinfo (dmli, lcl_colinfo, dfixed, 0, 7,
              10, [  ], fp_val_all_with_len);
        ak77loc_and_descr_val (acv, dmli, lcl_colinfo,
              curr_n, c_is_input);
        curr_n := a_ap_tree^ [ curr_n ].n_sa_level;
        IF  a_ex_kind <> only_parsing
        THEN
            BEGIN
            WITH mb_qual^.mcl_copy_long DO
                BEGIN
                a77get_int4 (acv, lcq_len, vppos, 10);
                IF  src_code = csp_unicode
                THEN
                    lcq_len := (lcq_len * 2);
                (*ENDIF*) 
                IF  lcq_len < (-1)
                THEN
                    a07_b_put_error (acv, e_st_invalid_length, 1)
                (*ENDIF*) 
                END;
            (*ENDWITH*) 
            vppos := vppos + lcl_colinfo.cinoutlen
            END
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        BEGIN
        ak77init_colinfo (dmli, lcl_colinfo, dfixed, 0, 7,
              10, [  ], fp_val_all_with_len);
        IF  a_ex_kind = only_parsing
        THEN
            ak77col_short_info (acv, dmli.d_sparr, lcl_colinfo,
                  a_ap_tree^ [ curr_n ].n_length)
        ELSE
            IF  a_info_output
            THEN
                BEGIN
                a60_get_longinfobuffer (acv, dmli.d_sparr, 1,
                      cak_into_res_fid);
                IF  a_return_segm^.sp1r_returncode = 0
                THEN
                    a77infop_exists := true;
                (*ENDIF*) 
                dmli.d_inoutpos := cgg_rec_key_offset + 1;
                dmli.d_keylen := 0;
                a061assign_colname ('COPIED LENGTH     ',
                      lcl_colinfo.ccolumnn);
                lcl_colinfo.ccolumnn_len := chr (13);
                IF  a77infop_exists
                THEN
                    ak77col_long_info (acv, dmli, lcl_colinfo)
                (*ENDIF*) 
                END;
            (*ENDIF*) 
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak77col_short_info (VAR acv : tak_all_command_glob;
            VAR sysp_arr : tak_syspointerarr;
            VAR colinf   : tak00_columninfo;
            info_index   : integer);
 
BEGIN
WITH colinf, sysp_arr.pinfop^.sshortinfo,
     siinfo[ info_index ]  DO
    BEGIN
    IF  info_index > sicount
    THEN
        sicount := info_index;
    (*ENDIF*) 
    IF  NOT (ctopt in ccolpropset)
    THEN
        sp1i_mode := [ sp1ot_mandatory ]
    ELSE
        sp1i_mode := [ sp1ot_optional ];
    (*ENDIF*) 
    sp1i_io_type := sp1io_output;
    sp1i_data_type := cdatatyp;
    IF  cdatatyp = dfloat
    THEN
        sp1i_frac := 0
    ELSE
        sp1i_frac := cdatafrac - cak_frac_offset;
    (*ENDIF*) 
    sp1i_length     := cdatalen;
    sp1i_in_out_len := cinoutlen;
    WITH acv DO
        BEGIN
        sp1i_bufpos       := a_output_data_pos;
        a_output_data_pos := a_output_data_pos + cinoutlen;
        END
    (*ENDWITH*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak77col_long_info (VAR acv : tak_all_command_glob;
            VAR dmli   : tak_dml_info;
            VAR colinf : tak00_columninfo);
 
VAR
      icolinf     : tak00_columninfo;
      err_char_no : tsp_int4;
      uni_err     : tsp8_uni_error;
      i_len       : integer;
 
BEGIN
(* this procedure is called only with constant column names *)
(* therefore the distinction between unicode and not-unicode*)
(* is correct *)
icolinf := colinf;
IF  g01unicode
THEN
    BEGIN
    i_len := sizeof(tsp_knl_identifier);
    s80uni_trans (@colinf.ccolumnn, ord(colinf.ccolumnn_len), csp_ascii,
          @icolinf.ccolumnn, i_len,
          csp_unicode, [ ], uni_err, err_char_no);
    icolinf.ccolumnn_len := chr(i_len)
    END;
(*ENDIF*) 
a61_p_long_info (acv, dmli, icolinf);
END;
 
(*------------------------------*) 
 
PROCEDURE
      rw_loc_input_params (VAR acv : tak_all_command_glob;
            VAR curr_n      : tsp_int2;
            VAR dmli        : tak_dml_info;
            VAR lcl_colinfo : tak00_columninfo;
            VAR cfd         : tgg_string_filedescr;
            VAR coldesc_id  : tgg_surrogate);
 
VAR
      vppos : tsp_int4;
 
BEGIN
WITH acv DO
    BEGIN
    vppos := 1;
    lcl_colinfo.ccolumnn := a01_il_b_identifier;
    IF  a_ap_tree^ [ curr_n ].n_symb = s_parameter_name
    THEN
        BEGIN
        ak77init_colinfo (dmli, lcl_colinfo, dchb, 0, 9, 8,
              [  ], fp_val_all_with_len);
        ak77loc_and_descr_val (acv, dmli, lcl_colinfo,
              curr_n, c_is_input);
        curr_n := a_ap_tree^ [ curr_n ].n_sa_level;
        IF  a_ex_kind <> only_parsing
        THEN
            a77replace_descr (acv, cfd,
                  coldesc_id, NOT c_cpy_source, vppos);
        (*ENDIF*) 
        vppos := vppos + lcl_colinfo.cinoutlen
        END;
    (*ENDIF*) 
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        IF  a_ap_tree^ [ curr_n ].n_symb = s_parameter_name
        THEN
            BEGIN
            ak77init_colinfo (dmli, lcl_colinfo, dfixed, 0, 7,
                  10, [  ], fp_val_all_with_len);
            ak77loc_and_descr_val (acv, dmli, lcl_colinfo,
                  curr_n, c_is_input);
            curr_n := a_ap_tree^ [ curr_n ].n_sa_level;
            IF  a_ex_kind <> only_parsing
            THEN
                a77lget_colpos (acv, vppos, 10, cfd, c_startpos);
            (*ENDIF*) 
            vppos := vppos + lcl_colinfo.cinoutlen
            END;
        (*ENDIF*) 
    (*ENDIF*) 
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        IF  a_ap_tree^ [ curr_n ].n_symb = s_parameter_name
        THEN
            BEGIN
            ak77init_colinfo (dmli, lcl_colinfo, dfixed, 0, 5,
                  5, [  ], fp_val_all_with_len);
            ak77loc_and_descr_val (acv, dmli, lcl_colinfo,
                  curr_n, c_is_input);
            curr_n := a_ap_tree^ [ curr_n ].n_sa_level;
            IF  a_ex_kind <> only_parsing
            THEN
                a77sget_length (acv, cfd.codespec, vppos, 5)
            (*ENDIF*) 
            END;
        (*ENDIF*) 
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak77init_colinfo (VAR dmli : tak_dml_info;
            VAR info        : tak00_columninfo;
            dtype           : tsp_data_type;
            dfrac           : tsp_int2;
            diolen          : tsp_int2;
            datlen          : tsp_int2;
            dpset           : tak00_colpropset;
            which_len       : tak_fp_kind_type);
 
BEGIN
dmli.d_pars_kind := which_len;
WITH info DO
    BEGIN
    ccolumnn    := a01_il_b_identifier;
    cdatatyp    := dtype;
    cdatafrac   := dfrac + cak_frac_offset;
    cinoutlen   := diolen;
    cdatalen    := datlen;
    ccolpropset := dpset;
    ctabno      := 0;
    creccolno   := 0;
    cextcolno   := 0;
    cbinary     := false;
    ccolstack.etype := st_dummy;
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak77info_output (VAR acv : tak_all_command_glob;
            VAR sysp_arr   : tak_syspointerarr;
            VAR output_cnt : integer);
 
VAR
      b_err : tgg_basis_error;
 
BEGIN
a60_p_info_output (acv, sysp_arr);
output_cnt := sysp_arr.pinfop^.sshortinfo.sicount;
a10del_sysinfo (acv, sysp_arr.pinfop^.syskey, b_err);
a10del_sysinfo (acv, sysp_arr.pcolnamep^.syskey, b_err)
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak77loc_and_descr_val (VAR acv : tak_all_command_glob;
            VAR dmli        : tak_dml_info;
            VAR lcl_colinfo : tak00_columninfo;
            curr_n          : tsp_int2;
            is_input        : boolean);
 
BEGIN
WITH acv DO
    BEGIN
    IF  a_ex_kind = only_parsing
    THEN
        IF  is_input
        THEN
            a55_describe_value (acv, dmli, lcl_colinfo, curr_n, 0)
        ELSE
            ak77col_short_info (acv, dmli.d_sparr, lcl_colinfo,
                  a_ap_tree^ [ curr_n ].n_length)
        (*ENDIF*) 
    ELSE
        BEGIN
        END
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a77replace_descr (VAR acv : tak_all_command_glob;
            VAR cfd         : tgg_string_filedescr;
            VAR coldesc_id  : tgg_surrogate;
            cpy_source      : boolean;
            pos             : tsp_int4);
 
VAR
      b_err          : tgg_basis_error;
      coldesc_ptr    : tak_sysbufferaddress;
      coldesc_key    : tgg_sysinfokey;
      col_lock       : tgg00_Lock;
      tableid_ptr    : ^tgg_surrogate;
 
BEGIN
b_err    := e_ok;
WITH acv DO
    BEGIN
    IF  a_ex_kind <> only_parsing
    THEN
        BEGIN
        IF  pos <> cak_is_undefined
        THEN
            BEGIN
            IF  a_data_part = NIL
            THEN
                a07_b_put_error (acv, e_too_short_datapart, 1)
            ELSE
                IF  a_data_part^.sp1p_buf_len < sizeof (coldesc_key.stableid)
                THEN
                    a07_b_put_error (acv, e_too_short_datapart, 1);
                (*ENDIF*) 
            (*ENDIF*) 
            IF  a_return_segm^.sp1r_returncode = 0
            THEN
                BEGIN
                coldesc_key           := a01sysnullkey;
                coldesc_key.sentrytyp := cak_etempscoldesc;
                coldesc_key.skeylen   := mxak_standard_sysk;
                tableid_ptr           := @(a_data_ptr^[pos + 1]);
                coldesc_key.stableid  := tableid_ptr^;
                coldesc_id            := coldesc_key.stableid;
                ak77check_external_descr (acv, coldesc_key);
                IF  a_return_segm^.sp1r_returncode = 0
                THEN
                    BEGIN
                    a10get_sysinfo (acv, coldesc_key, d_release,
                          coldesc_ptr, b_err);
                    IF  b_err <> e_ok
                    THEN
                        IF  b_err = e_sysinfo_not_found
                        THEN
                            a07_b_put_error (acv, e_st_col_not_open, 1)
                        ELSE
                            a07_b_put_error (acv, b_err, 1)
                        (*ENDIF*) 
                    (*ENDIF*) 
                    END
                (*ENDIF*) 
                END
            (*ENDIF*) 
            END
        ELSE
            coldesc_ptr := a_dbproc_cache.dbc_ptr;
        (*ENDIF*) 
        IF  a_return_segm^.sp1r_returncode = 0
        THEN
            BEGIN
            col_lock := coldesc_ptr^.sscoldesc.scd_lock;
            cfd      := coldesc_ptr^.sscoldesc.scd_stringfd;
            a_mblock.mb_qual^.mtree                   := cfd.str_treeid;
            a_mblock.mb_qual^.mtree.fileRoot_gg00     := NIL_PAGE_NO_GG00;
            a_mblock.mb_qual^.mtree.fileHandling_gg00 :=
                  a_transinf.tri_global_state;
            IF  a_mblock.mb_type2 in [ mm_write,
                mm_trunc, mm_copy, mm_expand ]
            THEN
                BEGIN
                col_lock.lockMode_gg00 := lckRowExcl_egg00;
                IF  NOT (cpy_source OR
                    (cfd.use_mode in [ fs_write, fs_readwrite ]))
                THEN
                    a07_b_put_error (acv,
                          e_st_col_open_read_only, 1)
                ELSE
                    WITH a_mblock.mb_qual^ DO
                        BEGIN
                        IF  hsWithoutLock_egg00 in mtree.fileHandling_gg00
                        THEN
                            mtree.fileHandling_gg00 := mtree.fileHandling_gg00 -
                                  [ hsWithoutLock_egg00 ]
                        (*ENDIF*) 
                        END;
                    (*ENDWITH*) 
                (*ENDIF*) 
                END
            ELSE
                col_lock.lockMode_gg00 := lckRowShare_egg00;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        IF  a_return_segm^.sp1r_returncode = 0
        THEN
            BEGIN
            IF  (a_mblock.mb_type2 = mm_copy) AND NOT cpy_source
            THEN
                BEGIN
                a_mblock.mb_qual^.mcl_copy_long.lcq_dest_lock_tabid :=
                      col_lock.lockTabId_gg00;
                col_lock.lockKeyPos_gg00 := a_mblock.mb_data_len + mxgg_lock + 1;
                g10mv13 ('VAK77 ',  10,    
                      sizeof (col_lock), a_mblock.mb_data_size,
                      col_lock, 1, a_mblock.mb_data^.mbp_buf,
                      cgg_rec_key_offset + mxgg_lock + 1,
                      sizeof (col_lock), a_return_segm^.sp1r_returncode)
                END
            ELSE
                BEGIN
                a_mblock.mb_qual^.ml_long_qual.lq_lock_tabid :=
                      col_lock.lockTabId_gg00;
                (*----- 8 = 4 * int2 length -----*)
                a_mblock.mb_data_len := cgg_rec_key_offset;
                col_lock.lockKeyPos_gg00 := mxgg_lock + 1;
                IF  (a_mblock.mb_type2 = mm_copy) AND cpy_source
                THEN
                    col_lock.lockKeyPos_gg00 := col_lock.lockKeyPos_gg00 + mxgg_lock;
                (*ENDIF*) 
                g10mv13 ('VAK77 ',  11,    
                      sizeof (col_lock), a_mblock.mb_data_size,
                      col_lock, 1, a_mblock.mb_data^.mbp_buf,
                      cgg_rec_key_offset + 1, sizeof (col_lock),
                      a_return_segm^.sp1r_returncode);
                END;
            (*ENDIF*) 
            IF  a_return_segm^.sp1r_returncode = 0
            THEN
                g10mv ('VAK77 ',  12,    
                      sizeof (coldesc_ptr^.sscoldesc.scd_key),
                      a_mblock.mb_data_size,
                      coldesc_ptr^.sscoldesc.scd_key, 1,
                      a_mblock.mb_data^.mbp_buf,
                      col_lock.lockKeyPos_gg00 + cgg_rec_key_offset,
                      col_lock.lockKeyLen_gg00, a_return_segm^.sp1r_returncode);
            (*ENDIF*) 
            IF  a_return_segm^.sp1r_returncode = 0
            THEN
                BEGIN
                IF  (a_mblock.mb_type2 = mm_copy) AND NOT cpy_source
                THEN
                    a_mblock.mb_data^.mbp_keylen := a_mblock.
                          mb_data^.mbp_keylen + col_lock.lockKeyLen_gg00 + mxgg_lock
                ELSE
                    a_mblock.mb_data^.mbp_keylen := col_lock.lockKeyLen_gg00 +
                          mxgg_lock;
                (*ENDIF*) 
                a_mblock.mb_data_len := a_mblock.mb_data_len +
                      col_lock.lockKeyLen_gg00 + mxgg_lock
                END
            (*ENDIF*) 
            END
        (*ENDIF*) 
        END
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a77test_and_change_coldesc (VAR acv : tak_all_command_glob;
            VAR coldesc_id : tgg_surrogate;
            use_dest_col   : boolean;
            m2type         : tgg_message2_type);
 
VAR
      b_err          : tgg_basis_error;
      coldesc_ptr    : tak_sysbufferaddress;
      coldesc_key    : tgg_sysinfokey;
 
BEGIN
b_err := e_ok;
WITH acv, a_mblock, mb_qual^ DO
    BEGIN
    IF  (m2type = mm_copy) OR
        (m2type = mm_expand) OR
        (m2type = mm_length) OR
        (m2type = mm_read) OR
        (m2type = mm_search) OR
        (m2type = mm_trunc) OR
        (m2type = mm_write)
    THEN
        IF  (mb_type = m_return_result)
            AND
            ( ml_long_qual.lq_long_in_file OR
            (mcl_copy_long.lcq_dest_long_in_file AND (m2type = mm_copy)))
        THEN
            BEGIN
            coldesc_key           := a01sysnullkey;
            coldesc_key.sentrytyp := cak_etempscoldesc;
            coldesc_key.skeylen   := mxak_standard_sysk;
            coldesc_key.stableid  := coldesc_id;
            a10get_sysinfo (acv, coldesc_key, d_release,
                  coldesc_ptr, b_err);
            IF  b_err <> e_ok
            THEN
                a07_b_put_error (acv, b_err, 1)
            ELSE
                BEGIN
                IF  use_dest_col
                THEN
                    BEGIN
                    IF  mcl_copy_long.lcq_dest_long_in_file
                    THEN
                        coldesc_ptr^.sscoldesc.scd_stringfd.
                              str_treeid.fileTfn_gg00 := tfnColumn_egg00
                    ELSE
                        coldesc_ptr^.sscoldesc.scd_stringfd.
                              str_treeid.fileTfn_gg00 := tfnShortScol_egg00;
                    (*ENDIF*) 
                    END
                ELSE
                    BEGIN
                    IF  ml_long_qual.lq_long_in_file
                    THEN
                        coldesc_ptr^.sscoldesc.scd_stringfd.
                              str_treeid.fileTfn_gg00 := tfnColumn_egg00
                    ELSE
                        coldesc_ptr^.sscoldesc.scd_stringfd.
                              str_treeid.fileTfn_gg00 := tfnShortScol_egg00;
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
                a_pars_curr.fileHandling_gg00 :=
                      a_pars_curr.fileHandling_gg00 - [ hsNoLog_egg00 ];
                a10repl_sysinfo (acv, coldesc_ptr, b_err);
                a_pars_curr.fileHandling_gg00 :=
                      a_pars_curr.fileHandling_gg00 + [ hsNoLog_egg00 ];
                IF  b_err <> e_ok
                THEN
                    a07_b_put_error (acv, b_err, 1)
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a77bget_buffer (VAR acv: tak_all_command_glob;
            colcode : tsp_code_type;
            pos     : tsp_int4);
 
VAR
      buflen       : tsp_int4;
      klen_offset  : tsp_int4;
      e            : tsp8_uni_error;
      err_char_no  : tsp_int4;
      outlen       : tsp_int4;
      dest_code    : tsp00_Uint1;
 
BEGIN
WITH acv, a_mblock, mb_qual^, mb_data^ DO
    BEGIN
&   ifdef TRACE
    t01int4 (ak_sem, 'bget vppos  ', pos);
    t01int4 (ak_sem, 'bget  rec_l ', mbp_reclen);
    t01int4 (ak_sem, 'bget  key_l ', mbp_keylen);
    t01int4 (ak_sem, 'bget data_l ', mb_data_len);
&   endif
    IF  a_ex_kind <> only_parsing
    THEN
        BEGIN
        buflen      := ml_long_qual.lq_len;
        klen_offset := mbp_keylen;
        IF  mb_type2 = mm_write
        THEN
            klen_offset := klen_offset - mxgg_lock;
&       ifdef TRACE
        (*ENDIF*) 
        t01int4 (ak_sem, 'buflen :    ', buflen);
        t01int4 (ak_sem, 'klen offset:', klen_offset);
        t01int4 (ak_sem, 'data_length ', a_data_length);
&       endif
        IF  (((mb_type2 = mm_write) AND
            (a_data_length < buflen + 22))
            (*======== id + fix 10 + fix 5 + def by  = 22 Byte *)
            OR
            ((mb_type2 = mm_fwrite) AND
            (a_data_length < buflen + 6)))
            (*======== fix 5 + def by  = any + 6 Byte *)
            AND (colcode <> csp_unicode)
        THEN
            a07_b_put_error (acv, e_st_invalid_length, 1)
        ELSE
            BEGIN
            IF  ((buflen > (mb_data_size - mb_data_len)) AND
                (colcode <> csp_unicode))
                OR
                ((2 * buflen > (mb_data_size - mb_data_len)) AND
                (colcode = csp_unicode))
            THEN
                a07_b_put_error (acv, e_too_many_mb_data, 1);
            (*ENDIF*) 
            IF  a_return_segm^.sp1r_returncode = 0
            THEN
                BEGIN
                a77convert (acv, a_data_ptr^,
                      colcode, pos + 1, buflen, c_is_input);
                ml_long_qual.lq_data_offset := mb_data_len;
                IF  (colcode in [csp_ascii, csp_ebcdic]) AND
                    (a_out_packet^.sp1_header.sp1h_mess_code in
                    [csp_unicode, csp_unicode_swap])
                THEN
                    BEGIN
                    IF  colcode = csp_ebcdic
                    THEN
                        dest_code := csp_ascii
                    ELSE
                        dest_code := colcode;
                    (*ENDIF*) 
                    outlen :=  2 * buflen;  (* mb_data_size; *)
                    s80uni_trans (@(a_data_ptr^[pos+1]), a_data_length - pos,
                          a_out_packet^.sp1_header.sp1h_mess_code,
                          @(mbp_buf [mb_data_len + 1]), outlen,
                          dest_code, [ ], e, err_char_no);
                    IF  e in [ uni_ok, uni_dest_too_short ]
                    THEN
                        BEGIN
                        buflen              := outlen;
                        ml_long_qual.lq_len := outlen;
                        IF  colcode = csp_ebcdic
                        THEN
                            s30map (g02codetables.tables[ cgg_to_ebcdic ],
                                  mbp_buf, mb_data_len + 1,
                                  mbp_buf, mb_data_len + 1,
                                  ml_long_qual.lq_len);
                        (*ENDIF*) 
                        END
                    ELSE
                        a07_uni_error (acv, e, err_char_no);
                    (*ENDIF*) 
                    END
                ELSE
                    IF  (colcode =  csp_unicode) AND
                        (a_out_packet^.sp1_header.sp1h_mess_swap <> sw_normal) AND
                        (a_out_packet^.sp1_header.sp1h_mess_code <> csp_unicode)
                    THEN
                        BEGIN
                        outlen := buflen;  (* mb_data_size; *)
                        s80uni_trans (@(a_data_ptr^[pos+1]), a_data_length - pos,
                              csp_unicode_swap,
                              @(mbp_buf [mb_data_len + 1]), outlen,
                              csp_unicode, [ ], e, err_char_no);
                        IF  e <> uni_ok
                        THEN
                            a07_uni_error (acv, e, err_char_no);
                        (*ENDIF*) 
                        END
                    ELSE
                        g10mv6 ('VAK77 ',  13,    
                              a_data_length, mb_data_size,
                              a_data_ptr^, pos + 1, mbp_buf,
                              mb_data_len + 1, buflen,
                              a_return_segm^.sp1r_returncode);
                    (*ENDIF*) 
                (*ENDIF*) 
                mb_data_len := buflen + mb_data_len;
                END
            (*ENDIF*) 
            END
        (*ENDIF*) 
        END
    ELSE
        IF  mb_type2 = mm_write
        THEN
            BEGIN
            mb_data_len := cgg_rec_key_offset;
            mbp_keylen  := 0;
            END;
&       ifdef TRACE
        (*ENDIF*) 
    (*ENDIF*) 
    t01int4 (ak_sem, 'bget buf end', 0);
    t01int4 (ak_sem, 'm.data_len  ', mb_data_len);
&   endif
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a77pget_pattern (VAR acv : tak_all_command_glob;
            VAR cfd    : tgg_string_filedescr;
            VAR  vppos : tsp_int4;
            is_pattern : boolean);
 
VAR
      ok          : boolean;
      ct_is_ascii : boolean;
      patt_len    : integer;
      patt_pos    : integer;
      lcl_blank   : char;
 
BEGIN
ok          := false;
ct_is_ascii := (g01code.ctype = csp_ascii);
WITH acv, a_mblock, mb_data^ DO
    BEGIN
&   ifdef TRACE
    t01int4 (ak_sem, 'vppos :     ', vppos);
    t01int4 (ak_sem, 'is_patt     ', ord(is_pattern));
&   endif
    IF  a_ex_kind <> only_parsing
    THEN
        BEGIN
        IF  cfd.codespec = csp_unicode
        THEN
            a07_b_put_error (acv, e_not_implemented, 1)
        ELSE
            BEGIN
&           ifdef TRACE
            t01int4 (ak_sem, 'column code ',
                  ord (cfd.codespec));
&           endif
            a77convert (acv, a_data_ptr^,
                  cfd.codespec, vppos+1,
                  c_max_pattern_len, c_is_input);
            patt_len := a_data_length - vppos;
            patt_pos := mb_data_len + 1;
&           ifdef TRACE
            t01int4 (ak_sem, 'patt_pos    ', patt_pos);
            t01int4 (ak_sem, 'patt_length ', patt_len);
&           endif
            g10mv6 ('VAK77 ',  14,    
                  a_data_length, mb_data_size,
                  a_data_ptr^, vppos + 1,
                  mbp_buf, patt_pos, patt_len,
                  a_return_segm^.sp1r_returncode)
            END;
        (*ENDIF*) 
        IF  a_return_segm^.sp1r_returncode = 0
        THEN
            g10fil ('VAK77 ',  15,    
                  mb_data_size, mbp_buf,
                  patt_pos + patt_len,   (* ?? *)
                  c_max_pattern_len - patt_len, chr (0),
                  a_return_segm^.sp1r_returncode);
        (*ENDIF*) 
        IF  a_return_segm^.sp1r_returncode = 0
        THEN
            BEGIN
&           ifdef TRACE
            t01moveobj (ak_sem, mbp_buf, 1,
                  patt_pos + c_max_pattern_len - 1);
&           endif
            CASE cfd.codespec OF
                csp_ascii :
                    lcl_blank := csp_ascii_blank;
                csp_ebcdic :
                    lcl_blank := csp_ebcdic_blank;
                OTHERWISE
                    lcl_blank := bsp_c1;
                END;
            (*ENDCASE*) 
            mb_data_len := s30lnr (mbp_buf, chr (0), 1,
                  mb_data_len + c_max_pattern_len - 2);
&           ifdef TRACE
            t01int4 (ak_sem, 'pattern len ', mb_data_len - patt_pos + 1);
&           endif
            (* mb_data_len := s30lnr (mbp_buf, lcl_blank, 1, mb_data_len); *)
            (*11.10.93 JH*)
&           ifdef TRACE
                  t01int4 (ak_sem, 'pattern len ', mb_data_len - patt_pos + 1);
&           endif
            IF  is_pattern
            THEN
                BEGIN
                WITH cfd DO
                    ct_is_ascii := (codespec = csp_ascii)  OR
                          ((codespec = csp_codeneutral) AND
                          (g01code.ctype = csp_ascii));
                (*ENDWITH*) 
                s49build_pattern (mbp_buf, ct_is_ascii,
                      patt_pos, mb_data_len,
                      bsp_c1, NOT c_escape, c_string, sqlm_adabas, ok);
                IF  NOT ok
                THEN
                    a07_b_put_error (acv, e_invalid_pattern, 1)
                (*ENDIF*) 
                END
            (*ENDIF*) 
            END
        (*ENDIF*) 
        END
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a77get_int4 (VAR acv  : tak_all_command_glob;
            VAR val4        : tsp_int4;
            cmd_varpart_pos : tsp_int4;
            len             : tsp_int2);
 
VAR
      res        : tsp_num_error;
 
BEGIN
WITH acv DO
    BEGIN
&   ifdef TRACE
    t01int4 (ak_sem, 'vppos :     ', cmd_varpart_pos);
    t01int4 (ak_sem, 'len :       ', len);
&   endif
    IF  a_ex_kind <> only_parsing
    THEN
        BEGIN
        s40glint (a_data_ptr^, cmd_varpart_pos + 1, 10, val4, res);
        IF  res <> num_ok
        THEN
            a77sel_res_err (acv, res)
        (*ENDIF*) 
        END
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a77lget_colpos (VAR acv: tak_all_command_glob;
            cmd_varpart_pos : tsp_int4;
            len             : tsp_int2;
            cfd             : tgg_string_filedescr;
            qual            : tak_fs_value_qual);
 
VAR
      eob        : boolean;
      column_pos : tsp_int4;
      res        : tsp_num_error;
 
BEGIN
WITH acv DO
    BEGIN
&   ifdef TRACE
    t01int4 (ak_sem, 'vppos :     ', cmd_varpart_pos);
    t01int4 (ak_sem, 'len :       ', len);
&   endif
    eob := false;
    IF  a_ex_kind <> only_parsing
    THEN
        BEGIN
        s40glint (a_data_ptr^, cmd_varpart_pos + 1, 10, column_pos, res);
        IF  res <> num_ok
        THEN
            a77sel_res_err (acv, res)
        ELSE
            BEGIN
&           ifdef TRACE
            t01int4 (ak_sem, 'lget_pos :  ', column_pos);
&           endif
            IF  (column_pos = -1) AND
                (a_mblock.mb_type2 in [ mm_write, mm_search ])
            THEN
                eob := true;
            (*ENDIF*) 
            IF  a_mblock.mb_type2 in [ mm_write, mm_trunc ]
            THEN
                BEGIN
                IF  (column_pos <= 0) AND (column_pos <> -1)
                THEN
                    IF  a_mblock.mb_type2 = mm_write
                    THEN
                        a07_b_put_error (acv, e_st_invalid_pos, 1)
                    ELSE
                        IF  column_pos < 0
                        THEN
                            a07_b_put_error (acv, e_st_invalid_length,1);
                        (*ENDIF*) 
                    (*ENDIF*) 
                (*ENDIF*) 
                WITH a_mblock, mb_qual^ DO
                    BEGIN
                    ml_long_qual.lq_long_in_file :=
                          (cfd.str_treeid.fileTfn_gg00 <> tfnShortScol_egg00);
                    IF  eob
                    THEN
                        column_pos := cgg_eo_bytestr
                    ELSE
                        IF  (cfd.codespec = csp_unicode) AND (column_pos > 0)
                        THEN
                            BEGIN
                            column_pos := (column_pos * 2) -1;
                            (* for trunc lq_pos is used instead of lq_len *)
                            IF  a_mblock.mb_type2 = mm_trunc
                            THEN
                                column_pos := column_pos + 1;
                            (*ENDIF*) 
                            END;
                        (*ENDIF*) 
                    (*ENDIF*) 
                    ml_long_qual.lq_pos := column_pos
                    END
                (*ENDWITH*) 
                END
            ELSE
                CASE qual OF
                    c_startpos:
                        BEGIN
                        IF  (column_pos <= 0) AND (column_pos <> -1)
                        THEN
                            a07_b_put_error (acv, e_st_invalid_pos, 1)
                        ELSE
                            WITH a_mblock, mb_qual^ DO
                                BEGIN
                                ml_long_qual.lq_long_in_file :=
                                      (cfd.str_treeid.fileTfn_gg00 <> tfnShortScol_egg00);
                                IF  (cfd.codespec = csp_unicode) AND
                                    (column_pos > 0)
                                THEN
                                    column_pos := (column_pos * 2) -1;
                                (*ENDIF*) 
                                ml_long_qual.lq_pos := column_pos
                                END;
                            (*ENDWITH*) 
                        (*ENDIF*) 
                        END;
                    c_endpos  :
                        BEGIN
                        IF  (column_pos <= 0)
                            AND NOT ((column_pos = -1)
                            AND eob)
                        THEN
                            a07_b_put_error (acv,
                                  e_st_invalid_pos, 1)
                        ELSE
                            WITH a_mblock, mb_qual^ DO
                                BEGIN
                                IF  (cfd.codespec = csp_unicode) AND
                                    (column_pos > 0)
                                THEN
                                    column_pos := (column_pos * 2) -1;
                                (* lq_len instead of endpos *)
                                (*ENDIF*) 
                                ml_long_qual.lq_len := column_pos -
                                      ml_long_qual.lq_pos + 1;
                                END;
                            (*ENDWITH*) 
                        (*ENDIF*) 
                        END;
                    END;
                (*ENDCASE*) 
            (*ENDIF*) 
            END
        (*ENDIF*) 
        END
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a77sget_length (VAR acv: tak_all_command_glob;
            column_code     : tsp_code_type;
            cmd_varpart_pos : tsp_int4;
            len             : tsp_int2);
 
VAR
      column_len : tsp_int2;
      res        : tsp_num_error;
 
BEGIN
WITH acv, a_mblock DO
    BEGIN
&   ifdef TRACE
    t01int4 (ak_sem, 'vppos :     ', cmd_varpart_pos);
    t01int4 (ak_sem, 'len :       ', len);
&   endif
    IF  a_ex_kind <> only_parsing
    THEN
        BEGIN
        s40gsint (a_data_ptr^, cmd_varpart_pos + 1, 5, column_len, res);
        IF  res <> num_ok
        THEN
            a77sel_res_err (acv, res)
        ELSE
            BEGIN
&           ifdef TRACE
            t01int4 (ak_sem, 'sget_len :  ', column_len);
            t01int4 (ak_sem, 'mb p2 kl :  ', mb_data^.mbp_keylen);
&           endif
            IF  (column_len = -1) AND
                (mb_type2 = mm_read)
            THEN
                mb_qual^.ml_long_qual.lq_len := column_len
            ELSE
                IF  (column_len <= 0)
                    OR
                    ((mb_type2 = mm_fwrite) AND
                    (column_len > mb_data_size - mb_data^.mbp_keylen))
                    OR
                    ((mb_type2 = mm_write) AND
                    (column_len > mb_data_size - mb_data^.mbp_keylen+mxgg_lock))
                THEN
                    a07_b_put_error (acv, e_st_invalid_length, 1)
                ELSE
                    IF  (column_code = csp_unicode) AND (column_len > 0)
                    THEN
                        mb_qual^.ml_long_qual.lq_len := (column_len * 2)
                    ELSE
                        mb_qual^.ml_long_qual.lq_len := column_len;
                    (*ENDIF*) 
                (*ENDIF*) 
            (*ENDIF*) 
            END
        (*ENDIF*) 
        END
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a77convert (VAR acv : tak_all_command_glob;
            VAR buffer  : tsp_moveobj;
            column_code : tsp_code_type;
            pos         : tsp_int4;
            len         : tsp_int4;
            is_input    : boolean);
 
BEGIN
WITH acv DO
    BEGIN
    IF  column_code <> csp_unicode
    THEN
        IF  is_input
        THEN
            BEGIN
            (* buffer = a_data_ptr^ *)
            IF  column_code <> csp_codeneutral
            THEN
                g02fromtermchar (a_mess_code,
                      buffer, pos, len);
            (*ENDIF*) 
            IF  a_basic_code = csp_ebcdic
            THEN
                BEGIN
                IF  (column_code = csp_ascii)
                THEN (*ebcdic to ascii*)
                    s30map (g02codetables.tables[ cgg_to_ascii ],
                          buffer, pos,
                          buffer, pos, len)
                (*ENDIF*) 
                END
            ELSE   (* a_basic_code = ascii *)
                IF  (column_code = csp_ebcdic)
                THEN   (*ascii to ebcdic*)
                    s30map (g02codetables.tables[ cgg_to_ebcdic ],
                          buffer, pos, buffer, pos, len)
                (*ENDIF*) 
            (*ENDIF*) 
            END
        ELSE
            BEGIN
            (* buffer = a_curr_retpart^.sp1p_buf *)
            IF  a_basic_code = csp_ebcdic
            THEN
                BEGIN
                IF  (column_code = csp_ascii)
                THEN (*ascii to ebcdic*)
                    s30map (g02codetables.tables[ cgg_to_ebcdic ],
                          buffer, pos, buffer, pos, len)
                (*ENDIF*) 
                END
            ELSE   (* a_basic_code = ascii *)
                IF  (column_code = csp_ebcdic)
                THEN (*ebcdic to ascii*)
                    s30map (g02codetables.tables[ cgg_to_ascii ],
                          buffer, pos, buffer, pos, len);
                (*ENDIF*) 
            (*ENDIF*) 
            IF  column_code <> csp_codeneutral
            THEN
                g02totermchar (a_mess_code, buffer, pos, len);
            (*ENDIF*) 
            END;
        (*ENDIF*) 
&   ifdef TRACE
    (*ENDIF*) 
    t01sname (fs_ak, 'a77convert  ');
    t01int4 (ak_sem, 'column code ', ord (column_code));
    t01int4 (ak_sem, 'host code   ', ord (a_mess_code));
    t01int4 (ak_sem, 'basic code  ', ord (a_basic_code));
    t01int4 (ak_sem, 'is input    ', ord (is_input));
    t01int4 (ak_sem, 'pos         ', pos);
    t01int4 (ak_sem, 'len         ', len);
&   endif
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a77sel_res_err (VAR acv : tak_all_command_glob;
            res : tsp_num_error);
 
BEGIN
CASE res OF
    num_invalid :
        a07_b_put_error (acv,
              e_num_invalid, 1);
    num_trunc :
        a07_b_put_error (acv,
              e_num_truncated, 1);
    num_overflow :
        a07_b_put_error (acv,
              e_num_overflow, 1);
    END
(*ENDCASE*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak77generate_external_descr (VAR acv : tak_all_command_glob;
            VAR coldesc_key : tgg_sysinfokey);
 
VAR
      i  : integer;
      ic : tsp_int_map_c2;
 
BEGIN
WITH acv DO
    BEGIN
    a_col_file_count.map_int :=
          succ (a_col_file_count.map_int);
    IF  a_col_file_count.map_int MOD 256 = 0
    THEN
        a_col_file_count.map_int :=
              succ (a_col_file_count.map_int);
    (*ENDIF*) 
    WITH coldesc_key DO
        BEGIN
        stableid [ 1 ] := a_col_file_count.map_c2 [ 1 ];
        stableid [ 2 ] := a_col_file_count.map_c2 [ 2 ];
        i := a_col_file_count.map_int MOD 100;
        IF  i = 0
        THEN
            i := 255;
        (*ENDIF*) 
        stableid [ 3 ] := chr (i);
        stableid [ 6 ] := chr (i);
        i := a_col_file_count.map_int MOD 10;
        IF  i = 0
        THEN
            i := 255;
        (*ENDIF*) 
        stableid [ 4 ] := chr (i);
        stableid [ 5 ] := chr (i);
        ic.map_int := 0;
        FOR i := 1 TO 6 DO
            ic.map_int := ic.map_int + ord (stableid [i]);
        (*ENDFOR*) 
        IF  ic.map_c2 [1] = chr (0)
        THEN
            ic.map_c2 [1] := chr (80);
        (*ENDIF*) 
        IF  ic.map_c2 [2] = chr (0)
        THEN
            ic.map_c2 [2] := chr (80);
        (*ENDIF*) 
        stableid [ 7 ] := ic.map_c2 [ 1 ];
        stableid [ 8 ] := ic.map_c2 [ 2 ];
        END
    (*ENDWITH*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak77check_external_descr (VAR acv : tak_all_command_glob;
            VAR coldesc_key : tgg_sysinfokey);
 
VAR
      i  : integer;
      ic : tsp_int_map_c2;
 
BEGIN
WITH coldesc_key DO
    BEGIN
    ic.map_int := 0;
    FOR i := 1 TO 6 DO
        ic.map_int := ic.map_int + ord (stableid [i]);
    (*ENDFOR*) 
    IF  ic.map_c2 [1] = chr (0)
    THEN
        ic.map_c2 [1] := chr (80);
    (*ENDIF*) 
    IF  ic.map_c2 [2] = chr (0)
    THEN
        ic.map_c2 [2] := chr (80);
    (*ENDIF*) 
    IF  ((stableid [ 7 ] <> ic.map_c2 [1]) OR
        (stableid [ 8 ] <> ic.map_c2 [2]))
    THEN
        a07_b_put_error (acv, e_st_col_not_open, 1)
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak77unlock_colid (VAR acv : tak_all_command_glob;
            VAR cfd   : tgg_string_filedescr;
            VAR clock : tgg00_Lock);
 
CONST
      c_is_lock_excl = true;
 
BEGIN
IF  clock.lockMode_gg00 = lckRowExcl_egg00
THEN
    a508_unlock_lock_lcolumnid (acv, cfd.str_treeid.fileTabId_gg00,
          m_unlock, c_is_lock_excl);
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      ak77max_read_len (VAR acv : tak_all_command_glob;
            VAR dmli        : tak_dml_info;
            long_data_pos   : tsp_int4;
            no_of_out_cols  : tsp_int2) : tsp_int4;
 
VAR
      max_read_len : tsp_int4;
 
BEGIN
WITH acv DO
    BEGIN
    (* PTS 1116801 E.Z. *)
    max_read_len := s26size_new_part (a_out_packet, a_return_segm^)
          - long_data_pos;
    IF  (a_ex_kind <> only_parsing) AND a77infop_exists
    THEN
        WITH dmli.d_sparr, pcolnamep^.scolnames, pinfop^.sshortinfo DO
            BEGIN
            max_read_len := max_read_len - 2 * sizeof (tsp1_part_header) -
                  a01aligned_cmd_len (sicount * sizeof(siinfo [1]))
                  -
                  a01aligned_cmd_len (cnfullen - (sizeof (pcolnamep^.scolnames) -
                  no_of_out_cols * (((sizeof (tsp_knl_identifier) DIV 2) * 3) + 1)));
            END;
        (*ENDWITH*) 
    (*ENDIF*) 
    IF  max_read_len > c_max_fixed_5
    THEN
        max_read_len := c_max_fixed_5;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
ak77max_read_len := max_read_len;
END;
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
*-PRETTY-*  statements    :       1243
*-PRETTY-*  lines of code :       3832        PRETTYX 3.10 
*-PRETTY-*  lines in file :       4551         1997-12-10 
.PA 
