.ad 8
.bm 8
.fm 4
.bt $Copyright (c) 2000-2005 SAP AG$$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
 
 .nf
 
    ========== licence begin  GPL
    Copyright (c) 2000-2005 SAP AG
 
    This program is free software; you can redistribute it and/or
    modify it under the terms of the GNU General Public License
    as published by the Free Software Foundation; either version 2
    of the License, or (at your option) any later version.
 
    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.
 
    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
    ========== licence end
.fo
 
 
.fo
.nf
.sp
MODULE  : 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 : tgg00_Surrogate;
                    show_kind     : tgg00_ShowKind;
                    colno         : integer;
                    bufSize       : integer;
                    VAR buf       : tsp00_MoveObj;
                    VAR textlen   : tsp00_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  : tgg00_Surrogate;
                    mtype          : tgg00_MessType;
                    lock_excl      : boolean);
 
.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :
 
        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 : tsp00_Int2);
 
        PROCEDURE
              a06retpart_move (VAR acv : tak_all_command_glob;
                    moveobj_ptr : tsp00_MoveObjPtr;
                    move_len    : tsp00_Int4);
 
        PROCEDURE
              a06_systable_get (VAR acv : tak_all_command_glob;
                    dstate      : tak_directory_state;
                    VAR tableid : tgg00_Surrogate;
                    VAR base_ptr: tak_sysbufferaddress;
                    get_all     : boolean;
                    VAR ok      : boolean);
 
        PROCEDURE
              a06rsend_mess_buf (VAR acv : tak_all_command_glob;
                    VAR mbuf    : tgg00_MessBlock;
                    return_req  : boolean;
                    VAR e       : tgg00_BasisError);
 
      ------------------------------ 
 
        FROM
              AK_error_handling : VAK07;
 
        PROCEDURE
              a07_uni_error (VAR acv : tak_all_command_glob;
                    uni_err  : tsp8_uni_error;
                    err_code : tsp00_Int4);
 
        PROCEDURE
              a07_b_put_error (VAR acv : tak_all_command_glob;
                    b_err   : tgg00_BasisError;
                    err_code : tsp00_Int4);
 
      ------------------------------ 
 
        FROM
              AK_error_handling : VAK071;
 
        FUNCTION
              a07_return_code (
                    b_err   : tgg00_BasisError;
                    sqlmode : tsp00_SqlMode) : tsp00_Int2;
 
      ------------------------------ 
 
        FROM
              AK_Comment : VAK26;
 
        PROCEDURE
              a26getval (VAR acv      : tak_all_command_glob;
                    VAR long_desc     : tak_long_descriptor;
                    VAR ret_long_qual : tgg00_LongQual);
 
      ------------------------------ 
 
        FROM
              AK_Trigger : VAK262;
 
        PROCEDURE
              a262GetDBProcDefinition (VAR acv : tak_all_command_glob;
                    VAR DBProcId : tgg00_Surrogate;
                    VAR def_len  : tsp00_Int4;
                    VAR buf      : tsp00_MoveObj;
                    buf_size     : tsp00_Int4);
 
        PROCEDURE
              a262GetValDBProcDefinition (VAR acv : tak_all_command_glob;
                    VAR long_desc     : tak_long_descriptor;
                    VAR ret_long_qual : tgg00_LongQual);
 
      ------------------------------ 
 
        FROM
              SystemViews : VAK400;
 
        PROCEDURE
              a400SVCopyLongValue (
                    VAR acv      : tak_all_command_glob;
                    VAR longId   : tgg00_Surrogate;
                    rowCount     : integer;
                    pDest        : tsp00_Addr;
                    destSize     : tsp00_Int4;
                    VAR length   : tsp00_Int4);
 
      ------------------------------ 
 
        FROM
              AK_Show_synonym_domain : VAK44;
 
        PROCEDURE
              a44constraint_into_moveobj (VAR acv : tak_all_command_glob;
                    base_ptr       : tak_sysbufferaddress;
                    VAR tabid      : tgg00_Surrogate;
                    object_type    : tak_object_type;
                    constraint_id  : integer;
                    tabno          : integer;
                    VAR moveobj    : tsp00_MoveObj;
                    moveobj_size   : tsp00_Int4;
                    VAR filled_len : tsp00_Int4);
 
        PROCEDURE
              a44get_domaindef (VAR acv : tak_all_command_glob;
                    VAR dom_surrogate : tgg00_Surrogate;
                    constraint_only   : boolean;
                    VAR moveobj       : tsp00_MoveObj;
                    moveobj_size      : tsp00_Int4;
                    VAR filled_len    : tsp00_Int4);
 
      ------------------------------ 
 
        FROM
              AK_Show_view : VAK48;
 
        PROCEDURE
              a48get_view_def_string (VAR acv : tak_all_command_glob;
                    VAR tabid       : tgg00_Surrogate;
                    length_only     : boolean;
                    outbuf_size     : tsp00_Int4;
                    VAR outbuf      : tsp00_MoveObj;
                    VAR viewtextlen : tsp00_Int4);
 
      ------------------------------ 
 
        FROM
              AK_Show_Procedure : VAK49;
 
        PROCEDURE
              a49get_trigger_def (VAR acv : tak_all_command_glob;
                    VAR tabid    : tgg00_Surrogate;
                    trigger_kind : tsp00_C1;
                    VAR def_len  : tsp00_Int2;
                    VAR buf      : tsp00_MoveObj;
                    buf_size     : tsp00_Int4);
 
      ------------------------------ 
 
        FROM
              Resulttable: VAK73;
 
        FUNCTION
              a73_calc_unused_space (
                    VAR acv : tak_all_command_glob) : tsp00_Int4;
 
      ------------------------------ 
 
        FROM
              Deal-With-User-Commands: VAK92;
 
        PROCEDURE
              a92ReadLongDemandData (VAR acv  : tak_all_command_glob;
                    LongColCnt: tsp00_Int4;
                    VAR MaxColCnt: tsp00_Int4;
                    VAR Position: tsp00_Int4;
                    VAR Length: tsp00_Int4;
                    VAR AtOnce: boolean);
 
      ------------------------------ 
 
        FROM
              filesysteminterface_1 : VBD01;
 
        VAR
              b01niltree_id : tgg00_FileId;
 
      ------------------------------ 
 
        FROM
              Configuration_Parameter : VGG01;
 
        VAR
              g01code           : tgg04_CodeGlobals;
              g01nil_long_qual  : tgg00_LongQual;
              g01nil_stack_desc : tgg00_StackDesc;
              g01unicode        : boolean;
 
        PROCEDURE
              g01mblock_init (VAR source_trans : tgg00_TransContext;
                    mess_type  : tgg00_MessType;
                    mess2_type : tgg00_MessType2;
                    VAR mblock : tgg00_MessBlock);
 
        FUNCTION
              g01packet_size : tsp00_Int4;
 
      ------------------------------ 
 
        FROM
              Kernel_move_and_fill : VGG101;
 
        PROCEDURE
              SAPDB_PascalFill (
                    mod_id      : tsp00_C6;
                    mod_num     : tsp00_Int4;
                    obj_upb     : tsp00_Int4;
                    obj         : tsp00_MoveObjPtr;
                    obj_pos     : tsp00_Int4;
                    length      : tsp00_Int4;
                    fillchar    : char;
                    VAR e       : tgg00_BasisError);
 
        PROCEDURE
              SAPDB_PascalUnicodeFill (
                    mod_id      : tsp00_C6;
                    mod_num     : tsp00_Int4;
                    obj_upb     : tsp00_Int4;
                    obj         : tsp00_MoveObjPtr;
                    obj_pos     : tsp00_Int4;
                    length      : tsp00_Int4;
                    fillchar    : tsp00_C2;
                    VAR e       : tgg00_BasisError);
 
        PROCEDURE
              SAPDB_PascalForcedUnicodeFill (
                    obj_upb     : tsp00_Int4;
                    obj         : tsp00_MoveObjPtr;
                    obj_pos     : tsp00_Int4;
                    length      : tsp00_Int4;
                    fillchar    : tsp00_C2 );
 
        PROCEDURE
              SAPDB_PascalMove (
                    mod_id      : tsp00_C6;
                    mod_num     : tsp00_Int4;
                    source_upb  : tsp00_Int4;
                    dest_upb    : tsp00_Int4;
                    source      : tsp00_MoveObjPtr;
                    src_pos     : tsp00_Int4;
                    destin      : tsp00_MoveObjPtr;
                    dest_pos    : tsp00_Int4;
                    length      : tsp00_Int4;
                    VAR e       : tgg00_BasisError);
 
        PROCEDURE
              SAPDB_PascalOverlappingMove (
                    mod_id      : tsp00_C6;
                    mod_num     : tsp00_Int4;
                    source_upb  : tsp00_Int4;
                    dest_upb    : tsp00_Int4;
                    source      : tsp00_MoveObjPtr;
                    src_pos     : tsp00_Int4;
                    destin      : tsp00_MoveObjPtr;
                    dest_pos    : tsp00_Int4;
                    length      : tsp00_Int4;
                    VAR e       : tgg00_BasisError);
 
        PROCEDURE
              SAPDB_PascalForcedFill (
                    size        : tsp00_Int4;
                    m           : tsp00_MoveObjPtr;
                    pos         : tsp00_Int4;
                    len         : tsp00_Int4;
                    fillchar    : char);
 
        PROCEDURE
              SAPDB_PascalForcedMove (
                    source_upb  : tsp00_Int4;
                    destin_upb  : tsp00_Int4;
                    source      : tsp00_MoveObjPtr;
                    source_pos  : tsp00_Int4;
                    destin      : tsp00_MoveObjPtr;
                    destin_pos  : tsp00_Int4;
                    length      : tsp00_Int4);
 
        PROCEDURE
              SAPDB_PascalForcedOverlappingMove (
                    source_upb  : tsp00_Int4;
                    destin_upb  : tsp00_Int4;
                    source      : tsp00_MoveObjPtr;
                    source_pos  : tsp00_Int4;
                    destin      : tsp00_MoveObjPtr;
                    destin_pos  : tsp00_Int4;
                    length      : tsp00_Int4);
 
        PROCEDURE
              g10mv (
                    mod_id      : tsp00_C6;
                    mod_num     : tsp00_Int4;
                    source_upb  : tsp00_Int4;
                    dest_upb    : tsp00_Int4;
                    source      : tsp00_MoveObjPtr;
                    src_pos     : tsp00_Int4;
                    destin      : tsp00_MoveObjPtr;
                    dest_pos    : tsp00_Int4;
                    length      : tsp00_Int4;
                    VAR e       : tgg00_BasisError);
 
        PROCEDURE
              s10mv (
                    source_upb  : tsp00_Int4;
                    destin_upb  : tsp00_Int4;
                    source      : tsp00_MoveObjPtr;
                    source_pos  : tsp00_Int4;
                    destin      : tsp00_MoveObjPtr;
                    destin_pos  : tsp00_Int4;
                    length      : tsp00_Int4);
 
      ------------------------------ 
 
        FROM
              GG_allocator_interface : VGG941;
 
        FUNCTION
              gg941Allocate(VAR TransContext : tgg00_TransContext;
                    wantedBytes : integer) : tsp00_Addr;
 
        PROCEDURE
              gg941Deallocate(VAR TransContext : tgg00_TransContext;
                    VAR p : tsp00_Addr);
 
      ------------------------------ 
 
        FROM
              RTE-Extension-20: VSP20;
 
        PROCEDURE
              s20ch4sw (val    : tsp00_Int4;
                    sourceswap : tsp00_SwapKind;
                    VAR dest   : tsp00_Int4;
                    di         : tsp00_Int4;
                    destswap   : tsp00_SwapKind);
 
      ------------------------------ 
 
        FROM
              RTE-Extension-80: VSP80;
 
        PROCEDURE
              s80uni_trans
                    (src_ptr        : tsp00_MoveObjPtr;
                    src_len         : tsp00_Int4;
                    src_codeset     : tsp00_Int2;
                    dest_ptr        : tsp00_MoveObjPtr;
                    VAR dest_len    : tsp00_Int4;
                    dest_codeset    : tsp00_Int2;
                    trans_options   : tsp8_uni_opt_set;
                    VAR rc          : tsp8_uni_error;
                    VAR err_char_no : tsp00_Int4);
&       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;
 
              tgg00_Linkset tsp00_C1
 
        PROCEDURE
              s20ch4sw;
 
              tsp00_MoveObj tsp00_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_invalid_longcolcnt = -1;(* PTS 1122546 D.T. *)
 
 
(*------------------------------*) 
 
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;
      max_ld_cnt        : integer;
      desc_len          : integer;
      longdescs_ptr     : tsp00_MoveObjPtr;
      p                 : tsp00_Addr;
 
BEGIN
(* *** extern call (Getval) *** *)
WITH acv DO
    BEGIN
    (* PTS 1116801 E.Z. *)
    desc_len := mxsp_long_desc;
    ld_cnt      := 0;
    ld_pos      := 1;
    with_lock   := false;
    buffer_full := false;
    max_ld_cnt  := a_data_part^.sp1p_arg_count;
    p := gg941Allocate (acv.a_transinf.tri_trans, acv.a_data_length);
    IF  p = NIL
    THEN
        a07_b_put_error (acv, e_no_more_memory, 1)
    ELSE
        BEGIN
        longdescs_ptr := @p^;
        g10mv ('VAK508',   1,    
              acv.a_data_length, acv.a_data_length,
              @acv.a_data_ptr^, 1, @longdescs_ptr^, 1,
              acv.a_data_length, acv.a_returncode);
        WHILE (ld_cnt < max_ld_cnt)                AND
              (a_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, longdescs_ptr, ld_pos,
                  NOT c_intern_getval, buffer_full, c_invalid_longcolcnt); (* PTS 1122546 D.T. *)
            g10mv ('VAK508',   2,    
                  acv.a_data_length, a_curr_retpart^.sp1p_buf_size,
                  @longdescs_ptr^, ld_pos, @a_curr_retpart^.sp1p_buf, save_retpart_pos,
                  (desc_len + 1), a_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_returncode = 0) AND (NOT a_part_rollback) AND
            ((ld_cnt < max_ld_cnt) OR buffer_full)
        THEN
            a_long_desc_pos := 1;
&       IFDEF TRACE
        (*ENDIF*) 
        t01int4 (ak_sem, 'returncode  ', a_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', max_ld_cnt);
        t01int4 (ak_sem, 'buffer_full ', ord (buffer_full));
&       endif
        (* *** Update counter of long_descriptors *** *)
        a06finish_curr_retpart (acv, sp1pk_longdata, ld_cnt);
        gg941Deallocate (acv.a_transinf.tri_trans, p);
        END
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a508get_definition_text (VAR acv : tak_all_command_glob;
            VAR surrogate : tgg00_Surrogate;
            show_kind     : tgg00_ShowKind;
            colno         : integer;
            bufSize       : integer;
            VAR buf       : tsp00_MoveObj;
            VAR textlen   : tsp00_Int4);
 
VAR
      ok       : boolean;
      c        : tsp00_C1;
      int2len  : tsp00_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, bufSize, textlen);
            END;
        (*ENDIF*) 
        END;
    sh_pseudo_long :
        a400SVCopyLongValue (acv, surrogate, colno, @buf, bufSize, textlen);
    sh_procedure, sh_all_procedures :
        a262GetDBProcDefinition (acv, surrogate, textlen, buf, bufSize);
    sh_trigger, sh_all_triggers :
        BEGIN
        i2c2.map_int := colno;
        c[1]         := i2c2.map_c2[1];
        a49get_trigger_def (acv, surrogate,
              c, int2len, buf, bufSize);
        textlen := int2len
        END;
    sh_u_domain, sh_domain_constraints :
        a44get_domaindef (acv, surrogate,
              show_kind = sh_domain_constraints,
              buf, bufSize, textlen);
    (* PTS 1111576 E.Z. *)
    sh_view, sh_all_views :
        a48get_view_def_string (acv,
              surrogate, false, bufSize, 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
IF  (acv.a_long_desc_pos > 0) AND
    (rec_len >= acv.a_long_desc_pos + startpos)
THEN
    WITH acv, 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_returncode = 0) AND
              (NOT buffer_full)         DO
            BEGIN
            ak508_long_column_handling (acv, change_rec, i, rec_len,
                  startpos + (i * rec_len), buffer_full);
            i := succ (i);
            END;
        (*ENDWHILE*) 
        IF  (a_returncode = 0) AND (NOT a_part_rollback) AND
            ((i < rec_cnt) OR
            ((i = rec_cnt) AND data_part))
        THEN
            BEGIN
            IF  (i < rec_cnt) AND (aux_long_pos > 0)
            THEN
                BEGIN
                a_long_desc_pos := aux_long_pos;
                ak508_fetch_long_desc (acv, change_rec, rec_cnt - i, i,
                      rec_len, startpos + (i * rec_len), 1);
                END;
            (* *** reset a_long_desc_pos for indicate     *)
            (*     that subtrans should not 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*) 
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak508_long_column_handling (VAR acv : tak_all_command_glob;
            VAR change_rec      : tak_changerecord;
            done_records        : integer;
            rec_len             : integer;
            startpos            : integer;
            VAR buffer_full     : boolean);
 
VAR
      i   : integer;
      pos : integer;
      longcolcnt : integer;
 
BEGIN
(* *** intern call (Select/Fetch) *** *)
WITH acv, 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;
    longcolcnt  := 1;
    WHILE (i <= cr_colcount) AND
          (a_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, a_data_ptr, pos,
                          c_intern_getval, buffer_full, longcolcnt); (* PTS 1122546 D.T. *)
                (*ENDIF*) 
                longcolcnt := succ(longcolcnt);
                END;
            (*ENDIF*) 
            END;
        (*ENDWITH*) 
        i := succ (i);
        END;
    (*ENDWHILE*) 
    IF  (i <= cr_colcount) AND (a_returncode = 0)
    THEN
        BEGIN
        a_long_desc_pos := i;
        ak508_fetch_long_desc (acv, change_rec, 1, done_records, rec_len, startpos, longcolcnt);
        END;
    (*ENDIF*) 
    IF  ((a_returncode = 0) AND
        buffer_full        AND
        (i > cr_colcount)     )
    THEN
        a_long_desc_pos := 0;
&   IFDEF TRACE
    (*ENDIF*) 
    t01int4 (ak_sem, 'returncode  ', a_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;
            longdescs_ptr       : tsp00_MoveObjPtr;
            pos_long_desc       : integer;
            intern_getval       : boolean;
            VAR buffer_full     : boolean;
            longcolcnt          : integer); (* PTS 1122546 D.T. *)
 
VAR
      read_more          : boolean;
      first_zoom         : boolean;
      is_comment         : boolean;
      is_locked          : boolean;
      pseudo_long_column : boolean;
      with_lock          : boolean;
      prefetch           : boolean; (* PTS 1122546 D.T. *)
      atonce             : boolean; (* PTS 1122546 D.T. *)
      valpos             : tsp00_Int4;
      desc_len           : tsp00_Int4;
      len_desired        : tsp00_Int4;
      unused_leng        : tsp00_Int4;
      maxcolcnt          : tsp00_Int4; (* PTS 1122546 D.T. *)
      aux_valmode        : tsp00_ValMode;
      curr_long_qual     : tgg00_LongQual;
      long_desc          : tak_long_descriptor;
 
BEGIN
WITH acv, 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;
    prefetch   := (ld_first_call IN ld_state); (* PTS 1122546 D.T. *)
    IF  (longdescs_ptr^ [ pos_long_desc ] <> csp_undef_byte)
    THEN
        BEGIN
        g10mv ('VAK508',   3,    
              a_data_length, sizeof (long_desc.desc),
              @longdescs_ptr^, pos_long_desc + 1,
              @long_desc.desc, 1, desc_len,
              a_returncode);
        IF  a_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
                IF  (longcolcnt <> c_invalid_longcolcnt)  (* PTS 1122546 D.T. *)
                THEN
                    BEGIN
                    a92ReadLongDemandData (acv, longcolcnt, maxcolcnt, ld_intern_pos, ld_vallen, atonce);
                    END
                ELSE
                    BEGIN
                    ld_intern_pos := 1;
                    ld_vallen     := -1;
                    END;
                (*ENDIF*) 
                (*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*) 
                first_zoom := true;
                END
            ELSE
                IF  (ld_valmode    = vm_data_trunc) AND
                    (ld_first_call IN ld_state)   AND (* PTS 1122546 D.T. *)
                    (ld_no_close IN ld_infoset)
                THEN
                    BEGIN
                    ld_valmode := vm_nodata;
                    with_lock  := true;
                    first_zoom := true;
                    END;
                (*ENDIF*) 
            (*ENDIF*) 
            IF  (a_returncode = 0)
            THEN
                BEGIN
                len_desired := ld_vallen;
                with_lock   := NOT pseudo_long_column;
                is_locked   := (ld_with_lock in ld_infoset) AND
                      NOT (ld_first_call IN ld_state); (* PTS 1122546 D.T. *)
                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  ];
                    ld_state   := ld_state   - [ ld_first_call ]; (* PTS 1122546 D.T. *)
                    is_locked  := true;
                    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_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,
                                  prefetch); (* PTS 1122546 D.T. *)
                        (*ENDIF*) 
                        IF  a_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_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;
                            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, longdescs_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_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_returncode);
&                   ENDIF
                    IF  (a_returncode =
                        cak_e_table_or_file_dropped) OR
                        (a_returncode =
                        a07_return_code (e_old_fileversion, a_sqlmode))
                    THEN
                        BEGIN
                        a_returncode := 0;
                        ld_valmode  := vm_alldata;
                        ld_vallen   := 0;
                        END;
&                   IFDEF TRACE
                    (*ENDIF*) 
                    t01longdescriptor (ak_sem, long_desc.desc);
&                   ENDIF
                    (* PTS 1105838 E.Z. *)
                    ;
                    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);
                    g10mv ('VAK508',   4,    
                          sizeof (long_desc.desc), a_data_length,
                          @long_desc.desc, 1, @longdescs_ptr^, pos_long_desc + 1,
                          desc_len, a_returncode);
                    END;
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak508o_getval (VAR acv  : tak_all_command_glob;
            VAR long_desc     : tsp00_LongDescriptor;
            VAR ret_long_qual : tgg00_LongQual;
            prefetch          : boolean);
 
VAR
      b_err        : tgg00_BasisError;
      mblock       : tgg00_MessBlock;
      e            : tsp8_uni_error;
      err_char_no  : tsp00_Int4;
      outlen       : tsp00_Int4;
 
BEGIN
WITH acv, 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  := MB_PART1_HEAD_MXGG00 + sizeof (mb_qual^.ml_long_qual);
        (* PTS 1105838 E.Z. *)
        IF  (ld_use_toascii in ld_state) AND
            (a_out_packet^.sp1_header.sp1h_mess_code in
            [csp_unicode_swap, csp_unicode])
        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 1120472 E.Z. *)
        lq_prefetch := prefetch; (* PTS 1122546 D.T. *)
        IF  (ld_use_toascii in ld_state) AND
            (a_out_packet^.sp1_header.sp1h_mess_code in
            [csp_unicode_swap, csp_unicode])
        THEN
            (* ascii --> UCS2 will be done afterwards *)
            IF  mb_data_size < ld_vallen DIV 2
            THEN
                lq_len := mb_data_size
            ELSE
                lq_len := ld_vallen DIV 2
            (*ENDIF*) 
        ELSE
            IF  mb_data_size < ld_vallen
            THEN
                lq_len := mb_data_size
            ELSE
                lq_len := ld_vallen;
            (*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);
        IF  (b_err = e_file_limit)
        THEN
            BEGIN
            ld_valmode := vm_startpos_invalid;
            b_err := e_ok;
            END;
&       ifdef TRACE
        (*ENDIF*) 
        t01int4 (ak_sem, 'b_err hhh   ', ord(b_err));
&       endif
        IF  b_err <> e_ok
        THEN
            a_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) AND
                    (a_out_packet^.sp1_header.sp1h_mess_code in
                    [csp_unicode_swap, csp_unicode])
                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) AND
                    (acv.a_out_packet^.sp1_header.sp1h_mess_swap <> sw_normal)
                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,
                          @(a_curr_retpart^.sp1p_buf [ld_valpos]), outlen,
                          csp_unicode_swap, [ ], 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;
                IF  ld_valmode <> vm_startpos_invalid (* PTS 1122546 D.T. *)
                THEN
                    ld_valmode  := vm_nodata;
                (*ENDIF*) 
                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;
            done_records        : integer;
            rec_len             : integer;
            startpos            : integer;
            longcolcnt          : integer);
 
VAR
      atonce        : boolean; (* PTS 1122546 D.T. *)
      i             : integer;
      pos           : integer;
      rec_no        : integer;
      maxcolcnt     : tsp00_Int4; (* PTS 1122546 D.T. *)
      long_desc     : tak_long_descriptor;
 
BEGIN
WITH acv, 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) AND (a_returncode=0) DO
            BEGIN
            WITH cr_columns[ i ] DO
                BEGIN
                IF  (ch_to_longsupport in ch_type)
                THEN
                    IF  ch_startpos + startpos + sizeof(long_desc) >
                        (done_records + succ(rec_no)) * rec_len
                    THEN
                        i := cr_colcount (* break the while loop *)
                    ELSE
                        BEGIN
                        pos := ch_startpos + startpos + (rec_no * rec_len);
                        g10mv ('VAK508',   5,    
                              a_curr_retpart^.sp1p_buf_size, sizeof (long_desc),
                              @a_data_ptr^, pos + 1,
                              @long_desc.desc, 1, sizeof(long_desc),
                              a_returncode);
                        long_desc.lds_valmode := vm_nodata;
                        (* PTS 1122546 D.T. *)
                        a92ReadLongDemandData (acv, longcolcnt, maxcolcnt, long_desc.lds_intern_pos,
                              long_desc.lds_vallen, atonce);
                        IF  (a_returncode = 0)
                        THEN
                            BEGIN
                            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*) 
                            g10mv ('VAK508',   6,    
                                  sizeof (long_desc), a_curr_retpart^.sp1p_buf_size,
                                  @long_desc.desc, 1, @a_data_ptr^, pos + 1,
                                  sizeof (long_desc), a_returncode);
                            longcolcnt := succ(longcolcnt);
                            END;
                        (*ENDIF*) 
                        END;
                    (*ENDIF*) 
                (*ENDIF*) 
                END;
            (*ENDWITH*) 
            i := succ (i);
            END;
        (*ENDWHILE*) 
        rec_no     := succ (rec_no);
        longcolcnt := 1;
        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  : tgg00_Surrogate;
            mtype          : tgg00_MessType;
            lock_excl      : boolean);
 
VAR
      e           : tgg00_BasisError;
      aux_data    : tsp00_Name;
      mblock      : tgg00_MessBlock;
      aux_qual    : tgg00_QualBuf;
 
BEGIN
WITH acv 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        := MB_PART1_LOCKHEAD_MXGG04 + LOCK_MXGG04;
        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  : tgg00_LongQual);
 
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*) 
    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 : tgg00_LongQual);
 
VAR
      viewtextlen   : tsp00_Int4;
      move_len      : tsp00_Int4;
      rest_buf_size : tsp00_Int4;
      info_len      : tsp00_Int4;
      err_char_no   : tsp00_Int4;
      uni_err       : tsp8_uni_error;
      curr_data_ptr : tsp00_MoveObjPtr;
      obj_ptr       : tsp00_MoveObjPtr;   (* PTS 1120915 E.Z. *)
 
      pLongBuffer   : RECORD
            CASE boolean OF
                true :
                    (mobj : tsp00_MoveObjPtr);
                false :
                    (addr : tsp00_Addr);
                END;
            (*ENDCASE*) 
 
 
BEGIN
ret_long_qual := g01nil_long_qual;
WITH acv, long_desc, ret_long_qual DO
    BEGIN
    pLongBuffer.addr := gg941Allocate(a_transinf.tri_trans,  g01packet_size);
    IF  pLongBuffer.addr = NIL
    THEN
        a07_b_put_error (acv, e_no_more_memory, 1)
    ELSE
        BEGIN
        viewtextlen := 0;
        a508get_definition_text (acv, lds_descriptor,
              lds_show_kind, lds_colno, g01packet_size, pLongBuffer.mobj^, viewtextlen);
        IF  a_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 1120915 E.Z. *)
                s80uni_trans (@(pLongBuffer.mobj^[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 - 1 (* PTS 1130935 *)
                    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;
                g10mv ('VAK508',   7,    
                      g01packet_size, rest_buf_size,
                      @pLongBuffer.mobj^, lds_intern_pos, @curr_data_ptr^, 1, move_len,
                      a_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*) 
        gg941Deallocate (acv.a_transinf.tri_trans, pLongBuffer.addr);
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(* PTS 1116801 E.Z. *)
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
.PA 
