.ad 8
.bm 8
.fm 4
.bt $Copyright by SAP AG, 2003$$Page %$
.tm 12
.hm 6
.hs 3
.TT 1 $SQL$Project Distributed Database System$VAK508$
.tt 2 $$$
.TT 3 $$Long-Support-Getval$$2000-03-06$
***********************************************************
.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  : Long-Support-Getval
=========
.sp
Purpose : Module, which suppots longcolumn getval.
.CM *-END-* purpose -------------------------------------
.sp
.cp 3
Define  :
 
        PROCEDURE
              a508_getval (VAR acv : tak_all_command_glob);
 
        PROCEDURE
              a508get_definition_text (VAR acv : tak_all_command_glob;
                    VAR surrogate : tgg_surrogate;
                    show_kind     : tgg_show_kind;
                    colno         : integer;
                    VAR buf       : tgg00_SelectBuffer;
                    VAR textlen   : tsp_int4);
 
        PROCEDURE
              a508_lget_long_columns (VAR acv : tak_all_command_glob;
                    VAR change_rec      : tak_changerecord;
                    VAR lcol_lock       : boolean;
                    rec_cnt             : integer;
                    rec_len             : integer;
                    startpos            : integer);
 
        FUNCTION
              a508_lcol_found (VAR acv : tak_all_command_glob;
                    VAR change_rec : tak_changerecord) : boolean;
 
        PROCEDURE
              a508_unlock_lock_lcolumnid (VAR acv : tak_all_command_glob;
                    ld_descriptor  : tgg_surrogate;
                    mtype          : tgg_message_type;
                    lock_excl      : boolean);
 
.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :
 
        FROM
              Scanner: VAK01;
 
        FUNCTION
              a01aligned_cmd_len (len : tsp_int4) : tsp_int4;
 
      ------------------------------ 
 
        FROM
              AK_universal_semantic_tools : VAK06;
 
        PROCEDURE
              a06init_curr_retpart (VAR acv : tak_all_command_glob);
 
        PROCEDURE
              a06finish_curr_retpart (VAR acv : tak_all_command_glob;
                    part_kind : tsp1_part_kind;
                    arg_count : tsp_int2);
 
        PROCEDURE
              a06retpart_move (VAR acv : tak_all_command_glob;
                    moveobj_ptr : tsp_moveobj_ptr;
                    move_len    : tsp_int4);
 
        PROCEDURE
              a06_systable_get (VAR acv : tak_all_command_glob;
                    dstate      : tak_directory_state;
                    VAR tableid : tgg_surrogate;
                    VAR base_ptr: tak_sysbufferaddress;
                    get_all     : boolean;
                    VAR ok      : boolean);
 
        PROCEDURE
              a06rsend_mess_buf (VAR acv : tak_all_command_glob;
                    VAR mbuf    : tgg_mess_block;
                    return_req  : boolean;
                    VAR e       : tgg_basis_error);
 
      ------------------------------ 
 
        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);
 
        FUNCTION
              a07_return_code (b_err : tgg_basis_error;
                    sqlmode : tsp_sqlmode) : tsp_int2;
 
      ------------------------------ 
 
        FROM
              AK_Comment : VAK26;
 
        PROCEDURE
              a26getval (VAR acv      : tak_all_command_glob;
                    VAR long_desc     : tak_long_descriptor;
                    VAR ret_long_qual : tgg_long_qual);
 
      ------------------------------ 
 
        FROM
              AK_Trigger : VAK262;
 
        PROCEDURE
              a262GetDBProcDefinition (VAR acv : tak_all_command_glob;
                    VAR DBProcId : tgg_surrogate;
                    VAR def_len  : tsp_int4;
                    VAR buf      : tgg00_SelectBuffer;
                    buf_size     : tsp_int4);
 
        PROCEDURE
              a262GetValDBProcDefinition (VAR acv : tak_all_command_glob;
                    VAR long_desc     : tak_long_descriptor;
                    VAR ret_long_qual : tgg_long_qual);
 
      ------------------------------ 
 
        FROM
              AK_universal_show_tools : VAK40;
 
        PROCEDURE
              a40GetFromLongColContainer (
                    VAR acv       : tak_all_command_glob;
                    VAR longId    : tgg00_Surrogate;
                    VAR buf       : tgg00_SelectBuffer;
                    VAR buf_len   : tsp00_Int4);
 
      ------------------------------ 
 
        FROM
              AK_Show_synonym_domain : VAK44;
 
        PROCEDURE
              a44constraint_into_moveobj (VAR acv : tak_all_command_glob;
                    base_ptr       : tak_sysbufferaddress;
                    VAR tabid      : tgg_surrogate;
                    object_type    : tak_object_type;
                    constraint_id  : integer;
                    tabno          : integer;
                    VAR moveobj    : tgg00_SelectBuffer;
                    moveobj_size   : tsp_int4;
                    VAR filled_len : tsp_int4);
 
        PROCEDURE
              a44get_domaindef (VAR acv : tak_all_command_glob;
                    VAR dom_surrogate : tgg_surrogate;
                    constraint_only   : boolean;
                    VAR moveobj       : tgg00_SelectBuffer;
                    moveobj_size      : tsp_int4;
                    VAR filled_len    : tsp_int4);
 
      ------------------------------ 
 
        FROM
              AK_Show_view : VAK48;
 
        PROCEDURE
              a48get_view_def_string (VAR acv : tak_all_command_glob;
                    VAR tabid       : tgg_surrogate;
                    length_only     : boolean;
                    outbuf_size     : tsp_int4;
                    VAR outbuf      : tgg00_SelectBuffer;
                    VAR viewtextlen : tsp_int4);
 
      ------------------------------ 
 
        FROM
              AK_Show_Procedure : VAK49;
 
        PROCEDURE
              a49get_trigger_def (VAR acv : tak_all_command_glob;
                    VAR tabid    : tgg_surrogate;
                    trigger_kind : tsp_c1;
                    VAR def_len  : tsp_int2;
                    VAR buf      : tgg00_SelectBuffer;
                    buf_size     : tsp_int4);
 
      ------------------------------ 
 
        FROM
              Resulttable: VAK73;
 
        FUNCTION
              a73_calc_unused_space (
                    VAR acv : tak_all_command_glob) : tsp_int4;
 
      ------------------------------ 
 
        FROM
              filesysteminterface_1 : VBD01;
 
        VAR
              b01niltree_id : tgg00_FileId;
 
      ------------------------------ 
 
        FROM
              Configuration_Parameter : VGG01;
 
        VAR
              g01code           : tgg_code_globals;
              g01nil_long_qual  : tgg_long_qual;
              g01nil_stack_desc : tgg_stack_desc;
              g01unicode        : boolean;
 
        PROCEDURE
              g01mblock_init (VAR source_trans : tgg00_TransContext;
                    mess_type  : tgg_message_type;
                    mess2_type : tgg_message2_type;
                    VAR mblock : tgg_mess_block);
 
      ------------------------------ 
 
        FROM
              Codetransformation_and_Coding : VGG02;
 
        PROCEDURE
              g02pascii_pos_ebcdic (VAR source : tsp_moveobj;
                    srcind   : tsp_int4;
                    VAR dest : tsp_moveobj;
                    destind  : tsp_int4;
                    length   : tsp_int4);
 
        PROCEDURE
              g02pebcdic_pos_ascii (VAR source : tsp_moveobj;
                    srcind   : tsp_int4;
                    VAR dest : tsp_moveobj;
                    destind  : 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
              g10mv   (mod_id      : tsp_c6;
                    mod_intern_num : tsp_int4;
                    size1          : tsp_int4;
                    size2          : tsp_int4;
                    VAR val1       : tsp_moveobj;
                    p1             : tsp_int4;
                    VAR val2       : tsp_moveobj;
                    p2             : tsp_int4;
                    cnt            : tsp_int4;
                    VAR e          : tgg_basis_error);
 
        PROCEDURE
              g10mv1  (mod_id      : tsp_c6;
                    mod_intern_num : tsp_int4;
                    size1          : tsp_int4;
                    size2          : tsp_int4;
                    VAR val1       : tgg00_SelectBuffer;
                    p1             : tsp_int4;
                    VAR val2       : tsp_moveobj;
                    p2             : tsp_int4;
                    cnt            : tsp_int4;
                    VAR e          : tgg_basis_error);
 
        PROCEDURE
              g10mv2  (mod_id      : tsp_c6;
                    mod_intern_num : tsp_int4;
                    size1          : tsp_int4;
                    size2          : tsp_int4;
                    VAR val1       : tsp_moveobj;
                    p1             : tsp_int4;
                    VAR val2       : tsp_long_descriptor;
                    p2             : tsp_int4;
                    cnt            : tsp_int4;
                    VAR e          : tgg_basis_error);
 
        PROCEDURE
              g10mv3  (mod_id      : tsp_c6;
                    mod_intern_num : tsp_int4;
                    size1          : tsp_int4;
                    size2          : tsp_int4;
                    VAR val1       : tsp_long_descriptor;
                    p1             : tsp_int4;
                    VAR val2       : tsp_moveobj;
                    p2             : tsp_int4;
                    cnt            : tsp_int4;
                    VAR e          : tgg_basis_error);
 
      ------------------------------ 
 
        FROM
              RTE-Extension-20: VSP20;
 
        PROCEDURE
              s20ch4sw (val    : tsp_int4;
                    sourceswap : tsp_swap_kind;
                    VAR dest   : tsp_int4;
                    di         : tsp_int4;
                    destswap   : tsp_swap_kind);
 
      ------------------------------ 
 
        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
              t01long_qual (debug : tgg00_Debug;
                    nam           : tsp00_Sname;
                    VAR long_qual : tgg00_LongQual);
 
        PROCEDURE
              t01longdescriptor (debug : tgg00_Debug;
                    long_desc : tsp00_LongDescriptor);
 
        PROCEDURE
              t01moveobj (debug : tgg00_Debug;
                    VAR moveobj : tsp00_MoveObj;
                    startpos    : tsp00_Int4;
                    endpos      : tsp00_Int4);
 
        PROCEDURE
              t01int4 (debug : tgg00_Debug;
                    nam      : tsp00_Sname;
                    int      : tsp00_Int4);
&       ENDIF
 
.CM *-END-* use -----------------------------------------
.sp;.cp 3
Synonym :
 
        PROCEDURE
              a49get_trigger_def;
 
              tgg_linkset tsp_c1
              tsp_moveobj tgg00_SelectBuffer
 
        PROCEDURE
              a48get_view_def_string;
 
              tsp_moveobj tgg00_SelectBuffer
 
        PROCEDURE
              a44constraint_into_moveobj;
 
              tsp_moveobj tgg00_SelectBuffer
 
        PROCEDURE
              a44get_domaindef;
 
              tsp_moveobj tgg00_SelectBuffer
 
        PROCEDURE
              a40GetFromLongColContainer;
 
              tgg_double_buf tgg00_SelectBuffer
 
        PROCEDURE
              a262GetDBProcDefinition;
 
              tsp_moveobj tgg00_SelectBuffer
 
        PROCEDURE
              g10mv1;
 
              tsp_moveobj tgg00_SelectBuffer
 
        PROCEDURE
              g10mv2;
 
              tsp_moveobj tsp_long_descriptor
 
        PROCEDURE
              g10mv3;
 
              tsp_moveobj tsp_long_descriptor
 
        PROCEDURE
              s20ch4sw;
 
              tsp_moveobj tsp_int4
 
.CM *-END-* synonym -------------------------------------
.sp;.cp 3
Author  :
.sp
.cp 3
Created : 1993-03-02
.sp
.cp 3
.sp
.cp 3
Release :      Date : 2000-03-06
.sp
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Specification:
.CM *-END-* specification -------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Description:
.sp 2
.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_intern_getval    = true (* ak508get_one_long_column  *);
      c_lock_excl        = true (* a508_unlock_lock_lcolumnid *);
      c_rescount_len61   = 11   (* mxsp_resnum for pre 6.2    *);
 
 
(*------------------------------*) 
 
FUNCTION
      a508_lcol_found (VAR acv : tak_all_command_glob;
            VAR change_rec : tak_changerecord) : boolean;
 
VAR
      i     : integer;
      found : boolean;
 
BEGIN
WITH acv, change_rec DO
    BEGIN
    i     := 1;
    found := false;
    WHILE (i <= cr_colcount) AND (NOT found) DO
        BEGIN
        found := (ch_to_longsupport in  cr_columns[ i ].ch_type);
        i     := succ (i);
        END;
    (*ENDWHILE*) 
    IF  found
    THEN
        a_long_desc_pos := pred (i);
    (*ENDIF*) 
    END;
(*ENDWITH*) 
a508_lcol_found := found;
END;
 
(*------------------------------*) 
 
PROCEDURE
      a508_getval (VAR acv : tak_all_command_glob);
 
VAR
      buffer_full       : boolean;
      with_lock         : boolean;
      ld_pos            : integer;
      save_retpart_pos  : integer;
      ld_cnt            : integer;
      desc_len          : integer;
 
BEGIN
(* *** extern call (Getval) *** *)
WITH acv, a_cmd_segm^ DO
    BEGIN
    (* PTS 1116801 E.Z. *)
    desc_len := mxsp_long_desc;
    ld_cnt      := 0;
    ld_pos      := 1;
    with_lock   := false;
    buffer_full := false;
    WHILE (ld_cnt < sp1p_arg_count)            AND
          (a_return_segm^.sp1r_returncode = 0) AND
          (NOT buffer_full)                        DO
        BEGIN
        (* don't forget the defined_byte *)
        a06retpart_move (acv, @a_data_ptr^[ld_pos], desc_len + 1);
        save_retpart_pos := a_curr_retpart^.sp1p_buf_len + 1
              - (desc_len + 1);
        ak508get_one_long_column (acv, ld_pos,
              NOT c_intern_getval, buffer_full);
        g10mv ('VAK508',   1,    
              a_data_part^.sp1p_buf_size, a_curr_retpart^.sp1p_buf_size,
              a_data_ptr^, ld_pos, a_curr_retpart^.sp1p_buf, save_retpart_pos,
              (desc_len + 1), a_return_segm^.sp1r_returncode);
        ld_cnt := succ (ld_cnt);
        ld_pos := ld_pos + desc_len + 1;
        (* PTS 1116801 E.Z. *)
        (* PTS 1116917 E.Z. *)
        buffer_full := (a_curr_retpart^.sp1p_buf_len + desc_len + 1
              >= a73_calc_unused_space (acv));
        END;
    (*ENDWHILE*) 
    (* *** subtrans don't be closed *** *)
    IF  (a_return_segm^.sp1r_returncode = 0) AND (NOT a_part_rollback) AND
        ((ld_cnt < sp1p_arg_count) OR buffer_full)
    THEN
        a_long_desc_pos := 1;
&   IFDEF TRACE
    (*ENDIF*) 
    t01int4 (ak_sem, 'returncode  ', a_return_segm^.sp1r_returncode);
    t01int4 (ak_sem, 'a_part_rollb', ord (a_part_rollback));
    t01int4 (ak_sem, 'a_long_desc_', a_long_desc_pos);
    t01int4 (ak_sem, 'ld_cnt      ', ld_cnt);
    t01int4 (ak_sem, 'max_long_col', sp1p_arg_count);
    t01int4 (ak_sem, 'buffer_full ', ord (buffer_full));
&   endif
    (* *** Update counter of long_descriptors *** *)
    a06finish_curr_retpart (acv, sp1pk_longdata, ld_cnt);
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a508get_definition_text (VAR acv : tak_all_command_glob;
            VAR surrogate : tgg_surrogate;
            show_kind     : tgg_show_kind;
            colno         : integer;
            VAR buf       : tgg00_SelectBuffer;
            VAR textlen   : tsp_int4);
 
VAR
      ok       : boolean;
      c        : tsp_c1;
      int2len  : tsp_int2;
      i2c2     : tsp_int_map_c2;
      obj_type : tak_object_type;
      base_ptr : tak_sysbufferaddress;
 
BEGIN
textlen := 0;
CASE show_kind OF
    sh_constraint, sh_all_constraint :
        BEGIN
        a06_systable_get (acv, d_release,
              surrogate, base_ptr, true, ok);
        IF  ok
        THEN
            BEGIN
            IF  base_ptr^.sbase.btreeid.fileTfn_gg00 = tfnTemp_egg00
            THEN
                obj_type := obj_temp_table
            ELSE
                obj_type := obj_table;
            (*ENDIF*) 
            a44constraint_into_moveobj (acv, base_ptr, surrogate,
                  obj_type, colno, 1,
                  buf, sizeof (buf), textlen);
            END;
        (*ENDIF*) 
        END;
    sh_heap_content, sh_memoryholders :
        a40GetFromLongColContainer (acv, surrogate, buf, textlen);
    sh_procedure, sh_all_procedures :
        a262GetDBProcDefinition (acv, surrogate, textlen, buf, sizeof(buf));
    sh_trigger, sh_all_triggers :
        BEGIN
        i2c2.map_int := colno;
        c[1]         := i2c2.map_c2[1];
        a49get_trigger_def (acv, surrogate,
              c, int2len, buf, sizeof (buf));
        textlen := int2len
        END;
    sh_u_domain, sh_domain_constraints :
        a44get_domaindef (acv, surrogate,
              show_kind = sh_domain_constraints,
              buf, sizeof (buf), textlen);
    (* PTS 1111576 E.Z. *)
    sh_view, sh_all_views :
        a48get_view_def_string (acv,
              surrogate, false, sizeof (buf), buf, textlen)
    OTHERWISE
        a07_b_put_error (acv, e_not_implemented, 1);
    END;
(*ENDCASE*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a508_lget_long_columns (VAR acv : tak_all_command_glob;
            VAR change_rec      : tak_changerecord;
            VAR lcol_lock       : boolean;
            rec_cnt             : integer;
            rec_len             : integer;
            startpos            : integer);
 
VAR
      buffer_full     : boolean;
      data_part       : boolean;
      aux_long_pos    : integer;
      i               : integer;
 
BEGIN
WITH acv, a_cmd_segm^, change_rec DO
    BEGIN
&   IFDEF TRACE
    t01int4 (ak_sem, 'startpos    ', startpos);
    t01int4 (ak_sem, 'rec_len     ', rec_len);
    t01int4 (ak_sem, 'rec_cnt     ', rec_cnt);
&   ENDIF
    data_part       := false;
    i               := 0;
    aux_long_pos    := a_long_desc_pos;
    buffer_full     := false;
    IF  a_curr_retpart = NIL
    THEN
        a06init_curr_retpart (acv);
    (* *** (a_long_desc_pos = 0) indicates that      *)
    (*     varpart is full                       *** *)
    (*ENDIF*) 
    WHILE (i < rec_cnt)         AND
          (a_long_desc_pos > 0) AND
          (a_return_segm^.sp1r_returncode = 0) AND
          (NOT buffer_full)         DO
        BEGIN
        ak508_long_column_handling (acv, change_rec,
              startpos + (i * rec_len), buffer_full);
        i := succ (i);
        END;
    (*ENDWHILE*) 
    IF  (a_return_segm^.sp1r_returncode = 0) AND (NOT a_part_rollback) AND
        ((i < rec_cnt) OR
        ((i = rec_cnt) AND data_part))
    THEN
        BEGIN
        IF  (i < rec_cnt)
        THEN
            BEGIN
            a_long_desc_pos := aux_long_pos;
            ak508_fetch_long_desc (acv, change_rec, rec_cnt - i,
                  rec_len, startpos + (i * rec_len));
            END;
        (* *** reset a_long_desc_pos for indicate     *)
        (*     that subtrans don't be closed      *** *)
        (*ENDIF*) 
        a_long_desc_pos := aux_long_pos;
        END
    ELSE
        a_long_desc_pos := 0;
    (*ENDIF*) 
&   IFDEF TRACE
    t01int4 (ak_sem, 'lcol_lock   ', ord (lcol_lock));
    t01int4 (ak_sem, 'i           ', i);
    t01int4 (ak_sem, 'rec_cnt     ', rec_cnt);
    t01int4 (ak_sem, 'a_long_desc_', a_long_desc_pos);
&   endif
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak508_long_column_handling (VAR acv : tak_all_command_glob;
            VAR change_rec      : tak_changerecord;
            startpos            : integer;
            VAR buffer_full     : boolean);
 
VAR
      i   : integer;
      pos : integer;
 
BEGIN
(* *** intern call (Select/Fetch) *** *)
WITH acv, a_cmd_segm^, change_rec DO
    BEGIN
    a_data_ptr    := @a_curr_retpart^.sp1p_buf[1];
    a_data_length := a_curr_retpart^.sp1p_buf_len;
&   IFDEF TRACE
    t01int4 (ak_sem, 'cr_colcount ', change_rec.cr_colcount);
    t01int4 (ak_sem, 'startpos    ', startpos);
    t01int4 (ak_sem, 'a_data_lengt', a_data_length);
    t01moveobj (ak_sem, a_data_ptr^, 1, a_data_length);
    t01int4 (ak_sem, 'ende varpart', a_curr_retpart^.sp1p_buf_size);
&   endif
    i           := a_long_desc_pos;
    buffer_full := false;
    WHILE (i <= cr_colcount) AND
          (a_return_segm^.sp1r_returncode = 0)  AND
          (NOT buffer_full)      DO
        BEGIN
        WITH cr_columns[ i ] DO
            BEGIN
            IF  (ch_to_longsupport in ch_type)
            THEN
                BEGIN
                pos := ch_startpos + startpos;
                (* PTS 1116801 E.Z. *)
                IF  (a_data_ptr^[ pos ] = csp_defined_byte)
                    AND
                    (ord (ch_length) = mxsp_long_desc + 1)
                THEN
                    ak508get_one_long_column (acv, pos,
                          c_intern_getval, buffer_full)
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            END;
        (*ENDWITH*) 
        i := succ (i);
        END;
    (*ENDWHILE*) 
    IF  (i <= cr_colcount) AND (a_return_segm^.sp1r_returncode = 0)
    THEN
        BEGIN
        a_long_desc_pos := i;
        ak508_fetch_long_desc (acv, change_rec, 1, 0, startpos);
        END;
    (*ENDIF*) 
    IF  ((a_return_segm^.sp1r_returncode = 0) AND
        buffer_full        AND
        (i > cr_colcount)     )
    THEN
        a_long_desc_pos := 0;
&   IFDEF TRACE
    (*ENDIF*) 
    t01int4 (ak_sem, 'returncode  ', a_return_segm^.sp1r_returncode);
    t01int4 (ak_sem, 'a_part_rollb', ord (a_part_rollback));
    t01int4 (ak_sem, 'buffer_full ', ord (buffer_full));
&   endif
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak508get_one_long_column (VAR acv : tak_all_command_glob;
            pos_long_desc       : integer;
            intern_getval       : boolean;
            VAR buffer_full     : boolean);
 
VAR
      read_more          : boolean;
      first_zoom         : boolean;
      is_comment         : boolean;
      is_locked          : boolean;
      pseudo_long_column : boolean;
      with_lock          : boolean;
      valpos             : tsp_int4;
      desc_len           : tsp_int4;
      len_desired        : tsp_int4;
      unused_leng        : tsp_int4;
      aux_valmode        : tsp_valmode;
      curr_long_qual     : tgg_long_qual;
      long_desc          : tak_long_descriptor;
 
BEGIN
WITH acv, a_cmd_segm^, a_mblock, long_desc, desc DO
    BEGIN
&   IFDEF TRACE
    t01int4 (ak_sem, 'pos_long_de ', pos_long_desc);
&   ENDIF
    (* PTS 1116801 E.Z. *)
    desc_len := sizeof(long_desc.desc);
    first_zoom := false;
    IF  (a_data_ptr^ [ pos_long_desc ] <> csp_undef_byte)
    THEN
        BEGIN
        g10mv2 ('VAK508',   2,    
              sizeof (a_data_ptr^), sizeof (long_desc.desc),
              a_data_ptr^, pos_long_desc + 1,
              long_desc.desc, 1, desc_len,
              a_return_segm^.sp1r_returncode);
        IF  a_return_segm^.sp1r_returncode = 0
        THEN
            BEGIN
            is_comment         := ld_is_comment in lds_infoset;
            pseudo_long_column := is_comment OR (ld_is_catalog in lds_infoset);
            (* PTS 1105838 E.Z. *)
            IF  (a_out_packet^.sp1_header.sp1h_mess_swap <>
                g01code.kernel_swap)
            THEN
                s20ch4sw (ld_vallen,
                      a_out_packet^.sp1_header.sp1h_mess_swap,
                      ld_vallen, 1, g01code.kernel_swap);
            (*ENDIF*) 
            IF  (a_out_packet^.sp1_header.sp1h_mess_swap <>
                g01code.kernel_swap)    AND
                (NOT intern_getval)
            THEN
                s20ch4sw (ld_intern_pos,
                      a_out_packet^.sp1_header.sp1h_mess_swap,
                      ld_intern_pos, 1, g01code.kernel_swap);
            (*ENDIF*) 
            IF  intern_getval
            THEN (* *** initialization of long_descriptor *** *)
                BEGIN
                ld_intern_pos := 1;
                (*IF  NOT pseudo_long_column
                      THEN
                      ld_short_scol := true; *)
                ld_valmode    := vm_nodata;
                IF  (ld_unicode in ld_infoset) AND (ld_vallen MOD 2 <> 0)
                    AND (ld_vallen > 1)
                THEN
                    ld_vallen := ld_vallen - 1;
                (*ENDIF*) 
                END
            ELSE
                IF  (ld_valmode    = vm_data_trunc) AND
                    (ld_intern_pos = 1)             AND
                    (ld_no_close IN ld_infoset)
                THEN
                    BEGIN
                    ld_valmode := vm_nodata;
                    with_lock  := true;
                    first_zoom := true;
                    END;
                (*ENDIF*) 
            (*ENDIF*) 
            len_desired := ld_vallen;
            with_lock   := NOT pseudo_long_column;
            is_locked   := (ld_with_lock in ld_infoset) AND
                  (ld_intern_pos <> 1);
            aux_valmode := ld_valmode;
            valpos      := 0;
            read_more   :=
                  (ld_valmode <> vm_no_more_data) AND
                  (ld_valmode <> vm_close);
            IF  (ld_valmode = vm_data_trunc)
            THEN
                len_desired := 2;
            (*ENDIF*) 
            IF  with_lock  AND
                first_zoom AND
                ( ld_valmode    = vm_nodata)
            THEN
                BEGIN
                a508_unlock_lock_lcolumnid (acv, lds_descriptor,
                      m_lock, NOT c_lock_excl);
                ld_infoset := ld_infoset + [ ld_with_lock ];
                END;
            (*ENDIF*) 
            IF  (ld_unicode in ld_infoset) AND (ld_vallen MOD 2 <> 0)
                AND (ld_vallen > 1)
            THEN
                a07_b_put_error (acv, e_st_invalid_length, 0);
            (*ENDIF*) 
            WHILE read_more AND (a_return_segm^.sp1r_returncode = 0) DO
                BEGIN
                ld_valpos := a_curr_retpart^.sp1p_buf_len+1;
                (* PTS 1116917 E.Z. *)
                ld_vallen := a73_calc_unused_space (acv)
                      - a_curr_retpart^.sp1p_buf_len;
                IF  (ld_unicode in ld_infoset) AND (ld_vallen MOD 2 <> 0)
                THEN
                    ld_vallen := pred(ld_vallen);
                (* *** check limits for getval *** *)
                (* *** 1. old packet limit *** *)
                (* PTS 1116801 E.Z. *)
                (* *** 2. user limit *** *)
                (*ENDIF*) 
                IF  (ld_vallen   > len_desired) AND
                    (len_desired > 0)
                THEN
                    ld_vallen := len_desired;
                (*ENDIF*) 
                IF  (valpos = 0)
                THEN
                    valpos := ld_valpos;
                (*ENDIF*) 
                ;
&               IFDEF TRACE
                t01longdescriptor (ak_sem, long_desc.desc);
                t01int4 (ak_sem, 'free varpart', a_curr_retpart^.sp1p_buf_size);
&               ENDIF
                IF  ld_vallen > 0
                THEN
                    BEGIN
                    IF  pseudo_long_column
                    THEN
                        ak508opseudoget (acv, long_desc, curr_long_qual)
                    ELSE
                        ak508o_getval (acv, long_desc.desc, curr_long_qual,
                              ld_intern_pos = 1);
                    (*ENDIF*) 
                    IF  a_return_segm^.sp1r_returncode = 0
                    THEN
                        BEGIN
                        IF  (ld_vallen  = len_desired) AND (* PTS 1117910 *)
                            (len_desired > 0)          AND
                            (ld_valmode = vm_datapart)
                        THEN
                            BEGIN
                            ld_valmode := vm_data_trunc;
                            (* *** Return max_column_length + 1 for truncated   *)
                            (*     long column to the precompiler           *** *)
                            ld_intern_pos := curr_long_qual.lq_long_size + 1;
                            END;
&                       IFDEF TRACE
                        (*ENDIF*) 
                        t01int4 (ak_sem, 'to         1', ld_valpos);
                        t01int4 (ak_sem, 'length     1', ld_vallen);
                        t01int4 (ak_sem, 'a_data_lengt',
                              a_curr_retpart^.sp1p_buf_len + ld_vallen);
                        (* PTS 1105838 E.Z. *)
                        IF  (ld_use_conversion in ld_state)
                        THEN
                            t01int4 (ak_sem, 'ld_use_conve', 1);
                        (*ENDIF*) 
                        IF  (ld_use_ucs_2_swap in ld_state)
                        THEN
                            t01int4 (ak_sem, 'ld_swap_ucs2', 1);
                        (*ENDIF*) 
                        IF  (ld_use_toascii in ld_state)
                        THEN
                            t01int4 (ak_sem, 'ld_use_toasc', 1);
&                       ENDIF
                        (*ENDIF*) 
                        a_curr_retpart^.sp1p_buf_len :=
                              a_curr_retpart^.sp1p_buf_len + ld_vallen;
                        IF  (ld_use_conversion in ld_state)
                        THEN
                            BEGIN
                            IF  (a_basic_code = csp_ebcdic)
                            THEN
                                g02pascii_pos_ebcdic (
                                      a_curr_retpart^.sp1p_buf, ld_valpos,
                                      a_curr_retpart^.sp1p_buf, ld_valpos,
                                      ld_vallen)
                            ELSE
                                g02pebcdic_pos_ascii (
                                      a_curr_retpart^.sp1p_buf, ld_valpos,
                                      a_curr_retpart^.sp1p_buf, ld_valpos,
                                      ld_vallen);
                            (*ENDIF*) 
                            END;
                        (* PTS 1116801 E.Z. *)
                        (* PTS 1116917 E.Z. *)
                        (*ENDIF*) 
                        unused_leng := a73_calc_unused_space (acv)
                              - a_curr_retpart^.sp1p_buf_len;
                        IF  (ld_unicode in ld_infoset) AND (ld_vallen MOD 2 <> 0)
                        THEN
                            unused_leng := pred(unused_leng);
                        (*ENDIF*) 
                        WITH curr_long_qual DO
                            BEGIN
                            read_more := (ld_valmode = vm_datapart) AND
                                  (lq_long_size - lq_pos + 1 > 0)  AND
                                  (unused_leng > lq_long_size - lq_pos + 1);
&                           ifdef TRACE
                            IF  (ld_valmode = vm_datapart) AND
                                (lq_long_size - lq_pos + 1 > 0)
                            THEN
                                t01int4 (ak_sem, 'read_more   ',
                                      a_curr_retpart^.sp1p_buf_size);
&                           ENDIF
                            (*ENDIF*) 
                            is_locked := is_locked OR lq_try_unlock
                            END
                        (*ENDWITH*) 
                        END;
&                   IFDEF TRACE
                    (*ENDIF*) 
                    t01int4    (ak_sem, 'ld_valpos   ', ld_valpos);
                    t01moveobj (ak_sem, a_data_ptr^, 1, a_data_length);
                    t01int4    (ak_sem, 'ende varpart',
                          a_curr_retpart^.sp1p_buf_size);
&                   ENDIF
                    END
                ELSE
                    BEGIN
                    ld_valmode := vm_nodata;
                    ld_vallen  := 0;
                    read_more  := false;
                    END;
                (*ENDIF*) 
                END;
            (*ENDWHILE*) 
            IF  (aux_valmode = vm_data_trunc)
            THEN
                ld_valmode := aux_valmode;
            (*ENDIF*) 
            IF  (ld_valmode <> vm_no_more_data)
            THEN
                BEGIN
                ld_valpos := valpos;
                ld_vallen := a_curr_retpart^.sp1p_buf_len + 1 - ld_valpos;
                IF  with_lock                                     AND
                    is_locked                                     AND
                    ((a_return_segm^.sp1r_returncode <> 0)    OR
                    ((ld_valmode = vm_close)                OR
                    (NOT (ld_no_close in ld_infoset)) AND
                    ((ld_valmode = vm_lastdata)   OR
                    ( ld_valmode = vm_data_trunc)   )         )  )
                THEN
                    a508_unlock_lock_lcolumnid (acv, long_desc.lds_descriptor,
                          m_unlock, NOT c_lock_excl)
                ELSE
                    IF  (with_lock AND is_locked)
                    THEN
                        ld_infoset := ld_infoset + [ ld_with_lock ];
&                   ifdef TRACE
                    (*ENDIF*) 
                (*ENDIF*) 
                t01int4 (ak_sem, 'returncode  ', a_return_segm^.sp1r_returncode);
&               ENDIF
                IF  (a_return_segm^.sp1r_returncode =
                    cak_e_table_or_file_dropped) OR
                    (a_return_segm^.sp1r_returncode =
                    a07_return_code (e_old_fileversion, a_sqlmode))
                THEN
                    BEGIN
                    a_return_segm^.sp1r_returncode := 0;
                    ld_valmode  := vm_alldata;
                    ld_vallen   := 0;
                    END;
&               IFDEF TRACE
                (*ENDIF*) 
                t01longdescriptor (ak_sem, long_desc.desc);
&               ENDIF
                (* PTS 1105838 E.Z. *)
                IF  ld_use_termchar in ld_state
                THEN
                    g02totermchar (a_mess_code, a_data_ptr^, ld_valpos, ld_vallen);
                (*ENDIF*) 
                ;
                ld_valpos := ld_valpos;
                IF  (a_out_packet^.sp1_header.sp1h_mess_swap <>
                    g01code.kernel_swap)
                THEN
                    BEGIN
                    s20ch4sw (ld_vallen, g01code.kernel_swap,
                          ld_vallen, 1,
                          a_out_packet^.sp1_header.sp1h_mess_swap);
                    s20ch4sw (ld_valpos, g01code.kernel_swap,
                          ld_valpos, 1,
                          a_out_packet^.sp1_header.sp1h_mess_swap);
                    s20ch4sw (ld_intern_pos, g01code.kernel_swap,
                          ld_intern_pos, 1,
                          a_out_packet^.sp1_header.sp1h_mess_swap);
                    s20ch4sw (ld_maxlen, g01code.kernel_swap,
                          ld_maxlen, 1,
                          a_out_packet^.sp1_header.sp1h_mess_swap);
                    END;
                (* *** Update long-desc values *** *)
                (*ENDIF*) 
                buffer_full   := (ld_valmode = vm_datapart);
                g10mv3 ('VAK508',   3,    
                      sizeof (long_desc.desc), sizeof (a_data_ptr^),
                      long_desc.desc, 1, a_data_ptr^, pos_long_desc + 1,
                      desc_len, a_return_segm^.sp1r_returncode);
                END;
            (*ENDIF*) 
            END
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak508o_getval (VAR acv  : tak_all_command_glob;
            VAR long_desc     : tsp_long_descriptor;
            VAR ret_long_qual : tgg_long_qual;
            first_user_getval : boolean);
 
VAR
      b_err        : tgg_basis_error;
      mblock       : tgg_mess_block;
      e            : tsp8_uni_error;
      err_char_no  : tsp_int4;
      outlen       : tsp_int4;
 
BEGIN
WITH acv, a_cmd_segm^, long_desc DO
    BEGIN
    g01mblock_init (a_transinf.tri_trans, m_column, mm_new_read, mblock);
    WITH mblock DO
        BEGIN
        mb_struct    := mbs_long;
        mb_qual      := a_mblock.mb_qual;
        mb_qual_size := a_mblock.mb_qual_size;
        WITH mb_qual^ DO
            BEGIN
            mstack_desc    := g01nil_stack_desc;
            mtree          := b01niltree_id;
            mtree.fileHandling_gg00 := a_transinf.tri_global_state;
            ml_long_qual   := g01nil_long_qual;
            END;
        (*ENDWITH*) 
        mb_qual_len  := mxgg_mb_part1head + sizeof (mb_qual^.ml_long_qual);
        (* PTS 1105838 E.Z. *)
        IF  ld_use_toascii in ld_state
        THEN
            BEGIN
            mb_data      := a_mblock.mb_data;
            mb_data_size := a_mblock.mb_data_size;
            END
        ELSE
            BEGIN
            mb_data      := @a_curr_retpart^.sp1p_buf [ld_valpos];
            mb_data_size := a_curr_retpart^.sp1p_buf_size -
                  ld_valpos + 1;
            END;
        (*ENDIF*) 
        END;
    (*ENDWITH*) 
    WITH mblock, mb_qual^, ml_long_qual, mb_data^ DO
        BEGIN
        mtree.fileType_gg00  := [ftsPerm_egg00, ftsConcurrent_egg00];
        mtree.fileTabId_gg00 := ld_descriptor;
        lq_lock_tabid   := ld_tabid;
        (* PTS 1105838 E.Z. *)
        lq_long_in_file := NOT (ld_short_scol in ld_state);
        IF  ld_short_scol in ld_state
        THEN
            mtree.fileTfn_gg00 := tfnShortScol_egg00
        ELSE
            mtree.fileTfn_gg00 := tfnColumn_egg00;
        (*ENDIF*) 
        lq_pos := ld_intern_pos;
        (* PTS 1120570 E.Z. *)
        lq_read_ahead := false;
        IF  ld_use_toascii in ld_state
        THEN
            (* ascii --> UCS2 will be done afterwards *)
            IF  mb_data_size < ld_vallen DIV 2
            THEN
                lq_len := mb_data_size
            ELSE
                BEGIN
                lq_len := ld_vallen DIV 2;
                IF  first_user_getval
                THEN
                    lq_read_ahead := true;
                (*ENDIF*) 
                END
            (*ENDIF*) 
        ELSE
            IF  mb_data_size < ld_vallen
            THEN
                lq_len := mb_data_size
            ELSE
                BEGIN
                lq_len := ld_vallen;
                IF  first_user_getval
                THEN
                    lq_read_ahead := true;
                (*ENDIF*) 
                END;
            (*ENDIF*) 
        (*ENDIF*) 
&       ifdef TRACE
        t01long_qual (ak_sem, 'getv l_qual1', ml_long_qual);
&       endif
        a06rsend_mess_buf (acv, mblock, cak_return_req, b_err);
&       ifdef TRACE
        t01int4 (ak_sem, 'b_err hhh   ', ord(b_err));
&       endif
        IF  b_err <> e_ok
        THEN
            a_return_segm^.sp1r_returncode :=
                  a07_return_code (b_err, a_sqlmode)
        ELSE
            BEGIN
            IF  mb_type = m_return_result
            THEN
                BEGIN
&               ifdef TRACE
                t01int4 (ak_sem, 'ret result  ', ord(mb_type));
                t01long_qual (ak_sem, 'getv l_qual2', ml_long_qual);
&               endif
                (* PTS 1105838 E.Z. *)
                IF  ld_use_toascii in ld_state
                THEN
                    BEGIN
                    outlen := a_curr_retpart^.sp1p_buf_size -
                          ld_valpos + 1;
                    s80uni_trans (@(a_mblock.mb_data^), lq_len, csp_ascii,
                          @(a_curr_retpart^.sp1p_buf [ld_valpos]), outlen,
                          a_out_packet^.sp1_header.sp1h_mess_code,
                          [ ], e, err_char_no);
                    lq_len := outlen;
                    IF  e = uni_dest_too_short
                    THEN
                        BEGIN
                        lq_pos := lq_pos - (lq_len - err_char_no);
                        e      := uni_ok;
                        END;
                    (*ENDIF*) 
                    IF  e <> uni_ok
                    THEN
                        a07_uni_error (acv, e, err_char_no);
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
                IF  (ld_use_ucs_2_swap in ld_state)
                THEN
                    BEGIN
                    outlen := a_curr_retpart^.sp1p_buf_size -
                          ld_valpos + 1;
                    s80uni_trans (@(a_curr_retpart^.sp1p_buf [ld_valpos]),
                          lq_len, csp_unicode_swap,
                          @(a_curr_retpart^.sp1p_buf [ld_valpos]), outlen,
                          csp_unicode, [ ], e, err_char_no);
                    lq_len := outlen;
                    IF  e <> uni_ok
                    THEN
                        a07_uni_error (acv, e, err_char_no);
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
                IF  lq_long_in_file
                THEN
                    ld_state := ld_state - [ ld_short_scol ];
                (*ENDIF*) 
                ld_maxlen := lq_long_size;
                IF  lq_pos > lq_long_size
                THEN
                    ld_valmode := vm_lastdata
                ELSE
                    ld_valmode := vm_datapart;
                (*ENDIF*) 
                ld_vallen     := lq_len;
                ld_intern_pos := lq_pos;
&               ifdef TRACE
                t01int4 (ak_sem, 'valmode     ', ord(ld_valmode));
&               endif
                END
            ELSE
                BEGIN
                ld_vallen   := 0;
                ld_valmode  := vm_nodata;
                END;
            (*ENDIF*) 
            ret_long_qual := ml_long_qual
            END
        (*ENDIF*) 
        END;
    (*ENDWITH*) 
    END;
(*ENDWITH*) 
END;
 
(* PTS 1111576 E.Z. *)
(*------------------------------*) 
 
PROCEDURE
      ak508_fetch_long_desc (VAR acv : tak_all_command_glob;
            VAR change_rec      : tak_changerecord;
            rec_cnt             : integer;
            rec_len             : integer;
            startpos            : integer);
 
VAR
      i             : integer;
      pos           : integer;
      rec_no        : integer;
      long_desc     : tak_long_descriptor;
 
BEGIN
WITH acv, a_cmd_segm^, change_rec DO
    BEGIN
    a_data_ptr    := @a_curr_retpart^.sp1p_buf[1];
&   IFDEF TRACE
    t01int4 (ak_sem, 'startpos    ', startpos);
    t01int4 (ak_sem, 'rec_len     ', rec_len);
    t01int4 (ak_sem, 'rec_cnt     ', rec_cnt);
&   ENDIF
    rec_no       := 0;
    WHILE (rec_no < rec_cnt) DO
        BEGIN
        i := a_long_desc_pos;
        WHILE (i <= cr_colcount) DO
            BEGIN
            WITH cr_columns[ i ] DO
                BEGIN
                IF  (ch_to_longsupport in ch_type)
                THEN
                    BEGIN
                    pos := ch_startpos + startpos + (rec_no * rec_len);
                    g10mv2 ('VAK508',   4,    
                          a_curr_retpart^.sp1p_buf_size, sizeof (long_desc),
                          a_data_ptr^, pos + 1,
                          long_desc.desc, 1, sizeof(long_desc),
                          a_return_segm^.sp1r_returncode);
                    long_desc.lds_valmode := vm_nodata;
                    IF  (a_out_packet^.sp1_header.sp1h_mess_swap <>
                        g01code.kernel_swap)
                    THEN
                        WITH long_desc DO
                            BEGIN
                            (* PTS 1105838 E.Z. *)
                            (* PTS 1115845 E.Z. *)
                            s20ch4sw (lds_vallen,
                                  a_out_packet^.sp1_header.sp1h_mess_swap,
                                  lds_vallen, 1,
                                  g01code.kernel_swap);
                            s20ch4sw (lds_valpos,
                                  a_out_packet^.sp1_header.sp1h_mess_swap,
                                  lds_valpos, 1,
                                  g01code.kernel_swap);
                            s20ch4sw (lds_intern_pos,
                                  a_out_packet^.sp1_header.sp1h_mess_swap,
                                  lds_intern_pos, 1,
                                  g01code.kernel_swap);
                            END;
                        (*ENDWITH*) 
                    (*ENDIF*) 
                    g10mv3 ('VAK508',   5,    
                          sizeof (long_desc), a_curr_retpart^.sp1p_buf_size,
                          long_desc.desc, 1, a_data_ptr^, pos + 1,
                          sizeof (long_desc), a_return_segm^.sp1r_returncode);
                    END;
                (*ENDIF*) 
                END;
            (*ENDWITH*) 
            i := succ (i);
            END;
        (*ENDWHILE*) 
        rec_no := succ (rec_no);
        END;
    (*ENDWHILE*) 
&   IFDEF TRACE
    t01int4 (ak_sem, 'rec_no      ', rec_no);
    t01int4 (ak_sem, 'rec_cnt     ', rec_cnt);
&   endif
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a508_unlock_lock_lcolumnid (VAR acv : tak_all_command_glob;
            ld_descriptor  : tgg_surrogate;
            mtype          : tgg_message_type;
            lock_excl      : boolean);
 
VAR
      e           : tgg_basis_error;
      aux_data    : tsp_name;
      mblock      : tgg_mess_block;
      aux_qual    : tgg_qual_buf;
 
BEGIN
WITH acv, a_cmd_segm^ DO
    BEGIN
    g01mblock_init (a_transinf.tri_trans, mtype, mm_nil, mblock);
    WITH mblock DO
        BEGIN
        mb_struct    := mbs_lock;
        mb_qual      := @aux_qual;
        mb_qual_size := sizeof (aux_qual);
        mb_data      := @aux_data;
        mb_data_size := sizeof (aux_data);
        WITH mb_data^ DO
            BEGIN
            mbp_reclen := 0;
            mbp_keylen := 0
            END;
        (*ENDWITH*) 
        END;
    (*ENDWITH*) 
    WITH mblock, mb_qual^.mlock[ 1 ] DO
        BEGIN
        mb_qual^.mlock_cnt := 1;
        lockTabId_gg00            := ld_descriptor;
        (* *** make long_columnid surrogate distinct from tabid's *** *)
        lockTabId_gg00[ 3 ]       := chr (128);
        (* *** we need a special locktype for long_columns ! *** *)
        IF  lock_excl
        THEN
            lockMode_gg00 := lckTabExcl_egg00
        ELSE
            lockMode_gg00 := lckTabShare_egg00;
        (*ENDIF*) 
        lockState_gg00            := [  ];
        lockKeyLen_gg00           := 0;
        lockKeyPos_gg00           := 0;
        mb_qual_len        := mxgg_mb_part1_lockhead + mxgg_lock;
        END;
    (*ENDWITH*) 
    a06rsend_mess_buf (acv, mblock, NOT cak_return_req, e);
    IF  e <> e_ok
    THEN
        BEGIN
        IF  e = e_key_not_found
        THEN
            e := e_sysinfo_not_found;
        (*ENDIF*) 
        a07_b_put_error (acv, e, 8);
        END;
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak508opseudoget (VAR acv : tak_all_command_glob;
            VAR old_long_desc  : tak_long_descriptor;
            VAR ret_long_qual  : tgg_long_qual);
 
VAR
      long_desc : tak_long_descriptor;
 
BEGIN
long_desc := old_long_desc;
(* PTS 1105838 E.Z. *)
long_desc.lds_state := [ ld_short_scol ];
WITH old_long_desc DO
    BEGIN
    IF  g01unicode
    THEN
        IF  (acv.a_out_packet^.sp1_header.sp1h_mess_swap <>
            sw_normal)
        THEN
            long_desc.lds_state := long_desc.lds_state + [ ld_use_ucs_2_swap ];
        (*ENDIF*) 
    (*ENDIF*) 
    IF  ld_use_termchar in lds_state
    THEN
        long_desc.lds_state := long_desc.lds_state + [ld_use_termchar];
    (*ENDIF*) 
    IF  ld_use_conversion in lds_state
    THEN
        long_desc.lds_state := long_desc.lds_state + [ld_use_conversion];
    (*ENDIF*) 
    long_desc.lds_infoset   := [];
    IF  ld_new_rec in lds_infoset
    THEN
        long_desc.lds_infoset := long_desc.lds_infoset + [ld_new_rec];
    (*ENDIF*) 
    IF  ld_is_comment in lds_infoset
    THEN
        long_desc.lds_infoset := long_desc.lds_infoset + [ld_is_comment];
    (*ENDIF*) 
    IF  ld_is_catalog in lds_infoset
    THEN
        long_desc.lds_infoset := long_desc.lds_infoset + [ld_is_catalog];
    (*ENDIF*) 
    IF  ld_is_comment in lds_infoset
    THEN
        a26getval (acv, long_desc, ret_long_qual)
    ELSE
        IF  long_desc.lds_show_kind in [sh_procedure, sh_all_procedures]
        THEN
            a262GetValDBProcDefinition (acv, long_desc, ret_long_qual)
        ELSE
            ak508read_catalog (acv, long_desc, ret_long_qual);
        (*ENDIF*) 
    (*ENDIF*) 
    lds_maxlen := long_desc.lds_maxlen;
    IF  lds_show_kind <> sh_no_kind
    THEN
        BEGIN
        lds_valmode    := long_desc.lds_valmode;
        lds_intern_pos := long_desc.lds_intern_pos;
        lds_valpos     := long_desc.lds_valpos;
        lds_vallen     := long_desc.lds_vallen
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak508read_catalog (VAR acv : tak_all_command_glob;
            VAR long_desc     : tak_long_descriptor;
            VAR ret_long_qual : tgg_long_qual);
 
VAR
      viewtextlen   : tsp_int4;
      move_len      : tsp_int4;
      rest_buf_size : tsp_int4;
      info_len      : tsp_int4;
      err_char_no   : tsp_int4;
      uni_err       : tsp8_uni_error;
      curr_data_ptr : tsp_moveobj_ptr;
      obj_ptr       : tsp_moveobj_ptr;   (* PTS 1120916 E.Z. *)
      view_buf      : tgg00_SelectBuffer;
 
BEGIN
ret_long_qual := g01nil_long_qual;
WITH acv, long_desc, ret_long_qual DO
    BEGIN
    viewtextlen := 0;
    a508get_definition_text (acv, lds_descriptor,
          lds_show_kind, lds_colno, view_buf, viewtextlen);
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        BEGIN
        curr_data_ptr := @a_curr_retpart^.sp1p_buf [lds_valpos];
        rest_buf_size := a_curr_retpart^.sp1p_buf_size - lds_valpos + 1;
&       ifdef trace
        t01int4 (ak_sem, 'required_len', lds_vallen);
&       endif
        IF  (g01unicode) AND
            (ld_use_ucs_2_swap in lds_state)
        THEN
            BEGIN
            IF  rest_buf_size > lds_vallen
            THEN
                move_len := lds_vallen
            ELSE
                move_len := rest_buf_size;
            (*ENDIF*) 
            info_len := viewtextlen - lds_intern_pos + 1;
            (* PTS 1120916 E.Z. *)
            obj_ptr := @view_buf;
            s80uni_trans (@(obj_ptr^[lds_intern_pos]),
                  viewtextlen - lds_intern_pos + 1, csp_unicode,
                  @curr_data_ptr^, move_len, csp_unicode_swap,
                  [ ], uni_err, err_char_no);
            IF  uni_err <> uni_ok
            THEN
                IF  uni_err = uni_dest_too_short
                THEN
                    info_len := err_char_no
                ELSE
                    a07_uni_error (acv, uni_err, err_char_no);
                (*ENDIF*) 
            (*ENDIF*) 
            END
        ELSE
            BEGIN
            move_len := viewtextlen - lds_intern_pos + 1;
            IF  move_len > rest_buf_size
            THEN
                move_len := rest_buf_size;
            (*ENDIF*) 
            IF  move_len > lds_vallen
            THEN
                move_len := lds_vallen;
            (*ENDIF*) 
            info_len := move_len;
            g10mv1 ('VAK508',   6,    
                  sizeof (view_buf), rest_buf_size,
                  view_buf, lds_intern_pos, curr_data_ptr^, 1, move_len,
                  a_return_segm^.sp1r_returncode);
            END;
        (*ENDIF*) 
        lds_vallen     := move_len;
        lds_intern_pos := lds_intern_pos + info_len;
        lq_pos         := lds_intern_pos;
        lq_long_size   := viewtextlen;
        (* PTS 1105838 E.Z. *)
        lds_maxlen     := viewtextlen;
        IF  lds_intern_pos > viewtextlen
        THEN
            lds_valmode := vm_lastdata
        ELSE
            lds_valmode := vm_datapart;
        (*ENDIF*) 
&       ifdef trace
        t01int4 (ak_sem, 'lds_vallen  ', lds_vallen);
        t01int4 (ak_sem, 'lds_intern_p', lds_intern_pos);
        t01int4 (ak_sem, 'rest len    ', lq_long_size - lq_pos + 1)
&             endif
        END
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(* PTS 1116801 E.Z. *)
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
.PA 
