.nf
 
 
    ========== licence begin  GPL
    Copyright (c) 2000-2004 SAP AG
 
    This program is free software; you can redistribute it and/or
    modify it under the terms of the GNU General Public License
    as published by the Free Software Foundation; either version 2
    of the License, or (at your option) any later version.
 
    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.
 
    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
    ========== licence end
 
.fo
*****************************************************
Copyright (c) 2000-2004 SAP AG
SAP Database Technology
 
Release :      Date : 2000-11-17
*****************************************************
modname : VAK13
changed : 2000-11-17
module  : AK_Alter_Table
 
Author  : ThomasA
Created : 1985-10-16
*****************************************************
 
Purpose : semantic execution of alter table orders
 
Define  :
 
        PROCEDURE
              a13_call_semantic (VAR acv : tak_all_command_glob);
 
        PROCEDURE
              a13add_dropped_columns (
                    VAR acv         : tak_all_command_glob;
                    view_level      : integer;
                    VAR viewscanpar : tak_viewscan_par);
 
        PROCEDURE
              a13_build_mapping_stack (
                    VAR acv        : tak_all_command_glob;
                    VAR a11v       : tak_a11_glob;
                    VAR src_st_ptr : tgg00_StackListPtr;
                    VAR tar_st_ptr : tgg00_StackListPtr;
                    VAR src_col_cnt: tsp00_Int2;
                    VAR new_base   : boolean);
 
        PROCEDURE
              a13_new_catalog_desc (
                    VAR acv        : tak_all_command_glob;
                    VAR a11v       : tak_a11_glob;
                    VAR old_p      : tak_syspointerarr;
                    VAR extcol_map : tgg03_extcol_map;
                    VAR new_base   : boolean);
 
        PROCEDURE
              a13repl_priv_column   (
                    VAR acv       : tak_all_command_glob;
                    base_ptr      : tak_sysbufferaddress;
                    VAR extcolset : tak_columnset);
 
        PROCEDURE
              a13store_col_alter_date (
                    VAR acv      : tak_all_command_glob;
                    VAR p_arr    : tak_syspointerarr;
                    VAR col_info : tak00_columninfo);
 
.CM *-END-* define --------------------------------------
***********************************************************
 
Use     :
 
        FROM
              Scanner : VAK01;
 
        VAR
              a01defaultkey        : tgg00_SysInfoKey;
              a01emptypriv         : tak_privilege;
              a01fullset           : tak_columnset;
              a01_il_b_identifier  : tsp00_KnlIdentifier;
              a01kw                : tak_keywordtab;
 
      ------------------------------ 
 
        FROM
              AK_semantic_scanner_tools : VAK05;
 
        PROCEDURE
              a05_int4_unsigned_get (
                    VAR acv            : tak_all_command_glob;
                    pos                : integer;
                    l                  : tsp00_Int2;
                    VAR int            : tsp00_Int4);
 
        PROCEDURE
              a05_nextval_get (
                    VAR acv      : tak_all_command_glob;
                    m2_type      : tgg00_MessType2;
                    VAR seq_id   : tgg00_Surrogate (*ptocSynonym const tgg00_Surrogate VAR_ARRAY_REF *);
                    VAR seq_info : tgg00_SeqInfo;
                    VAR dest     : tsp00_C32;
                    destpos      : integer;
                    VAR actlen   : integer);
 
        PROCEDURE
              a05surrogate_get (
                    VAR acv         : tak_all_command_glob;
                    VAR surrogate   : tgg00_Surrogate);
 
        PROCEDURE
              a05identifier_get (
                    VAR acv     : tak_all_command_glob;
                    tree_index  : integer;
                    obj_len     : integer;
                    VAR moveobj : tsp00_KnlIdentifier);
 
      ------------------------------ 
 
        FROM
              AK_universal_semantic_tools : VAK06;
 
        PROCEDURE
              a06a_mblock_init (
                    VAR acv      : tak_all_command_glob;
                    mtype        : tgg00_MessType;
                    m2type       : tgg00_MessType2;
                    VAR tree     : tgg00_FileId);
 
        PROCEDURE
              a06extcolno (
                    VAR baserec : tak_baserecord;
                    extcolno   : integer;
                    VAR colptr : tak00_colinfo_ptr);
 
        PROCEDURE
              a06inc_linkage (VAR linkage : tsp00_C2);
 
        PROCEDURE
              a06public_priv  (
                    VAR acv  : tak_all_command_glob;
                    VAR brec : tak_baserecord;
                    VAR priv : tak_privilege);
 
        PROCEDURE
              a06_systable_get (
                    VAR acv      : tak_all_command_glob;
                    dstate       : tak_directory_state;
                    VAR tableid  : tgg00_Surrogate;
                    VAR base_ptr : tak_sysbufferaddress;
                    get_all      : boolean;
                    VAR ok       : boolean);
 
        PROCEDURE
              a06reset_retpart (VAR acv : tak_all_command_glob);
 
        PROCEDURE
              a06rsend_mess_buf (
                    VAR acv    : tak_all_command_glob;
                    VAR m_buf  : tgg00_MessBlock;
                    result_req : boolean;
                    VAR e      : tgg00_BasisError);
 
        PROCEDURE
              a06unpack_priv (
                    VAR packed_priv   : tak_privilege;
                    VAR unpacked_priv : tak_privilege);
 
        PROCEDURE
              a06determine_username (
                    VAR acv       : tak_all_command_glob;
                    VAR userid    : tgg00_Surrogate;
                    VAR user_name : tsp00_KnlIdentifier);
&       ifdef trace
 
        PROCEDURE
              a06td_priv (
                    p        : tak_privilege;
                    id       : tsp00_C18;
                    unpacked : boolean);
&       endif
 
      ------------------------------ 
 
        FROM
              AK_Identifier_Handling : VAK061;
 
        PROCEDURE
              a061add_name (
                    VAR acv      : tak_all_command_glob;
                    VAR base_rec : tak_baserecord;
                    VAR name     : tsp00_KnlIdentifier;
                    VAR p        : tsp00_KnlIdentifierPtr);
 
        PROCEDURE
              a061app_columnname (
                    VAR acv               : tak_all_command_glob;
                    VAR base_rec          : tak_baserecord;
                    VAR column            : tsp00_KnlIdentifier;
                    VAR index             : integer);
 
        PROCEDURE
              a061copy_colinfo (
                    VAR src_col : tak00_columninfo;
                    VAR dst_col : tak00_columninfo);
 
        FUNCTION
              a061exist_columnname (
                    VAR base_rec    : tak_baserecord;
                    VAR column      : tsp00_KnlIdentifier;
                    VAR colinfo_ptr : tak00_colinfo_ptr) : boolean;
 
        PROCEDURE
              a061get_colname (
                    VAR col_info : tak00_columninfo;
                    VAR colname  : tsp00_KnlIdentifier);
&       ifdef trace
 
        PROCEDURE
              a061td_colinfo (
                    VAR colinfo : tak00_columninfo;
                    index : integer);
&       endif
 
      ------------------------------ 
 
        FROM
              Select_List : VAK61;
 
        PROCEDURE
              a61_set_jump (
                    VAR mess_block : tgg00_MessBlock;
                    stentrynr : integer;
                    operator  : tgg00_StackEntryType);
 
      ------------------------------ 
 
        FROM
              AK_error_handling : VAK07;
 
        PROCEDURE
              a07_b_put_error (
                    VAR acv : tak_all_command_glob;
                    b_err : tgg00_BasisError;
                    err_code : tsp00_Int4);
 
        PROCEDURE
              a07_const_b_put_error (
                    VAR acv    : tak_all_command_glob;
                    b_err      : tgg00_BasisError;
                    err_code   : tsp00_Int4;
                    param_addr : tsp00_MoveObjPtr;
                    const_len  : integer);
 
        PROCEDURE
              a07_nb_put_error (
                    VAR acv : tak_all_command_glob;
                    b_err : tgg00_BasisError;
                    err_code : tsp00_Int4;
                    VAR n    : tsp00_KnlIdentifier);
 
        PROCEDURE
              a07ak_system_error (
                    VAR acv  : tak_all_command_glob;
                    modul_no : integer;
                    id       : integer);
 
      ------------------------------ 
 
        FROM
              AK_error_handling : VAK071;
 
        FUNCTION
              a07_return_code (
                    b_err   : tgg00_BasisError;
                    sqlmode : tsp00_SqlMode) : tsp00_Int2;
 
      ------------------------------ 
 
        FROM
              Systeminfo_cache   : VAK10;
 
        PROCEDURE
              a10alter_long_version (
                    VAR acv        : tak_all_command_glob;
                    VAR base_rec   : tak_baserecord;
                    old_long_cnt   : integer;
                    m_type         : tgg00_MessType;
                    view_scan      : boolean);
 
        FUNCTION
              a10BaseRecPersistentOffset : integer;
 
        PROCEDURE
              a10_nil_get_sysinfo (
                    VAR acv      : tak_all_command_glob;
                    VAR syskey   : tgg00_SysInfoKey;
                    dstate       : tak_directory_state;
                    syslen       : tsp00_Int2;
                    VAR syspoint : tak_sysbufferaddress;
                    VAR b_err    : tgg00_BasisError);
 
        PROCEDURE
              a10_copy_catalog_rec (
                    VAR acv         : tak_all_command_glob;
                    VAR old_key     : tgg00_SysInfoKey;
                    del_old_rec     : boolean;
                    VAR new_key     : tgg00_SysInfoKey;
                    new_segment_id  : tsp00_C2;
                    add_new_rec     : boolean;
                    VAR b_err       : tgg00_BasisError);
 
        PROCEDURE
              a10add_sysinfo (
                    VAR acv      : tak_all_command_glob;
                    VAR syspoint : tak_sysbufferaddress;
                    VAR b_err    : tgg00_BasisError);
 
        PROCEDURE
              a10_del_tab_sysinfo  (
                    VAR acv     : tak_all_command_glob;
                    VAR tableid : tgg00_Surrogate;
                    VAR qual    : tak_del_tab_qual;
                    temp_table  : boolean;
                    VAR b_err   : tgg00_BasisError);
 
        PROCEDURE
              a10_cache_delete  (
                    VAR acv     : tak_all_command_glob;
                    is_rollback : boolean);
 
        PROCEDURE
              a10_version (
                    VAR acv        : tak_all_command_glob;
                    VAR base_rec   : tak_baserecord;
                    m_type         : tgg00_MessType;
                    view_scan      : boolean);
 
        PROCEDURE
              a10_fix_len_get_sysinfo (
                    VAR acv      : tak_all_command_glob;
                    VAR syskey   : tgg00_SysInfoKey;
                    dstate       : tak_directory_state;
                    required_len : integer;
                    plus         : integer;
                    VAR syspoint : tak_sysbufferaddress;
                    VAR b_err    : tgg00_BasisError);
 
        PROCEDURE
              a10get_sysinfo (
                    VAR acv    : tak_all_command_glob;
                    VAR syskey : tgg00_SysInfoKey;
                    dstate     : tak_directory_state;
                    VAR syspoint : tak_sysbufferaddress;
                    VAR b_err    : tgg00_BasisError);
 
        PROCEDURE
              a10next_sysinfo (
                    VAR acv      : tak_all_command_glob;
                    VAR syskey   : tgg00_SysInfoKey;
                    stop_prefix  : integer;
                    dstate       : tak_directory_state;
                    reckind      : tsp00_C2;
                    VAR syspoint : tak_sysbufferaddress;
                    VAR b_err    : tgg00_BasisError);
 
        PROCEDURE
              a10repl_sysinfo (
                    VAR acv      : tak_all_command_glob;
                    VAR syspoint : tak_sysbufferaddress;
                    VAR b_err    : tgg00_BasisError);
 
        PROCEDURE
              a10del_sysinfo (
                    VAR acv      : tak_all_command_glob;
                    VAR syskey   : tgg00_SysInfoKey;
                    VAR b_err    : tgg00_BasisError);
 
        PROCEDURE
              a10_key_del  (
                    VAR acv    : tak_all_command_glob;
                    VAR syskey : tgg00_SysInfoKey);
 
        PROCEDURE
              a10_rel_sysinfo (
                    VAR acv    : tak_all_command_glob;
                    VAR syskey : tgg00_SysInfoKey);
 
      ------------------------------ 
 
        FROM
              AK_Table : VAK11;
 
        PROCEDURE
              a11condition (
                    VAR acv          : tak_all_command_glob;
                    VAR a11v         : tak_a11_glob;
                    constraint_id    : integer;
                    end_pos          : tsp00_Int4);
 
        PROCEDURE
              a11constraint (
                    VAR acv       : tak_all_command_glob;
                    VAR a11v      : tak_a11_glob;
                    VAR base_rec  : tak_baserecord;
                    constraint_id : integer);
 
        PROCEDURE
              a11del_usage_entry (
                    VAR acv       : tak_all_command_glob;
                    VAR usa_tabid : tgg00_Surrogate;
                    VAR del_tabid : tgg00_Surrogate);
 
        PROCEDURE
              a11domain_usage (
                    VAR acv         : tak_all_command_glob;
                    VAR a11v        : tak_a11_glob;
                    VAR owner_id    : tgg00_Surrogate;
                    VAR domain_name : tsp00_KnlIdentifier;
                    VAR domain_id   : tgg00_Surrogate;
                    colno           : integer);
 
        FUNCTION
              a11firstindex (
                    colcount    : integer;
                    VAR baserec : tak_baserecord) : tsp00_Int2;
 
        PROCEDURE
              a11getconstraintname (
                    VAR constraint_rec  : tak_constraintrecord;
                    VAR constraint_name : tsp00_KnlIdentifier);
 
        PROCEDURE
              a11one_column_def  (
                    VAR acv  : tak_all_command_glob;
                    VAR a11v : tak_a11_glob);
 
        PROCEDURE
              a11glob_init (VAR acv : tak_all_command_glob;
                    VAR a11v : tak_a11_glob);
 
        PROCEDURE
              a11end_create_table (
                    VAR acv  : tak_all_command_glob;
                    VAR a11v : tak_a11_glob);
 
        PROCEDURE
              a11put_date_time (
                    VAR date : tsp00_Int4;
                    VAR time : tsp00_Int4);
 
        PROCEDURE
              a11put_systemkey (
                    VAR acv  : tak_all_command_glob;
                    VAR a11v : tak_a11_glob);
 
        PROCEDURE
              a11get_check_table (
                    VAR acv          : tak_all_command_glob;
                    must_exist       : boolean;
                    basetable        : boolean;
                    unload_allowed   : boolean;
                    required_priv    : tak00_PrivilegeSet;
                    any_priv         : boolean;
                    all_base_rec     : boolean;
                    d_state          : tak_directory_state;
                    VAR act_tree_ind : tsp00_Int4;
                    VAR authid       : tsp00_KnlIdentifier;
                    VAR tablen       : tsp00_KnlIdentifier;
                    VAR d_sparr      : tak_syspointerarr);
 
        PROCEDURE
              a11sort (VAR base_rec : tak_baserecord);
 
      ------------------------------ 
 
        FROM
              AK_Domain : VAK12;
 
        PROCEDURE
              a12get_domain (
                    VAR acv         : tak_all_command_glob;
                    VAR owner       : tsp00_KnlIdentifier;
                    VAR domain_name : tsp00_KnlIdentifier;
                    ti              : integer;
                    VAR domain_ref  : tak_sysbufferaddress;
                    VAR domain_def  : tak_sysbufferaddress);
 
        PROCEDURE
              a12read_domain_ref (
                    VAR acv         : tak_all_command_glob;
                    VAR owner_id    : tgg00_Surrogate;
                    VAR domain_name : tsp00_KnlIdentifier;
                    VAR domain_ref  : tak_sysbufferaddress);
 
      ------------------------------ 
 
        FROM
              AK_Data_Type_Options : VAK14;
 
        PROCEDURE
              a14constraint_check (
                    VAR acv       : tak_all_command_glob;
                    col_info      : tak00_columninfo;
                    constraint_id : integer;
                    error_pos     : integer);
 
        PROCEDURE
              a14default_spec (
                    VAR acv      : tak_all_command_glob;
                    VAR a11v     : tak_a11_glob;
                    VAR col_info : tak00_columninfo);
 
        PROCEDURE
              a14dfunction (
                    VAR acv      : tak_all_command_glob;
                    VAR col_info : tak00_columninfo;
                    subproc      : integer;
                    error_pos    : integer;
                    VAR func_id  : tsp00_Int2);
 
        PROCEDURE
              a14drop_default (
                    VAR acv      : tak_all_command_glob;
                    VAR col_info : tak00_columninfo);
 
        FUNCTION
              a14LengthOfDefaultValue (
                    VAR DefaultRec : tak_defaultrecord) : integer; (* PTS 1108428 *)
 
      ------------------------------ 
 
        FROM
              AK_save_scheme : VAK15;
 
        PROCEDURE
              a15restore_catalog (
                    VAR acv         : tak_all_command_glob;
                    VAR treeid      : tgg00_FileId;
                    VAR viewscanpar : tak_viewscan_par);
 
        PROCEDURE
              a15catalog_save (
                    VAR acv         : tak_all_command_glob;
                    VAR viewscanpar : tak_viewscan_par);
 
      ------------------------------ 
 
        FROM
              AK_usertab_tools : VAK19;
 
        PROCEDURE
              a19del_usertab  (
                    VAR acv       : tak_all_command_glob;
                    VAR user      : tgg00_Surrogate;
                    VAR surrogate : tgg00_Surrogate);
 
        PROCEDURE
              a19change_usertab  (
                    VAR acv           : tak_all_command_glob;
                    operation         : integer;
                    VAR user          : tgg00_Surrogate;
                    VAR surrogate     : tgg00_Surrogate;
                    VAR new_surrogate : tgg00_Surrogate);
 
      ------------------------------ 
 
        FROM
              AK_Grant_Revoke : VAK22;
 
        PROCEDURE
              a22pack_priv (
                    privbuf         : tak_sysbufferaddress;
                    VAR new_priv    : tak_privilege;
                    VAR packed_priv : tak_privilege);
 
      ------------------------------ 
 
        FROM
              AK_Synonym : VAK23;
 
        PROCEDURE
              a23flush_sequence (VAR t : tgg00_TransContext;
                    VAR seq_surrogate : tgg00_Surrogate;
                    VAR seq_value     : tsp00_Number);
 
      ------------------------------ 
 
        FROM
              AK_Index  : VAK24;
 
        PROCEDURE
              a24drop_multiple_index (
                    VAR acv          : tak_all_command_glob;
                    VAR viewscanpar  : tak_viewscan_par;
                    indexname_errpos  : integer;
                    do_a38_input      : boolean);
 
        PROCEDURE
              a24find_indexname (
                    VAR acv            : tak_all_command_glob;
                    VAR tabid          : tgg00_Surrogate;
                    VAR indexname      : tsp00_KnlIdentifier;
                    VAR index_scan_rec : tak_index_scan_record);
 
        PROCEDURE
              a24finish_index_scan (
                    VAR acv            : tak_all_command_glob;
                    VAR index_scan_rec : tak_index_scan_record);
 
        PROCEDURE
              a24get_indexname (
                    VAR acv        : tak_all_command_glob;
                    indexbuf       : tak_sysbufferaddress;
                    index          : integer;
                    VAR index_name : tsp00_KnlIdentifier);
 
        PROCEDURE
              a24init_index_scan (
                    VAR acv            : tak_all_command_glob;
                    VAR tabid          : tgg00_Surrogate;
                    VAR index_scan_rec : tak_index_scan_record);
 
        FUNCTION
              a24next_named_index (
                    VAR acv            : tak_all_command_glob;
                    VAR index_scan_rec : tak_index_scan_record) : boolean;
 
        PROCEDURE
              a24send_index_command_to_kb (
                    VAR acv         : tak_all_command_glob;
                    VAR viewscanpar : tak_viewscan_par;
                    index_no        : integer;
                    m_type          : tgg00_MessType;
                    mm_type         : tgg00_MessType2);
 
      ------------------------------ 
 
        FROM
              AK_Link : VAK25;
 
        PROCEDURE
              a25get_linkname (
                    VAR acv        : tak_all_command_glob;
                    linkbuf        : tak_sysbufferaddress;
                    index          : integer;
                    VAR link_name  : tsp00_KnlIdentifier);
 
        PROCEDURE
              a25drop_foreign_link (
                    VAR acv      : tak_all_command_glob;
                    VAR sysk     : tgg00_SysInfoKey;
                    VAR linkName : tsp00_KnlIdentifier);
 
      ------------------------------ 
 
        FROM
              AK_Comment : VAK26;
 
        PROCEDURE
              a26drop_comment (
                    VAR acv      : tak_all_command_glob;
                    comment_type : tak_comment_type;
                    VAR id1      : tgg00_Surrogate;
                    VAR id2      : tgg00_Surrogate;
                    colno        : integer);
 
      ------------------------------ 
 
        FROM
              AK_Trigger : VAK262;
 
        PROCEDURE
              a262drop_tab_col_trigger (
                    VAR acv         : tak_all_command_glob;
                    VAR viewscanpar : tak_viewscan_par;
                    VAR new_stack   : tgg00_StackEntry);
 
        PROCEDURE
              a262get_trigger_name (
                    VAR trigger_rec  : tak_triggerrecord;
                    VAR trigger_name : tsp00_KnlIdentifier;
                    VAR b_err        : tgg00_BasisError);
 
      ------------------------------ 
 
        FROM
              AK_VIEW_SCAN   : VAK27;
 
        PROCEDURE
              a27init_viewscanpar (
                    VAR acv         : tak_all_command_glob;
                    VAR viewscanpar : tak_viewscan_par;
                    v_type          : tak_viewscantype);
 
        PROCEDURE
              a27view_scan   (
                    VAR acv         : tak_all_command_glob;
                    VAR tableid     : tgg00_Surrogate;
                    VAR viewscanpar : tak_viewscan_par);
 
      ------------------------------ 
 
        FROM
              AK_update_statistics : VAK28;
 
        PROCEDURE
              a28set_col_info (
                    VAR stat_rec : tak_statisticsinfo;
                    colno        : integer;
                    dist_values  : tsp00_Int4;
                    pages        : tsp00_Int4;
                    avg_lst_len  : tsp00_Int4);
 
      ------------------------------ 
 
        FROM
              AK_distributor : VAK35;
 
        PROCEDURE
              a35_asql_statement (VAR acv : tak_all_command_glob);
 
      ------------------------------ 
 
        FROM
              AK_data_dictionary : VAK38;
 
        PROCEDURE
              a38column_drop (
                    VAR acv    : tak_all_command_glob;
                    VAR userid : tsp00_KnlIdentifier;
                    VAR tablen : tsp00_KnlIdentifier;
                    VAR column : tsp00_KnlIdentifier);
 
      ------------------------------ 
 
        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);
 
      ------------------------------ 
 
        FROM
              AK_Connect : VAK51;
 
        PROCEDURE
              a51switch_user (
                    VAR acv            : tak_all_command_glob;
                    VAR new_user_name  : tsp00_KnlIdentifier;
                    VAR curr_user_name : tsp00_KnlIdentifier);
 
      ------------------------------ 
 
        FROM
              AK_Lock_Commit_Rollback : VAK52;
 
        PROCEDURE
              a52_ex_commit_rollback (
                    VAR acv        : tak_all_command_glob;
                    m_type         : tgg00_MessType;
                    n_rel          : boolean;
                    normal_release : boolean);
 
      ------------------------------ 
 
        FROM
              DML_Help_Procedures : VAK542;
 
        PROCEDURE
              a542char_to_packet (
                    VAR acv : tak_all_command_glob;
                    c : char);
 
        PROCEDURE
              a542identifier_to_packet (
                    VAR acv        : tak_all_command_glob;
                    VAR identifier : tsp00_KnlIdentifier);
 
        PROCEDURE
              a542internal_packet (
                    VAR acv                 : tak_all_command_glob;
                    release_internal_packet : boolean;
                    required_len            : tsp00_Int4);
 
        PROCEDURE
              a542move_to_packet (
                    VAR acv    : tak_all_command_glob;
                    const_addr : tsp00_MoveObjPtr;
                    const_len  : tsp00_Int4);
 
        PROCEDURE
              a542pop_packet (VAR acv : tak_all_command_glob);
 
      ------------------------------ 
 
        FROM
              Build_Strategy_2 : VAK71;
 
        PROCEDURE
              a71default_strat (VAR gg_strategy : tgg07_StrategyInfo);
&       ifdef trace
 
      ------------------------------ 
 
        FROM
              Test_Procedures  : VTA01;
 
        PROCEDURE
              t01columnset (
                    debug           : tgg00_Debug;
                    nam             : tsp00_Sname;
                    columnset       : tak_columnset);
 
        PROCEDURE
              t01addr (
                    debug    : tgg00_Debug;
                    nam      : tsp00_Sname;
                    bufaddr  : tsp00_BufAddr);
 
        PROCEDURE
              t01buf (
                    debug    : tgg00_Debug;
                    VAR buf  : tak00_columninfo;
                    startpos : integer;
                    endpos   : integer);
 
        PROCEDURE
              t01moveobj (
                    layer       : tgg00_Debug;
                    VAR moveobj : tsp00_MoveObj;
                    startpos    : tsp00_Int4;
                    endpos      : tsp00_Int4);
 
        PROCEDURE
              t01int4 (
                    debug    : tgg00_Debug;
                    nam      : tsp00_Sname;
                    int      : tsp00_Int4);
 
        PROCEDURE
              t01lidentifier (
                    debug : tgg00_Debug;
                    nam : tsp00_KnlIdentifier);
 
        PROCEDURE
              t01stackentry (
                    debug          : tgg00_Debug;
                    VAR st         : tgg00_StackEntry;
                    entry_index    : integer);
 
        PROCEDURE
              t01surrogate (
                    debug     : tgg00_Debug;
                    nam       : tsp00_Sname;
                    VAR tabid : tgg00_Surrogate);
 
        PROCEDURE
              t01treeid (
                    debug      : tgg00_Debug;
                    nam        : tsp00_Sname;
                    VAR treeid : tgg00_FileId);
&       endif
 
      ------------------------------ 
 
        FROM
              Codetransformation_and_Coding : VGG02;
 
        PROCEDURE
              g02pascii_pos_ebcdic (
                    VAR source : tak_default_value;
                    srcind   : tsp00_Int4;
                    VAR dest : tak_default_value;
                    destind  : tsp00_Int4;
                    length   : tsp00_Int4);
 
        PROCEDURE
              g02pebcdic_pos_ascii (
                    VAR source : tak_default_value;
                    srcind   : tsp00_Int4;
                    VAR dest : tak_default_value;
                    destind  : tsp00_Int4;
                    length   : tsp00_Int4);
 
      ------------------------------ 
 
        FROM
              Check-Date-Time : VGG03;
 
        PROCEDURE
              g03fdcheck_date (
                    VAR sbuf  : tak_default_value;
                    VAR dbuf  : tak_default_value;
                    spos      : tsp00_Int4;
                    dpos      : tsp00_Int4;
                    actlen    : integer;
                    format    : tgg00_DateTimeFormat;
                    ch_code   : boolean;
                    VAR b_err : tgg00_BasisError);
 
        PROCEDURE
              g03ftcheck_time (
                    VAR sbuf  : tak_default_value;
                    VAR dbuf  : tak_default_value;
                    spos      : tsp00_Int4;
                    dpos      : tsp00_Int4;
                    actlen    : integer;
                    format    : tgg00_DateTimeFormat;
                    ch_code   : boolean;
                    VAR b_err : tgg00_BasisError);
 
        PROCEDURE
              g03ftscheck_timestamp (
                    VAR sbuf  : tak_default_value;
                    VAR dbuf  : tak_default_value;
                    spos      : tsp00_Int4;
                    dpos      : tsp00_Int4;
                    actlen    : integer;
                    format    : tgg00_DateTimeFormat;
                    language  : tsp00_C3;
                    ch_code   : boolean;
                    VAR b_err : tgg00_BasisError);
 
      ------------------------------ 
 
        FROM
              Record_Encapsulate_Procedures : VGG09;
 
        PROCEDURE
              g09StratStackentry (
                    VAR NewStackEntry : tgg00_StackEntry;
                    inp_startpos      : tsp00_Int2;
                    inp_len           : tsp00_Int2);
 
      ------------------------------ 
 
        FROM
              Kernel_move_and_fill : VGG101;
 
        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_PascalMove (
                    mod_id   : tsp00_C6;
                    mod_num  : tsp00_Int4;
                    src_upb  : tsp00_Int4;
                    dest_upb : tsp00_Int4;
                    src      : tsp00_MoveObjPtr;
                    src_pos  : tsp00_Int4;
                    dest     : tsp00_MoveObjPtr;
                    dest_pos : tsp00_Int4;
                    length   : tsp00_Int4;
                    VAR err  : tgg00_BasisError);
 
        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_edit_routines : VGG17;
 
        PROCEDURE
              g17int4to_line (
                    intval    : tsp00_Int4;
                    with_zero : boolean;
                    int_len   : integer;
                    ln_pos    : integer;
                    VAR ln    : tsp00_C20);
 
      ------------------------------ 
 
        FROM
              KB_file_table_handling : VKB64;
 
        PROCEDURE
              k64short_col_file_create (
                    VAR t       : tgg00_TransContext;
                    VAR tree_id : tgg00_FileId);
 
        PROCEDURE
              k64short_col_file_drop (
                    VAR t       : tgg00_TransContext;
                    VAR tree_id : tgg00_FileId);
 
      ------------------------------ 
 
        FROM
              KB_get : VKB71;
 
        VAR
              k71serial_seq_info : tgg00_SeqInfo;
 
      ------------------------------ 
 
        FROM
              filesysteminterface_1 : VBD01;
 
        VAR
              b01niltree_id : tgg00_FileId;
 
        PROCEDURE
              b01empty_file (
                    VAR t       : tgg00_TransContext;
                    VAR file_id : tgg00_FileId);
 
        PROCEDURE
              bd01SetToBad (
                    VAR trans  : tgg00_TransContext;
                    VAR fileId : tgg00_FileId);
 
      ------------------------------ 
 
        FROM
              filesysteminterface_2 : VBD07;
 
        PROCEDURE
              b07cadd_record (
                    VAR t    : tgg00_TransContext;
                    VAR curr : tgg00_FileId;
                    VAR b    : tgg00_Rec);
 
        PROCEDURE
              b07cnext_record (
                    VAR t          : tgg00_TransContext;
                    VAR file_id    : tgg00_FileId;
                    VAR rk         : tgg00_Lkey;
                    VAR set_result : tgg00_BdSetResultRecord;
                    VAR tree_pos   : tgg00_FilePos;
                    VAR b          : tgg00_Rec);
 
      ------------------------------ 
 
        FROM
              Packet_handling : VSP26;
 
        PROCEDURE
              s26find_part (
                    VAR segm         : tsp1_segment;
                    part_kind        : tsp1_part_kind;
                    VAR part_ptr     : tsp1_part_ptr);
 
      ------------------------------ 
 
        FROM
              RTE-Extension-30 : VSP30;
 
        PROCEDURE
              s30cmp1 (
                    VAR buf1     : tsp00_KnlIdentifier;
                    fieldpos1    : tsp00_Int4;
                    fieldlength1 : tsp00_Int4;
                    VAR buf2     : tsp00_KnlIdentifier;
                    fieldpos2    : tsp00_Int4;
                    fieldlength2 : tsp00_Int4;
                    VAR l_result : tsp00_LcompResult);
 
        FUNCTION
              s30lnr_defbyte (
                    str       : tsp00_MoveObjPtr;
                    defbyte   : char;
                    start_pos : tsp00_Int4;
                    length    : tsp00_Int4) : tsp00_Int4;
 
      ------------------------------ 
 
        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);
 
.CM *-END-* use -----------------------------------------
***********************************************************
 
Synonym :
 
        PROCEDURE
              t01buf;
 
              tsp00_Buf tak00_columninfo
 
        PROCEDURE
              a05_nextval_get;
 
              tsp00_MoveObj tsp00_C32
 
        PROCEDURE
              a05identifier_get;
 
              tsp00_MoveObj  tsp00_KnlIdentifier
 
        PROCEDURE
              a15catalog_save;
 
              tak_save_viewscan_par tak_viewscan_par
 
        PROCEDURE
              a15restore_catalog;
 
              tak_save_viewscan_par tak_viewscan_par
 
        PROCEDURE
              b07cnext_record;
 
              tsp00_MoveObj tgg00_Rec
 
        PROCEDURE
              g02pascii_pos_ebcdic;
 
              tsp00_MoveObj tak_default_value;
 
        PROCEDURE
              g02pebcdic_pos_ascii;
 
              tsp00_MoveObj tak_default_value;
 
        PROCEDURE
              g03fdcheck_date;
 
              tsp00_MoveObj tak_default_value
              tsp00_MoveObj tak_default_value
 
        PROCEDURE
              g03ftcheck_time;
 
              tsp00_MoveObj tak_default_value
              tsp00_MoveObj tak_default_value
 
        PROCEDURE
              g03ftscheck_timestamp;
 
              tsp00_MoveObj tak_default_value
              tsp00_MoveObj tak_default_value
 
        PROCEDURE
              g17int4to_line;
 
              tsp00_Line tsp00_C20
 
        PROCEDURE
              s30cmp1;
 
              tsp00_MoveObj tsp00_KnlIdentifier
 
.CM *-END-* synonym -------------------------------------
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Specification:
 
.nf
PROCEDURE A13_CALL_SEMANTIC
            VAR acv : all_command_glob;
.sp;.fo
The procedure executes the various alter table commands semantically, i.e. the
syntax tree is processed and the corresponding catalog alterations are
implemented. The following alter table commands are possible:
.hi +5;
i)@@@Adding of columns by Alter Table Add. More than one column can be added by
an add command. The new columns are always the last ones of the table
definition.
.br
ii)@@Deletion of columns. More than one column can be deleted by an Alter Table
Drop command. Deletion is performed only at the logical level, i.e. the columns
are marked as deleted in the catalog; the columns still exist at BD
level.
.br
iii)@Alteration of the data type and/or range definition of a column.
.hi -5;.sp
The alterations to the base table must be taken into account in all dependent
views. In cases i) and iii) this is done by an internal Save/Restore Schema,
i.e. the views are virtually re-built, while, in case ii), a27view_scan is
used.
.nf
.CM *-END-* specification -------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.fo
.oc _/1
.pb '@'
Description:
 
.nf
.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_found             = csp_maxint2;
      c_add_rec           = true;
      c_release_packet    = true;
      c_modify_index      = true;
      c_new_file_version  = true;
      c_drop_all_index    = true;
      c_scan_views        = true;
      c_release_space     = true;
      c_do_a38_input      = true;
      c_max_ext_map       = MAX_COL_PER_TAB_GG00;
      verify1 = 'SELECT COUNT(*) INTO :A FROM  ';
      c_is_not_true = ' IS NOT TRUE';
      cak13_err_return = 20000;
      c_is_rollback    = true;
 
TYPE
      tverify_operation = SET OF (no_verify, verify_range,
            verify_not_null, verify_add_column, verify_length);
 
      tak13ext_mapping = ARRAY[1..c_max_ext_map] OF RECORD
            em_old_colp : tak00_colinfo_ptr;
            em_new_colp : tak00_colinfo_ptr;
      END;
 
 
      tak13domain_info = RECORD
            dd_determined    : boolean;
            dd_valid_dom_cnt : integer;
            dd_del_dom_cnt   : integer;
            dd_dom_owners    : ARRAY[1..MAX_COL_PER_TAB_GG00] OF tgg00_Surrogate;
            dd_dom_names     : ARRAY[1..MAX_COL_PER_TAB_GG00] OF tsp00_KnlIdentifier;
      END;
 
      tak13_default_added = ARRAY [1..MAX_COL_PER_TAB_GG00] OF boolean;
 
 
(*------------------------------*) 
 
PROCEDURE
      ak13alter_tab_alter (
            VAR acv          : tak_all_command_glob;
            VAR a11v         : tak_a11_glob;
            VAR verify       : tverify_operation);
 
VAR
      pos             : integer;
      alter_indicator : integer;
 
BEGIN
WITH acv, a11v DO
    BEGIN
    alter_indicator := a_ap_tree^[ a1ti ].n_length;
    a1ti   := a_ap_tree^[ a1ti ].n_lo_level;
    a05identifier_get (acv, a1ti, sizeof (a1coln), a1coln);
    pos := a_ap_tree^[a1ti].n_pos;
    IF  NOT (a061exist_columnname (a_p_arr1.pbasep^.sbase,
        a1coln, a1colptr))
    THEN
        a07_nb_put_error (acv, e_unknown_columnname,
              pos, a1coln)
    ELSE
        IF  alter_indicator <> cak_i_references
        THEN
            a13store_col_alter_date (acv, a_p_arr1, a1colptr^);
        (*ENDIF*) 
    (*ENDIF*) 
    IF  a_returncode = 0
    THEN
        WITH a1colptr^ DO
            BEGIN
            CASE  alter_indicator OF
                cak_i_default :
                    IF  ak13default_or_null_foreign_key (acv,
                        a_p_arr1.pbasep^.sbase.bsurrogate, a1colptr^, cak_x_set_default)
                    THEN
                        a07_b_put_error (acv,
                              e_link_column_not_allowed, pos)
                    ELSE
                        a14drop_default (acv, a1colptr^);
                    (*ENDIF*) 
                cak_i_null :
                    IF  ctkey in ccolpropset
                    THEN
                        a07_b_put_error (acv, e_null_not_allowed, 1)
                    ELSE
                        BEGIN
                        IF  ctdefault in ccolpropset
                        THEN
                            a14drop_default (acv, a1colptr^);
                        (*ENDIF*) 
                        ccolpropset := ccolpropset + [ ctopt ];
                        END;
                    (*ENDIF*) 
                cak_i_add, cak_i_alter, cak_i_modify :
                    BEGIN (* add or alter default *)
                    IF  alter_indicator = cak_i_modify
                    THEN
                        IF  ctdefault in ccolpropset
                        THEN
                            alter_indicator := cak_i_alter
                        ELSE
                            alter_indicator := cak_i_add;
                        (*ENDIF*) 
                    (*ENDIF*) 
                    a1ti      := a_ap_tree^[ a1ti ].n_lo_level;
                    IF  alter_indicator = cak_i_add
                    THEN
                        IF  ak13default_or_null_foreign_key (acv,
                            a_p_arr1.pbasep^.sbase.bsurrogate, a1colptr^, cak_x_null)
                        THEN
                            a07_b_put_error (acv,
                                  e_link_column_not_allowed, pos)
                        ELSE
                            IF  ctdefault in ccolpropset
                            THEN
                                a07_b_put_error (acv,
                                      e_duplicate_default, pos)
                            ELSE
                                BEGIN
                                a1add_rec := true;
                                END
                            (*ENDIF*) 
                        (*ENDIF*) 
                    ELSE
                        IF  NOT (ctdefault in ccolpropset)
                        THEN
                            a07_b_put_error (acv,
                                  e_unknown_default, pos)
                        ELSE
                            a1add_rec := false;
                        (*ENDIF*) 
                    (*ENDIF*) 
                    a14default_spec (acv, a11v, a1colptr^);
                    IF  ctdefault in ccolpropset
                    THEN
                        ak13check_default (acv, a11v, a1colptr^)
                    (*ENDIF*) 
                    END;
                cak_i_not :
                    IF  ctopt in ccolpropset
                    THEN
                        BEGIN
                        ccolpropset := ccolpropset - [ ctopt ];
                        verify      := [verify_not_null]
                        END;
                    (*ENDIF*) 
                cak_i_references :
                    ak13domain_migration (acv, a11v);
                OTHERWISE;
                END;
            (*ENDCASE*) 
            END;
        (*ENDWITH*) 
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      ak13count_short_cols (
            VAR acv : tak_all_command_glob) : tsp00_Int2;
 
VAR
      exit_loop    : boolean;
      shrtcolcount : tsp00_Int2;
      colindex     : tsp00_Int2;
 
BEGIN
WITH acv, a_p_arr1.pbasep^.sbase DO
    BEGIN
    colindex     := bcolumn[ blastkeyind ]^.cnextind;
    shrtcolcount := 0;
    exit_loop    := false;
    WHILE (NOT exit_loop) AND
          (colindex > 0)  DO
        BEGIN
        IF  (bcolumn[ colindex ]^.cdatatyp in
            [ dstra, dstre, dstruni, dstrb ]) AND
            (NOT (ctdropped in bcolumn[ colindex ]^.ccolpropset))
        THEN
            shrtcolcount := shrtcolcount + 1
        ELSE
            IF  NOT (bcolumn[ colindex ]^.cdatatyp in
                [ dstra, dstre, dstruni, dstrb,
                dlonga, dlonge, dlonguni, dlongb ])
            THEN
                exit_loop := true;
            (*ENDIF*) 
        (*ENDIF*) 
        colindex := bcolumn[ colindex ]^.cnextind;
        END;
    (*ENDWHILE*) 
    END;
(*ENDWITH*) 
ak13count_short_cols := shrtcolcount;
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13alter_table_add (
            VAR acv           : tak_all_command_glob;
            VAR a11v          : tak_a11_glob;
            VAR default_added : tak13_default_added;
            VAR default_cnt   : integer);
 
VAR
      add_column    : boolean;
      shrtcolexist  : boolean; (* PTS 1115206 M.Ki. *)
      tlo           : integer;
      colcount      : integer;
      ix            : integer;
      jx            : integer;
      coldef_ti     : integer;
      init_long_cnt : integer;
      owner         : tsp00_KnlIdentifier;
      colname       : tsp00_KnlIdentifier;
 
BEGIN
WITH acv, a11v DO
    BEGIN
    a1ti      := a_ap_tree^[ a1ti ].n_lo_level;
    ix        := a1ti;
    colcount  := 0;
    coldef_ti := a1ti;
    REPEAT
        IF  a_ap_tree^[ix].n_symb = s_identifier
        THEN
            colcount := succ(colcount);
        (*ENDIF*) 
        ix := a_ap_tree^[ix].n_lo_level;
    UNTIL
        ix = 0;
    (*ENDREPEAT*) 
    IF  a_returncode = 0
    THEN
        BEGIN
        IF  a_sqlmode = sqlm_oracle
        THEN
            a1reclen := cgg_rec_key_offset
        ELSE
            a1reclen := a_p_arr1.pbasep^.sbase.bmaxreclen;
        (*ENDIF*) 
        WITH a_p_arr1.pbasep^.sbase DO
            FOR jx := bfirstindex TO blastindex DO
                WITH bcolumn[jx]^ DO
                    BEGIN
                    default_added[cextcolno] := false; (* PTS 1114336 M.Ki. *)
                    IF  a_sqlmode = sqlm_oracle
                    THEN
                        CASE ccolstack.etype OF
                            st_fixkey, st_varkey, st_fixcol :
                                a1reclen := a1reclen + cinoutlen;
                            st_varcol :
                                a1reclen := a1reclen + 2;
                            st_varlongchar :
                                a1reclen := a1reclen + 3;
                            OTHERWISE ;
                            END;
                        (*ENDCASE*) 
                    (*ENDIF*) 
                    END;
                (*ENDWITH*) 
            (*ENDFOR*) 
        (*ENDWITH*) 
        (* check if short column file exists (needed in case we have *)
        (* to add a LONG table)                                      *)
        (* PTS 1115206 M.Ki. *)
        shrtcolexist    := (ak13count_short_cols (acv) > 0);
        init_long_cnt   := a_p_arr1.pbasep^.sbase.bstringcount;
        a1init_colcount := a_p_arr1.pbasep^.sbase.bmaxcol;
        default_cnt     := 0; (* PTS 1114336 M.Ki. *)
        REPEAT
            tlo           := a_ap_tree^[ a1ti ].n_lo_level;
            add_column    := false;
            CASE a_ap_tree^[ a1ti ].n_symb OF
                s_between :
                    BEGIN
                    a1constraint_cnt := a1constraint_cnt + 1;
                    WITH a1constraint_info[ a1constraint_cnt ] DO
                        BEGIN
                        tree_index := a1ti;
                        extcolno   := -1
                        END;
                    (*ENDWITH*) 
                    END;
                s_index :
                    IF  a1unique_node = 0
                    THEN
                        a1unique_node := a1ti;
                    (*ENDIF*) 
                s_identifier :
                    IF  a_p_arr1.pbasep^.sbase.bmaxcol >= MAX_COL_PER_TAB_GG00
                    THEN
                        a07_b_put_error (acv,e_too_many_columns,1)
                    ELSE
                        BEGIN
                        add_column := true;
                        a11one_column_def (acv, a11v)
                        END;
                    (*ENDIF*) 
                s_key :
                    a07_b_put_error (acv, e_key_not_allowed,
                          a_ap_tree^[a1ti].n_pos);
                (* PTS 1111002 E.Z. *)
                OTHERWISE
                    IF  a1temp_table
                    THEN
                        a07_b_put_error (acv,
                              e_not_allowed_in_temp_table,
                              a_ap_tree^[ a1ti ].n_pos)
                    ELSE
                        IF  a1foreign_key_node = 0
                        THEN
                            a1foreign_key_node := a1ti
                        (*ENDIF*) 
                    (*ENDIF*) 
                END;
            (*ENDCASE*) 
            IF  (a_returncode = 0) AND add_column
            THEN
                WITH a1colptr^, ccolstack DO
                    BEGIN
                    (* PTS 1114336 M.Ki. *)
                    IF  (ctdefault in ccolpropset) OR
                        (ctserial in ccolpropset)
                    THEN
                        IF  (cdatatyp in
                            [dstra, dstre, dstruni, dstrb,
                            dlonga, dlonge, dlonguni, dlongb])
                        THEN
                            BEGIN
                            a061get_colname (a1colptr^, colname);
                            a07_nb_put_error (acv,
                                  e_default_spec_not_allowed,
                                  a_ap_tree^[ tlo ].n_pos,
                                  colname);
                            END
                        ELSE
                            BEGIN
                            default_added[ cextcolno ] := true;
                            default_cnt                := succ (default_cnt);
                            END
                        (*ENDIF*) 
                    ELSE
                        default_added[ cextcolno ] := false;
                    (*ENDIF*) 
                    IF  a_returncode = 0
                    THEN
                        BEGIN
                        WITH a_p_arr1.pbasep^.sbase DO
                            BEGIN
                            IF  ccolstack.etype = st_varlongchar
                            THEN
                                BEGIN
                                blongvarcolcnt := blongvarcolcnt + 1;
                                ecolno         := blongvarcolcnt
                                END;
                            (*ENDIF*) 
                            END;
                        (*ENDWITH*) 
                        owner := a01_il_b_identifier;
                        a06determine_username (acv,
                              a_p_arr1.pbasep^.sbase.bauthid, owner);
                        a13store_col_alter_date (acv, a_p_arr1, a1colptr^)
                        END;
                    (*ENDIF*) 
                    END;
                (*ENDWITH*) 
            (*ENDIF*) 
            a1ti := tlo;
        UNTIL
            (a1ti = 0) OR (a_returncode <> 0);
        (*ENDREPEAT*) 
        IF  a_returncode = 0
        THEN
            BEGIN
            WITH a_p_arr1.pbasep^.sbase DO
                bstringcount := bstringcount + a1strcolcount;
            (*ENDWITH*) 
            a10alter_long_version (acv, a_p_arr1.pbasep^.sbase,
                  init_long_cnt, m_succ_file_version, NOT c_scan_views);
            (* PTS 1115206 M.Ki. *)
            IF  (a1strcolcount > a1long_col_cnt) AND
                (NOT shrtcolexist)               AND
                (a_returncode = 0)
            THEN
                WITH a_transinf DO
                    BEGIN
                    tri_trans.trError_gg00 := e_ok;
                    k64short_col_file_create (tri_trans,
                          a_p_arr1.pbasep^.sbase.btreeid);
                    IF  tri_trans.trError_gg00 <> e_ok
                    THEN
                        a07_b_put_error (acv, tri_trans.trError_gg00, 1);
                    (*ENDIF*) 
                    END
                (*ENDWITH*) 
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        a1ti   := coldef_ti;
        a1sort := true;
&       ifdef TRACE
        t01int4 (ak_sem, 'bmaxcol     ',
              a_p_arr1.pbasep^.sbase.bmaxcol);
        t01int4 (ak_sem, 'maxreclen   ', a1reclen);
&       endif
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13check_compatibility (
            VAR acv               : tak_all_command_glob;
            old_base_p            : tak_sysbufferaddress;
            VAR old_col           : tak00_columninfo;
            VAR new_base_required : boolean;
            VAR modify_colset     : tak_columnset;
            VAR index_drop_set    : tak_columnset;
            VAR e                 : tgg00_BasisError);
 
VAR
      do_skip     : boolean;
      aux_propset : tak00_colpropset;
      columnName  : tsp00_KnlIdentifier;
 
BEGIN
WITH acv DO
    BEGIN
    e       := e_ok;
    do_skip := false;
&   ifdef trace
    t01buf (ak_sem, old_col, 1, sizeof (old_col));
    WITH a_p_arr1.pbasep^.sbase DO
        t01buf (ak_sem,
              bcolumn[blastindex]^, 1, sizeof (old_col));
    (*ENDWITH*) 
&   endif
    IF  a_returncode = 0
    THEN
        WITH a_p_arr1.pbasep^.sbase,
             bcolumn[blastindex]^ DO
            BEGIN
            IF  cdatatyp = old_col.cdatatyp
            THEN
                BEGIN
                IF  ((old_col.ccolstack.etype in
                    [st_fixkey, st_fixcol]) AND
                    (old_col.cinoutlen <> cinoutlen))
                    OR
                    (old_col.ccolstack.etype <> ccolstack.etype)
                THEN
                    BEGIN
                    IF  old_col.ccolstack.etype = st_fixkey
                    THEN (* all indexes must be dropped *)
                        index_drop_set := a01fullset;
                    (*ENDIF*) 
                    new_base_required := true
                    END
                ELSE
                    IF  ((cdatatyp = dfixed) AND
                        cbinary             AND
                        NOT old_col.cbinary)
                        OR
                        ((cdatatyp = dfixed) AND
                        ((old_col.cdatafrac > cdatafrac) OR
                        ( old_col.cdatalen  > cdatalen )))
                        OR
                        ((cdatatyp in [dcha, dchb, dche, dunicode]) AND
                        (cbinary <> old_col.cbinary))
                    THEN
                        new_base_required := true
                    ELSE
                        do_skip := (cinoutlen = old_col.cinoutlen) AND
                              (cbinary = old_col.cbinary); (* PTS 1121474 *)
                    (*ENDIF*) 
                (*ENDIF*) 
                END
            ELSE
                BEGIN
                CASE cdatatyp OF
                    dcha, dche, dchb, dunicode,
                    ddate, dtime, dtimestamp :
                        IF  NOT (old_col.cdatatyp in
                            [dcha, dche, dunicode, ddate,
                            dtime, dtimestamp])
                        THEN
                            e := e_incompatible_datatypes
                        ELSE
                            BEGIN
                            IF  old_col.ccolstack.etype = st_fixkey
                            THEN (* all indexes must be dropped *)
                                index_drop_set := a01fullset
                            ELSE
                                IF  (ctmulti in old_col.ccolpropset)
                                    AND
                                    (ccolstack.etype = st_varlongchar)
                                THEN
                                    BEGIN
                                    (* PTS 1112556 *)
                                    a061get_colname (bcolumn[blastindex]^, columnName);
                                    a07_nb_put_error (acv, e_too_long_key,
                                          1, columnName)
                                    END;
                                (*ENDIF*) 
                            (*ENDIF*) 
                            new_base_required := true;
                            END;
                        (*ENDIF*) 
                    dfixed :
                        IF  old_col.cdatatyp <> dfloat
                        THEN
                            e := e_incompatible_datatypes
                        ELSE
                            IF  old_col.cinoutlen <> cinoutlen
                            THEN
                                new_base_required := true;
                            (*ENDIF*) 
                        (*ENDIF*) 
                    dfloat :
                        IF  old_col.cdatatyp <> dfixed
                        THEN
                            e := e_incompatible_datatypes
                        ELSE
                            IF  old_col.cinoutlen <> cinoutlen
                            THEN
                                new_base_required := true;
                            (*ENDIF*) 
                        (*ENDIF*) 
                    OTHERWISE
                        e := e_incompatible_datatypes;
                    END;
                (*ENDCASE*) 
                END;
            (*ENDIF*) 
            IF  e = e_ok
            THEN
                BEGIN
                aux_propset := old_col.ccolpropset - [ctopt, ctdefault];
                ccolpropset := ccolpropset + aux_propset;
                IF  NOT do_skip
                THEN
                    modify_colset := modify_colset + [cextcolno];
                (*ENDIF*) 
                IF  ((cdatatyp  <> old_col.cdatatyp) OR
                    ( cdatalen  <> old_col.cdatalen) OR
                    ( cdatafrac <> old_col.cdatafrac))
                THEN
                    ak13check_ref_column (acv, old_base_p, old_col, e)
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            END;
        (*ENDWITH*) 
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13colset_drop (
            privbuf    : tak_sysbufferaddress;
            VAR priv   : tak_privilege;
            VAR colset : tak_columnset;
            VAR empty  : boolean;
            VAR repl   : boolean);
 
VAR
      i       : tak_priv_descriptors;
      oldpriv : tak_privilege;
      newpriv : tak_privilege;
 
BEGIN
newpriv := a01emptypriv;
a06unpack_priv (priv, newpriv);
oldpriv                    := newpriv;
newpriv.priv_sel_set       := newpriv.priv_sel_set - colset;
newpriv.priv_upd_set       := newpriv.priv_upd_set - colset;
newpriv.priv_grant_sel_set := newpriv.priv_grant_sel_set - colset;
newpriv.priv_grant_upd_set := newpriv.priv_grant_upd_set - colset;
FOR i := priv_col_sel TO priv_col_upd_grant DO
    IF  newpriv.priv_col[ i ] = [  ]
    THEN
        newpriv.priv_col_exist := newpriv.priv_col_exist - [ i ];
    (*ENDIF*) 
(*ENDFOR*) 
empty := newpriv.priv_c132 = a01emptypriv.priv_c132;
repl  := (newpriv.priv_c132 <> oldpriv.priv_c132) AND NOT empty;
a22pack_priv (privbuf, newpriv, priv)
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13constraint_reconstruction (
            VAR acv  : tak_all_command_glob;
            VAR a11v : tak_a11_glob;
            colset   : tak_columnset);
 
VAR
      b_err   : tgg00_BasisError;
      i       : integer;
      j       : integer;
      sysk    : tgg00_SysInfoKey;
 
BEGIN
WITH acv, a11v DO
    BEGIN
&   ifdef trace
    FOR i := 1 TO MAX_COL_PER_TAB_GG00 DO
        IF  i in colset
        THEN
            t01int4 (ak_sem, 'modified col', i);
&       endif
        (*ENDIF*) 
    (*ENDFOR*) 
    sysk           := a_p_arr1.pbasep^.syskey;
    sysk.sentrytyp := cak_econstraint;
    i              := 1;
    WHILE (a_returncode = 0) AND
          (i <= a_p_arr1.pbasep^.sbase.bnamed_constr) DO
        BEGIN (* check if constraint must be reconstructed *)
        sysk.slinkage[1] := chr(i DIV 256);
        sysk.slinkage[2] := chr(i MOD 256);
        a10get_sysinfo (acv, sysk, d_release, a_ptr1, b_err);
        IF  b_err = e_ok
        THEN
            WITH a_ptr1^.sconstraint DO
                BEGIN
&               ifdef trace
                FOR j := 1 TO MAX_COL_PER_TAB_GG00 DO
                    IF  j in ccolset
                    THEN
                        t01int4 (ak_sem, 'in constrain', j);
&                   endif
                    (* reconstruct constraint *)
                    (*ENDIF*) 
                (*ENDFOR*) 
                a1add_rec         := false;
                a11getconstraintname (a_ptr1^.sconstraint,
                      a1constraint_name);
                a10_key_del (acv, sysk);
                a11constraint (acv, a11v,
                      a_p_arr1.pbasep^.sbase, i)
                END
            (*ENDWITH*) 
        ELSE
            a07_b_put_error (acv, b_err, 1);
        (*ENDIF*) 
        i := i + 1
        END;
    (*ENDWHILE*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13domain_migration (
            VAR acv  : tak_all_command_glob;
            VAR a11v : tak_a11_glob);
 
VAR
      dom_ref     : tak_sysbufferaddress;
      dom_def     : tak_sysbufferaddress;
      owner       : tsp00_KnlIdentifier;
      domain_name : tsp00_KnlIdentifier;
 
BEGIN
WITH acv, a11v DO
    BEGIN
    a1ti := a_ap_tree^[a1ti].n_sa_level;
    a12get_domain (acv, owner, domain_name, a1ti,
          dom_ref, dom_def);
    IF  a_returncode = 0
    THEN
        a11domain_usage (acv, a11v,
              dom_ref^.sdomainref.downer, domain_name,
              dom_def^.sdomain.dom_surrogate,
              a1colptr^.cextcolno);
    (*ENDIF*) 
    IF  a_returncode = 0
    THEN
        a1colptr^.ccolpropset := a1colptr^.ccolpropset + [ctdomain]
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13add_constraint (
            VAR acv          : tak_all_command_glob;
            VAR a11v         : tak_a11_glob;
            VAR verify       : tverify_operation);
 
BEGIN
WITH acv, a11v DO
    BEGIN
    a_is_ddl                          := ddl_add_constraint;
    a1ti                              := a_ap_tree^[ a1ti ].n_sa_level;
    a1constraint_cnt                  := 1;
    a1constraint_info[ 1 ].tree_index := a1ti;
    verify                            := [verify_range]
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13alter_drop_constraint (
            VAR acv          : tak_all_command_glob;
            VAR a11v         : tak_a11_glob;
            drop_constraint  : boolean;
            VAR viewscanpar  : tak_viewscan_par;
            VAR verify       : tverify_operation;
            VAR constraintId : integer);
 
VAR
      b_err      : tgg00_BasisError;
      sysk       : tgg00_SysInfoKey;
 
BEGIN
WITH acv, a11v DO
    BEGIN
    a1ti := a_ap_tree^[ a1ti ].n_lo_level;
    a05identifier_get (acv, a1ti, sizeof (a1coln), a1coln);
    viewscanpar.vsc_type := v_version;
    sysk                 := a_p_arr1.pbasep^.syskey;
    sysk.sentrytyp       := cak_econstraintname;
    sysk.sidentifier     := a1coln;
    sysk.skeylen         := mxak_standard_sysk + sizeof (sysk.sidentifier);
    a10get_sysinfo (acv, sysk,
          d_release, a_ptr1, b_err);
    IF  b_err <> e_ok
    THEN (* PTS 1118454 M.Ki. *)
        IF  (b_err = e_sysinfo_not_found) AND drop_constraint
        THEN
            BEGIN (* check if constraint is actually a named foreign key *)
            a25drop_foreign_link (acv, a_p_arr1.pbasep^.syskey, a1coln);
            IF  acv.a_transinf.tri_trans.trError_gg00 <> e_ok
            THEN
                BEGIN
                IF  acv.a_transinf.tri_trans.trError_gg00 = e_sysinfo_not_found
                THEN
                    a07_nb_put_error (acv,
                          e_unknown_constraint, a_ap_tree^[ a1ti ].n_pos, a1coln)
                ELSE
                    a07_b_put_error (acv,
                          acv.a_transinf.tri_trans.trError_gg00, -1);
                (*ENDIF*) 
                END
            (*ENDIF*) 
            END
        ELSE
            IF  b_err = e_sysinfo_not_found (* PTS 1132968 *)
            THEN
                a07_nb_put_error (acv,
                      e_unknown_constraint, a_ap_tree^[ a1ti ].n_pos, a1coln)
            ELSE
                a07_b_put_error (acv, b_err, 1)
            (*ENDIF*) 
        (*ENDIF*) 
    ELSE
        IF  drop_constraint
        THEN
            ak13drop_constraint (acv, a11v)
        ELSE
            BEGIN
            a_is_ddl             := ddl_alter_constraint;
            a1ti                 := a_ap_tree^[ a1ti ].n_lo_level;
            a1add_rec            := false;
            verify               := [verify_range];
            constraintId         := a_ptr1^.sconstrname.cnid; (* PTS 1116788 *)
            a11condition (acv, a11v,
                  constraintId, cak_is_undefined)
            END;
        (*ENDIF*) 
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13alter_sample (
            VAR acv    : tak_all_command_glob;
            tree_index : integer);
 
VAR
      sa_level : integer;
 
BEGIN
WITH acv, a_p_arr1.pbasep^.sbase DO
    BEGIN
&   ifdef trace
    t01int4 (ak_sem, 'tree_index  ', tree_index);
&   endif
    sa_level := a_ap_tree^[tree_index].n_sa_level;
    WITH a_ap_tree^[sa_level] DO
        a05_int4_unsigned_get (acv, n_pos, n_length, bsample);
    (*ENDWITH*) 
    IF  a_ap_tree^[tree_index].n_length = cak_i_percent
    THEN
        IF  (bsample < 1) OR (bsample > 100)
        THEN
            a07_b_put_error (acv,
                  e_invalid_unsign_integer, a_ap_tree^[sa_level].n_pos)
        ELSE
            bsample := -bsample
        (*ENDIF*) 
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13alter_bad (
            VAR acv    : tak_all_command_glob);
 
BEGIN
bd01SetToBad (acv.a_transinf.tri_trans, acv.a_p_arr1.pbasep^.sbase.btreeid);
(* don't check the error, will be bad page *)
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13alter_table_type (
            VAR acv    : tak_all_command_glob);
 
VAR
      b_err  : tgg00_BasisError;
      sysbuf : tak_sysbufferaddress;
      sysk   : tgg00_SysInfoKey;
 
BEGIN
WITH acv DO
    BEGIN
    sysk.sauthid     := a_p_arr1.pbasep^.sbase.bauthid;
    sysk.sidentifier := a_p_arr1.pbasep^.sbase.btablen^;
    sysk.sentrytyp   := cak_etableref;
    sysk.slinkage    := cak_init_linkage;
    sysk.skeylen     := mxak_standard_sysk + sizeof (sysk.sidentifier);
    a10get_sysinfo (acv, sysk, d_release, sysbuf, b_err);
    IF  b_err = e_ok
    THEN
        BEGIN
        sysbuf^.stableref.rsystable := false;
        a10repl_sysinfo (acv, sysbuf, b_err)
        END;
    (*ENDIF*) 
    IF  b_err <> e_ok
    THEN
        a07_b_put_error (acv, b_err, 1)
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13alter_attribute (
            VAR acv          : tak_all_command_glob;
            attribute        : integer;
            remove_attribute : boolean);
 
BEGIN
WITH acv, a_p_arr1.pbasep^.sbase DO
    BEGIN
    CASE attribute OF
        cak_x_alter_fact :
            BEGIN
            IF  remove_attribute
            THEN
                battributes  := battributes - [ ta_fact ]
            ELSE
                battributes  := battributes + [ ta_fact ]
            (*ENDIF*) 
            END;
        cak_x_alter_dimension :
            BEGIN
            IF  remove_attribute
            THEN
                battributes  := battributes - [ ta_dimension ]
            ELSE
                battributes  := battributes + [ ta_dimension ];
            (*ENDIF*) 
            END;
        cak_x_alter_bwhierarchy :
            BEGIN
            IF  remove_attribute
            THEN
                battributes  := battributes - [ ta_bwhierarchy ]
            ELSE
                battributes  := battributes + [ ta_bwhierarchy ];
            (*ENDIF*) 
            END;
        OTHERWISE :
            BEGIN
            END;
        END;
    (*ENDCASE*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13alter_dynamic (
            VAR acv          : tak_all_command_glob;
            remove_dynamic   : boolean);
 
VAR
      b_err        : tgg00_BasisError;
 
BEGIN
WITH acv, a_p_arr1.pbasep^.sbase DO
    BEGIN
    IF  remove_dynamic
    THEN
        btreeid.fileType_gg00 := btreeid.fileType_gg00 - [ftsDynamic_egg00]
    ELSE
        btreeid.fileType_gg00 := btreeid.fileType_gg00 + [ftsDynamic_egg00];
    (*ENDIF*) 
    a06a_mblock_init (acv, m_change, mm_file, btreeid);
    a06rsend_mess_buf (acv, a_mblock, cak_return_req, b_err);
    IF  b_err <> e_ok
    THEN
        a07_b_put_error (acv, b_err, 1)
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13check_default (
            VAR acv          : tak_all_command_glob;
            VAR a11v         : tak_a11_glob;
            VAR colinfo      : tak00_columninfo);
 
VAR
      b_err  : tgg00_BasisError;
      i      : integer;
      sysk   : tgg00_SysInfoKey;
 
BEGIN
WITH acv, a11v DO
    BEGIN
    sysk           := a_p_arr1.pbasep^.syskey;
    sysk.sentrytyp := cak_econstraint;
    i              := 1;
    WHILE (i <= a_p_arr1.pbasep^.sbase.bnamed_constr) AND
          (a_returncode = 0) DO
        BEGIN
        sysk.slinkage[1] := chr(i DIV 256);
        sysk.slinkage[2] := chr(i MOD 256);
        a10get_sysinfo (acv, sysk, d_release,
              a_ptr1, b_err);
        IF  b_err = e_ok
        THEN
            BEGIN
            IF  a_ptr1^.sconstraint.ccolset = [ colinfo.creccolno ]
            THEN
                a14constraint_check (acv, colinfo, i, 1);
            (*ENDIF*) 
            END
        ELSE
            a07_b_put_error (acv, b_err, 1);
        (*ENDIF*) 
        i := i + 1
        END;
    (*ENDWHILE*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13check_domain_ref (
            VAR acv          : tak_all_command_glob;
            VAR base_arr     : tak_syspointerarr;
            VAR col_info     : tak00_columninfo;
            VAR owner_id     : tgg00_Surrogate;
            VAR old_dom_name : tsp00_KnlIdentifier);
 
VAR
      ix                : integer;
      jx                : integer;
      dom_ref           : tak_sysbufferaddress;
      curr_dom_owner_id : tgg00_Surrogate;
      curr_dom_name     : tsp00_KnlIdentifier;
 
BEGIN
(* checks, if old_dom_name is used by any other column of   *)
(* table identified by base_arr. If not, the reference is   *)
(* deleted from the usage record of the domain old_dom_name *)
WITH acv DO
    BEGIN
    WITH base_arr.pbasep^.sbase DO
        BEGIN
        jx := bfirstindex;
        WHILE jx <= blastindex DO
            WITH bcolumn[jx]^ DO
                BEGIN
                IF  (cextcolno <> col_info.cextcolno) AND
                    (ctdomain in ccolpropset)
                THEN
                    BEGIN
                    ak13get_domain_name (acv,
                          base_arr, cextcolno,
                          curr_dom_owner_id, curr_dom_name);
                    IF  ((curr_dom_owner_id = owner_id) AND
                        (curr_dom_name = old_dom_name))
                        OR
                        (a_returncode <> 0)
                    THEN
                        BEGIN
                        ix := c_found;
                        jx := c_found
                        END;
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
                jx := jx + 1
                END;
            (*ENDWITH*) 
        (*ENDWHILE*) 
        END;
    (*ENDWITH*) 
    IF  (a_returncode = 0) AND (ix <> c_found)
    THEN
        BEGIN
        a12read_domain_ref (acv, owner_id, old_dom_name, dom_ref);
        IF  dom_ref <> NIL
        THEN
            a11del_usage_entry (acv,
                  dom_ref^.sdomainref.dsurrogate,
                  base_arr.pbasep^.syskey.stableid)
        ELSE
            a07ak_system_error (acv, 13, 4)
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      ak13chk_key_is_linked (
            VAR acv       : tak_all_command_glob;
            VAR pbasep    : tak_sysbufferaddress) : boolean;
 
VAR
      is_linked  : boolean;
      entry_count: integer;
      ix         : integer;
      scanned    : integer;
      count      : integer;
      link_count : integer;
      b_err      : tgg00_BasisError;
      sysbuf     : tak_sysbufferaddress;
      sysk       : tgg00_SysInfoKey;
 
BEGIN
b_err     := e_ok;
is_linked := false;
IF  is_primary_table in pbasep^.sbase.blinkexist
THEN
    BEGIN
    IF  unique_pk_table in pbasep^.sbase.blinkexist
    THEN
        BEGIN
        (* check, if old key is used by a referential *)
        (* constraint                                 *)
        scanned        := 0;
        count          := 0;
        sysk           := pbasep^.syskey;
        sysk.sentrytyp := cak_eprimarykey;
        REPEAT
            a10get_sysinfo (acv,
                  sysk, d_release, sysbuf, b_err);
            IF  b_err = e_ok
            THEN
                WITH sysbuf^.slink DO
                    BEGIN
                    IF  sysk.slinkage = cak_init_linkage
                    THEN
                        link_count := linkcount;
                    (*ENDIF*) 
                    entry_count := lreclen DIV sizeof (linkdef[1]);
                    FOR ix := 1 TO entry_count DO
                        WITH linkdef[ix] DO
                            IF  lindexid[1] = chr(0)
                            THEN (* key is used *)
                                is_linked := true;
                            (*ENDIF*) 
                        (*ENDWITH*) 
                    (*ENDFOR*) 
                    scanned := scanned + entry_count; (* PTS 1115359 *)
                    count   := count + entry_count;   (* M.Ki.       *)
                    IF  count >= cak_maxlinkdef
                    THEN
                        BEGIN
                        count := 0;
                        a06inc_linkage (sysk.slinkage)
                        END;
                    (*ENDIF*) 
                    END;
                (*ENDWITH*) 
            (*ENDIF*) 
        UNTIL
            (scanned = link_count) OR (b_err <> e_ok) OR is_linked;
        (*ENDREPEAT*) 
        END
    ELSE
        (* old key is used by a referential constraint *)
        is_linked := true;
    (*ENDIF*) 
    END;
(*ENDIF*) 
ak13chk_key_is_linked := is_linked;
IF  (b_err <> e_ok)
THEN
    a07_b_put_error (acv, b_err, 1)
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13check_key (
            VAR acv          : tak_all_command_glob;
            VAR a11v         : tak_a11_glob;
            VAR key_cnt      : integer;
            VAR key_cols     : tak_colinteger);
 
VAR
      ix             : integer;
      old_key_index  : integer;
      key_pos        : integer;
      err_pos        : integer;
      colname        : tsp00_KnlIdentifier;
      key_col_set    : tak_columnset;
 
BEGIN
WITH acv, a11v DO
    BEGIN
    key_pos     := 1;
    key_col_set := [];
    key_cnt     := 0;
    err_pos     := cak_is_undefined;
    WHILE (a1ti <> 0) AND (a_returncode = 0) DO
        BEGIN
        (* read in new primary key columns and check them *)
        WITH a_ap_tree^[a1ti] DO
            BEGIN
            IF  err_pos = cak_is_undefined
            THEN
                err_pos := n_pos;
            (*ENDIF*) 
            a05identifier_get (acv, a1ti,
                  sizeof (colname), colname);
            IF  NOT (a061exist_columnname (a_p_arr1.pbasep^.sbase, colname,
                a1colptr))
            THEN
                a07_nb_put_error (acv, e_unknown_columnname,
                      n_pos, colname)
            ELSE
                WITH a1colptr^ DO
                    BEGIN
                    IF  (cdatatyp in [dstra, dstre, dstruni, dstrb,
                        dlonga, dlonge, dlonguni, dlongb])
                        OR
                        ((ctkey in ccolpropset) AND
                        (ctopt in ccolpropset))
                    THEN
                        a07_b_put_error (acv,
                              e_key_not_allowed, n_pos)
                    ELSE
                        BEGIN
                        key_pos := key_pos + cinoutlen;
&                       ifdef trace
                        t01buf (ak_sem,
                              a1colptr^, 1, 44);
                        t01int4 (ak_sem, 'key_pos     ', key_pos);
&                       endif
                        IF  (key_pos > mxsp_key + 1) OR
                            (key_cnt >= cak_maxkeyfields)
                        THEN
                            a07_b_put_error (acv, e_too_long_key,
                                  a_ap_tree^[a1ti].n_pos)
                        ELSE
                            IF  cextcolno in key_col_set
                            THEN
                                a07_b_put_error (acv,
                                      e_duplicate_columnname,
                                      a_ap_tree^[a1ti].n_pos)
                            ELSE
                                BEGIN
                                key_cnt           := key_cnt + 1;
                                key_col_set       := key_col_set +
                                      [cextcolno];
                                key_cols[key_cnt] := cextcolno
                                END;
                            (*ENDIF*) 
                        (*ENDIF*) 
                        END;
                    (*ENDIF*) 
                    END;
                (*ENDWITH*) 
            (*ENDIF*) 
            a1ti := n_sa_level
            END;
        (*ENDWITH*) 
        END;
    (*ENDWHILE*) 
    WITH a_p_arr1.pbasep^.sbase DO
        IF  (key_cnt = bkeycolcount) AND (a_returncode = 0)
        THEN
            BEGIN (* check if new and old key definition are equal *)
            old_key_index := bfirstcolind;
            ix            := 1;
            WHILE ix <= key_cnt DO
                WITH a_p_arr1.pbasep^.sbase.
                     bcolumn[old_key_index]^ DO
                    BEGIN
&                   ifdef trace
                    t01int4 (ak_sem, 'old colno   ', cextcolno);
                    t01int4 (ak_sem, 'new colno   ', key_cols[ix]);
&                   endif
                    IF  cextcolno = key_cols[ix]
                    THEN
                        BEGIN
                        ix            := ix + 1;
                        old_key_index := cnextind
                        END
                    ELSE
                        ix := csp_maxint2;
                    (*ENDIF*) 
                    END;
                (*ENDWITH*) 
            (*ENDWHILE*) 
            IF  ix <> csp_maxint2
            THEN (* old and new key are equal *)
                a_returncode := cak13_err_return
            (*ENDIF*) 
            END;
        (*ENDIF*) 
    (*ENDWITH*) 
    IF  (a_returncode = 0) AND
        ak13chk_key_is_linked (acv, a_p_arr1.pbasep) (* PTS 1115359 M.Ki. *)
    THEN
        (* old key has referential constraints => *)
        (* new key not allowed                    *)
        a07_b_put_error (acv, e_key_not_allowed, err_pos)
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13determine_domain_names (
            VAR acv          : tak_all_command_glob;
            VAR drop_col_set : tak_columnset;
            VAR dom_desc     : tak13domain_info);
 
VAR
      jx    : integer;
 
BEGIN
WITH acv, dom_desc DO
    BEGIN
    dd_valid_dom_cnt := 0;
    dd_del_dom_cnt   := 0;
    dd_determined    := true;
    WITH a_p_arr1.pbasep^.sbase DO
        FOR jx := bfirstindex TO blastindex DO
            WITH bcolumn[jx]^ DO
                IF  (ctdomain in ccolpropset)             AND
                    NOT (cextcolno in drop_col_set) AND
                    (a_returncode = 0)
                THEN
                    BEGIN
                    dd_valid_dom_cnt := dd_valid_dom_cnt + 1;
                    ak13get_domain_name (acv,
                          a_p_arr1, cextcolno,
                          dd_dom_owners[dd_valid_dom_cnt],
                          dd_dom_names [dd_valid_dom_cnt])
                    END;
                (*ENDIF*) 
            (*ENDWITH*) 
        (*ENDFOR*) 
    (*ENDWITH*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13drop_constraint (
            VAR acv          : tak_all_command_glob;
            VAR a11v         : tak_a11_glob);
 
VAR
      last_found : boolean;
      b_err      : tgg00_BasisError;
      id         : integer;
      qual       : tak_del_tab_qual;
      sysk       : tgg00_SysInfoKey;
      new_sysk   : tgg00_SysInfoKey;
 
BEGIN
WITH acv, a11v DO
    BEGIN
    a_is_ddl             := ddl_drop_constraint;
    sysk                 := a_ptr1^.syskey;
    qual.del_qual_cnt    := 2;
    qual.del_qual[ 1 ]   := cak_eviewdesc;
    qual.del_qual[ 2 ]   := cak_econstraint;
    id                   := a_ptr1^.sconstrname.cnid;
    qual.del_colno       := id;
    a10_del_tab_sysinfo (acv,
          a_p_arr1.pbasep^.syskey.stableid,
          qual, false, b_err);
    IF  b_err = e_ok
    THEN
        a10del_sysinfo (acv, sysk, b_err);
    (*ENDIF*) 
    IF  (id < a_p_arr1.pbasep^.sbase.bnamed_constr) AND
        (b_err = e_ok)
    THEN
        BEGIN
        (* assign id of dropped constraint to constraint *)
        (* with highest id                               *)
        sysk.skeylen := mxak_standard_sysk;
        (* find constraint with highest constraint id *)
        REPEAT
            a10next_sysinfo (acv, sysk,
                  SURROGATE_MXGG00+2, d_release,
                  cak_econstraintname, a_ptr1, b_err);
            IF  b_err = e_ok
            THEN
                last_found := a_ptr1^.sconstrname.cnid =
                      a_p_arr1.pbasep^.sbase.bnamed_constr;
            (*ENDIF*) 
        UNTIL
            last_found OR (b_err <> e_ok);
        (*ENDREPEAT*) 
        IF  last_found
        THEN
            BEGIN
            sysk.sentrytyp     := cak_eviewdesc;
            sysk.slinkage[ 1 ] :=
                  chr (a_ptr1^.sconstrname.cnid DIV 256);
            sysk.slinkage[ 2 ] :=
                  chr (a_ptr1^.sconstrname.cnid MOD 256);
            sysk.skeylen           := mxak_standard_sysk;
            new_sysk               := sysk;
            new_sysk.slinkage[ 1 ] := chr(id DIV 256);
            new_sysk.slinkage[ 2 ] := chr(id MOD 256);
            a10_copy_catalog_rec (acv,
                  sysk, true, new_sysk,
                  a_p_arr1.pbasep^.sbase.bsegmentid,
                  c_add_rec, b_err);
            IF  b_err = e_ok
            THEN
                BEGIN
                sysk.sentrytyp     := cak_econstraint;
                new_sysk.sentrytyp := cak_econstraint;
                a10_copy_catalog_rec (acv,
                      sysk, true, new_sysk,
                      a_p_arr1.pbasep^.sbase.bsegmentid,
                      c_add_rec, b_err)
                END;
            (*ENDIF*) 
            IF  b_err = e_ok
            THEN
                BEGIN
                a_ptr1^.sconstrname.cnid := id;
                a10repl_sysinfo (acv, a_ptr1, b_err)
                END;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  b_err <> e_ok
    THEN
        a07_b_put_error (acv, b_err, 1)
    ELSE
        a_p_arr1.pbasep^.sbase.bnamed_constr :=
              a_p_arr1.pbasep^.sbase.bnamed_constr - 1;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13drop_col_dependant_obj (
            VAR acv          : tak_all_command_glob;
            VAR a11v         : tak_a11_glob;
            VAR viewscanpar  : tak_viewscan_par);
 
VAR
      b_err               : tgg00_BasisError;
      ix                  : integer;
      pSequence           : tak_sysbufferaddress;
      dom_id              : tgg00_Surrogate;
      qual                : tak_del_tab_qual;
      dom_desc            : tak13domain_info;
      sysk                : tgg00_SysInfoKey;
 
BEGIN
WITH acv.a_p_arr1  DO
    BEGIN
    (* procedure is executed in the course of a alter table     *)
    (* drop column order. All catalog information depending     *)
    (* on the dropped columns are dropped, i.e.                 *)
    (* dfaults of the columns,                                  *)
    (* single indexes defined on the columns,                   *)
    (* domain references, if the column is defined via a domain *)
    (* comments defined for the column,                         *)
    (* alter date information of the column                     *)
    (* all constraints containing a dropped column              *)
    qual.del_qual_cnt   := 3;
    qual.del_qual [ 1 ] := cak_edefault;
    qual.del_qual [ 2 ] := cak_edomainusage;
    qual.del_qual [ 3 ] := cak_ealterdate;
    dom_desc.dd_determined := false;
&   ifdef trace
    FOR ix := 1 TO viewscanpar.vsc_dr_col.dcount DO
        a061td_colinfo (viewscanpar.vsc_dr_col.dcol[ix].dcolptr^, ix);
    (*ENDFOR*) 
&   endif
    ix := 1;
    WHILE (ix <= viewscanpar.vsc_dr_col.dcount) AND (acv.a_returncode = 0) DO
        WITH viewscanpar.vsc_dr_col.dcol[ ix ], dcolptr^ DO
            BEGIN
            IF  ctcomment in ccolpropset
            THEN
                a26drop_comment (acv, cm_column,
                      acv.a_p_arr1.pbasep^.syskey.stableid,
                      acv.a_p_arr1.pbasep^.syskey.stableid,
                      cextcolno);
            (*ENDIF*) 
            IF  ctdomain in ccolpropset
            THEN
                BEGIN
                IF  NOT dom_desc.dd_determined
                THEN
                    ak13determine_domain_names (acv,
                          viewscanpar.vsc_drop_set, dom_desc);
                (*ENDIF*) 
                IF  NOT ak13in_rest_domains (acv,
                    dom_desc, cextcolno, dom_id)
                THEN
                    a11del_usage_entry (acv, dom_id,
                          acv.a_p_arr1.pbasep^.syskey.stableid)
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            IF  ((ctdefault in ccolpropset) OR
                (ctaltered  in ccolpropset) OR
                (ctdomain   in ccolpropset))
                AND
                (acv.a_returncode = 0)
            THEN
                BEGIN
                qual.del_colno := cextcolno;
                a10_del_tab_sysinfo (acv,
                      acv.a_p_arr1.pbasep^.syskey.stableid,
                      qual, false, b_err);
                IF  b_err <> e_ok
                THEN
                    a07_b_put_error (acv, b_err, 1);
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            IF  (ctserial in ccolpropset) (* PTS 1111778 *)
            THEN
                BEGIN
                sysk           := acv.a_p_arr1.pbasep^.syskey;
                sysk.sentrytyp := cak_esequence;
                a10get_sysinfo (acv, sysk, d_release, pSequence, b_err);
                IF  b_err = e_ok
                THEN
                    BEGIN
                    ak13FlushSequenceForDrop (acv, pSequence^.ssequence, b_err);
                    IF  b_err = e_ok
                    THEN
                        (* remove from catalog *)
                        a10del_sysinfo (acv, sysk, b_err);
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
                IF  b_err <> e_ok
                THEN
                    a07_b_put_error (acv, b_err, 1);
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            ccolpropset := [ ctopt, ctdropped ];
            ix := ix + 1;
            END;
        (*ENDWITH*) 
    (*ENDWHILE*) 
    IF  (acv.a_returncode = 0) AND
        (acv.a_p_arr1.pbasep^.sbase.bnamed_constr > 0)
    THEN
        ak13constraint_handling (acv, a11v, viewscanpar)
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13FlushSequenceForDrop (
            VAR acv            : tak_all_command_glob;
            VAR sequenceRecord : tak_sequencerecord;
            VAR b_err          : tgg00_BasisError);
 
VAR
      ix        : integer;
      dummyLen  : integer;
      currVal   : tsp00_C32;
 
BEGIN
FOR ix := 2 TO sizeof(tsp00_Number) + 1 DO
    currVal[ix] := chr(0);
(*ENDFOR*) 
(* read the current sequence value and store it in catalog *)
a05_nextval_get (acv, mm_direct, sequenceRecord.seq_surrogate,
      sequenceRecord.seq_info, currVal, 1, dummyLen);
FOR ix := 1 TO sizeof(tsp00_Number) DO
    sequenceRecord.seq_value[ix] := currVal[ix+1];
(*ENDFOR*) 
(* flush the catalog, this is required in case of a following       *)
(* rollback. This flush provides the currval as before image of the *)
(* following catalog delete. (see call of this procedure)           *)
a23flush_sequence (acv.a_transinf.tri_trans,
      sequenceRecord.seq_surrogate,
      sequenceRecord.seq_value);
b_err := acv.a_transinf.tri_trans.trError_gg00;
IF  b_err = e_ok
THEN
    BEGIN
    (* remove sequence from sequence cache; PTS 1115774 M.Ki. *)
    a06a_mblock_init  (acv, m_nextval, mm_close,  b01niltree_id);
    s10mv (sizeof (sequenceRecord.seq_surrogate),
          acv.a_mblock.mb_qual_size,
          @sequenceRecord.seq_surrogate,
          1, @acv.a_mblock.mb_qual^.buf, 1,
          sizeof (sequenceRecord.seq_surrogate));
    acv.a_mblock.mb_qual_len := sizeof (sequenceRecord.seq_surrogate);
    a06rsend_mess_buf (acv, acv.a_mblock, cak_return_req, b_err);
    END;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13drop_indexes (
            VAR acv               : tak_all_command_glob;
            VAR a11v              : tak_a11_glob;
            VAR viewscanpar       : tak_viewscan_par;
            VAR base_arr          : tak_syspointerarr;
            VAR drop_colset       : tak_columnset;
            VAR drop_single_index : tak_columnset;
            drop_all_indexes      : boolean;
            mult_desc_ptr         : tgg00_StackListPtr;
            VAR mult_desc_cnt     : integer);
 
VAR
      drop_index     : boolean;
      k              : integer;
      desc_cnt       : integer;
      auxbuf         : tak_sysbufferaddress;
      index_scan_rec : tak_index_scan_record;
      prev_scan_rec  : tak_index_scan_record;
 
BEGIN
&ifdef trace
t01columnset( ak_sem, 'drop colset ', drop_colset );
t01columnset( ak_sem, 'drop sindexs', drop_single_index );
&endif
desc_cnt := 0;
IF  (acv.a_returncode = 0) AND
    (base_arr.pbasep^.sbase.bindexexist)
THEN
    BEGIN
    auxbuf   := acv.a_ptr1;
    a24init_index_scan (acv, a11v.a1tableid, index_scan_rec);
    prev_scan_rec := index_scan_rec;
    WHILE a24next_named_index (acv, index_scan_rec) DO
        WITH index_scan_rec, isr_buf^.smindex.indexdef[isr_index] DO
            BEGIN
            (* if a dropped or modified column is part of  *)
            (* the current index, drop the index           *)
            acv.a_ptr1     := isr_buf;
            drop_index := drop_all_indexes;
            k          := 1;
            WHILE (k <= icount) AND NOT (drop_index)  DO
                IF  (icolseq[k] in drop_colset)
                THEN (* index over dropped column OR  *)
                    (* index to be dropped caused by *)
                    (* alter table alter datatype    *)
                    drop_index := true
                ELSE
                    k := k + 1;
                (*ENDIF*) 
            (*ENDWHILE*) 
            IF  drop_index AND (viewscanpar.vsc_type = v_alter_drop)
            THEN
                BEGIN
                a24get_indexname (acv, isr_buf, isr_index,
                      viewscanpar.vsc_indexname);
                a24drop_multiple_index (acv, viewscanpar, 1, c_do_a38_input);
                IF  NOT base_arr.pbasep^.sbase.bindexexist
                THEN (* last index of table has been dropped *)
                    index_scan_rec.isr_buf := NIL
                ELSE
                    index_scan_rec := prev_scan_rec
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            IF  drop_index AND (viewscanpar.vsc_type <> v_alter_drop)
            THEN
                a24send_index_command_to_kb (acv, viewscanpar,
                      isr_index, m_drop, mm_index)
            ELSE
                IF  mult_desc_ptr <> NIL
                THEN
                    BEGIN
                    desc_cnt := desc_cnt + 1;
                    IF  desc_cnt > mult_desc_cnt
                    THEN
                        a07_b_put_error (acv,
                              e_too_many_mb_stackentries, 1)
                    ELSE
                        mult_desc_ptr^[desc_cnt] := icolstack[1]
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
            (*ENDIF*) 
            prev_scan_rec := index_scan_rec
            END;
        (*ENDWITH*) 
    (*ENDWHILE*) 
    a24finish_index_scan (acv, index_scan_rec);
    acv.a_ptr1        := auxbuf
    END;
(*ENDIF*) 
mult_desc_cnt := desc_cnt;
END;
 
(*------------------------------*) 
 
FUNCTION
      ak13default_or_null_foreign_key (
            VAR acv     : tak_all_command_glob;
            VAR tabid   : tgg00_Surrogate;
            VAR colInfo : tak00_columninfo;
            action      : integer) : boolean;
 
VAR
      is_default_foreign_key : boolean;
      b_err                  : tgg00_BasisError;
      analyzed               : integer;
      j                      : integer;
      link_count             : integer;
      index                  : integer; (* PTS 1115359 M.Ki. *)
      sysk                   : tgg00_SysInfoKey;
 
BEGIN
(* function returns true, if the column identified by *)
(* colInfo is foreign key column of a link            *)
(* defined with link rule ON DELETE SET DEFAULT/NULL  *)
WITH acv DO
    BEGIN
    is_default_foreign_key := false;
    IF  ctlink in colInfo.ccolpropset
    THEN
        BEGIN
        analyzed       := 0;
        index          := 0;
        sysk           := a01defaultkey;
        sysk.stableid  := tabid;
        sysk.sentrytyp := cak_eforeignkey;
        REPEAT
            a10get_sysinfo (acv, sysk, d_release,
                  a_ptr2, b_err);
            IF  b_err = e_ok
            THEN
                WITH a_ptr2^.slink DO
                    BEGIN
                    IF  sysk.slinkage = cak_init_linkage
                    THEN
                        link_count := linkcount;
                    (*ENDIF*) 
                    WHILE (analyzed < link_count)     AND  (* PTS 1115359 *)
                          (index < cak_maxlinkdef)    AND  (* M.Ki.       *)
                          (NOT is_default_foreign_key) DO
                        BEGIN
                        analyzed := analyzed + 1;
                        index    := index + 1;
                        WITH linkdef[ index ] DO
                            IF  laction = action
                            THEN
                                FOR j := 1 TO lcolcount DO
                                    IF  lseccolseq[ j ] = colInfo.creccolno
                                    THEN
                                        is_default_foreign_key := true;
                                    (*ENDIF*) 
                                (*ENDFOR*) 
                            (*ENDIF*) 
                        (*ENDWITH*) 
                        END;
                    (*ENDWHILE*) 
                    IF  index >= cak_maxlinkdef
                    THEN
                        BEGIN
                        index := 0;
                        a06inc_linkage (sysk.slinkage)
                        END;
                    (*ENDIF*) 
                    END
                (*ENDWITH*) 
            ELSE
                a07_b_put_error (acv, b_err, 1);
            (*ENDIF*) 
        UNTIL
            (analyzed = link_count) OR (a_returncode <> 0);
        (*ENDREPEAT*) 
        END;
    (*ENDIF*) 
    ak13default_or_null_foreign_key := is_default_foreign_key
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13constraint_handling (
            VAR acv         : tak_all_command_glob;
            VAR a11v        : tak_a11_glob;
            VAR viewscanpar : tak_viewscan_par);
 
VAR
      b_err      : tgg00_BasisError;
      constr_id  : integer;
      constr_key : tgg00_SysInfoKey;
      sysk       : tgg00_SysInfoKey;
      old_sysk   : tgg00_SysInfoKey;
      new_sysk   : tgg00_SysInfoKey;
      qual       : tak_del_tab_qual;
 
BEGIN
WITH acv, a11v, viewscanpar DO
    BEGIN
    constr_id  := 0;
    constr_key := a_p_arr1.pbasep^.syskey;
    constr_key.sentrytyp := cak_econstraint;
    constr_key.skeylen   := SURROGATE_MXGG00 + 2;
    sysk                 := constr_key;
    sysk.sentrytyp       := cak_econstraintname;
    sysk.skeylen         := mxak_standard_sysk + sizeof (sysk.sidentifier);
    qual.del_qual_cnt    := 2;
    qual.del_qual[ 1 ]   := cak_eviewdesc;
    qual.del_qual[ 2 ]   := cak_econstraint;
    REPEAT
        a10next_sysinfo (acv, constr_key, SURROGATE_MXGG00+2, d_release,
              cak_econstraint, a_ptr1, b_err);
        IF  b_err = e_ok
        THEN
            IF  a_ptr1^.sconstraint.ccolset * vsc_drop_set <> [  ]
            THEN
                BEGIN
                (* constraint contains a dropped column  *)
                (* ==> drop constraint, i.e. drop        *)
                (* tconstraintrecord and tviewdescrecord *)
                qual.del_colno :=
                      ord(a_ptr1^.syskey.slinkage[1]) * 256 +
                      ord(a_ptr1^.syskey.slinkage[2]);
                a11getconstraintname (a_ptr1^.sconstraint,
                      sysk.sidentifier);
                a10_del_tab_sysinfo (acv,
                      a_p_arr1.pbasep^.syskey.stableid,
                      qual, false, b_err);
                IF  b_err = e_ok
                THEN
                    a10del_sysinfo (acv, sysk, b_err)
                (*ENDIF*) 
                END
            ELSE
                BEGIN
                constr_id := constr_id + 1;
                IF  ord(a_ptr1^.syskey.slinkage[1]) * 256 +
                    ord(a_ptr1^.syskey.slinkage[2]) <> constr_id
                THEN
                    BEGIN
                    a11getconstraintname (a_ptr1^.sconstraint,
                          sysk.sidentifier); (* PTS 1117283 M.Ki. *)
                    a10get_sysinfo (acv, sysk, d_release,
                          a_ptr2, b_err);
                    IF  b_err = e_ok
                    THEN
                        BEGIN
                        a_ptr2^.sconstrname.cnid := constr_id;
                        a10repl_sysinfo (acv, a_ptr2, b_err)
                        END;
                    (*ENDIF*) 
                    IF  b_err = e_ok
                    THEN
                        BEGIN
                        old_sysk := constr_key;
                        new_sysk := constr_key;
                        new_sysk.slinkage[1] := chr(constr_id DIV 256);
                        new_sysk.slinkage[2] := chr(constr_id MOD 256);
                        a10_copy_catalog_rec (acv,
                              old_sysk, true, new_sysk,
                              a_p_arr1.pbasep^.sbase.bsegmentid,
                              c_add_rec, b_err)
                        END;
                    (*ENDIF*) 
                    IF  b_err = e_ok
                    THEN
                        BEGIN
                        old_sysk.sentrytyp := cak_eviewdesc;
                        new_sysk.sentrytyp := cak_eviewdesc;
                        a10_copy_catalog_rec (acv,
                              old_sysk, true, new_sysk,
                              a_p_arr1.pbasep^.sbase.bsegmentid,
                              c_add_rec, b_err)
                        END;
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
                END;
            (*ENDIF*) 
        (*ENDIF*) 
    UNTIL
        b_err <> e_ok;
    (*ENDREPEAT*) 
    IF  b_err <> e_no_next_record
    THEN
        a07_b_put_error (acv, b_err, 1)
    ELSE
        a_p_arr1.pbasep^.sbase.bnamed_constr := constr_id
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13get_domain_name (
            VAR acv          : tak_all_command_glob;
            VAR base_arr     : tak_syspointerarr;
            colno            : integer;
            VAR dom_owner_id : tgg00_Surrogate;
            VAR dom_name     : tsp00_KnlIdentifier);
 
VAR
      b_err  : tgg00_BasisError;
      sysbuf : tak_sysbufferaddress;
      sysk   : tgg00_SysInfoKey;
 
BEGIN
(* determines the owner and domain name of the domain referenced by *)
(* the column identified by colno. table description is             *)
(* expected in base_arr                                             *)
sysk             := base_arr.pbasep^.syskey;
sysk.sentrytyp   := cak_edomainusage;
sysk.slinkage[1] := chr (colno DIV 256);
sysk.slinkage[2] := chr (colno MOD 256);
a10get_sysinfo (acv, sysk, d_release, sysbuf, b_err);
IF  b_err = e_ok
THEN
    BEGIN
    dom_owner_id := sysbuf^.scol_uses_dom.cud_owner;
    dom_name     := sysbuf^.scol_uses_dom.cud_name
    END
ELSE
    a07_b_put_error (acv, b_err, 1)
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      ak13in_rest_domains (
            VAR acv      : tak_all_command_glob;
            VAR dom_info : tak13domain_info;
            colno        : integer;
            VAR dom_id   : tgg00_Surrogate) : boolean;
 
VAR
      ix           : integer;
      dom_ref      : tak_sysbufferaddress;
      dom_owner_id : tgg00_Surrogate;
      dom_name     : tsp00_KnlIdentifier;
 
BEGIN
(* finds out, if the domain referenced by the column identified by *)
(* colno is used by any other not dropped column of the table      *)
ak13get_domain_name (acv, acv.a_p_arr1, colno, dom_owner_id, dom_name);
IF  acv.a_returncode = 0
THEN
    WITH dom_info DO
        BEGIN
        ix := 1;
        WHILE ix <= dd_valid_dom_cnt DO
            IF  (dom_owner_id = dd_dom_owners[ix]) AND
                (dom_name = dd_dom_names[ix])
            THEN
                ix := c_found
            ELSE
                ix := ix + 1;
            (*ENDIF*) 
        (*ENDWHILE*) 
        IF  ix <> c_found
        THEN
            BEGIN
            ak13in_rest_domains := false;
            a12read_domain_ref (acv, dom_owner_id, dom_name, dom_ref);
            IF  dom_ref <> NIL
            THEN
                dom_id := dom_ref^.sdomainref.dsurrogate
            ELSE
                a07ak_system_error (acv, 13, 3)
            (*ENDIF*) 
            END
        ELSE
            ak13in_rest_domains := true;
        (*ENDIF*) 
        END;
    (*ENDWITH*) 
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13modify (
            VAR acv               : tak_all_command_glob;
            VAR a11v              : tak_a11_glob;
            VAR viewscanpar       : tak_viewscan_par;
            release_space         : boolean;
            VAR verify            : tverify_operation;
            VAR verify_cols       : tak_columnset;
            VAR verify_lengthcols : tak_columnset);
 
CONST
      c_max_mult_desc = 256;
 
VAR
      new_base              : boolean;
      null                  : boolean;
      not_null              : boolean;
      not_null_with_default : boolean;
      default_found         : boolean;
      error                 : tgg00_BasisError;
      bi                    : integer;
      ci                    : integer;
      colind                : integer;
      count                 : integer;
      ix                    : integer;
      lo_level              : integer;
      err_ti                : integer;
      mult_desc_cnt         : integer;
      aux                   : integer;
      min_reclen            : integer;
      packet_size           : tsp00_Int4;
      first_base            : ^tak_baserecord;
      mod_colset            : tak_columnset;
      aux_colset            : tak_columnset;
      index_drop_set        : tak_columnset;
      old_p_arr             : tak_syspointerarr;
      old_tabid             : tgg00_Surrogate;
      map                   : tak_colinteger;
      ext_map               : tak13ext_mapping;
      old_colp              : tak00_colinfo_ptr;
      new_colp              : tak00_colinfo_ptr;
      colname               : tsp00_KnlIdentifier;
      info                  : tsp00_C24;
      new_default    : ARRAY[1..MAX_COL_PER_TAB_GG00] OF boolean;
      mult_desc      : ARRAY[1..c_max_mult_desc] OF tgg00_StackEntry;
      qual           : tak_del_tab_qual;
 
BEGIN
WITH acv, a11v DO
    BEGIN
    verify            := [];
    verify_lengthcols := [];
    old_tabid         := cgg_zero_id;
    mult_desc_cnt     := 0;
    FOR ix := 1 TO c_max_ext_map DO
        BEGIN
        ext_map[ix].em_new_colp := NIL;
        ext_map[ix].em_old_colp := NIL
        END;
    (*ENDFOR*) 
    IF  release_space
    THEN
        a1ti := 0
    ELSE
        a1ti := a_ap_tree^[a1ti].n_lo_level;
    (*ENDIF*) 
&   ifdef trace
    t01int4 (ak_sem, 'a1ti        ', a1ti);
&   endif
    new_base       := release_space;
    mod_colset     := [];
    index_drop_set := [];
    a1createtab    := true;
    count          := 0;
    FOR ix := 1 TO MAX_COL_PER_TAB_GG00 DO
        new_default[ix] := false;
    (*ENDFOR*) 
    ak13new_base_record (acv, a11v, viewscanpar, old_p_arr, c_new_file_version);
    count := 0;
    WHILE (a1ti <> 0) AND (a_returncode = 0) DO
        BEGIN
        (* read a new column definition *)
        lo_level := a_ap_tree^[a1ti].n_lo_level;
        err_ti   := a1ti;
        a05identifier_get (acv, a1ti, sizeof (a1coln), a1coln);
        IF  NOT a061exist_columnname (old_p_arr.pbasep^.sbase,
            a1coln, old_colp)
        THEN
            a07_nb_put_error (acv, e_unknown_columnname,
                  a_ap_tree^[err_ti].n_pos, a1coln)
        ELSE
            BEGIN
            count     := count + 1;
            IF  ctdomain in old_colp^.ccolpropset
            THEN
                ak13m_drop_dom_usage (acv,
                      old_p_arr, old_colp^);
            (*ENDIF*) 
            a1add_rec := NOT (ctdefault in old_colp^.ccolpropset);
            a_p_arr1.pbasep^.sbase.bmaxcol :=
                  old_colp^.cextcolno - 1;
            null                  := false;
            not_null              := false;
            not_null_with_default := false;
            default_found         := false;
            CASE a_ap_tree^[a_ap_tree^[a1ti].n_sa_level].n_symb OF
                s_not_null :
                    BEGIN
                    not_null := true;
                    a1ti     := a_ap_tree^[a1ti].n_sa_level;
                    not_null_with_default :=
                          a_ap_tree^[a1ti].n_length = cak_i_with;
                    END;
                s_null :
                    BEGIN
                    null := true;
                    a1ti := a_ap_tree^[a1ti].n_sa_level
                    END;
                OTHERWISE ;
                END;
            (*ENDCASE*) 
            IF  a_ap_tree^[a_ap_tree^[a1ti].n_sa_level].n_proc = a14
            THEN
                BEGIN
                a1ti := a_ap_tree^[a1ti].n_sa_level;
                default_found := true
                END;
            (*ENDIF*) 
            IF  null OR not_null OR default_found
            THEN
                BEGIN
                a061get_colname (old_colp^, colname);
                a061app_columnname (acv, a_p_arr1.pbasep^.sbase,
                      colname, colind);
                IF  a_returncode = 0
                THEN
                    WITH a_p_arr1.pbasep^.sbase DO
                        BEGIN
                        a061copy_colinfo (old_colp^, bcolumn[blastindex]^);
                        IF  null
                        THEN
                            BEGIN
                            (* PTS 1118658 M.Ki. *)
                            IF  NOT (ctkey in bcolumn[blastindex]^.ccolpropset)
                            THEN
                                bcolumn[blastindex]^.ccolpropset :=
                                      bcolumn[blastindex]^.ccolpropset +
                                      [ctopt]
                            ELSE
                                a07_nb_put_error (acv,
                                      e_key_not_allowed,
                                      a_ap_tree^[err_ti].n_pos, a1coln);
                            (*ENDIF*) 
                            END;
                        (*ENDIF*) 
                        IF  not_null
                        THEN
                            bcolumn[blastindex]^.ccolpropset :=
                                  bcolumn[blastindex]^.ccolpropset -
                                  [ctopt];
                        (*ENDIF*) 
                        IF  default_found OR not_null_with_default
                        THEN
                            BEGIN
                            aux := a1ti;
                            IF  not_null_with_default
                            THEN
                                a1ti := -a1ti;
                            (*ENDIF*) 
                            a14default_spec (acv,
                                  a11v, bcolumn[blastindex]^);
                            new_default[bcolumn[blastindex]^.creccolno] := true;
                            (* PTS 1123951 *)
                            IF  (ctdefault in old_colp^.ccolpropset) AND
                                NOT (ctdefault in bcolumn[blastindex]^.ccolpropset)
                            THEN
                                IF  ak13default_or_null_foreign_key (acv,
                                    old_p_arr.pbasep^.sbase.bsurrogate, old_colp^, cak_x_set_default)
                                THEN
                                    a07_nb_put_error (acv,
                                          e_link_column_not_allowed, a_ap_tree^[err_ti].n_pos, a1coln);
                                (*ENDIF*) 
                            (*ENDIF*) 
                            a1ti := aux
                            END;
                        (*ENDIF*) 
                        END;
                    (*ENDWITH*) 
                (*ENDIF*) 
                END
            ELSE
                BEGIN
                a11one_column_def (acv, a11v);
                IF  NOT (ctopt in old_colp^.ccolpropset)
                THEN
                    WITH a_p_arr1.pbasep^.sbase DO
                        bcolumn[blastindex]^.ccolpropset := bcolumn[blastindex]^.ccolpropset - [ctopt];
                    (*ENDWITH*) 
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            IF  a1constraint_cnt > 0
            THEN
                BEGIN
                info := 'DOMAIN WITH CONSTRAINT  ';
                a07_const_b_put_error (acv, e_not_implemented, 1, @info,
                      sizeof (info))
                END;
            (*ENDIF*) 
            IF  a_returncode = 0
            THEN
                BEGIN
                WITH a_p_arr1.pbasep^.sbase DO
                    new_colp := bcolumn[blastindex];
                (*ENDWITH*) 
                ak13check_compatibility (acv, old_p_arr.pbasep, old_colp^,
                      new_base, mod_colset, index_drop_set, error);
                IF  error <> e_ok
                THEN
                    a07_nb_put_error (acv,
                          error, a_ap_tree^[err_ti].n_pos, a1coln)
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            IF  a_returncode = 0
            THEN
                BEGIN
                IF  ctkey in old_colp^.ccolpropset
                THEN
                    IF  ak13chk_key_is_linked (acv, old_p_arr.pbasep)  AND (* PTS 1115359 M.Ki. *)
                        ((old_colp^.cdatatyp  <> new_colp^.cdatatyp)   OR
                        ( old_colp^.cdatalen  <> new_colp^.cdatalen)   OR
                        ( old_colp^.cdatafrac <> new_colp^.cdatafrac))
                    THEN
                        a07_nb_put_error (acv,
                              e_link_column_not_allowed,
                              a_ap_tree^[err_ti].n_pos, a1coln)
                    ELSE
                        IF  new_colp^.cinoutlen > mxsp_key - 1
                        THEN
                            a07_nb_put_error (acv, e_too_long_key,
                                  a_ap_tree^[err_ti].n_pos, a1coln)
                        ELSE
                            BEGIN
                            (* new column inherits key attribute *)
                            new_colp^.ccolpropset := new_colp^.ccolpropset +
                                  [ctkey] - [ctopt];
                            new_colp^.ccolstack.etype :=
                                  old_colp^.ccolstack.etype;
                            END;
                        (*ENDIF*) 
                    (*ENDIF*) 
                (*ENDIF*) 
                IF  ctserial in new_colp^.ccolpropset
                THEN
                    IF  NOT (ctserial in old_colp^.ccolpropset)
                    THEN
                        a07_const_b_put_error (acv, e_default_not_allowed,
                              a_ap_tree^[err_ti].n_pos,
                              @a01kw[cak_i_serial],
                              sizeof (a01kw[cak_i_serial]));
                    (*ENDIF*) 
                (*ENDIF*) 
                IF  (ctdefault in old_colp^.ccolpropset)     AND
                    NOT (ctdefault in new_colp^.ccolpropset) AND
                    NOT new_default[new_colp^.creccolno]
                THEN
                    ak13modify_default (acv,
                          old_p_arr, old_colp^, new_colp^);
                (*ENDIF*) 
                a_p_arr1.pbasep^.sbase.bmaxcol := count;
                a1ti := lo_level
                END;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        END;
    (*ENDWHILE*) 
    a1createtab := false;
    a1add_rec   := false;
&   ifdef trace
    FOR ix := 1 TO old_p_arr.pbasep^.sbase.bmaxcol DO
        BEGIN
        t01int4 (ak_sem, 'new_default ', ord (
              new_default[ix]));
        IF  ix in mod_colset
        THEN
            t01int4 (ak_sem, 'modified_col', ix);
        (*ENDIF*) 
        END;
    (*ENDFOR*) 
    FOR ix := 1 TO old_p_arr.pbasep^.sbase.bmaxcol DO
        IF  ix in index_drop_set
        THEN
            t01int4 (ak_sem, 'dr index col', ix);
&       endif
        (*ENDIF*) 
    (*ENDFOR*) 
    IF  a_returncode = 0
    THEN
        BEGIN
        (* drop all indexes that have to be dropped    *)
        (* due to column change, describe all multiple *)
        (* indexes that just have to be renamed        *)
        mult_desc_cnt := c_max_mult_desc;
        ak13drop_indexes  (acv, a11v, viewscanpar,
              old_p_arr, mod_colset, index_drop_set,
              index_drop_set = a01fullset,
              @mult_desc, mult_desc_cnt)
        END;
    (*ENDIF*) 
    IF  a_returncode = 0
    THEN
        ak13TriggerHandling (acv, viewscanpar, old_p_arr, packet_size);
    (*ENDIF*) 
    IF  a_returncode = 0
    THEN
        IF  new_base
        THEN
            BEGIN
            (* new column definition(s) require new *)
            (* catalog description of table         *)
            ak13new_table_ref (acv, a11v);
            ak13new_catalog_desc (acv, a_p_arr1.pbasep^.sbase,
                  old_p_arr.pbasep^.sbase, a1reclen,
                  a1keypos, map, ext_map);
            IF  a_returncode = 0
            THEN
                ak13pk_change_file (acv, a11v,
                      old_p_arr, map, ext_map,
                      @mult_desc, mult_desc_cnt, b01niltree_id);
            (*ENDIF*) 
            IF  a_returncode = 0
            THEN
                ak13copy_table_records (acv, a11v, mod_colset,
                      old_p_arr, ext_map, c_modify_index, 0);
            (*ENDIF*) 
            ak13m_create_index (acv, a11v, viewscanpar,
                  old_p_arr, @mult_desc, mult_desc_cnt);
            IF  a_returncode = 0
            THEN
                BEGIN
                aux_colset := [];
                FOR ix := 1 TO old_p_arr.pbasep^.sbase.bmaxcol DO
                    IF  ix in mod_colset
                    THEN
                        aux_colset := aux_colset +
                              [ext_map[ix].em_new_colp^.cextcolno];
                    (*ENDIF*) 
                (*ENDFOR*) 
                mod_colset := aux_colset
                END;
            (*ENDIF*) 
            old_tabid := a1tableid
            END
        ELSE
            BEGIN
            (* no new base record required, copy new column *)
            (* definitions into old base record             *)
            viewscanpar.vsc_base_tabid :=
                  old_p_arr.pbasep^.sbase.bsurrogate;
            a1add_rec := false;
            a1keypos  := old_p_arr.pcount;
            WITH a_p_arr1.pbasep^.sbase DO
                FOR ci := bfirstindex TO blastindex DO
                    WITH bcolumn[ci]^ DO
                        BEGIN
                        a061get_colname (bcolumn[ci]^, colname);
                        IF  a061exist_columnname (old_p_arr.pbasep^.sbase,
                            colname, old_colp)
                        THEN
                            BEGIN
                            (* copy new column definition into *)
                            (* old one                         *)
&                           ifdef trace
                            t01int4 (ak_sem, 'creccolno   ', creccolno);
                            t01int4 (ak_sem, 'ctdefault   ', ord (ctdefault in
                                  ccolpropset));
&                           endif
                            IF  ctdefault in ccolpropset
                            THEN
                                old_colp^.ccolpropset :=
                                      old_colp^.ccolpropset +
                                      [ctdefault]
                            ELSE
                                IF  new_default[creccolno]
                                THEN
                                    old_colp^.ccolpropset :=
                                          old_colp^.ccolpropset -
                                          [ctdefault];
                                (*ENDIF*) 
                            (*ENDIF*) 
                            IF  ctopt in ccolpropset
                            THEN
                                old_colp^.ccolpropset :=
                                      old_colp^.ccolpropset +
                                      [ctopt]
                            ELSE
                                BEGIN
                                IF  ctopt in old_colp^.ccolpropset
                                THEN
                                    BEGIN
                                    verify_cols := verify_cols +
                                          [cextcolno];
                                    verify := verify + [verify_not_null];
                                    END;
                                (*ENDIF*) 
                                old_colp^.ccolpropset :=
                                      old_colp^.ccolpropset -
                                      [ctopt]
                                END;
                            (*ENDIF*) 
                            old_colp^.cdatatyp  := cdatatyp;
                            IF  old_colp^.cdatalen > cdatalen
                            THEN
                                BEGIN
                                verify := verify + [verify_length];
                                verify_lengthcols := verify_lengthcols + [cextcolno];
                                END;
                            (*ENDIF*) 
                            old_colp^.cdatalen  := cdatalen;
                            old_colp^.cinoutlen := cinoutlen;
                            old_colp^.cdatafrac := cdatafrac;
                            old_colp^.cbinary   := cbinary; (* PTS 1121474 *)
                            (* PTS 1115318 E.Z. *)
                            old_colp^.ccolstack.elen_var := cinoutlen;
                            END
                        ELSE
                            a07ak_system_error (acv, 13, 8);
                        (*ENDIF*) 
                        END;
                    (*ENDWITH*) 
                (*ENDFOR*) 
            (*ENDWITH*) 
            a_p_arr1 := old_p_arr;
            ak13m_create_index (acv, a11v, viewscanpar,
                  old_p_arr, @mult_desc, mult_desc_cnt)
            END;
        (*ENDIF*) 
    (*ENDIF*) 
    IF  a_returncode = 0
    THEN
        BEGIN
        (* check max record length *)
        first_base             := @a_p_arr1.pbasep^.sbase;
        first_base^.bmaxreclen := cgg_rec_key_offset;
        min_reclen             := 0;
        WITH a_p_arr1.pbasep^.sbase DO
            FOR bi := bfirstindex TO blastindex DO
                WITH bcolumn[bi]^ DO
                    BEGIN
                    IF  a_sqlmode = sqlm_oracle
                    THEN
                        CASE ccolstack.etype OF
                            st_varcol :
                                min_reclen := min_reclen + 1 + 1;
                            st_varlongchar :
                                min_reclen := min_reclen + 2 + 1;
                            OTHERWISE
                                min_reclen := min_reclen + cinoutlen;
                            END;
                        (*ENDCASE*) 
                    (*ENDIF*) 
                    first_base^.bmaxreclen :=
                          first_base^.bmaxreclen + cinoutlen;
                    END;
                (*ENDWITH*) 
            (*ENDFOR*) 
        (*ENDWITH*) 
        first_base^.bmaxreclen := first_base^.bmaxreclen +
              first_base^.bvarcolcount +
              2 * first_base^.blongvarcolcnt;
        IF  a_sqlmode = sqlm_oracle
        THEN
            BEGIN
            IF  first_base^.bmaxreclen > MAX_RECLEN_GG00
            THEN
                first_base^.bmaxreclen := MAX_RECLEN_GG00
            (*ENDIF*) 
            END
        ELSE
            min_reclen := first_base^.bmaxreclen;
        (*ENDIF*) 
        IF  min_reclen > MAX_RECLEN_GG00
        THEN
            a07_b_put_error (acv, e_too_long_record, 1)
        ELSE
            BEGIN
            a1sort    := true;
            a1tableid := a_p_arr1.pbasep^.sbase.bsurrogate;
            a11end_create_table (acv, a11v)
            END;
        (*ENDIF*) 
        IF  a_returncode = 0
        THEN
            ak13constraint_reconstruction (acv, a11v, mod_colset);
        (*ENDIF*) 
        IF  a_returncode = 0
        THEN
            ak13trigger_reconstruction (acv, packet_size)
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  (old_tabid <> cgg_zero_id) AND (a_returncode = 0)
    THEN
        BEGIN
        qual.del_colno := 0;
        a10_del_tab_sysinfo (acv, old_tabid,
              qual, false, error);
        IF  error <> e_ok
        THEN
            a07_b_put_error (acv, error, 1)
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13m_drop_dom_usage (
            VAR acv      : tak_all_command_glob;
            VAR base_arr : tak_syspointerarr;
            VAR colinfo   : tak00_columninfo);
 
VAR
      b_err        : tgg00_BasisError;
      dom_owner_id : tgg00_Surrogate;
      dom_name     : tsp00_KnlIdentifier;
      sysk         : tgg00_SysInfoKey;
 
BEGIN
ak13get_domain_name (acv, base_arr,
      colinfo.cextcolno, dom_owner_id, dom_name);
IF  acv.a_returncode = 0
THEN
    BEGIN
    colinfo.ccolpropset := colinfo.ccolpropset - [ctdomain];
    sysk                := base_arr.pbasep^.syskey;
    sysk.sentrytyp      := cak_edomainusage;
    sysk.slinkage[1]    := chr (colinfo.cextcolno DIV 256);
    sysk.slinkage[2]    := chr (colinfo.cextcolno MOD 256);
    a10del_sysinfo (acv, sysk, b_err);
    IF  b_err <> e_ok
    THEN
        a07_b_put_error (acv, b_err, 1)
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  acv.a_returncode = 0
THEN
    ak13check_domain_ref (acv, base_arr, colinfo,
          dom_owner_id, dom_name)
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13modify_default (
            VAR acv        : tak_all_command_glob;
            VAR old_p_arr  : tak_syspointerarr;
            VAR oldcolinfo : tak00_columninfo;
            VAR newcolinfo : tak00_columninfo);
 
CONST
      c_change_code = true;
 
TYPE
      tcheck = (no_check, check_date, check_time, check_timestamp,
            check_smallint, check_int);
 
VAR
      to_check        : tcheck;
      replace         : boolean;
      b_err           : tgg00_BasisError;
      val_len         : integer;
      subproc         : integer;
      number          : tsp00_Number;
      sysbuf          : tak_sysbufferaddress;
      sysk            : tgg00_SysInfoKey;
 
BEGIN
newcolinfo.ccolpropset := newcolinfo.ccolpropset + [ctdefault];
IF  (oldcolinfo.cdatatyp  <> newcolinfo.cdatatyp ) OR
    (newcolinfo.cinoutlen < oldcolinfo.cinoutlen ) OR
    ((newcolinfo.cdatatyp = dfixed) AND
    ( newcolinfo.cbinary AND NOT oldcolinfo.cbinary))
THEN
    BEGIN
    sysk             := old_p_arr.pbasep^.syskey;
    sysk.sentrytyp   := cak_edefault;
    sysk.slinkage[1] := chr (oldcolinfo.cextcolno DIV 256);
    sysk.slinkage[2] := chr (oldcolinfo.cextcolno MOD 256);
    a10_fix_len_get_sysinfo (acv, sysk, d_release,
          cak_is_undefined, sizeof (tak_default_value), sysbuf, b_err);
    IF  b_err = e_ok
    THEN
        WITH sysbuf^.sdefault DO
            BEGIN
            replace := false;
            IF  dfdefault_function <> 0
            THEN
                BEGIN
                CASE dfdefault_function OF
                    cak_x_stamp :
                        subproc := cak_i_stamp;
                    cak_x_uid :
                        subproc := cak_i_uid;
                    cak_x_user, cak_x_usergroup :
                        subproc := cak_i_user;
                    cak_x_date :
                        subproc := cak_i_date;
                    cak_x_time :
                        subproc := cak_i_time;
                    (* PTS 1122683 E.Z. *)
                    cak_x_timestamp :
                        subproc := cak_i_timestamp;
                    cak_x_false :
                        subproc := cak_i_false;
                    cak_x_true :
                        subproc := cak_i_true;
                    (* PTS 1122484 E.Z. *)
                    cak_x_utcdate :
                        subproc := cak_i_utcdate;
                    cak_x_utcdiff :
                        subproc := cak_i_utcdiff;
                    cak_x_timezone :
                        subproc := cak_i_timezone;
                    cak_x_sysdba :
                        subproc := cak_i_sysdba;
                    END;
                (*ENDCASE*) 
                a14dfunction (acv, newcolinfo, subproc, 1,
                      dfdefault_function)
                END
            ELSE
                BEGIN
                val_len := 1 +
                      s30lnr_defbyte (@dfvalues, dfvalues[2],
                      3,   a14LengthOfDefaultValue (sysbuf^.sdefault) - 1);
&               ifdef trace
                t01int4 (ak_sem, 'val_len     ', val_len);
&               endif
                to_check := no_check;
                CASE newcolinfo.cdatatyp OF
                    dcha :
                        CASE oldcolinfo.cdatatyp OF
                            dcha, ddate, dtime, dtimestamp :
                                BEGIN
                                END;
                            dche :
                                BEGIN
                                g02pebcdic_pos_ascii (dfvalues, 2,
                                      dfvalues, 2, val_len);
                                replace := true
                                END;
                            dunicode :
                                BEGIN
                                ak13m_uni_trans_default (dfvalues,
                                      csp_unicode, csp_ascii, val_len,
                                      b_err);
                                replace := true
                                END;
                            OTHERWISE
                                b_err := e_not_implemented
                            END;
                        (*ENDCASE*) 
                    dche :
                        CASE oldcolinfo.cdatatyp OF
                            dcha, ddate, dtime, dtimestamp :
                                BEGIN
                                g02pascii_pos_ebcdic (dfvalues, 2,
                                      dfvalues, 2, val_len);
                                replace := true
                                END;
                            dche :
                                BEGIN
                                END;
                            dunicode :
                                BEGIN
                                ak13m_uni_trans_default (dfvalues,
                                      csp_unicode, csp_ascii, val_len,
                                      b_err);
                                g02pascii_pos_ebcdic (dfvalues, 2,
                                      dfvalues, 2, val_len);
                                replace := true
                                END;
                            OTHERWISE
                                b_err := e_not_implemented
                            END;
                        (*ENDCASE*) 
                    ddate :
                        CASE oldcolinfo.cdatatyp OF
                            dcha :
                                to_check := check_date;
                            OTHERWISE
                                b_err := e_not_implemented;
                            END;
                        (*ENDCASE*) 
                    dtime :
                        CASE oldcolinfo.cdatatyp OF
                            dcha :
                                to_check := check_time;
                            OTHERWISE
                                b_err := e_not_implemented;
                            END;
                        (*ENDCASE*) 
                    dtimestamp :
                        CASE oldcolinfo.cdatatyp OF
                            dcha :
                                to_check := check_timestamp;
                            OTHERWISE
                                b_err := e_not_implemented;
                            END;
                        (*ENDCASE*) 
                    dfixed :
                        IF  newcolinfo.cbinary
                        THEN
                            IF  newcolinfo.cdatalen = 5
                            THEN
                                to_check := check_smallint
                            ELSE
                                to_check := check_int;
                            (*ENDIF*) 
                        (*ENDIF*) 
                    dunicode :
                        CASE oldcolinfo.cdatatyp OF
                            dcha :
                                BEGIN
                                ak13m_uni_trans_default (dfvalues,
                                      csp_ascii, csp_unicode, val_len,
                                      b_err);
                                replace := true
                                END;
                            dche :
                                BEGIN
                                g02pebcdic_pos_ascii (dfvalues, 2,
                                      dfvalues, 2, val_len);
                                ak13m_uni_trans_default (dfvalues,
                                      csp_ascii, csp_unicode, val_len,
                                      b_err);
                                replace := true
                                END;
                            dunicode :
                                BEGIN
                                END;
                            OTHERWISE
                                b_err := e_not_implemented;
                            END;
                        (*ENDCASE*) 
                    OTHERWISE
                        b_err := e_not_implemented
                    END;
                (*ENDCASE*) 
                CASE to_check  OF
                    check_date :
                        g03fdcheck_date (dfvalues, dfvalues,
                              3 , 3, val_len - 1, acv.a_dt_format,
                              c_change_code, b_err);
                    check_time :
                        g03ftcheck_time (dfvalues, dfvalues,
                              3 , 3, val_len - 1, acv.a_dt_format,
                              c_change_code, b_err);
                    check_timestamp :
                        g03ftscheck_timestamp (dfvalues, dfvalues,
                              3 , 3, val_len - 1, acv.a_dt_format,
                              acv.a_ak_language, c_change_code, b_err);
                    check_int, check_smallint :
                        BEGIN
                        number := csp_null_number;
                        g10mv ('VAK13 ',   1,    
                              sizeof (dfvalues), sizeof (number),
                              @dfvalues, 3, @number, 1, val_len - 1,
                              acv.a_returncode);
                        IF  to_check = check_smallint
                        THEN
                            BEGIN
                            IF  (number < csp_minsint) OR
                                (number > csp_maxsint)
                            THEN
                                b_err := e_range_violation
                            (*ENDIF*) 
                            END
                        ELSE
                            IF  (number < csp_minlint) OR
                                (number > csp_maxlint)
                            THEN
                                b_err := e_range_violation
                            (*ENDIF*) 
                        (*ENDIF*) 
                        END;
                    OTHERWISE ;
                    END;
                (*ENDCASE*) 
&               ifdef trace
                t01int4 (ak_sem, 'val_len     ', val_len);
&               endif
                IF  replace AND (b_err = e_ok)
                THEN
                    IF  val_len > newcolinfo.cinoutlen
                    THEN
                        a07_b_put_error (acv, e_column_trunc, 1)
                    ELSE
                        BEGIN
                        sysbuf^.b_sl := cak_sysbufferoffset + 4 + 1 + val_len;
                        dfvalues[1]  := chr(1);
                        a10repl_sysinfo (acv, sysbuf, b_err);
                        END;
                    (*ENDIF*) 
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            END;
        (*ENDWITH*) 
    (*ENDIF*) 
    IF  b_err <> e_ok
    THEN
        a07_b_put_error (acv, b_err, 1)
    (*ENDIF*) 
    END;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13m_create_index (
            VAR acv         : tak_all_command_glob;
            VAR a11v        : tak_a11_glob;
            VAR viewscanpar : tak_viewscan_par;
            VAR old_arr     : tak_syspointerarr;
            mult_desc_ptr   : tgg00_StackListPtr;
            mult_desc_cnt   : integer);
 
VAR
      b_err          : tgg00_BasisError;
      ix             : integer;
      curr           : integer;
      sec_keylen     : integer;
      indexname      : tsp00_KnlIdentifier;
      index_scan_rec : tak_index_scan_record;
      colptr         : tak00_colinfo_ptr;
 
BEGIN
WITH acv, a11v, viewscanpar DO
    BEGIN
    IF  a_p_arr1.pbasep^.sbase.bindexexist
    THEN
        BEGIN
        (* analyze all named indexes *)
        a24init_index_scan (acv, a_p_arr1.pbasep^.sbase.bsurrogate,
              index_scan_rec);
        curr := 1;
        WHILE a24next_named_index (acv, index_scan_rec) DO
            WITH index_scan_rec, isr_buf^.smindex.indexdef[isr_index] DO
                BEGIN
                a_ptr1 := isr_buf;
                IF  (icolstack[1].ecol_tab[1] =
                    mult_desc_ptr^[curr].ecol_tab[1])
                    AND
                    (curr <= mult_desc_cnt)
                THEN
                    curr := curr + 1
                ELSE
                    BEGIN
                    IF  a_p_arr1.pbasep = old_arr.pbasep
                    THEN
                        BEGIN
                        sec_keylen := 0;
                        FOR ix := 1 TO icount DO
                            BEGIN (* PTS 1116696 *)
                            a06extcolno (old_arr.pbasep^.sbase,
                                  icolseq[ix], colptr);
                            icolstack[ix].elen_var :=  colptr^.cinoutlen;
                            sec_keylen := sec_keylen + icolstack[ix].elen_var;
                            END;
                        (*ENDFOR*) 
                        IF  sec_keylen > mxsp_key - 1
                        THEN
                            BEGIN
                            a24get_indexname (acv, isr_buf, isr_index,
                                  indexname);
                            a07_nb_put_error (acv,
                                  e_too_long_key, 1, indexname)
                            END;
                        (*ENDIF*) 
                        END;
                    (*ENDIF*) 
                    a24send_index_command_to_kb (acv,
                          viewscanpar,
                          isr_index, m_create_index, mm_nil);
                    IF  (a_returncode = 0)
                    THEN
                        ipages := a_mblock.mb_data^.mbp_sample.indexnodes
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
                a10repl_sysinfo (acv, a_ptr1, b_err);
                IF  b_err <> e_ok
                THEN
                    a07_b_put_error (acv, b_err, 1)
                (*ENDIF*) 
                END;
            (*ENDWITH*) 
        (*ENDWHILE*) 
        a24finish_index_scan (acv, index_scan_rec);
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13modify_index (
            VAR acv      : tak_all_command_glob;
            VAR ext_map  : tak13ext_mapping;
            VAR indexrec : tak_mindexrecord);
 
VAR
      ix          : integer;
      col         : integer;
      sec_key_len : integer;
      indexname   : tsp00_KnlIdentifier;
 
BEGIN
WITH acv, indexrec DO
    BEGIN
    FOR ix := 1 TO indexcount DO
        WITH indexdef[ix] DO
            BEGIN
            sec_key_len := 0;
            FOR col := 1 TO icount DO
                BEGIN
                WITH ext_map[icolseq[col]], em_new_colp^ DO
                    BEGIN
                    icolseq[col] := cextcolno;
                    WITH icolstack[col] DO
                        BEGIN
                        etype       := ccolstack.etype;
                        epos        := ccolstack.epos;
                        elen_var    := ccolstack.elen_var;
                        ecol_tab[1] := chr (indexno);
                        ecol_tab[2] := chr(0);
                        END;
                    (*ENDWITH*) 
                    sec_key_len := sec_key_len + cinoutlen;
                    IF  sec_key_len > mxsp_key - 1
                    THEN
                        BEGIN
                        a24get_indexname (acv, @indexrec, ix,
                              indexname);
                        a07_nb_put_error (acv,
                              e_too_long_key, 1, indexname)
                        END;
                    (*ENDIF*) 
                    END;
                (*ENDWITH*) 
                END;
            (*ENDFOR*) 
            END;
        (*ENDWITH*) 
    (*ENDFOR*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13m_uni_trans_default (
            VAR default_buf : tak_default_value;
            src_codeset     : tsp00_Int2;
            dest_codeset    : tsp00_Int2;
            VAR val_len     : integer;
            VAR b_err       : tgg00_BasisError);
 
VAR
      rc          : tsp8_uni_error;
      moved_len   : tsp00_Int4;
      err_char_no : tsp00_Int4;
      defaultValue: tak_default_value;
 
BEGIN
CASE dest_codeset OF
    csp_ascii :
        default_buf[2] := csp_ascii_blank;
    csp_unicode :
        default_buf[2] := csp_unicode_def_byte;
    END;
(*ENDCASE*) 
moved_len := sizeof (tak_default_value);
s80uni_trans (@default_buf[3], val_len - 1,
      src_codeset, @defaultValue, moved_len, dest_codeset,
      [], rc, err_char_no);
IF  (rc <> uni_ok) OR (moved_len > sizeof (tak_default_value) - 1)
THEN
    b_err := e_const_incompatible_with_typ
ELSE
    BEGIN
    g10mv ('VAK13 ',   2,    
          sizeof (defaultValue), sizeof (default_buf),
          @defaultValue, 1, @default_buf, 3, moved_len, b_err);
    val_len := 1 + moved_len
    END;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13new_base_record (
            VAR acv          : tak_all_command_glob;
            VAR a11v         : tak_a11_glob;
            VAR viewscanpar  : tak_viewscan_par;
            VAR old_p        : tak_syspointerarr;
            new_file_version : boolean); (* PTS 1116259 M.Ki. *)
 
VAR
      b_err     : tgg00_BasisError;
      move_len  : integer;
      new_tabid : tgg00_Surrogate;
      sysk      : tgg00_SysInfoKey;
 
BEGIN
WITH acv, a11v, viewscanpar DO
    BEGIN
    IF  new_file_version (* PTS 1116259 M.Ki. *)
    THEN
        BEGIN
        a10_version (acv, a_p_arr1.pbasep^.sbase,
              m_succ_file_version, NOT c_scan_views);
        vsc_filevers := a_p_arr1.pbasep^.sbase.btreeid.fileVersion_gg00;
        END;
    (*ENDIF*) 
    IF  a_returncode = 0
    THEN
        BEGIN
        old_p := a_p_arr1;
        a05surrogate_get (acv, new_tabid);
        IF  a_returncode = 0
        THEN
            BEGIN
            sysk             := old_p.pbasep^.syskey;
            sysk.stableid    := new_tabid;
            sysk.slinkage    := cak_init_linkage;
            a_p_arr1.pcount  := 1;
            a10_nil_get_sysinfo (acv, sysk, d_fix,
                  sizeof (tak_baserecord), a_p_arr1.pbasep, b_err)
            END
        ELSE
            b_err := e_cancelled;
        (*ENDIF*) 
        IF  b_err = e_ok
        THEN
            BEGIN
            a_p_arr1.pcount  := 1;
            vsc_base_tabid   := new_tabid;
            move_len         := a10BaseRecPersistentOffset -  (* PTS 1105713, T.A. 24.02.2000 *)
                  cak_sysbufferoffset;
            s10mv (sizeof (tak_systembuffer), sizeof (tak_systembuffer),
                  @old_p.pbasep^, cak_sysbufferoffset + 1,
                  @a_p_arr1.pbasep^, cak_sysbufferoffset + 1, move_len);
            WITH a_p_arr1.pbasep^.sbase DO
                BEGIN
                IF  new_tabid <> old_p.pbasep^.sbase.bsurrogate
                THEN
                    breccnt := 0;
                (*ENDIF*) 
                a061add_name (acv, a_p_arr1.pbasep^.sbase,
                      old_p.pbasep^.sbase.btablen^, btablen);
                bmaxcol        := 0;
                bstringcount   := 0;
                bmaxreclen     := cgg_rec_key_offset;
                bcntdropcol    := 0;
                blongvarcolcnt := 0;
                bfirstindex    := a11firstindex (MAX_COL_PER_TAB_GG00,
                      a_p_arr1.pbasep^.sbase);
                blastindex     := bfirstindex - 1;
                END;
            (*ENDWITH*) 
            END
        ELSE
            a07_b_put_error (acv, b_err, 1);
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13new_table_ref (
            VAR acv       : tak_all_command_glob;
            VAR a11v      : tak_a11_glob);
 
VAR
      b_err  : tgg00_BasisError;
      sysbuf : tak_sysbufferaddress;
      sysk   : tgg00_SysInfoKey;
 
BEGIN
WITH acv, a11v DO
    BEGIN
    sysk.sauthid     := a_p_arr1.pbasep^.sbase.bauthid;
    sysk.sidentifier := a1tablen;
    sysk.sentrytyp   := cak_etableref;
    sysk.slinkage    := cak_init_linkage;
    sysk.skeylen     := mxak_standard_sysk + sizeof (sysk.sidentifier);
    (*======== assignment of a new table surrogate =========*)
    a10get_sysinfo (acv, sysk, d_release, sysbuf, b_err);
    IF  b_err = e_ok
    THEN
        BEGIN
        sysbuf^.stableref.rtableid := a_p_arr1.pbasep^.sbase.bsurrogate;
        a10repl_sysinfo (acv, sysbuf, b_err)
        END;
    (*ENDIF*) 
    IF  b_err <> e_ok
    THEN
        a07_b_put_error (acv, b_err, 1)
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13check_ref_column (
            VAR acv      : tak_all_command_glob;
            base_ptr     : tak_sysbufferaddress;
            VAR colinfo  : tak00_columninfo;
            VAR b_err    : tgg00_BasisError);
 
VAR
      ix          : integer;
      jx          : integer;
      count       : integer;
      link_count  : integer;
      entry_count : integer;
      scanned     : integer; (* PTS 1115359 M.Ki. *)
      sysbuf      : tak_sysbufferaddress;
      sysk        : tgg00_SysInfoKey;
 
BEGIN
IF  ctlink in colinfo.ccolpropset
THEN
    b_err := e_link_column_not_allowed
ELSE
    WITH acv, base_ptr^.sbase DO
        IF  unique_pk_table in blinkexist
        THEN
            BEGIN
            scanned        := 0;
            count          := 0;
            sysk           := base_ptr^.syskey;
            sysk.sentrytyp := cak_eprimarykey;
            REPEAT
                a10get_sysinfo (acv,
                      sysk, d_release, sysbuf, b_err);
                IF  b_err = e_ok
                THEN
                    WITH sysbuf^.slink DO
                        BEGIN
                        IF  sysk.slinkage = cak_init_linkage
                        THEN
                            link_count := linkcount;
                        (*ENDIF*) 
                        entry_count := lreclen DIV sizeof (linkdef[1]);
                        FOR ix := 1 TO entry_count DO
                            WITH linkdef[ix] DO
                                FOR jx := 1 TO lcolcount DO
                                    IF  lseccolseq[jx] = colinfo.creccolno
                                    THEN
                                        b_err := e_key_not_allowed;
                                    (*ENDIF*) 
                                (*ENDFOR*) 
                            (*ENDWITH*) 
                        (*ENDFOR*) 
                        scanned := scanned + entry_count; (* PTS 1115359 *)
                        count   := count + entry_count;   (* M.Ki        *)
                        IF  count >= cak_maxlinkdef
                        THEN
                            BEGIN
                            count := 0;
                            a06inc_linkage (sysk.slinkage)
                            END;
                        (*ENDIF*) 
                        END;
                    (*ENDWITH*) 
                (*ENDIF*) 
            UNTIL
                (scanned = link_count) OR (b_err <> e_ok);
            (*ENDREPEAT*) 
            END;
        (*ENDIF*) 
    (*ENDWITH*) 
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a13store_col_alter_date (
            VAR acv      : tak_all_command_glob;
            VAR p_arr    : tak_syspointerarr;
            VAR col_info : tak00_columninfo);
 
VAR
      new_alterdate : boolean;
      b_err         : tgg00_BasisError;
      req_len       : integer;
      sysptr        : tak_sysbufferaddress;
      sysk          : tgg00_SysInfoKey;
 
BEGIN
WITH acv DO
    BEGIN
    sysk             := p_arr.pbasep^.syskey;
    sysk.sentrytyp   := cak_ealterdate;
    sysk.slinkage[1] := chr (col_info.cextcolno DIV 256);
    sysk.slinkage[2] := chr (col_info.cextcolno MOD 256);
    IF  ctaltered in col_info.ccolpropset
    THEN
        BEGIN
        new_alterdate := false;
        a10get_sysinfo (acv, sysk,
              d_release, sysptr, b_err);
        IF  b_err = e_ok
        THEN
            BEGIN
            WITH sysptr^.salterdate DO
                a11put_date_time (ad_alterdate, ad_altertime);
            (*ENDWITH*) 
            a10repl_sysinfo (acv, sysptr, b_err)
            END
        ELSE
            IF  b_err = e_sysinfo_not_found
            THEN
                new_alterdate := true
            (*ENDIF*) 
        (*ENDIF*) 
        END
    ELSE
        new_alterdate := true;
    (*ENDIF*) 
    IF  new_alterdate
    THEN
        BEGIN
        req_len := sizeof (tak_alterdaterecord);
        a10_nil_get_sysinfo (acv, sysk, d_release,
              req_len, sysptr, b_err);
        IF  b_err = e_ok
        THEN
            WITH sysptr^.salterdate DO
                BEGIN
                ad_segmentid := p_arr.pbasep^.sbase.bsegmentid;
                IF  a_is_ddl = ddl_alter_tab_add
                THEN
                    BEGIN
                    a11put_date_time (ad_createdate, ad_createtime);
                    ad_alterdate := ad_createdate;
                    ad_altertime := ad_createtime;
                    END
                ELSE
                    BEGIN
                    a11put_date_time (ad_alterdate, ad_altertime);
                    WITH p_arr.pbasep^.sbase DO
                        BEGIN
                        ad_createdate := bdatecreate;
                        ad_createtime := btimecreate
                        END;
                    (*ENDWITH*) 
                    END;
                (*ENDIF*) 
                a10add_sysinfo (acv, sysptr, b_err)
                END;
            (*ENDWITH*) 
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  b_err <> e_ok
    THEN
        a07_b_put_error (acv, b_err, 1)
    ELSE
        col_info.ccolpropset := col_info.ccolpropset +
              [ctaltered]
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13verify_constraint_not_null (
            VAR acv               : tak_all_command_glob;
            VAR a11v              : tak_a11_glob;
            verify_op             : tverify_operation;
            VAR verify_cols       : tak_columnset;
            VAR verify_lengthcols : tak_columnset;
            constraintId          : integer);
 
CONST
      c_reserve = 256;
 
VAR
      first          : boolean;
      ok             : boolean;
      i              : integer;
      move_len       : integer;
      init_ex_kind   : tak_execution_kind;
      part_desc_ptr  : tsp1_part_ptr;
      colptr         : tak00_colinfo_ptr;
      and_token      : tsp00_C6;
      is_null        : tsp00_C12;
      is_not_true    : tsp00_C12;
      is_not_null    : tsp00_C18;
      length_token   : tsp00_C8;
      greater_token  : tsp00_C4;
      or_token       : tsp00_C4;
      c_datalen      : tsp00_C20;
      init_user_name : tsp00_KnlIdentifier;
      colname        : tsp00_KnlIdentifier;
      c30            : tsp00_C30;
 
BEGIN
a06_systable_get (acv, d_fix, a11v.a1tableid,
      acv.a_p_arr1.pbasep, true, ok);
IF  NOT ok
THEN
    a07_b_put_error  (acv, e_old_fileversion, 1)
ELSE
    WITH acv, a11v DO
        BEGIN
&       ifdef trace
        WITH a_p_arr1.pbasep^.sbase DO
            FOR i := bfirstindex TO blastindex DO
                BEGIN
                t01addr (ak_sem, 'bcolumn     ', @bcolumn[i]^);
                a061td_colinfo (bcolumn[i]^, i);
                END;
            (*ENDFOR*) 
        (*ENDWITH*) 
&       endif
        a542internal_packet (acv,
              NOT c_release_packet, a_cmd_part^.sp1p_buf_len + c_reserve);
&       ifdef trace
        WITH a_p_arr1.pbasep^.sbase DO
            FOR i := bfirstindex TO blastindex DO
                BEGIN
                t01addr (ak_sem, 'bcolumn     ', @bcolumn[i]^);
                a061td_colinfo (bcolumn[i]^, i);
                END;
            (*ENDFOR*) 
        (*ENDWITH*) 
&       endif
        IF  a_returncode = 0
        THEN
            BEGIN
            c30 := verify1;
            a542move_to_packet (acv, @c30, sizeof (c30));
            a542identifier_to_packet (acv,
                  a_p_arr1.pbasep^.sbase.btablen^);
            a542char_to_packet (acv, bsp_c1);
            a542move_to_packet (acv, @a01kw[cak_i_where], 6);
            IF  (verify_range in verify_op     ) OR
                (verify_add_column in verify_op)
            THEN
                a542char_to_packet (acv, '(')
            ELSE
                IF  (verify_cols = []) AND NOT (verify_length in verify_op)
                THEN
                    a542identifier_to_packet (acv, a1coln);
                (*ENDIF*) 
            (*ENDIF*) 
            IF  verify_add_column in verify_op
            THEN
                BEGIN
                (* where (<constraint> .. AND <constraint>) is not true *)
                and_token    := ' AND (';
                a542char_to_packet (acv, '(');
                first := true;
                i     := 1;
                WHILE (i <= a1constraint_cnt) AND
                      (a_returncode = 0) DO
                    BEGIN
                    IF  a1constraint_info[ i ].tree_index <> 0
                    THEN
                        BEGIN
                        IF  NOT first
                        THEN
                            a542move_to_packet (acv, @and_token,
                                  sizeof (and_token));
                        (*ENDIF*) 
                        first := false;
                        a44constraint_into_moveobj (acv,
                              a_p_arr1.pbasep,
                              a_p_arr1.pbasep^.syskey.stableid, obj_table,
                              a1constraint_info[ i ].tree_index, 1,
                              a_cmd_part^.sp1p_buf, a_cmd_part^.sp1p_buf_size,
                              a_cmd_part^.sp1p_buf_len);
                        a542char_to_packet (acv, ')')
                        END;
                    (*ENDIF*) 
                    i := i + 1
                    END;
                (*ENDWHILE*) 
                a542char_to_packet (acv, ')');
                is_not_true := c_is_not_true;
                a542move_to_packet (acv, @is_not_true,
                      sizeof (is_not_true))
                END;
            (*ENDIF*) 
            IF  verify_range in verify_op
            THEN
                BEGIN (* where <constraint> is not true *)
                IF  verify_not_null in verify_op
                THEN
                    a542char_to_packet (acv, '(');
                (*ENDIF*) 
                IF  constraintId = cak_is_undefined
                THEN (* PTS 1116788 *)
                    constraintId := a_p_arr1.pbasep^.sbase.bnamed_constr;
                (*ENDIF*) 
                a44constraint_into_moveobj (acv, a_p_arr1.pbasep,
                      a_p_arr1.pbasep^.syskey.stableid,
                      obj_table, constraintId,
                      1, a_cmd_part^.sp1p_buf, a_cmd_part^.sp1p_buf_size,
                      a_cmd_part^.sp1p_buf_len);
                a542char_to_packet (acv, ')');
                IF  verify_not_null in verify_op
                THEN
                    BEGIN
                    and_token := ' AND  ';
                    a542move_to_packet (acv, @and_token,
                          sizeof (and_token));
                    a542identifier_to_packet (acv, a1coln);
                    is_not_null := ' IS NOT NULL      ';
                    a542move_to_packet (acv, @is_not_null,
                          sizeof (is_not_null));
                    a542char_to_packet (acv, ')');
                    verify_op    := verify_op - [verify_not_null]
                    END;
                (*ENDIF*) 
                is_not_true := c_is_not_true;
                a542move_to_packet (acv, @is_not_true,
                      sizeof (is_not_true))
                END;
            (*ENDIF*) 
            is_null := ' IS NULL OR ';
            IF  verify_not_null in verify_op
            THEN
                IF  verify_cols = []
                THEN
                    a542move_to_packet (acv, @is_null, 8)
                ELSE
                    BEGIN
                    i := 1;
                    WHILE verify_cols <> [] DO
                        BEGIN
                        IF  i in verify_cols
                        THEN
                            BEGIN
                            a06extcolno (a_p_arr1.pbasep^.sbase,
                                  i, colptr);
                            a061get_colname (colptr^, colname);
                            a542identifier_to_packet (acv, colname);
                            verify_cols := verify_cols - [i];
                            IF  (verify_cols = []) AND NOT (verify_length in verify_op)
                            THEN
                                move_len := 8
                            ELSE
                                move_len := sizeof (is_null);
                            (*ENDIF*) 
                            a542move_to_packet (acv, @is_null, move_len)
                            END;
                        (*ENDIF*) 
                        i := i + 1;
                        END;
                    (*ENDWHILE*) 
                    END;
                (*ENDIF*) 
            (*ENDIF*) 
            IF  verify_length in verify_op
            THEN
                BEGIN
                i := 1;
                length_token  :=  'LENGTH( ';
                greater_token := ') > ';
                or_token      := ' OR ';
                WHILE verify_lengthcols <> [] DO
                    BEGIN
                    IF  i in verify_lengthcols
                    THEN
                        BEGIN
                        a542move_to_packet (acv, @length_token, 7);
                        a06extcolno (a_p_arr1.pbasep^.sbase, i, colptr);
                        a061get_colname (colptr^, colname);
                        a542identifier_to_packet (acv, colname);
                        a542move_to_packet (acv, @greater_token, 4);
                        c_datalen := bsp_c20;
                        g17int4to_line (colptr^.cdatalen, false, 5, 1, c_datalen);
                        a542move_to_packet (acv, @c_datalen, 5);
                        verify_lengthcols := verify_lengthcols - [i];
                        IF  verify_lengthcols <> []
                        THEN
                            a542move_to_packet (acv, @or_token, 4);
                        (*ENDIF*) 
                        END;
                    (*ENDIF*) 
                    i := i + 1;
                    END;
                (*ENDWHILE*) 
                END;
            (*ENDIF*) 
            IF  a_returncode = 0
            THEN
                BEGIN
                a51switch_user (acv, a1authname, init_user_name);
                init_ex_kind     := a_ex_kind;
                a_ex_kind        := parsing_executing;
                a_is_ddl         := no_ddl;
                (* PTS 1115778 E.Z. *)
&               ifdef trace
                t01moveobj (ak_sem, a_cmd_part^.sp1p_buf,
                      1, a_cmd_part^.sp1p_buf_len);
&               endif
                IF  a_returncode = 0
                THEN
                    a35_asql_statement (acv);
                (*ENDIF*) 
                a542pop_packet (acv);
                IF  a_returncode = 0
                THEN
                    BEGIN
                    s26find_part (a_return_segm^, sp1pk_data,
                          part_desc_ptr);
                    IF  part_desc_ptr = NIL
                    THEN
                        a07ak_system_error (acv, 13, 9)
                    ELSE
                        IF  part_desc_ptr^.sp1p_buf[2] <>
                            cgg04_zero_exponent
                        THEN
                            a07_b_put_error (acv,
                                  e_alter_column_not_allowed, 1);
                        (*ENDIF*) 
                    (*ENDIF*) 
                    a06reset_retpart (acv)
                    END;
                (*ENDIF*) 
                a51switch_user (acv, init_user_name, init_user_name);
                a_is_ddl  := a_init_ddl;
                a_ex_kind := init_ex_kind
                END;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        END;
    (*ENDWITH*) 
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13long_col_drop (
            VAR acv     : tak_all_command_glob;
            VAR dropcol : tak_dropcol;
            longcoldrop : integer);
 
VAR
      b_err       : tgg00_BasisError;
      col_no      : integer;
      qual_no     : integer;
      i           : integer;
      ilen        : integer;
      gg_strategy : tgg07_StrategyInfo;
 
BEGIN
(* PTS 1115206 M.Ki. *)
IF  acv.a_returncode = 0
THEN
    BEGIN
    a06a_mblock_init (acv, m_update, mm_qual, acv.a_p_arr1.pbasep^.sbase.btreeid);
    WITH acv.a_mblock.mb_qual^ DO
        BEGIN
        mcol_pos    := 1;
        mcol_cnt    := longcoldrop;
        mqual_pos   := mcol_pos + mcol_cnt;
        mqual_cnt   := longcoldrop * 3 + 1;
        mstrat_pos  := mqual_pos + mqual_cnt;
        mstrat_cnt  := 1;
        mfirst_free := mstrat_pos + 1;
        IF  mfirst_free+1 > acv.a_mblock.mb_st_max
        THEN
            a07_b_put_error (acv, e_too_many_mb_stackentries,
                  -acv.a_mblock.mb_st_max);
        (*ENDIF*) 
        col_no      := mcol_pos;
        qual_no     := mqual_pos + 1;
        END;
    (*ENDWITH*) 
    IF  acv.a_returncode = 0
    THEN
        BEGIN
        (* generate stack entries to update all values of this LONG/LONGFILE *)
        (* column to the null value                                          *)
        WITH acv.a_mblock, mb_qual^ DO
            BEGIN
            FOR i := 1 TO dropcol.dcount DO
                WITH dropcol.dcol[ i ].dcolptr^ DO
                    IF  cdatatyp in [ dstra,dstre,dstruni,dstrb,
                        dlonga, dlonge, dlonguni, dlongb ]
                    THEN
                        BEGIN
                        mb_st^[ col_no ]     := ccolstack;
                        mb_st^[ col_no ].eop := op_longcol_update;
                        col_no               := col_no + 1;
                        mb_st^[ qual_no ]    := ccolstack;
                        WITH mb_st^ [qual_no+1] DO
                            BEGIN
                            etype    := st_value;
                            eop      := op_longcol_update;
                            epos     := mb_data_len+1;
                            elen_var := 2;
                            ecol_pos := 0;
                            (* preset null value in data part: *)
                            mb_data_len := mb_data_len+2;
                            mb_data^.mbp_buf [mb_data_len-1] := csp_undef_byte;
                            mb_data^.mbp_buf [mb_data_len  ] := csp_defined_byte;
                            END;
                        (*ENDWITH*) 
                        WITH  mb_st^ [qual_no+2] DO
                            BEGIN
                            etype    := st_output;
                            eop_out  := op_o_output_var;
                            epos     := 0;
                            elen_var := cinoutlen;
                            ecol_pos := 0;
                            END;
                        (*ENDWITH*) 
                        qual_no := qual_no + 3;
                        END;
                    (*ENDIF*) 
                (*ENDWITH*) 
            (*ENDFOR*) 
            a61_set_jump (acv.a_mblock, mqual_pos, st_jump_output);
            mb_st^[ mqual_pos ].epos := mb_st^[ mqual_pos ].epos + 1;
            a71default_strat (gg_strategy);
            ilen:= STRATEGY_START_MXGG07 + sizeof (gg_strategy.str_key_in_range);
            g10mv ('VAK13 ',   3,    
                  sizeof (gg_strategy), mb_strat_size,
                  @gg_strategy, 1,
                  @mb_strat^, mb_strat_len + 1, ilen,
                  acv.a_returncode);
            mstrat_pos  := mfirst_free;
            mstrat_cnt  := 1;
            mfirst_free := mfirst_free + 1;
            g09StratStackentry (mb_st^[ mstrat_pos ], mb_strat_len + 1, ilen );
            mb_strat_len := mb_strat_len + ilen;
            END;
        (*ENDWITH*) 
        acv.a_transinf.tri_trans.trError_gg00 := e_ok;
        IF  acv.a_returncode = 0
        THEN
            BEGIN
            b_err := e_ok;
            a06rsend_mess_buf (acv, acv.a_mblock, cak_return_req, b_err);
            acv.a_transinf.tri_trans.trWarning_gg00 := [ ];
            IF  b_err <> e_ok
            THEN
                a07_b_put_error (acv, b_err, -b_err);
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13alter_tab_drop (
            VAR acv         : tak_all_command_glob;
            VAR a11v        : tak_a11_glob;
            VAR viewscanpar : tak_viewscan_par);
 
VAR
      shrtcolcnt  : tsp00_Int2;
      shrtcoldrop : tsp00_Int2;
      longcoldrop : tsp00_Int2;
      tstart      : integer;
      t           : integer;
      dummy       : integer;
      dummy_st    : tgg00_StackEntry;
      colname     : tsp00_KnlIdentifier;
 
BEGIN
IF  acv.a_returncode = 0
THEN
    BEGIN
    tstart        := acv.a_ap_tree^ [ a11v.a1ti ].n_lo_level;
    t             := tstart;
    viewscanpar.vsc_dr_col.dcount := 1;
    viewscanpar.vsc_drop_set      := [  ];
    viewscanpar.vsc_type          := v_alter_drop;
    viewscanpar.vsc_init_type     := v_version;
    shrtcolcnt  := ak13count_short_cols (acv); (* PTS 1115206 M.Ki *)
    shrtcoldrop := 0;
    longcoldrop := 0;
    REPEAT
        WITH viewscanpar.vsc_dr_col.dcol[ viewscanpar.vsc_dr_col.dcount ],
             acv.a_ap_tree^[ t ] DO
            BEGIN
            a05identifier_get (acv, t, sizeof (a11v.a1coln), a11v.a1coln);
            IF  NOT (a061exist_columnname (acv.a_p_arr1.pbasep^.sbase, a11v.a1coln,
                dcolptr))
            THEN
                a07_nb_put_error (acv, e_unknown_columnname,
                      n_pos, a11v.a1coln)
            ELSE
                BEGIN
                IF  ctkey in dcolptr^.ccolpropset
                THEN
                    a07_nb_put_error (acv, e_key_not_allowed,
                          n_pos, a11v.a1coln);
                (*ENDIF*) 
                IF  ctlink in dcolptr^.ccolpropset
                THEN
                    a07_nb_put_error (acv,
                          e_link_column_not_allowed,
                          n_pos, a11v.a1coln);
                (* PTS 1115206 M.Ki. *)
                (*ENDIF*) 
                IF  (dcolptr^.cdatatyp
                    in [ dstra,dstre,dstruni,dstrb ])    AND
                    (NOT (dcolptr^.cextcolno in viewscanpar.vsc_drop_set))
                THEN
                    shrtcoldrop := shrtcoldrop + 1;
                (*ENDIF*) 
                IF  (dcolptr^.cdatatyp
                    in [ dstra,dstre,dstruni,dstrb,
                    dlonga, dlonge, dlonguni, dlongb ])    AND
                    (NOT (dcolptr^.cextcolno in viewscanpar.vsc_drop_set))
                THEN
                    longcoldrop := longcoldrop + 1;
                (*ENDIF*) 
                dextno := dcolptr^.cextcolno;
                IF  NOT (dcolptr^.cextcolno in viewscanpar.vsc_drop_set)
                THEN
                    viewscanpar.vsc_dr_col.dcount := viewscanpar.vsc_dr_col.dcount + 1
                ELSE (* PTS 1118655 M.Ki. *)
                    IF  acv.a_sqlmode = sqlm_oracle
                    THEN
                        a07_nb_put_error (acv, e_duplicate_columnname, n_pos,
                              a11v.a1coln);
                    (*ENDIF*) 
                (*ENDIF*) 
                viewscanpar.vsc_drop_set := viewscanpar.vsc_drop_set + [ dextno ];
                a061get_colname (dcolptr^, colname);
                a38column_drop (acv,
                      a11v.a1authname, a11v.a1tablen, colname);
                END;
            (*ENDIF*) 
            t := acv.a_ap_tree^[ t ].n_sa_level;
            END;
        (*ENDWITH*) 
    UNTIL
        (t = 0) OR (acv.a_returncode <> 0);
    (*ENDREPEAT*) 
    viewscanpar.vsc_dr_col.dcount := viewscanpar.vsc_dr_col.dcount - 1;
&   ifdef TRACE
    t01int4 (ak_sem, 'dcount=     ', viewscanpar.vsc_dr_col.dcount);
&   endif
    WITH acv.a_p_arr1.pbasep^.sbase DO
        IF  bmaxcol - viewscanpar.vsc_dr_col.dcount - bkeycolcount - bcntdropcol <= 0
        THEN
            IF  btablekind = twithoutkey
            THEN
                a07_b_put_error(acv, e_too_many_cols_dropped, 1);
            (*ENDIF*) 
        (*ENDIF*) 
    (*ENDWITH*) 
    IF  acv.a_returncode = 0
    THEN
        BEGIN
        WITH acv.a_p_arr1.pbasep^.sbase DO
            IF  [ del_trigger, ins_trigger, upd_trigger ] *
                acv.a_p_arr1.pbasep^.sbase.blinkexist <> [  ]
            THEN
                a262drop_tab_col_trigger (acv,
                      viewscanpar, dummy_st);
            (*ENDIF*) 
        (*ENDWITH*) 
        a13add_dropped_columns (acv, 0, viewscanpar);
        a13repl_priv_column    (acv, acv.a_p_arr1.pbasep, viewscanpar.vsc_drop_set);
        dummy := 0;
        ak13drop_indexes       (acv, a11v, viewscanpar,
              acv.a_p_arr1, viewscanpar.vsc_drop_set, viewscanpar.vsc_drop_set,
              NOT c_drop_all_index, NIL, dummy);
        (* PTS 1115206 M.Ki. *)
        IF  longcoldrop > 0
        THEN
            ak13long_col_drop (acv, viewscanpar.vsc_dr_col, longcoldrop);
        (*ENDIF*) 
        IF  (shrtcoldrop = shrtcolcnt)          AND
            (shrtcolcnt > 0)                    AND
            (acv.a_returncode = 0)
        THEN
            BEGIN
            (* all short LONG columns dropped -> remove short column file *)
            WITH acv.a_transinf DO
                BEGIN
                tri_trans.trError_gg00 := e_ok;
                k64short_col_file_drop (tri_trans,
                      acv.a_p_arr1.pbasep^.sbase.btreeid);
                IF  tri_trans.trError_gg00 <> e_ok
                THEN
                    a07_b_put_error (acv, tri_trans.trError_gg00, 1);
                (*ENDIF*) 
                END
            (*ENDWITH*) 
            END;
        (*ENDIF*) 
        ak13drop_col_dependant_obj  (acv, a11v, viewscanpar);
        ak13rename_dropcolumns      (acv, a11v, viewscanpar.vsc_dr_col);
        a11v.a1keypos := acv.a_p_arr1.pcount;
        END;
    (*ENDIF*) 
    END;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13primary_key (
            VAR acv         : tak_all_command_glob;
            VAR a11v        : tak_a11_glob;
            VAR viewscanpar : tak_viewscan_par);
 
VAR
      skip_key     : boolean;
      drop_key     : boolean;
      b_err        : tgg00_BasisError;
      i            : integer;
      j            : integer;
      colno        : integer;
      colind       : integer;
      key_pos      : integer;
      fix_pos      : integer;
      key_cnt      : integer;
      var_cnt      : integer;
      longVarCnt   : integer;
      cnt          : integer;
      indexid      : integer;
      dummy        : integer;
      min_reclen   : integer;
      colptr       : tak00_colinfo_ptr;
      new_colptr   : tak00_colinfo_ptr;
      indexname    : tsp00_KnlIdentifier;
      colname      : tsp00_KnlIdentifier;
      index_treeid : tgg00_FileId;
      old_p        : tak_syspointerarr;
      key_cols     : tak_colinteger;
      map          : tak_colinteger;
      mod_colset   : tak_columnset;
      ext_map      : tak13ext_mapping;
      qual         : tak_del_tab_qual;
 
BEGIN
WITH acv, a11v, viewscanpar DO
    BEGIN
    FOR i := 1 TO c_max_ext_map DO
        BEGIN
        ext_map[i].em_new_colp := NIL;
        ext_map[i].em_old_colp := NIL
        END;
    (*ENDFOR*) 
    WITH a_ap_tree^[a1ti] DO
        BEGIN
        drop_key    := n_length = cak_i_drop;
        IF  ((n_length = cak_i_alter) OR (n_length = cak_i_drop))
            AND
            (a_p_arr1.pbasep^.sbase.btablekind = twithoutkey)
        THEN
            IF  n_length = cak_i_drop
            THEN
                a07_b_put_error (acv, e_key_does_not_exist, 1)
            ELSE
                n_length := cak_i_add
            (*ENDIF*) 
        ELSE
            IF  (n_length = cak_i_add) AND
                (a_p_arr1.pbasep^.sbase.btablekind = twithkey)
            THEN
                a07_b_put_error (acv, e_key_not_allowed, 1)
            ELSE
                (* PTS 1123535 E.Z. *)
                IF  (n_length = cak_i_add) AND
                    (ftsArchive_egg00 in a_p_arr1.pbasep^.sbase.btreeid.fileType_gg00)
                THEN
                    a07_b_put_error (acv, e_invalid_tabletype, 1);
                (*ENDIF*) 
            (*ENDIF*) 
        (*ENDIF*) 
        END;
    (*ENDWITH*) 
    i           := a_ap_tree^[a1ti].n_lo_level;
    indexname   := a01_il_b_identifier;
&   ifdef trace
    t01int4 (ak_sem, 'a1ti        ', a1ti);
    t01int4 (ak_sem, 'i           ', i);
&   endif
    IF  i <> 0
    THEN
        BEGIN
        (* read in indexname of unique index substituting *)
        (* the primary key                                *)
        a05identifier_get (acv, i, sizeof (indexname), indexname);
        a1ci := a_ap_tree^[i].n_pos
        END;
&   ifdef trace
    (*ENDIF*) 
    t01lidentifier (ak_sem, indexname);
&   endif
    a1ti := a_ap_tree^[a1ti].n_sa_level;
    IF  a1ti <> 0
    THEN
        a1ti := a_ap_tree^[a1ti].n_sa_level;
    (*ENDIF*) 
    ak13check_key (acv, a11v, key_cnt, key_cols);
    IF  a_returncode = 0
    THEN
        ak13new_base_record (acv, a11v, viewscanpar, old_p, c_new_file_version);
    (*ENDIF*) 
    IF  (a_returncode = 0) AND (* h.b. PTS 1002077 *)
        (vsc_base_tabid <> old_p.pbasep^.sbase.bsurrogate)
    THEN
        ak13new_table_ref (acv, a11v);
    (*ENDIF*) 
    IF  a_returncode = 0
    THEN
        BEGIN
        IF  drop_key
        THEN
            a11put_systemkey (acv, a11v);
        (* copy all visible columns of the table into the new *)
        (* base record(s)                                     *)
        (*ENDIF*) 
        WITH old_p.pbasep^.sbase DO
            skip_key := btablekind = twithoutkey;
        (*ENDWITH*) 
        colno := 1;
        WHILE (colno <= old_p.pbasep^.sbase.bmaxcol) AND
              (a_returncode = 0) DO
            BEGIN
            a06extcolno (old_p.pbasep^.sbase, colno, colptr);
            WITH colptr^ DO
                IF  NOT (ctdropped in ccolpropset) AND
                    NOT (skip_key AND (ctkey in ccolpropset))
                THEN
                    IF  a_p_arr1.pbasep^.sbase.bmaxcol = MAX_COL_PER_TAB_GG00
                    THEN
                        a07_b_put_error (acv,e_too_many_columns,1)
                    ELSE
                        BEGIN
                        IF  cdatatyp in [dstra, dstre, dstruni, dstrb,
                            dlonga, dlonge, dlonguni, dlongb]
                        THEN
                            a_p_arr1.pbasep^.sbase.bstringcount :=
                                  a_p_arr1.pbasep^.sbase.bstringcount + 1;
                        (*ENDIF*) 
                        IF  cinoutlen > cak_maxfieldlength + 1
                        THEN
                            a_p_arr1.pbasep^.sbase.blongvarcolcnt :=
                                  a_p_arr1.pbasep^.sbase.blongvarcolcnt + 1;
                        (*ENDIF*) 
                        a061get_colname (colptr^, colname);
                        a061app_columnname (acv, a_p_arr1.pbasep^.sbase,
                              colname, i);
                        IF  a_returncode = 0
                        THEN
                            BEGIN
                            new_colptr := a_p_arr1.pbasep^.sbase.bcolumn[i];
                            a061copy_colinfo (colptr^, new_colptr^);
                            new_colptr^.cextcolno :=
                                  a_p_arr1.pbasep^.sbase.bmaxcol;
                            new_colptr^.creccolno :=
                                  new_colptr^.cextcolno;
                            new_colptr^.ccolpropset :=
                                  new_colptr^.ccolpropset - [ctmulti];
                            IF  ctkey in ccolpropset
                            THEN
                                BEGIN
                                IF  (cinoutlen <= cak_maxconstlength + 1)
                                    AND (* PTS 1126958 *)
                                    NOT (
                                    ((cdatatyp in [dcha, dche, dunicode]) AND
                                    cvarchar                              AND
                                    (cdatalen > 2))
                                    )
                                    (* PTS 1126711 E.Z. *)
                                    AND
                                    NOT (ta_no_fixed_length_column in old_p.pbasep^.sbase.battributes)
                                THEN
                                    new_colptr^.ccolstack.etype :=
                                          st_fixcol
                                ELSE
                                    IF  cinoutlen > cak_maxfieldlength + 1 (* PTS 1126958 *)
                                    THEN
                                        new_colptr^.ccolstack.etype := st_varlongchar
                                    ELSE
                                        new_colptr^.ccolstack.etype :=
                                              st_varcol;
                                    (*ENDIF*) 
                                (*ENDIF*) 
                                new_colptr^.ccolpropset :=
                                      new_colptr^.ccolpropset - [ctkey]
                                END;
                            (*ENDIF*) 
                            IF  drop_key (* PTS 1126958 *)
                            THEN
                                IF  NOT (new_colptr^.cdatatyp in [dstra, dstre, dstrb, dstruni])
                                THEN
                                    new_colptr^.ccolstack.epos := colno +
                                          old_p.pbasep^.sbase.bstringcount *
                                          (cgg04_str_col_entry_size + 1);
                                (*ENDIF*) 
                            (*ENDIF*) 
                            WITH ext_map[cextcolno] DO
                                BEGIN
&                               ifdef trace
                                t01int4 (ak_sem, 'extmap      ',
                                      cextcolno);
                                a061td_colinfo (colptr^, 1);
                                a061td_colinfo (new_colptr^, 1);
&                               endif
                                em_old_colp := colptr;
                                em_new_colp := new_colptr
                                END;
                            (*ENDWITH*) 
                            map[new_colptr^.cextcolno] := cextcolno
                            END;
                        (*ENDIF*) 
                        END;
                    (*ENDIF*) 
                (*ENDIF*) 
            (*ENDWITH*) 
            colno := colno + 1
            END;
        (*ENDWHILE*) 
        END;
    (*ENDIF*) 
    IF  a_returncode = 0
    THEN
        BEGIN
        key_pos := 1;
        FOR i := 1 TO key_cnt DO
            BEGIN
            WITH ext_map[key_cols[i]].em_new_colp^ DO
                BEGIN
                IF  i = key_cnt
                THEN
                    ccolstack.etype := st_varkey
                ELSE
                    ccolstack.etype := st_fixkey;
                (*ENDIF*) 
                ccolpropset := ccolpropset + [ctkey] -
                      [ctopt];
                ccolstack.epos     := key_pos;
                ccolstack.elen_var := cinoutlen;
                key_pos            := key_pos + cinoutlen
                END;
            (*ENDWITH*) 
            END;
        (*ENDFOR*) 
        WITH a_p_arr1.pbasep^.sbase DO
            BEGIN
            IF  drop_key
            THEN
                btablekind := twithoutkey
            ELSE
                BEGIN
                (* PTS 1111576 E.Z. *)
                btablekind := twithkey;
                bkeycolcount := key_cnt
                END;
            (*ENDIF*) 
            END;
        (*ENDWITH*) 
        a11sort (a_p_arr1.pbasep^.sbase);
        fix_pos    := 1;
        var_cnt    := 0;
        longVarCnt := 0;
        colind     := a_p_arr1.pbasep^.sbase.bfirstcolind;
        min_reclen := 1;
        WHILE colind <> 0 DO
            WITH a_p_arr1.pbasep^.sbase.bcolumn[colind]^ DO
                BEGIN
                a_p_arr1.pbasep^.sbase.bmaxreclen :=
                      a_p_arr1.pbasep^.sbase.bmaxreclen + cinoutlen;
                CASE ccolstack.etype OF
                    st_fixcol :
                        BEGIN
                        ccolstack.epos := fix_pos;
                        fix_pos        := fix_pos + cinoutlen;
                        min_reclen     := min_reclen + cinoutlen;
                        END;
                    st_varcol :
                        BEGIN
                        a_p_arr1.pbasep^.sbase.bmaxreclen :=
                              a_p_arr1.pbasep^.sbase.bmaxreclen + 1;
                        var_cnt            := var_cnt + 1;
                        ccolstack.ecolno   := var_cnt;
                        min_reclen         := min_reclen + 1
                        END;
                    st_varlongchar :
                        BEGIN
                        longVarCnt       := longVarCnt + 1;
                        ccolstack.ecolno := longVarCnt; (* PTS 1108618 *)
                        a_p_arr1.pbasep^.sbase.bmaxreclen :=
                              a_p_arr1.pbasep^.sbase.bmaxreclen + 2;
                        min_reclen := min_reclen + 2
                        END;
                    OTHERWISE ;
                        min_reclen := min_reclen + cinoutlen;
                    END;
                (*ENDCASE*) 
&               ifdef trace
                t01int4 (ak_sem, 'maxreclen   ',
                      a_p_arr1.pbasep^.sbase.bmaxreclen);
&               endif
                IF  a_sqlmode <> sqlm_oracle
                THEN
                    min_reclen := a_p_arr1.pbasep^.sbase.bmaxreclen;
                (*ENDIF*) 
                IF  a_p_arr1.pbasep^.sbase.bmaxreclen > MAX_RECLEN_GG00
                THEN
                    a_p_arr1.pbasep^.sbase.bmaxreclen := MAX_RECLEN_GG00;
                (*ENDIF*) 
                IF  min_reclen > MAX_RECLEN_GG00
                THEN
                    a07_b_put_error (acv, e_too_long_record, 1);
                (*ENDIF*) 
                colind := cnextind;
                END;
            (*ENDWITH*) 
        (*ENDWHILE*) 
        WITH a_p_arr1.pbasep^.sbase DO
            BEGIN
            blenfixedcol := fix_pos;
            bvarcolcount := var_cnt;
            END;
        (*ENDWITH*) 
        cnt := 0;
        WITH a_p_arr1.pbasep^.sbase DO
            FOR j := bfirstindex TO blastindex DO
                WITH bcolumn[j]^ DO
                    BEGIN
                    a_p_arr1.pbasep^.sbase.
                          bextcolindex[cextcolno] := cnt;
                    cnt := cnt + 1
                    END;
                (*ENDWITH*) 
            (*ENDFOR*) 
        (*ENDWITH*) 
        END;
    (*ENDIF*) 
    IF  a_returncode = 0
    THEN
        BEGIN
        a11sort (a_p_arr1.pbasep^.sbase);
        (* PTS 1111576 E.Z. *)
        IF  a_returncode = 0
        THEN
            ak13pk_index_drop (acv, a11v, old_p, viewscanpar,
                  ext_map, key_cnt, key_cols, indexname, index_treeid);
        (*ENDIF*) 
        IF  a_returncode = 0
        THEN
            BEGIN
            dummy := 0;
            ak13pk_change_file (acv, a11v,
                  old_p, map, ext_map, NIL, dummy, index_treeid);
            END;
        (*ENDIF*) 
        IF  a_returncode = 0
        THEN
            ak13pk_create_index (acv, a11v, old_p, viewscanpar,
                  indexname, indexid);
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  a_returncode = 0
    THEN
        BEGIN
        mod_colset := [];
        ak13copy_table_records (acv, a11v, mod_colset, old_p,
              ext_map, NOT c_modify_index, indexid);
        IF  a_returncode = 0
        THEN
            BEGIN
            qual.del_colno := 0;
            a10_del_tab_sysinfo (acv, a1tableid,
                  qual, false, b_err);
            IF  b_err <> e_ok
            THEN
                a07_b_put_error (acv, b_err, 1)
            (*ENDIF*) 
            END
        (*ENDIF*) 
        END;
    (* force a11end_create table to insert *)
    (* new base records                    *)
    (*ENDIF*) 
    a1sort   := true;
    a11end_create_table (acv, a11v);
    IF  (indexname <> a01_il_b_identifier) AND
        (a_returncode = 0)
    THEN (* create unique index substituting the primary key *)
        ak13pk_unique_index (acv, a11v, old_p, indexname);
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13pk_change_file (
            VAR acv          : tak_all_command_glob;
            VAR a11v         : tak_a11_glob;
            VAR old_p        : tak_syspointerarr;
            VAR map          : tak_colinteger;
            VAR ext_map      : tak13ext_mapping;
            mult_desc_ptr    : tgg00_StackListPtr;
            mult_desc_cnt    : integer;
            VAR index_treeid : tgg00_FileId);
 
VAR
      is_new_long    : boolean;
      change_key     : boolean;
      m2_type        : tgg00_MessType2;
      b_err          : tgg00_BasisError;
 
BEGIN
WITH acv, a11v DO
    BEGIN
    is_new_long := false;
    change_key  := mult_desc_ptr = NIL;
    WITH a_p_arr1.pbasep^.sbase DO
        BEGIN
        btreeid.fileTabId_gg00 := a_p_arr1.pbasep^.syskey.stableid;
        btreeid.fileRoot_gg00  := NIL_PAGE_NO_GG00;
        a06a_mblock_init (acv,
              m_create_table, mm_key, btreeid);
        IF  is_new_long
        THEN
            a_mblock.mb_qual^.mstring_pos := blenfixedcol - 1
        ELSE
            a_mblock.mb_qual^.mstring_pos := cgg_nil_varcol_cnt_off;
        (*ENDIF*) 
        (* PTS 1115359: initialise mstring_cnt with 0 LONG columns; *)
        (* otherwise a rollback will delete long column files       *)
        (* 'inherited' from old base record:                        *)
        a_mblock.mb_qual^.mstring_cnt := 0;
        a06rsend_mess_buf (acv,
              a_mblock, cak_return_req, b_err);
        btreeid := a_mblock.mb_qual^.mtree
        END;
    (*ENDWITH*) 
    IF  b_err = e_ok
    THEN
        BEGIN
        IF  change_key
        THEN
            m2_type := mm_key
        ELSE
            m2_type := mm_table;
        (*ENDIF*) 
        a06a_mblock_init (acv,
              m_change, m2_type, a_p_arr1.pbasep^.sbase.btreeid);
        ak13build_mapping_stack(acv, old_p, map, ext_map,
              mult_desc_ptr, mult_desc_cnt, index_treeid,
              change_key, b_err);
        IF  b_err = e_ok
        THEN
            a06rsend_mess_buf (acv, a_mblock, cak_return_req, b_err)
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  b_err <> e_ok
    THEN
        a07_b_put_error (acv, b_err, 1)
    ELSE
        WITH a_p_arr1.pbasep^.sbase DO
            BEGIN
            IF  (bstringcount > 0)
            THEN
                (* PTS 1115359: increase file version and set LONG column *)
                (*              count to correct value:                   *)
                a10alter_long_version (acv, a_p_arr1.pbasep^.sbase, 0,
                      m_succ_file_version, NOT c_scan_views);
            (*ENDIF*) 
            brows  := a_mblock.mb_data^.mbp_sample.records;
            bpages := a_mblock.mb_data^.mbp_sample.leafnodes
            END;
        (*ENDWITH*) 
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13copy_table_records (
            VAR acv        : tak_all_command_glob;
            VAR a11v       : tak_a11_glob;
            VAR mod_colset : tak_columnset;
            VAR old_p      : tak_syspointerarr;
            VAR ext_map    : tak13ext_mapping;
            modify_index   : boolean;
            indexid        : integer);
 
VAR
      do_upd      : boolean;
      b_err       : tgg00_BasisError;
      entrytype   : tsp00_C2;
      colno       : integer;
      i           : integer;
      sysk        : tgg00_SysInfoKey;
      new_sysk    : tgg00_SysInfoKey;
 
BEGIN
WITH acv, a11v DO
    BEGIN
    sysk             := old_p.pbasep^.syskey;
    sysk.slinkage[2] := chr(255);
    entrytype        := cak_edummy;
    REPEAT
        a10next_sysinfo (acv, sysk,
              SURROGATE_MXGG00, d_fix,
              entrytype, a_ptr1, b_err);
        IF  b_err = e_ok
        THEN
            BEGIN
            do_upd            := true;
            new_sysk          := sysk;
            new_sysk.stableid := a_p_arr1.pbasep^.syskey.stableid;
            colno := ord (sysk.slinkage[1]) * 256 + ord (sysk.slinkage[2]);
            CASE sysk.sentrytyp[2] OF
                cak_calterdate :
                    BEGIN
                    WITH ext_map[colno] DO
                        IF  em_new_colp <> NIL
                        THEN
                            BEGIN
                            new_sysk.slinkage[1] :=
                                  chr (em_new_colp^.cextcolno DIV 256);
                            new_sysk.slinkage[2] :=
                                  chr (em_new_colp^.cextcolno MOD 256);
                            IF  em_new_colp^.cextcolno in mod_colset
                            THEN
                                WITH a_ptr1^.salterdate DO
                                    a11put_date_time (ad_alterdate, ad_altertime);
                                (*ENDWITH*) 
                            (*ENDIF*) 
                            END;
                        (*ENDIF*) 
                    (*ENDWITH*) 
                    END;
                cak_ccomment :
                    IF  sysk.stablen[1] = chr(ord(cm_column))
                    THEN
                        BEGIN
                        colno := ord (sysk.stablen[2]) * 256 +
                              ord (sysk.stablen[3]);
                        WITH ext_map[colno] DO
                            BEGIN
                            new_sysk.stablen[2] :=
                                  chr(em_new_colp^.cextcolno DIV 256);
                            new_sysk.stablen[3] :=
                                  chr(em_new_colp^.cextcolno MOD 256);
                            END;
                        (*ENDWITH*) 
                        END;
                    (*ENDIF*) 
                cak_cconstraint :
                    ak13pk_constraint (acv, ext_map, old_p);
                cak_cdefault, cak_cdomainusage :
                    WITH ext_map[colno] DO
                        BEGIN
                        new_sysk.slinkage[1] :=
                              chr (em_new_colp^.cextcolno DIV 256);
                        new_sysk.slinkage[2] :=
                              chr (em_new_colp^.cextcolno MOD 256)
                        END;
                    (*ENDWITH*) 
                cak_cforeignkey, cak_cprimarykey :
                    ak13pk_ref_integrity (acv, a_ptr1^.slink,
                          ext_map, a1tableid, indexid);
                cak_cmindex :
                    IF  modify_index
                    THEN
                        ak13modify_index (acv,
                              ext_map, a_ptr1^.smindex);
                    (*ENDIF*) 
                cak_cpriv  :
                    ak13pk_privrec (acv,
                          ext_map, sysk.suserid, a1tableid);
                cak_cprivuser :
                    ak13pk_priv (acv,
                          ext_map, a_ptr1^.sprivuser.pru_priv);
                cak_cstatistics :
                    ak13pk_statistics (acv, a_ptr1, ext_map);
                cak_cusage :
                    WITH a_ptr1^.susage DO
                        BEGIN
                        i := 1;
                        WHILE (i <= usagecount) AND (b_err = e_ok) DO
                            BEGIN
                            IF  NOT (usagedef[i].usa_empty) AND
                                (usagedef[i].usa_tablekind = tsynonym)
                            THEN
                                ak13pk_synonym (acv, usagedef[i]);
                            (*ENDIF*) 
                            i := i + 1
                            END;
                        (*ENDWHILE*) 
                        END;
                    (*ENDWITH*) 
                cak_cviewdesc :
                    (* PTS 1111576 E.Z. *)
                    ak13pk_viewdesc (ext_map, a_ptr1^.sviewdesc);
                cak_cpermmessblock : (* PTS 1113024 *)
                    a_ptr1^.smessblock.mbr_mess_block.mb_qual^.mtree.fileTabId_gg00 :=
                          new_sysk.stableid;
                cak_csequence :
                    BEGIN
                    (* copy current value into catalog und remove from cache *)
                    ak13FlushSequenceForDrop (acv, a_ptr1^.ssequence, b_err);
                    END;
                OTHERWISE
                    do_upd := false;
                END;
            (*ENDCASE*) 
            END;
        (*ENDIF*) 
        IF  (b_err = e_ok) AND (a_returncode = 0)
        THEN
            BEGIN
            IF  sysk.stableid = new_sysk.stableid
            THEN
                BEGIN
                IF  do_upd
                THEN
                    a10repl_sysinfo (acv, a_ptr1, b_err)
                (*ENDIF*) 
                END
            ELSE
                BEGIN
                a10_copy_catalog_rec (acv,
                      sysk, false, new_sysk,
                      a_p_arr1.pbasep^.sbase.bsegmentid,
                      c_add_rec, b_err);
                a10_key_del (acv, sysk);
                IF  new_sysk.sentrytyp = cak_epermmessblock (* PTS 1113024 *)
                THEN
                    BEGIN (* skip part records of perm messblock *)
                    sysk.stablen[1] := chr(255);
                    sysk.skeylen    := mxak_standard_sysk + 1
                    END;
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            a10_rel_sysinfo (acv, new_sysk)
            END
        ELSE
            IF  (b_err = e_no_next_record) AND
                (entrytype = cak_edummy)
            THEN
                BEGIN (* scan system file 2 *)
                b_err         := e_ok;
                entrytype     := cak_esysfile2;
                sysk          := a01defaultkey;
                sysk.stableid := a1tableid
                END;
            (*ENDIF*) 
        (*ENDIF*) 
    UNTIL
        b_err <> e_ok;
    (*ENDREPEAT*) 
    IF  b_err <> e_no_next_record
    THEN
        a07_b_put_error (acv, b_err, 1)
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13pk_constraint (
            VAR acv     : tak_all_command_glob;
            VAR ext_map : tak13ext_mapping;
            VAR old_p : tak_syspointerarr);
 
VAR
      i           : integer;
      extcolno    : integer;
      new_ccolset : tak_columnset;
 
BEGIN
WITH acv, a_ptr1^.sconstraint DO
    BEGIN
    new_ccolset := [];
    FOR i := 1 TO old_p.pbasep^.sbase.bmaxcol DO
        IF  i in ccolset
        THEN
            WITH ext_map[i] DO
                new_ccolset := new_ccolset +
                      [em_new_colp^.cextcolno];
            (*ENDWITH*) 
        (*ENDIF*) 
    (*ENDFOR*) 
    ccolset := new_ccolset;
    extcolno := 0; (* just to avoid warnings: uninitialized extcolno *)
    FOR i := 1 TO cstack_cnt DO
        BEGIN
        ak13eval_extcolno (old_p, cstack[i], extcolno);
        IF  extcolno > 0
        THEN
            WITH ext_map[extcolno].em_new_colp^ DO
                BEGIN
                cstack[i].etype    := ccolstack.etype;
                cstack[i].epos     := ccolstack.epos;
                cstack[i].elen_var := ccolstack.elen_var
                END;
            (*ENDWITH*) 
        (*ENDIF*) 
        END;
    (*ENDFOR*) 
    END;
(*ENDWITH*) 
END;
 
(* PTS 1111576 E.Z. *)
(*------------------------------*) 
 
PROCEDURE
      ak13pk_viewdesc (
            VAR ext_map      : tak13ext_mapping;
            VAR viewdesc_rec : tak_viewdescrecord);
 
VAR
      ix : integer;
 
BEGIN
WITH viewdesc_rec DO
    BEGIN
    FOR ix := 1 TO vdesc_cnt DO
        WITH vdescription[ix] DO
            BEGIN
&           ifdef trace
            t01int4 (ak_sem, 'vextcolno   ', vextcolno);
            t01int4 (ak_sem, 'vfromextcoln', vfromextcolno);
&           endif
            vfromextcolno :=
                  ext_map[vfromextcolno].em_new_colp^.cextcolno
            END;
        (*ENDWITH*) 
    (*ENDFOR*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13eval_extcolno (
            VAR p_arr       : tak_syspointerarr;
            VAR stack_entry : tgg00_StackEntry;
            VAR extcolno    : integer);
 
VAR
      colind : integer;
 
BEGIN
IF  stack_entry.etype in [st_fixkey, st_varkey, st_fixcol, st_varcol]
THEN
    BEGIN
    WITH p_arr.pbasep^.sbase DO
        BEGIN
        colind := bfirstindex;
        WHILE colind <= blastindex DO
            WITH bcolumn[colind]^, ccolstack DO
                IF  (etype = stack_entry.etype) AND
                    (epos  = stack_entry.epos ) AND
                    ((elen_var = stack_entry.elen_var) OR
                    (etype in [st_fixkey, st_fixcol]))
                THEN
                    BEGIN
                    extcolno := cextcolno;
                    colind   := blastindex + 1
                    END
                ELSE
                    colind := colind + 1;
                (*ENDIF*) 
            (*ENDWITH*) 
        (*ENDWHILE*) 
        END;
    (*ENDWITH*) 
    END
ELSE
    extcolno := cak_is_undefined;
(*ENDIF*) 
&ifdef trace
t01int4 (ak_sem, 'extcolno    ', extcolno);
&endif
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13pk_ref_integrity (
            VAR acv       : tak_all_command_glob;
            VAR linkrec   : tak_linkrecord;
            VAR ext_map   : tak13ext_mapping;
            VAR old_tabid : tgg00_Surrogate;
            indexid       : integer);
 
VAR
      found       : boolean;
      b_err       : tgg00_BasisError;
      i           : integer;
      j           : integer;
      k           : integer;
      index_id    : integer;
      ci          : integer;
      cnt         : integer;
      entry_cnt   : integer;
      linkbuf     : tak_sysbufferaddress;
      search_link : tsp00_KnlIdentifier;
      curr_link   : tsp00_KnlIdentifier;
      sysk        : tgg00_SysInfoKey;
 
BEGIN
WITH acv, linkrec DO
    BEGIN
&   ifdef trace
    t01int4 (ak_sem, 'indexid     ', indexid);
&   endif
    WITH a_p_arr1.pbasep^.sbase DO
        blinkexist := blinkexist - [unique_pk_table];
    (*ENDWITH*) 
    i         := 1;
    entry_cnt := linkrec.lreclen DIV sizeof (tak_linkdef);
    WHILE (i <= entry_cnt) AND (a_returncode = 0) DO
        BEGIN
        WITH linkdef[i] DO
            IF  linkrec.lentrytype = cak_eprimarykey
            THEN
                BEGIN
                index_id := ord (lindexid[1]);
                IF  a_p_arr1.pbasep^.sbase.btablekind = twithoutkey
                THEN
                    BEGIN (* primary key has been dropped *)
                    IF  lindexid[1] = chr(0)
                    THEN
                        IF  indexid = cak_is_undefined
                        THEN
                            a07_b_put_error (acv,
                                  e_link_column_not_allowed, 1)
                        ELSE
                            lindexid[1] := chr(indexid)
                        (*ENDIF*) 
                    ELSE
                        lindexid[1] := chr(index_id);
                    (*ENDIF*) 
&                   ifdef trace
                    t01int4 (ak_sem, 'lindexid(1) ', ord (lindexid[1]));
&                   endif
                    END
                ELSE
                    lindexid[1] := chr(0);
                (*ENDIF*) 
                FOR j := 1 TO lcolcount DO
                    BEGIN
                    WITH ext_map[lprimcolseq[j]] DO
                        lprimcolseq[j] :=
                              em_new_colp^.cextcolno;
                    (*ENDWITH*) 
                    ci := a_p_arr1.pbasep^.sbase.bfirstcolind;
                    WHILE ci <> 0 DO
                        WITH a_p_arr1.pbasep^.sbase.bcolumn[ci]^ DO
                            BEGIN
                            IF  cextcolno = lprimcolseq[j]
                            THEN
                                BEGIN
                                IF  a_p_arr1.pbasep^.sbase.btablekind =
                                    twithkey
                                THEN
                                    IF  (NOT (ctkey in ccolpropset)) OR
                                        (lcolcount <> a_p_arr1.pbasep^.
                                        sbase.bkeycolcount)
                                    THEN
                                        lindexid[1] := chr (index_id);
                                    (*ENDIF*) 
                                (*ENDIF*) 
                                lstack[j].etype := ccolstack.etype;
                                lstack[j].epos  := ccolstack.epos;
                                lstack[j].elen_var :=
                                      ccolstack.elen_var;
&                               ifdef trace
                                t01int4 (ak_sem, 'index_id    ',
                                      ord (lindexid[1]));
                                t01stackentry (ak_sem, lstack[j], 1);
&                               endif
                                END;
                            (*ENDIF*) 
                            ci := cnextind;
                            END;
                        (*ENDWITH*) 
                    (*ENDWHILE*) 
                    END;
                (*ENDFOR*) 
                IF  lindexid[1] <> chr (0)
                THEN
                    WITH a_p_arr1.pbasep^.sbase DO
                        blinkexist := blinkexist + [unique_pk_table]
                    (*ENDWITH*) 
                (*ENDIF*) 
                END
            ELSE
                BEGIN
                FOR j := 1 TO lcolcount DO
                    BEGIN
                    WITH ext_map[lseccolseq[j]] DO
                        lseccolseq[j] :=
                              em_new_colp^.cextcolno;
                    (*ENDWITH*) 
                    ci := a_p_arr1.pbasep^.sbase.bfirstcolind;
                    WHILE ci <> 0 DO
                        WITH a_p_arr1.pbasep^.sbase.bcolumn[ci]^ DO
                            BEGIN
                            IF  cextcolno = lseccolseq[j]
                            THEN
                                BEGIN
                                lstack[j].etype := ccolstack.etype;
                                lstack[j].epos  := ccolstack.epos;
                                lstack[j].elen_var :=
                                      ccolstack.elen_var;
                                END;
                            (*ENDIF*) 
                            ci := cnextind
                            END;
                        (*ENDWITH*) 
                    (*ENDWHILE*) 
                    END;
                (*ENDFOR*) 
                END;
            (*ENDIF*) 
        (*ENDWITH*) 
        sysk          := a01defaultkey;
        sysk.stableid := linkdef[i].ltableid;
        IF  linkrec.lentrytype = cak_eprimarykey
        THEN
            sysk.sentrytyp := cak_eforeignkey
        ELSE
            sysk.sentrytyp := cak_eprimarykey;
        (*ENDIF*) 
        found := false;
        REPEAT
            a10get_sysinfo (acv, sysk, d_release,
                  linkbuf, b_err);
            IF  b_err = e_ok
            THEN
                BEGIN
                cnt := linkbuf^.b_sl DIV sizeof (tak_linkdef);
                j   := 1;
                a25get_linkname (acv, @linkrec, i, search_link);
                WHILE (j <= cnt) AND NOT found DO
                    BEGIN
                    a25get_linkname (acv, linkbuf, j, curr_link);
                    IF  (linkbuf^.slink.linkdef[j].ltableid = old_tabid)
                        AND
                        (curr_link = search_link)
                    THEN
                        found := true
                    ELSE
                        j := j + 1;
                    (*ENDIF*) 
                    END;
                (*ENDWHILE*) 
                END;
            (*ENDIF*) 
            a06inc_linkage(sysk.slinkage);
        UNTIL
            found OR (b_err <> e_ok);
        (*ENDREPEAT*) 
        IF  found
        THEN
            WITH linkbuf^.slink.linkdef[j] DO
                BEGIN
&               ifdef trace
                t01int4 (ak_sem, 'found       ', j);
                t01int4 (ak_sem, 'i           ', i);
                t01int4 (ak_sem, 'indexid     ',
                      ord (linkrec.linkdef[i].lindexid[1]));
&               endif
                ltableid    := a_p_arr1.pbasep^.syskey.stableid;
                lindexid[1] := linkrec.linkdef[i].lindexid[1];
                FOR k := 1 TO lcolcount DO
                    IF  linkbuf^.slink.lentrytype = cak_eprimarykey
                    THEN
                        lseccolseq[k] := ext_map[lseccolseq[k]].em_new_colp^.cextcolno
                    ELSE
                        lprimcolseq[k] := ext_map[lprimcolseq[k]].em_new_colp^.cextcolno;
                    (*ENDIF*) 
                (*ENDFOR*) 
                a10repl_sysinfo (acv, linkbuf, b_err)
                END;
            (*ENDWITH*) 
        (*ENDIF*) 
        IF  b_err <> e_ok
        THEN
            a07_b_put_error (acv, b_err, 1)
        ELSE
            i := i + 1;
        (*ENDIF*) 
        END;
    (*ENDWHILE*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13pk_synonym (
            VAR acv      : tak_all_command_glob;
            VAR usagedef : tak_usagedef);
 
VAR
      b_err       : tgg00_BasisError;
      syn_buf     : tak_sysbufferaddress;
      syn_sysk    : tgg00_SysInfoKey;
 
BEGIN
syn_sysk          := a01defaultkey;
syn_sysk.stableid := usagedef.usa_tableid;
a10get_sysinfo (acv, syn_sysk, d_release, syn_buf, b_err);
IF  b_err = e_ok
THEN
    BEGIN
    syn_buf^.ssynonym.syn_tableid :=
          acv.a_p_arr1.pbasep^.syskey.stableid;
    a10repl_sysinfo (acv, syn_buf, b_err);
    END;
(*ENDIF*) 
IF  b_err = e_ok
THEN
    BEGIN
    syn_sysk.sauthid     := syn_buf^.ssynonym.syn_authid;
    syn_sysk.sentrytyp   := cak_etableref;
    syn_sysk.sidentifier := syn_buf^.ssynonym.syn_tablen;
    syn_sysk.skeylen     :=
          mxak_standard_sysk + sizeof (syn_sysk.sidentifier);
    a10get_sysinfo (acv, syn_sysk, d_release, syn_buf, b_err)
    END;
(*ENDIF*) 
IF  b_err = e_ok
THEN
    BEGIN
    syn_buf^.stableref.rtableid :=
          acv.a_p_arr1.pbasep^.syskey.stableid;
    a10repl_sysinfo (acv, syn_buf, b_err);
    END;
(*ENDIF*) 
IF  b_err <> e_ok
THEN
    a07_b_put_error (acv, b_err, 1);
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13pk_privrec (
            VAR acv       : tak_all_command_glob;
            VAR ext_map   : tak13ext_mapping;
            VAR grantee   : tgg00_Surrogate;
            VAR old_tabid : tgg00_Surrogate);
 
BEGIN
&ifdef trace
t01surrogate (ak_sem, 'old_tabid   ', old_tabid);
t01surrogate (ak_sem, 'new_tabid   ',
      acv.a_p_arr1.pbasep^.syskey.stableid);
&endif
ak13pk_priv (acv, ext_map, acv.a_ptr1^.spriv.pr_priv);
a19change_usertab (acv, cak_i_update, grantee, old_tabid,
      acv.a_p_arr1.pbasep^.syskey.stableid)
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13pk_priv (
            VAR acv     : tak_all_command_glob;
            VAR ext_map : tak13ext_mapping;
            VAR priv    : tak_privilege);
 
VAR
      colno   : integer;
      index   : tak_priv_descriptors;
      p_index : tak_priv_descriptors;
      colset  : tak_columnset;
 
BEGIN
&ifdef trace
a06td_priv (priv, 'priv :            ', false);
&endif
WITH acv, priv DO
    BEGIN
    p_index := priv_col_sel;
    FOR index := priv_col_sel TO priv_col_upd_grant DO
        BEGIN
        IF  index in priv_col_exist
        THEN
            BEGIN
            colset            := priv_col[p_index];
            priv_col[p_index] := [];
            FOR colno := 1 TO MAX_COL_PER_TAB_GG00 DO
                IF  (colno in colset) AND
                    (ext_map[colno].em_new_colp <> NIL)
                THEN
                    priv_col[p_index] := priv_col[p_index] + [
                          ext_map[colno].em_new_colp^.cextcolno];
                (*ENDIF*) 
            (*ENDFOR*) 
            IF  p_index < priv_col_upd_grant
            THEN
                p_index := succ(p_index)
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        END;
    (*ENDFOR*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13pk_statistics (
            VAR acv          : tak_all_command_glob;
            VAR stat_rec_ptr : tak_sysbufferaddress;
            VAR ext_map      : tak13ext_mapping);
 
VAR
      b_err        : tgg00_BasisError;
      jx           : integer;
      oldColno     : integer;
      new_stat_rec : tak_statisticsinfo;
 
BEGIN
WITH acv, stat_rec_ptr^.sstatistics DO
    BEGIN
    s10mv (sti_reclen, sizeof (new_stat_rec),
          @stat_rec_ptr^.sstatistics, 1, @new_stat_rec, 1,
          sizeof (new_stat_rec) - sizeof (new_stat_rec.sti_col_stats) -
          sizeof (new_stat_rec.sti_index));
    new_stat_rec.sti_col_cnt := 0;
    new_stat_rec.sti_index   := [];
    WITH a_p_arr1.pbasep^.sbase DO
        BEGIN
        new_stat_rec.sti_rows  := brows;
        new_stat_rec.sti_pages := bpages
        END;
    (*ENDWITH*) 
    jx := 0;
    FOR oldColno := 1 TO MAX_COL_PER_TAB_GG00 DO
        IF  (oldColno in sti_index) AND
            (jx < sti_col_cnt)
        THEN
            BEGIN
            jx := jx + 1;
            WITH ext_map[oldColno] DO
                IF  em_new_colp <> NIL
                THEN
                    BEGIN
                    a28set_col_info (new_stat_rec, em_new_colp^.cextcolno,
                          sti_col_stats[jx].cst_dist_values,
                          sti_col_stats[jx].cst_pages,
                          sti_col_stats[jx].cst_avg_lst_len);
                    END;
                (*ENDIF*) 
            (*ENDWITH*) 
            END;
        (*ENDIF*) 
    (*ENDFOR*) 
    new_stat_rec.sti_reclen := sizeof (new_stat_rec) -
          sizeof (new_stat_rec.sti_col_stats) +
          new_stat_rec.sti_col_cnt *
          sizeof (new_stat_rec.sti_col_stats[1]);
    IF  new_stat_rec.sti_reclen > sti_reclen
    THEN
        a10_fix_len_get_sysinfo (acv, stat_rec_ptr^.syskey,
              d_release, cak_is_undefined,
              new_stat_rec.sti_reclen - sti_reclen,
              stat_rec_ptr, b_err)
    ELSE
        b_err := e_ok;
    (*ENDIF*) 
    IF  b_err = e_ok
    THEN
        s10mv (sizeof (new_stat_rec),
              sizeof (stat_rec_ptr^.sstatistics),
              @new_stat_rec, 1, @stat_rec_ptr^.sstatistics, 1,
              new_stat_rec.sti_reclen)
    ELSE
        a07_b_put_error (acv, b_err, 1)
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13pk_create_index (
            VAR acv         : tak_all_command_glob;
            VAR a11v        : tak_a11_glob;
            VAR old_p_arr   : tak_syspointerarr;
            VAR viewscanpar : tak_viewscan_par;
            VAR indexname   : tsp00_KnlIdentifier;
            VAR indexid     : integer);
 
VAR
      j              : integer;
      b_err          : tgg00_BasisError;
      colptr         : tak00_colinfo_ptr;
      multkey        : tgg00_SysInfoKey;
      indexnoset     : SET OF 1 .. 255;
      index_scan_rec : tak_index_scan_record;
 
BEGIN
WITH acv, a11v, viewscanpar DO
    BEGIN
    indexid    := cak_is_undefined;
    indexnoset := [];
    IF  a_p_arr1.pbasep^.sbase.bindexexist
    THEN
        BEGIN
        multkey           := old_p_arr.pbasep^.syskey;
        multkey.sentrytyp := cak_emindex;
        a10get_sysinfo (acv, multkey, d_release, a_ptr1, b_err);
        IF  b_err = e_sysinfo_not_found
        THEN
            a_p_arr1.pbasep^.sbase.bindexexist := false
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  a_p_arr1.pbasep^.sbase.bindexexist
    THEN
        BEGIN
        (* analyze all named indexes *)
        a24init_index_scan (acv, old_p_arr.pbasep^.sbase.bsurrogate,
              index_scan_rec);
        WHILE a24next_named_index (acv, index_scan_rec) DO
            WITH index_scan_rec, isr_buf^.smindex.indexdef[isr_index] DO
                indexnoset := indexnoset + [indexno];
            (*ENDWITH*) 
        (*ENDWHILE*) 
        a24finish_index_scan (acv, index_scan_rec);
        a24init_index_scan (acv, old_p_arr.pbasep^.sbase.bsurrogate,
              index_scan_rec);
        WHILE a24next_named_index (acv, index_scan_rec) DO
            WITH index_scan_rec, isr_buf^.smindex.indexdef[isr_index] DO
                BEGIN
                a_ptr1 := isr_buf;
                a24send_index_command_to_kb (acv,
                      viewscanpar,
                      isr_index, m_create_index, mm_nil);
                IF  (a_returncode = 0)
                THEN
                    ipages := a_mblock.mb_data^.mbp_sample.indexnodes;
                (*ENDIF*) 
                FOR j := 1 TO icount DO
                    BEGIN
                    a06extcolno (a_p_arr1.pbasep^.sbase,
                          icolseq[j], colptr);
                    colptr^.ccolpropset :=
                          colptr^.ccolpropset + [ctmulti]
                    END;
                (*ENDFOR*) 
                a10repl_sysinfo (acv, a_ptr1, b_err);
                IF  b_err <> e_ok
                THEN
                    a07_b_put_error (acv, b_err, 1)
                (*ENDIF*) 
                END;
            (*ENDWITH*) 
        (*ENDWHILE*) 
        a24finish_index_scan (acv, index_scan_rec);
        END;
    (*ENDIF*) 
    IF  indexname <> a01_il_b_identifier
    THEN
        BEGIN
        IF  indexid <> cak_is_undefined
        THEN
            a07_b_put_error (acv, e_column_indexed, 1)
        ELSE
            BEGIN
            indexid := 0;
            REPEAT
                indexid := indexid + 1;
            UNTIL
                NOT (indexid in indexnoset);
            (*ENDREPEAT*) 
            END;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13pk_index_drop (
            VAR acv           : tak_all_command_glob;
            VAR a11v          : tak_a11_glob;
            VAR old_p_arr     : tak_syspointerarr;
            VAR viewscanpar   : tak_viewscan_par;
            VAR ext_map       : tak13ext_mapping;
            VAR key_cnt       : integer;
            VAR keycols       : tak_colinteger;
            VAR index_name    : tsp00_KnlIdentifier;
            VAR index_treeid  : tgg00_FileId);
 
VAR
      drop_index             : boolean;
      is_key_index           : boolean;
      j                      : integer;
      dummy                  : integer;
      b_err                  : tgg00_BasisError;
      new_p_arr              : tak_syspointerarr;
      index_scan_rec         : tak_index_scan_record;
      prev_scan_rec          : tak_index_scan_record;
 
BEGIN
(* a_p_arr1 contains new table description *)
WITH acv, a11v, viewscanpar DO
    BEGIN
    index_treeid  := b01niltree_id;
    new_p_arr     := a_p_arr1;
    a_p_arr1      := old_p_arr;
    b_err         := e_ok;
    IF  old_p_arr.pbasep^.sbase.bindexexist
    THEN
        BEGIN
        a24init_index_scan (acv, old_p_arr.pbasep^.sbase.bsurrogate,
              index_scan_rec);
        prev_scan_rec := index_scan_rec;
        WHILE a24next_named_index (acv, index_scan_rec) DO
            WITH index_scan_rec, isr_buf^.smindex.indexdef[isr_index] DO
                BEGIN
                a_ptr1 := isr_buf;
                is_key_index := false;
                drop_index   := false;
                IF  icount = key_cnt (* PTS 1122854 *)
                THEN
                    BEGIN
                    (* check, if current index and new key *)
                    (* differ. If not, index can be used   *)
                    (* to optimize the kb change process   *)
                    is_key_index := true;
                    drop_index   := true;
                    j            := 1;
                    WHILE (j <= icount) DO
                        BEGIN
&                       ifdef trace
                        t01int4 (ak_sem,
                              'index col   ', icolseq[j]);
                        t01int4 (ak_sem,
                              'key col     ', keycols[j]);
&                       endif
                        IF  icolseq[j] <> keycols[j]
                        THEN
                            drop_index := false;
                        (*ENDIF*) 
                        IF  (icolseq[ j ] <> keycols[ j ]) OR
                            (icolstack[j].eop in [op_order_asc,
                            op_unique_desc, op_order_desc])
                        THEN
                            is_key_index := false;
                        (*ENDIF*) 
                        j := j + 1;
                        END;
                    (*ENDWHILE*) 
                    END;
                (*ENDIF*) 
                IF  old_p_arr.pbasep^.sbase.btablekind =
                    twithoutkey
                THEN
                    BEGIN
                    j := 1;
                    WHILE j <= icount DO
                        IF  icolseq[j] = 1
                        THEN
                            BEGIN
                            (* system key in index ==> *)
                            (* drop index              *)
                            drop_index := true;
                            j          := icount + 1
                            END
                        ELSE
                            j := j + 1
                        (*ENDIF*) 
                    (*ENDWHILE*) 
                    END;
&               ifdef trace
                (*ENDIF*) 
                t01int4 (ak_sem, 'drop_index  ',
                      ord (drop_index));
                t01int4 (ak_sem, 'is_key_index',
                      ord (is_key_index));
&               endif
                IF  drop_index
                THEN
                    BEGIN
                    a24get_indexname (acv, isr_buf, isr_index,
                          vsc_indexname);
                    a24drop_multiple_index (acv,
                          viewscanpar, 1, c_do_a38_input);
                    IF  is_key_index
                    THEN
                        index_treeid := vsc_dropped_treeid;
                    (*ENDIF*) 
                    IF  NOT old_p_arr.pbasep^.sbase.bindexexist
                    THEN (* last index of table has been dropped *)
                        index_scan_rec.isr_buf := NIL
                    ELSE
                        index_scan_rec := prev_scan_rec
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
                prev_scan_rec := index_scan_rec
                END;
            (*ENDWITH*) 
        (*ENDWHILE*) 
        a24finish_index_scan (acv, index_scan_rec);
        dummy := 0;
        IF  old_p_arr.pbasep^.sbase.bindexexist (* PTS 1118825 *)
        THEN
            BEGIN
            a24init_index_scan (acv, old_p_arr.pbasep^.sbase.bsurrogate,
                  index_scan_rec);
            WHILE a24next_named_index (acv, index_scan_rec) DO
                WITH index_scan_rec, isr_buf^.smindex.indexdef[isr_index] DO
                    BEGIN
                    a_ptr1 := isr_buf;
                    FOR j := 1 TO icount DO
                        WITH ext_map[icolseq[j]].em_new_colp^ DO
                            BEGIN
                            icolseq[j] := cextcolno;
                            icolstack[j].etype    :=
                                  ccolstack.etype;
                            icolstack[j].epos     :=
                                  ccolstack.epos;
                            icolstack[j].elen_var :=
                                  ccolstack.elen_var
                            END;
                        (*ENDWITH*) 
                    (*ENDFOR*) 
                    IF  (icount > 1)
                    THEN
                        a24send_index_command_to_kb (acv,
                              viewscanpar,
                              isr_index, m_drop, mm_index);
                    (*ENDIF*) 
                    END;
                (*ENDWITH*) 
            (*ENDWHILE*) 
            a24finish_index_scan (acv, index_scan_rec);
            END;
        (*ENDIF*) 
        END;
&   ifdef trace
    (*ENDIF*) 
    t01int4 (ak_sem, 'bindexexist ',
          ord (old_p_arr.pbasep^.sbase.bindexexist));
&   endif
    new_p_arr.pbasep^.sbase.bindexexist :=
          old_p_arr.pbasep^.sbase.bindexexist;
    IF  new_p_arr.pbasep^.sbase.bindexexist
    THEN
        BEGIN
        a24find_indexname (acv, old_p_arr.pbasep^.sbase.bsurrogate,
              index_name, index_scan_rec);
        IF  index_scan_rec.isr_buf <> NIL
        THEN
            a07_nb_put_error (acv, e_duplicate_name,
                  a1ci, index_name);
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  b_err <> e_ok
    THEN
        a07_b_put_error (acv, b_err, 1);
    (*ENDIF*) 
    a_p_arr1  := new_p_arr;
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13pk_unique_index (
            VAR acv       : tak_all_command_glob;
            VAR a11v      : tak_a11_glob;
            VAR old_p     : tak_syspointerarr;
            VAR indexname : tsp00_KnlIdentifier);
 
VAR
      init_ex_kind   : tak_execution_kind;
      i              : integer;
      colind         : integer;
      colptr         : tak00_colinfo_ptr;
      c20            : tsp00_C20;
      colname        : tsp00_KnlIdentifier;
      init_user_name : tsp00_KnlIdentifier;
 
BEGIN
WITH acv, a11v DO
    BEGIN
    c20 := 'CREATE UNIQUE INDEX ';
    a542move_to_packet (acv, @c20, sizeof (c20));
    a542identifier_to_packet (acv, indexname);
    a542char_to_packet (acv, bsp_c1);
    a542move_to_packet (acv, @a01kw[cak_i_on], 3);
    a542identifier_to_packet (acv, a_p_arr1.pbasep^.sbase.btablen^);
    a542char_to_packet (acv, bsp_c1);
    a542char_to_packet (acv, '(');
    colind := old_p.pbasep^.sbase.bfirstcolind;
    FOR i := 1 TO old_p.pbasep^.sbase.bkeycolcount DO
        BEGIN
        colptr := old_p.pbasep^.sbase.bcolumn[colind];
        a061get_colname (colptr^, colname);
        a542identifier_to_packet (acv, colname);
        IF  i < old_p.pbasep^.sbase.bkeycolcount
        THEN
            a542char_to_packet (acv, ',')
        ELSE
            a542char_to_packet (acv, ')');
        (*ENDIF*) 
        colind := colptr^.cnextind
        END;
    (*ENDFOR*) 
    a51switch_user (acv, a1authname, init_user_name);
    init_ex_kind     := a_ex_kind;
    a_ex_kind        := parsing_executing;
&   ifdef trace
    t01moveobj (ak_sem,
          a_cmd_part^.sp1p_buf, 1, a_cmd_part^.sp1p_buf_len);
&   endif
    IF  a_returncode = 0
    THEN
        a35_asql_statement (acv);
    (*ENDIF*) 
    a51switch_user (acv, init_user_name, init_user_name);
    a_ex_kind := init_ex_kind
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13serial_stackentry (
            VAR acv      : tak_all_command_glob;
            VAR a11v     : tak_a11_glob;
            VAR col_info : tak00_columninfo);
 
VAR
      col_no   : integer;
      qual_no  : integer;
      seq_info : tgg00_SeqInfo;
 
BEGIN
(* PTS 1114929 M.Ki. *)
(* build stack entries to go through table and update all rows with *)
(* serial values                                                    *)
WITH acv, a_mblock, mb_qual^ DO
    BEGIN
    col_no  := 1;
    qual_no := mqual_pos + 1; (* reserve space for JUMP *)
    mb_st^[ col_no ]     := col_info.ccolstack;
    mb_st^[ col_no ].eop := op_expr_upd;
    (* qual entries: *)
    WITH mb_st^[ qual_no ] DO
        BEGIN
        etype := st_op;
        eop   := op_nextval;
        epos  := mb_data_len + 1;
        elen_var      := 0;
        ecol_tab[ 1 ] := chr(0);
        ecol_tab[ 2 ] := chr(0)
        END;
    (*ENDWITH*) 
    WITH mb_st^[ qual_no + 1 ] DO
        BEGIN
        etype         := st_result;
        eop           := op_order_asc;
        epos          := col_info.cdatalen;
        elen_var      := col_info.cdatafrac - cak_frac_offset;
        ecol_tab[ 1 ] := chr(0);
        ecol_tab[ 2 ] := chr(0)
        END;
    (*ENDWITH*) 
    WITH mb_st^[ qual_no + 2 ] DO
        BEGIN
        etype    := st_result;
        eop      := op_none;
        epos     := col_info.cdatalen;
        elen_var := col_info.cdatafrac - cak_frac_offset;
        ecol_tab[ 1 ] := chr(0);
        ecol_tab[ 2 ] := chr(0)
        END;
    (*ENDWITH*) 
    WITH mb_st^ [ qual_no + 3 ] DO
        BEGIN
        etype    := st_output;
        eop_out  := op_o_output_var;
        epos     := 0;
        elen_var := col_info.cinoutlen;
        ecol_pos := 0;
        END;
    (*ENDWITH*) 
    (* copy sequence info to mb_data *)
    WITH a_mblock, a11v, mb_data^ DO
        BEGIN
        IF  mb_data_len + sizeof (a1tableid) +
            sizeof (seq_info) > mb_data_size
        THEN
            a07_b_put_error (acv, e_too_many_mb_data,
                  -mb_data_size)
        ELSE
            BEGIN
            g10mv ('VAK13 ',   4,    
                  sizeof (a1tableid), mb_data_size,
                  @a1tableid, 1, @mbp_buf, mb_data_len + 1,
                  sizeof (a1tableid),
                  a_returncode);
            mb_data_len := mb_data_len + sizeof (a1tableid);
            seq_info    := k71serial_seq_info;
            seq_info.seq_maxvalue[1] := chr(192 + col_info.cdatalen);
            seq_info.seq_site        := cgg_zero_c2;
            g10mv ('VAK13 ',   5,    
                  sizeof (seq_info), mb_data_size,
                  @seq_info, 1, @mbp_buf, mb_data_len + 1,
                  sizeof (seq_info),
                  a_returncode);
            mb_data_len := mb_data_len + sizeof (seq_info)
            END
        (*ENDIF*) 
        END;
    (*ENDWITH*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13add_serial (
            VAR acv           : tak_all_command_glob;
            VAR a11v          : tak_a11_glob;
            VAR default_added : tak13_default_added);
 
VAR
      ok          : boolean;
      b_err       : tgg00_BasisError;
      ilen        : integer;
      colindex    : tsp00_Int2;
      gg_strategy : tgg07_StrategyInfo;
 
BEGIN
(* PTS 1114929 M.Ki. *)
(* build and execute stack program to update all existing rows *)
a06_systable_get (acv, d_fix, a11v.a1tableid,
      acv.a_p_arr1.pbasep, true, ok);
IF  NOT ok
THEN
    a07_b_put_error  (acv, e_old_fileversion, 1)
ELSE
    BEGIN
    a06a_mblock_init (acv, m_update, mm_qual, acv.a_p_arr1.pbasep^.sbase.btreeid);
    WITH acv.a_mblock.mb_qual^ DO
        BEGIN
        mcol_pos    := 1;
        mcol_cnt    := 1;
        mqual_pos   := mcol_pos + mcol_cnt;
        mqual_cnt   := 5; (* 4 entries per serial + 1 JUMP *)
        mfirst_free := mqual_pos + mqual_cnt;
        mstrat_pos  := mfirst_free;
        mstrat_cnt  := 1;
        mfirst_free := mfirst_free + 1;
        IF  mfirst_free+1 > acv.a_mblock.mb_st_max
        THEN
            a07_b_put_error (acv, e_too_many_mb_stackentries,
                  -acv.a_mblock.mb_st_max);
        (*ENDIF*) 
        END;
    (*ENDWITH*) 
    END;
(*ENDIF*) 
IF  acv.a_returncode = 0
THEN
    BEGIN
    WITH acv.a_p_arr1.pbasep^.sbase DO
        FOR colindex := bfirstindex TO blastindex DO
            WITH bcolumn[ colindex ]^ DO
                IF  (default_added[ cextcolno ]) AND
                    (ctserial in ccolpropset)
                THEN
                    ak13serial_stackentry (acv, a11v, bcolumn[ colindex ]^);
                (*ENDIF*) 
            (*ENDWITH*) 
        (*ENDFOR*) 
    (*ENDWITH*) 
    WITH acv.a_mblock, mb_qual^ DO
        BEGIN
        a61_set_jump (acv.a_mblock, mqual_pos, st_jump_output);
        mb_st^[ mqual_pos ].epos := mb_st^[ mqual_pos ].epos + 1;
        (* add strategy: *)
        a71default_strat (gg_strategy);
        ilen:= STRATEGY_START_MXGG07 + sizeof (gg_strategy.str_key_in_range);
        g10mv ('VAK13 ',   6,    
              sizeof (gg_strategy), mb_strat_size,
              @gg_strategy, 1,
              @mb_strat^, mb_strat_len + 1, ilen,
              acv.a_returncode);
        g09StratStackentry (mb_st^[ mstrat_pos ], mb_strat_len + 1, ilen );
        mb_strat_len := mb_strat_len + ilen;
        acv.a_transinf.tri_trans.trError_gg00 := e_ok;
        IF  acv.a_returncode = 0
        THEN
            BEGIN
            b_err := e_ok;
            a06rsend_mess_buf (acv, acv.a_mblock, cak_return_req, b_err);
            acv.a_transinf.tri_trans.trWarning_gg00 := [ ];
            IF  b_err <> e_ok
            THEN
                a07_b_put_error (acv, b_err, -b_err);
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        END;
    (*ENDWITH*) 
    END;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13propagate_default (
            VAR acv           : tak_all_command_glob;
            VAR a11v          : tak_a11_glob;
            VAR default_added : tak13_default_added;
            default_cnt       : integer);
 
CONST
      c_reserve = 256;
 
VAR
      do_add    : boolean;
      ok        : boolean;
      colindex  : tsp00_Int2;
      c8        : tsp00_C8;
      colname   : tsp00_KnlIdentifier;
 
BEGIN
(* PTS 1114336 M.Ki. *)
(* update all existing rows with default value for added column; if     *)
(* default is serial, update with value from sequence                   *)
a06_systable_get (acv, d_fix, a11v.a1tableid,
      acv.a_p_arr1.pbasep, true, ok);
IF  ok
THEN
    WITH acv, a11v, a_p_arr1.pbasep^.sbase DO
        BEGIN
        do_add := false;
        a542internal_packet (acv,
              NOT c_release_packet, a_cmd_part^.sp1p_buf_len + c_reserve);
        c8 := 'UPDATE  ';
        a542move_to_packet (acv, @c8, sizeof (c8));
        a542identifier_to_packet (acv,
              a_p_arr1.pbasep^.sbase.btablen^);
        a542char_to_packet (acv, bsp_c1);
        a542move_to_packet (acv, @a01kw[cak_i_set], 5);
        c8 := 'DEFAULT ';
        FOR colindex := bfirstindex TO blastindex DO
            WITH bcolumn[ colindex ]^ DO
                BEGIN
                IF  (default_added[ cextcolno ]) AND
                    (ctdefault in ccolpropset)
                THEN
                    BEGIN
                    IF  do_add
                    THEN
                        a542char_to_packet (acv, ',');
                    (*ENDIF*) 
                    do_add                     := true;
                    default_added[ cextcolno ] := false;
                    a061get_colname (bcolumn[ colindex ]^, colname);
                    a542identifier_to_packet (acv, colname);
                    a542char_to_packet (acv, '=');
                    a542move_to_packet (acv, @c8, sizeof (c8));
                    default_cnt := default_cnt - 1;
                    END;
                (*ENDIF*) 
                END;
            (*ENDWITH*) 
        (*ENDFOR*) 
        IF  do_add
        THEN
            BEGIN
&           ifdef trace
            t01moveobj (ak_sem, acv.a_cmd_part^.sp1p_buf,
                  1, acv.a_cmd_part^.sp1p_buf_len);
&           endif
            (* PTS 1127597 *)
            ak13SqlStatement (acv);
            IF  a_returncode = 100
            THEN (* ignore error "ROW NOT FOUND" (table was empty) *)
                a_returncode := 0;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        a542pop_packet (acv);
        IF  (default_cnt > 0)                     AND
            (a_returncode = 0)  AND
            ok
        THEN
            BEGIN
            IF  default_cnt = 1
            THEN
                ak13add_serial (acv, a11v, default_added)
            ELSE
                a07_b_put_error (acv, e_too_many_serials, -1);
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        END;
    (*ENDWITH*) 
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a13_call_semantic (VAR acv : tak_all_command_glob);
 
CONST
      c_max_system_error = -9000;
 
VAR
      release_space    : boolean;
      ok               : boolean;
      verify           : tverify_operation;
      ddl              : tak_ddl_descriptor;
      old_bstringcount : tsp00_Int2;
      i                : integer;
      indicator        : integer;
      constraintId     : integer; (* PTS 1116788 *)
      default_cnt      : integer; (* PTS 1114336 M.Ki. *)
      req_priv         : tak00_PrivilegeSet;
      aux_arr          : tak_syspointerarr;
      verify_cols      : tak_columnset;
      verify_lengthcols: tak_columnset;
      a11v             : tak_a11_glob;
      viewscanpar      : tak_viewscan_par;
      defaults_added   : tak13_default_added; (* PTS 1114336 M.Ki. *)
 
BEGIN
constraintId  := cak_is_undefined;
a11glob_init (acv, a11v);
a11v.a1ti         := acv.a_ap_tree^[acv.a_ap_tree^[ 0 ].n_lo_level].n_lo_level;
indicator         := 0;
verify            := [];
verify_cols       := [];
a10_cache_delete (acv, NOT c_is_rollback);
IF  acv.a_ap_tree^[acv.a_ap_tree^[ 0 ].n_lo_level].n_length = cak_i_references
THEN (* domain migration 3.1.2 -> 3.1.3 *)
    req_priv := []
ELSE
    req_priv := [r_alter, r_owner];
(*ENDIF*) 
a11get_check_table (acv, false, true, false, req_priv,
      false, true, d_fix, a11v.a1ti, a11v.a1authname, a11v.a1tablen, acv.a_p_arr1);
IF  acv.a_returncode = 0
THEN
    WITH acv.a_p_arr1.pbasep^.sbase DO
        IF  (ftsArchive_egg00 in btreeid.fileType_gg00)
        THEN
            a07_b_put_error (acv, e_invalid_tabletype, 1)
        ELSE
            BEGIN
            IF  acv.a_ap_tree^[acv.a_ap_tree^[ 0 ].n_lo_level].n_length <> cak_i_references
            THEN
                a11put_date_time (balterdate, baltertime);
            (*ENDIF*) 
            a11v.a1tableid            := acv.a_p_arr1.pbasep^.syskey.stableid;
            a11v.a1sysk.stableid      := a11v.a1tableid;
            a11v.a1keypos             := acv.a_p_arr1.pcount;
            a11v.a1ti                 := acv.a_ap_tree^[ a11v.a1ti ].n_sa_level;
            indicator                 := acv.a_ap_tree^[ a11v.a1ti ].n_subproc;
            acv.a_purgeSharedSqlCache := indicator in
                  [cak_x_alter_add, cak_x_alter_drop, cak_x_alter_alter, cak_x_modify];
            IF  indicator = cak_x_alter_drop
            THEN
                viewscanpar.vsc_type := v_alter_drop
            ELSE
                viewscanpar.vsc_type := v_save_scheme;
            (*ENDIF*) 
            a27init_viewscanpar (acv, viewscanpar, viewscanpar.vsc_type);
            release_space := false;
            IF  indicator = cak_x_alter_drop
            THEN
                BEGIN
                viewscanpar.vsc_restrict :=
                      acv.a_ap_tree^[a11v.a1ti].n_length = cak_i_restrict;
                release_space := acv.a_ap_tree^[a11v.a1ti].n_pos = cak_i_release;
                END;
            (*ENDIF*) 
            IF  (NOT a11v.a1global)
                AND
                (indicator <> cak_x_primary_key)
                AND
                (indicator <> cak_x_alter_add)
                AND
                (indicator <> cak_x_modify)
            THEN
                a10_version (acv, acv.a_p_arr1.pbasep^.sbase,
                      m_succ_file_version, NOT c_scan_views);
            (*ENDIF*) 
            viewscanpar.vsc_base_tabid     := a11v.a1tableid;
            viewscanpar.vsc_basetablen     := a11v.a1tablen;
            viewscanpar.vsc_ignore_error   := false;
            viewscanpar.vsc_filevers       := btreeid.fileVersion_gg00;
            END;
        (*ENDIF*) 
    (*ENDWITH*) 
(*ENDIF*) 
IF  acv.a_returncode = 0
THEN
    BEGIN
    CASE  indicator OF
        cak_x_alter_add :
            BEGIN
            (* PTS 1115206 M.Ki. *)
            old_bstringcount := acv.a_p_arr1.pbasep^.sbase.bstringcount;
            ak13alter_table_add (acv, a11v, defaults_added, default_cnt);
            IF  acv.a_p_arr1.pbasep^.sbase.bstringcount > old_bstringcount
            THEN
                BEGIN
                (* a LONG column was added: we need to reshuffle *)
                (* the records on disk; trick ak13modify into    *)
                (* doing this for us:                            *)
                viewscanpar.vsc_type := v_alter_drop;
                release_space        := true;
                END;
            (*ENDIF*) 
            END;
        cak_x_alter_drop :
            ak13alter_tab_drop (acv, a11v, viewscanpar);
        cak_x_alter_alter :
            ak13alter_tab_alter  (acv, a11v, verify);
        cak_x_add_constraint :
            ak13add_constraint (acv, a11v, verify);
        cak_x_alter_constraint, cak_x_drop_constraint :
            ak13alter_drop_constraint (acv, a11v,
                  indicator = cak_x_drop_constraint,
                  viewscanpar, verify, constraintId (* PTS 1116788 *));
        cak_x_modify :
            ak13modify (acv, a11v,
                  viewscanpar, NOT c_release_space, verify, verify_cols, verify_lengthcols);
        cak_x_primary_key :
            ak13primary_key (acv, a11v, viewscanpar);
        cak_x_alter_fact,
        cak_x_alter_dimension,
        cak_x_alter_bwhierarchy :
            ak13alter_attribute (acv, indicator,
                  acv.a_ap_tree^[a11v.a1ti].n_length = cak_i_not);
        cak_x_alter_dynamic : (* PTS 1111193 : removed begexcl call *)
            ak13alter_dynamic (acv,
                  acv.a_ap_tree^[a11v.a1ti].n_length = cak_i_not);
        cak_x_sample :
            ak13alter_sample (acv, a11v.a1ti);
        cak_x_alter_type : (* PTS 1105802 *)
            ak13alter_table_type (acv);
        cak_x_alter_bad :
            ak13alter_bad (acv);
        END;
    (*ENDCASE*) 
    IF  acv.a_returncode = 0
    THEN
        BEGIN
&       ifdef trace
        WITH acv.a_p_arr1.pbasep^.sbase DO
            FOR i := bfirstindex TO blastindex DO
                a061td_colinfo (bcolumn[i]^, i);
            (*ENDFOR*) 
        (*ENDWITH*) 
&       endif
        IF  (indicator <> cak_x_primary_key) AND
            (indicator <> cak_x_modify     )
        THEN
            a11end_create_table (acv, a11v);
&       ifdef trace
        (*ENDIF*) 
        WITH acv.a_p_arr1.pbasep^.sbase DO
            FOR i := bfirstindex TO blastindex DO
                a061td_colinfo (bcolumn[i]^, i);
            (*ENDFOR*) 
        (*ENDWITH*) 
&       endif
        END;
    (*ENDIF*) 
    aux_arr := acv.a_p_arr1;
    IF  indicator = cak_x_alter_add
    THEN
        BEGIN
        IF  (default_cnt > 0)             AND
            (acv.a_returncode = 0)
        THEN
            ak13propagate_default (acv, a11v, defaults_added, default_cnt);
        (* if a constraint is defined               *)
        (* for an added column a verify is required *)
        (*ENDIF*) 
        FOR i := 1 TO a11v.a1constraint_cnt DO
            IF  a11v.a1constraint_info[ i ].tree_index <> 0
            THEN
                verify := [verify_add_column];
            (*ENDIF*) 
        (*ENDFOR*) 
        END;
    (*ENDIF*) 
    IF  (verify <> []) AND (acv.a_returncode = 0)
    THEN
        ak13verify_constraint_not_null (acv,
              a11v, verify, verify_cols, verify_lengthcols, constraintId);
    (* PTS 1114336 M.Ki. *)
    (*ENDIF*) 
    IF  release_space AND (acv.a_returncode = 0)
    THEN
        BEGIN
        (* PTS 1120938 M.Ki. *)
        (* set constraint_cnt to 0 in case the add statement contained a *)
        (* constraint that we would try to parse a second time otherwise *)
        a11v.a1constraint_cnt := 0;
        a06_systable_get (acv, d_fix, a11v.a1tableid,
              acv.a_p_arr1.pbasep, true, ok);
        a27view_scan (acv, viewscanpar.vsc_base_tabid, viewscanpar);
        IF  acv.a_returncode = 0
        THEN
            BEGIN
            indicator := cak_x_modify;
            a06_systable_get (acv, d_fix, a11v.a1tableid,
                  acv.a_p_arr1.pbasep, true, ok);
            aux_arr := acv.a_p_arr1;
            IF  ok
            THEN
                ak13modify (acv, a11v, viewscanpar, c_release_space,
                      verify, verify_cols, verify_lengthcols)
            (*ENDIF*) 
            END
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  acv.a_returncode = 0
    THEN
        IF  (indicator <> cak_x_alter_drop       ) AND
            (acv.a_is_ddl  <> ddl_add_constraint     ) AND
            (acv.a_is_ddl  <> ddl_alter_constraint   ) AND
            (acv.a_is_ddl  <> ddl_drop_constraint    )
        THEN
            BEGIN
            acv.a_internal_sql    := sql_alter_table;
            viewscanpar.vsc_save_into     := false;
            viewscanpar.vsc_cmd_cnt       := 0;
            viewscanpar.vsc_first_save    := true;
            viewscanpar.vsc_last_save     := true;
            acv.a_p_arr1          := aux_arr;
            a15catalog_save (acv, viewscanpar);
            ddl               := acv.a_init_ddl;
            IF  indicator = cak_x_modify
            THEN
                acv.a_init_ddl := ddl_alter_key;
            (*ENDIF*) 
            IF  acv.a_returncode = 0
            THEN
                BEGIN
                a15restore_catalog (acv,
                      acv.a_p_arr1.pbasep^.sbase.btreeid, viewscanpar);
                acv.a_init_ddl        := ddl;
                acv.a_internal_sql    := no_internal_sql;
                IF  (acv.a_returncode < 0) AND
                    (acv.a_returncode > c_max_system_error) AND
                    (acv.a_returncode <>
                    a07_return_code (e_wait_for_lock_release, acv.a_sqlmode)) AND
                    (acv.a_returncode <>
                    a07_return_code (e_work_rolled_back, acv.a_sqlmode)) AND
                    (acv.a_returncode <>
                    a07_return_code (e_cancelled, acv.a_sqlmode)) AND
                    (acv.a_returncode <>
                    a07_return_code (e_lock_collision, acv.a_sqlmode)) AND
                    (acv.a_returncode <>
                    a07_return_code (e_request_timeout, acv.a_sqlmode)) AND
                    (acv.a_returncode <>
                    a07_return_code (e_no_more_perm_space, acv.a_sqlmode))
                THEN
                    BEGIN (* PTS 1109801 *)
                    acv.a_returncode := 0;
                    a07_nb_put_error (acv, e_view_def_contradicts_table_de, 1,
                          acv.a_viewname);
                    END;
                (*ENDIF*) 
                END
            (*ENDIF*) 
            END
        ELSE
            a27view_scan (acv, viewscanpar.vsc_base_tabid, viewscanpar)
        (*ENDIF*) 
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  acv.a_returncode <> 0
THEN
    BEGIN
    acv.a_part_rollback := true;
    IF  acv.a_returncode = cak13_err_return
    THEN
        acv.a_returncode := 0;
    (*ENDIF*) 
    END;
(*ENDIF*) 
acv.a_purgeSharedSqlCache := false;
IF  indicator =  cak_x_alter_dynamic
THEN (* PTS 1102862, T.A. 1999-05-26 *)
    BEGIN
    IF  acv.a_returncode = 0
    THEN
        a52_ex_commit_rollback (acv, m_commit, false, false);
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  acv.a_returncode <> 0
THEN
    b01empty_file (acv.a_transinf.tri_trans, acv.a_into_tree);
(*ENDIF*) 
END;
 
(* PTS 1111576 E.Z. *)
(*------------------------------*) 
 
PROCEDURE
      ak13rename_dropcolumns  (
            VAR acv     : tak_all_command_glob;
            VAR a11v    : tak_a11_glob;
            VAR dropcol : tak_dropcol);
 
VAR
      i       : integer;
      count   : integer;
 
BEGIN
WITH acv, a11v, dropcol, a_p_arr1  DO
    BEGIN
    IF  a_returncode = 0
    THEN
        BEGIN
        count := pbasep^.sbase.bcntdropcol;
        FOR i := 1 TO dcount DO
            WITH dcol[ i ].dcolptr^ DO
                BEGIN
                ccolumnn [1] := chr(255);
                ccolumnn_len := chr(1)
                END;
            (*ENDWITH*) 
        (*ENDFOR*) 
        pbasep^.sbase.bcntdropcol := count + dcount;
        a1sort                    := true
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a13add_dropped_columns (
            VAR acv         : tak_all_command_glob;
            view_level      : integer;
            VAR viewscanpar : tak_viewscan_par);
 
VAR
      i2c2  : tsp_int_map_c2;
 
BEGIN
acv.a_mblock.mb_data^.mbp_reclen := cgg_rec_key_offset + 2 + mxak_set;
acv.a_mblock.mb_data^.mbp_keylen := 2;
i2c2.map_int                    := view_level;
acv.a_mblock.mb_data^.mbp_buf[cgg_rec_key_offset + 1] := i2c2.map_c2[1];
acv.a_mblock.mb_data^.mbp_buf[cgg_rec_key_offset + 2] := i2c2.map_c2[2];
acv.a_mblock.mb_data^.mbp_varcol_offset := 0;
acv.a_mblock.mb_data^.mbp_varcol_cnt    := 0;
s10mv (sizeof (viewscanpar.vsc_drop_set), acv.a_mblock.mb_data_size,
      @viewscanpar.vsc_drop_set, 1, @acv.a_mblock.mb_data^.mbp_buf,
      acv.a_mblock.mb_data^.mbp_keylen + cgg_rec_key_offset + 1,
      sizeof (viewscanpar.vsc_drop_set));
b07cadd_record (acv.a_transinf.tri_trans, acv.a_into_tree,
      acv.a_mblock.mb_data^.mbp_rec);
IF  acv.a_transinf.tri_trans.trError_gg00 <> e_ok
THEN
    a07_b_put_error(acv, acv.a_transinf.tri_trans.trError_gg00, 1)
ELSE
    viewscanpar.vsc_col_dropped := true;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a13repl_priv_column   (
            VAR acv       : tak_all_command_glob;
            base_ptr      : tak_sysbufferaddress;
            VAR extcolset : tak_columnset);
 
VAR
      b_err            : tgg00_BasisError;
      repl             : boolean;
      empty            : boolean;
      entrytyp         : tsp00_C2;
      privbuf          : tak_sysbufferaddress;
      userid           : tgg00_Surrogate;
      privkey          : tgg00_SysInfoKey;
      priv             : tak_privilege;
 
BEGIN
IF  acv.a_returncode = 0
THEN
    BEGIN
    privkey.sstandardkey := base_ptr^.syskey.sstandardkey;
    privkey.sentrytyp    := cak_epriv;
    privkey.skeylen      := mxak_standard_sysk;
    entrytyp             := cak_epriv;
    REPEAT
        repl := false;
        a10next_sysinfo (acv, privkey, SURROGATE_MXGG00+2, d_fix,
              entrytyp, privbuf, b_err);
        IF  b_err = e_ok
        THEN
            BEGIN
            privkey.skeylen := privbuf^.b_kl;
            WITH base_ptr^.syskey DO
                IF  privkey.stableid <> stableid
                THEN
                    b_err := e_no_next_record;
                (*ENDIF*) 
            (*ENDWITH*) 
            END;
        (*ENDIF*) 
        repl  := false;
        empty := false;
        IF  (b_err = e_no_next_record) AND (entrytyp = cak_epriv)
        THEN
            BEGIN (* scan privuser catalog records *)
            b_err             := e_ok;
            entrytyp          := cak_eprivuser;
            privkey.sentrytyp := cak_eprivuser;
            privkey.skeylen   := mxak_standard_sysk
            END
        ELSE
            IF  (entrytyp = cak_epriv) AND (b_err = e_ok)
            THEN
                BEGIN
                IF  privbuf^.spriv.pr_priv.priv_col_exist <> [  ]
                THEN
                    BEGIN
                    ak13colset_drop (privbuf,
                          privbuf^.spriv.pr_priv, extcolset, empty, repl);
                    IF  empty
                    THEN
                        BEGIN
                        userid := privkey.suserid;
                        a19del_usertab (acv, userid,
                              base_ptr^.syskey.stableid)
                        END;
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
                END
            ELSE
                IF  b_err = e_ok
                THEN
                    IF  privbuf^.sprivuser.pru_priv.priv_col_exist <> []
                    THEN
                        ak13colset_drop (privbuf,
                              privbuf^.sprivuser.pru_priv,
                              extcolset, empty, repl);
                    (*ENDIF*) 
                (*ENDIF*) 
            (*ENDIF*) 
        (*ENDIF*) 
        IF  repl
        THEN
            BEGIN
            a10repl_sysinfo (acv, privbuf, b_err);
            a10_key_del      (acv, privkey);
            END
        ELSE
            IF  empty
            THEN
                a10del_sysinfo (acv, privkey, b_err);
            (*ENDIF*) 
        (*ENDIF*) 
    UNTIL
        (b_err <> e_ok);
    (*ENDREPEAT*) 
    IF  b_err <> e_no_next_record
    THEN
        a07_b_put_error (acv, b_err, 1)
    ELSE
        WITH base_ptr^.sbase DO
            BEGIN
            IF  base_ptr^.sbase.bpriv_col_exist <> [  ]
            THEN
                BEGIN
                a06public_priv (acv, base_ptr^.sbase, priv);
                base_ptr^.sbase.bpriv_col_exist := priv.priv_col_exist
                END;
            (*ENDIF*) 
            END;
        (*ENDWITH*) 
    (*ENDIF*) 
    END;
(*ENDIF*) 
END;
 
(* PTS 1127597 *)
(*------------------------------*) 
 
PROCEDURE
      ak13SqlStatement (VAR acv : tak_all_command_glob);
 
VAR
      isDDL      : tak_ddl_descriptor;
      initDDL    : tak_ddl_descriptor;
      exKind     : tak_execution_kind;
      initExKind : tak_execution_kind;
 
BEGIN
IF  acv.a_returncode = 0
THEN
    BEGIN
    exKind             := acv.a_ex_kind;
    initExKind         := acv.a_init_ex_kind;
    acv.a_ex_kind      := parsing_executing;
    acv.a_init_ex_kind := parsing_executing;
    isDDL              := acv.a_is_ddl;
    initDDL            := acv.a_init_ddl;
    acv.a_is_ddl       := no_ddl;
    acv.a_init_ddl     := no_ddl;
    a35_asql_statement (acv);
    acv.a_ex_kind      := exKind;
    acv.a_init_ex_kind := initExKind;
    acv.a_is_ddl       := isDDL;
    acv.a_init_ddl     := initDDL;
    END;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13TriggerHandling (
            VAR acv         : tak_all_command_glob;
            VAR viewscanpar : tak_viewscan_par;
            VAR old_p_arr   : tak_syspointerarr;
            VAR packet_size : tsp00_Int4);
 
VAR
      e             : tgg00_BasisError;
      exit_loop     : boolean;
      init_ddl      : tak_ddl_descriptor;
      aux_p_arr     : tak_syspointerarr;
      dummy_st      : tgg00_StackEntry;
      pTrigger      : tak_sysbufferaddress;
      pTriggerDef   : tak_sysbufferaddress;
      sysk          : tgg00_SysInfoKey;
      defSysk       : tgg00_SysInfoKey;
      trigger_cnt   : integer;
      ix            : integer;
      required_size : tsp00_Int4;
      trigger_name  : tsp00_KnlIdentifier;
      trigger_names : ARRAY[1..3] OF tsp00_KnlIdentifier;
      pRec          : ^tgg00_Rec;
 
BEGIN
packet_size := 0;
IF  [ del_trigger, ins_trigger, upd_trigger ] *
    old_p_arr.pbasep^.sbase.blinkexist <> [  ]
THEN
    BEGIN
    trigger_cnt    := 0;
    sysk           := old_p_arr.pbasep^.syskey;
    sysk.sentrytyp := cak_etrigger;
    (* PTS 1116632 E.Z. *)
    sysk.slinkage  := cak_zero_linkage;
    REPEAT
        a10next_sysinfo (acv, sysk,
              sizeof(sysk.stableid) + sizeof(sysk.sentrytyp), d_release,
              cak_etrigger, pTrigger, e);
        IF  e = e_ok
        THEN
            BEGIN
            IF  (sysk.slinkage = cak_ins_trigger_linkage) OR
                (sysk.slinkage = cak_del_trigger_linkage) OR
                (sysk.slinkage = cak_upd_trigger_linkage)
            THEN
                BEGIN
                a262get_trigger_name (pTrigger^.strigger, trigger_name, e);
                ix := 1;
                WHILE ix <= trigger_cnt DO
                    BEGIN
                    IF  trigger_names[ix] = trigger_name
                    THEN
                        ix := csp_maxint2
                    ELSE
                        ix := ix + 1
                    (*ENDIF*) 
                    END;
                (*ENDWHILE*) 
                IF  ix <> csp_maxint2
                THEN
                    BEGIN
                    trigger_cnt                := trigger_cnt + 1;
                    trigger_names[trigger_cnt] := trigger_name;
                    defSysk             := sysk;
                    defSysk.sentrytyp   := cak_eviewtext;
                    defSysk.slinkage[1] := chr(255 - ord (sysk.slinkage[2]));
                    defSysk.slinkage[2] := chr(0);
                    exit_loop           := false;
                    required_size       := 0;
                    REPEAT
                        defSysk.slinkage[2] := succ(defSysk.slinkage[2]);
                        a10get_sysinfo (acv, defSysk, d_release, pTriggerDef, e);
                        IF  e = e_ok
                        THEN
                            BEGIN
                            required_size := required_size + pTriggerDef^.sviewtext.vttextlength;
                            exit_loop := NOT pTriggerDef^.sviewtext.vtnextexist;
                            pTriggerDef^.syskey.sentrytyp := cak_etempviewtext;
                            pRec                          := @pTriggerDef^;
                            b07cadd_record (acv.a_transinf.tri_trans, acv.a_into_tree, pRec^);
                            e := acv.a_transinf.tri_trans.trError_gg00;
                            pTriggerDef^.syskey.sentrytyp := cak_eviewtext;
                            END;
                        (*ENDIF*) 
                    UNTIL
                        exit_loop OR (e <> e_ok);
                    (*ENDREPEAT*) 
                    IF  required_size > packet_size
                    THEN
                        packet_size := required_size;
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
    UNTIL
        e <> e_ok;
    (*ENDREPEAT*) 
    IF  e <> e_no_next_record
    THEN
        a07_b_put_error (acv, e, 1)
    ELSE
        BEGIN
        init_ddl       := acv.a_init_ddl;
        acv.a_init_ddl := ddl_drop_table;
        aux_p_arr      := acv.a_p_arr1;
        acv.a_p_arr1   := old_p_arr;
        a262drop_tab_col_trigger (acv, viewscanpar, dummy_st);
        acv.a_p_arr1   := aux_p_arr;
        acv.a_init_ddl := init_ddl
        END
    (*ENDIF*) 
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13trigger_reconstruction (
            VAR acv     : tak_all_command_glob;
            packet_size : tsp00_Int4);
 
VAR
      sqlMode      : tsp00_SqlMode;
      b_err        : tgg00_BasisError;
      set_result   : tgg00_BdSetResultRecord;
      tree_pos     : tgg00_FilePos;
      pKey         : ^tgg00_Lkey;
      pViewText    : ^ tak_viewtextrecord;
      b            : tgg00_Rec;
 
BEGIN
sqlMode       := acv.a_sqlmode;
acv.a_sqlmode := sqlm_internal;
a542internal_packet (acv, NOT c_release_packet, packet_size);
IF  acv.a_returncode = 0
THEN
    BEGIN
    WITH set_result DO
        BEGIN
        bd_key_check_len:= 0;
        bd_max_rec_cnt  := 1;
        bd_max_fill_len := sizeof (b);
        bd_next         := false;
        END;
    (*ENDWITH*) 
    pKey      := @b;
    pViewText := @b;
    pKey^.len := 0;
    tree_pos.tpsPno_gg00 := NIL_PAGE_NO_GG00;
    REPEAT
        b07cnext_record (acv.a_transinf.tri_trans, acv.a_into_tree,
              pKey^, set_result, tree_pos, b);
        b_err := acv.a_transinf.tri_trans.trError_gg00;
        IF  (b_err = e_ok) OR (b_err = e_key_not_found)
        THEN
            BEGIN
            (* PTS 1116632 E.Z. *)
            b_err := e_ok;
            g10mv ('VAK13 ',   7,    
                  sizeof (pViewText^.vttbuf), acv.a_cmd_part^.sp1p_buf_size,
                  @pViewText^.vttbuf, 1, @acv.a_cmd_part^.sp1p_buf,
                  acv.a_cmd_part^.sp1p_buf_len + 1, pViewText^.vttextlength, b_err);
            acv.a_cmd_part^.sp1p_buf_len := acv.a_cmd_part^.sp1p_buf_len + pViewText^.vttextlength;
            IF  NOT pViewText^.vtnextexist
            THEN
                BEGIN
&               ifdef trace
                t01moveobj (ak_sem, acv.a_cmd_part^.sp1p_buf, 1, acv.a_cmd_part^.sp1p_buf_len);
&               endif
                a35_asql_statement (acv);
                (* in-parts of packet are overwritten --> initialize really new *)
                (* perhaps it would be enough to set all variables, but not     *)
                (* free and realloc space                                       *)
                a542pop_packet (acv);
                a542internal_packet (acv, NOT c_release_packet, packet_size);
                END;
            (* PTS 1116632 E.Z. *)
            (*ENDIF*) 
            set_result.bd_next := true;
            END;
        (*ENDIF*) 
    UNTIL
        (b_err <> e_ok) OR (acv.a_returncode <> 0);
    (*ENDREPEAT*) 
    a542pop_packet (acv);
    END;
(*ENDIF*) 
acv.a_sqlmode := sqlMode;
b01empty_file (acv.a_transinf.tri_trans, acv.a_into_tree);
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13new_catalog_desc (
            VAR acv        : tak_all_command_glob;
            VAR newbaserec : tak_baserecord;
            VAR oldbaserec : tak_baserecord;
            VAR reclen     : tsp00_Int4;
            VAR keypos     : tsp00_Int2;
            VAR map        : tak_colinteger;
            VAR ext_map    : tak13ext_mapping);
 
VAR
      found         : boolean;
      exit_loop     : boolean;
      res           : tsp00_LcompResult;
      ix            : integer;
      ci            : integer;
      colind        : integer;
      colno         : integer;
      count         : integer;
      longcoloffset : integer;
      old_colp      : tak00_colinfo_ptr;
      new_colp      : tak00_colinfo_ptr;
      colname       : tsp00_KnlIdentifier;
 
BEGIN
(* construct the new base records now *)
colno := 0;
WITH newbaserec DO
    BEGIN
    blenfixedcol   := 1;
    bvarcolcount   := 0;
    blongvarcolcnt := 0
    END;
(*ENDWITH*) 
longcoloffset := 0;
reclen        := cgg_rec_key_offset;
ix            := 1;
WHILE (ix <= oldbaserec.bmaxcol) AND
      (acv.a_returncode = 0) DO
    BEGIN
    a06extcolno (oldbaserec, ix, old_colp);
    IF  NOT (ctdropped in old_colp^.ccolpropset)
    THEN
        BEGIN
        colno := colno + 1;
        (* find out, if current column is already *)
        (* present in new baserecord              *)
        (* a06_exist_columnname cannot be used    *)
        (* because columns are not sorted yet     *)
        WITH newbaserec DO
            BEGIN
            colind    := bfirstindex;
            new_colp  := bcolumn[bfirstindex];
            found     := false;
            exit_loop := colind > blastindex;
            WHILE NOT exit_loop DO
                BEGIN
                s30cmp1 (old_colp^.ccolumnn, 1,
                      ord (old_colp^.ccolumnn_len),
                      new_colp^.ccolumnn, 1,
                      ord (new_colp^.ccolumnn_len), res);
                IF  res = l_equal
                THEN
                    BEGIN
                    exit_loop := true;
                    found     := true
                    END
                ELSE
                    BEGIN
                    colind := colind + 1;
                    IF  colind > blastindex
                    THEN
                        exit_loop := true
                    ELSE
                        new_colp := bcolumn[colind]
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
                END;
            (*ENDWHILE*) 
            IF  NOT found AND
                (acv.a_returncode = 0)
            THEN
                BEGIN
                a061get_colname (old_colp^, colname);
                a061app_columnname (acv, newbaserec,
                      colname, colind);
                IF  acv.a_returncode = 0
                THEN
                    BEGIN
                    new_colp := bcolumn[colind];
                    a061copy_colinfo (old_colp^, new_colp^)
                    END;
                (*ENDIF*) 
                END
            (*ENDIF*) 
            END;
        (*ENDWITH*) 
        IF  acv.a_returncode = 0
        THEN
            BEGIN
            new_colp^.cextcolno := colno;
            new_colp^.creccolno := colno;
            WITH newbaserec,
                 new_colp^.ccolstack DO
                BEGIN
                CASE etype OF
                    st_fixkey, st_varkey :
                        BEGIN
                        elen_var := new_colp^.cinoutlen;
                        reclen := reclen +
                              new_colp^.cinoutlen;
                        END;
                    st_fixcol :
                        BEGIN
                        (* PTS 1115206 M.Ki. *)
                        IF  new_colp^.cdatatyp in
                            [dstra, dstre, dstrb, dstruni,
                            dlonga, dlonge, dlonguni, dlongb]
                        THEN
                            BEGIN
                            epos := longcoloffset + 1;
                            longcoloffset := longcoloffset + new_colp^.cinoutlen;
                            bstringcount := bstringcount + 1 (* PTS 1115401 M.Ki. *)
                            END
                        ELSE
                            BEGIN
                            epos         := blenfixedcol;
                            blenfixedcol := blenfixedcol +
                                  new_colp^.cinoutlen
                            END;
                        (*ENDIF*) 
                        elen_var := new_colp^.cinoutlen;
                        reclen := reclen + new_colp^.cinoutlen
                        END;
                    st_varcol :
                        BEGIN
                        (* move fixed length columns that were *)
                        (* ADDed and appended as VAR COLs to   *)
                        (* fixed section of record if possible *)
                        (* PTS 1115206 M.Ki. *)
                        IF  (((new_colp^.cinoutlen > cak_maxconstlength + 1)
                            (* PTS 1126711 E.Z. *)
                            OR (ta_no_fixed_length_column IN battributes)
                            OR (new_colp^.cvarchar            AND
                            (   new_colp^.cdatatyp <> dfixed) AND
                            ((  new_colp^.cdatalen > 2)       OR
                            (   new_colp^.cdatalen = cak_is_undefined)))))
                        THEN
                            BEGIN
                            bvarcolcount := bvarcolcount+1;
                            ecolno       := bvarcolcount;
                            elen_var     := new_colp^.cinoutlen;
                            IF  acv.a_sqlmode = sqlm_oracle
                            THEN
                                reclen := reclen + 2
                            ELSE
                                reclen := reclen + 1 +
                                      new_colp^.cinoutlen
                            (*ENDIF*) 
                            END
                        ELSE
                            BEGIN
                            (* column of fixed length *)
                            etype        :=  st_fixcol;
                            IF  new_colp^.cdatatyp in
                                [dstra, dstre, dstrb, dstruni,
                                dlonga, dlonge, dlonguni, dlongb]
                            THEN
                                BEGIN
                                epos          := longcoloffset + 1;
                                longcoloffset := longcoloffset
                                      + new_colp^.cinoutlen;
                                bstringcount  := bstringcount + 1
                                END
                            ELSE
                                BEGIN
                                epos         := blenfixedcol;
                                blenfixedcol := blenfixedcol +
                                      new_colp^.cinoutlen
                                END;
                            (*ENDIF*) 
                            elen_var := new_colp^.cinoutlen;
                            reclen := reclen + new_colp^.cinoutlen
                            END;
                        (*ENDIF*) 
                        END;
                    st_varlongchar :
                        BEGIN
                        blongvarcolcnt := blongvarcolcnt +1;
                        ecolno         := blongvarcolcnt;
                        elen_var       := new_colp^.cinoutlen;
                        IF  acv.a_sqlmode = sqlm_oracle
                        THEN
                            reclen := reclen + 3
                        ELSE
                            reclen := reclen + 2 +
                                  new_colp^.cinoutlen
                        (*ENDIF*) 
                        END;
                    END;
                (*ENDCASE*) 
                END;
            (*ENDWITH*) 
            IF  reclen > MAX_RECLEN_GG00
            THEN
                a07_b_put_error (acv, e_too_long_record, 1)
            ELSE
                WITH ext_map[old_colp^.cextcolno] DO
                    BEGIN
                    em_old_colp := old_colp;
                    em_new_colp := new_colp
                    END;
                (*ENDWITH*) 
            (*ENDIF*) 
            map[colno] := old_colp^.cextcolno
            END;
        (*ENDIF*) 
        END
    ELSE
        ext_map[old_colp^.creccolno].em_new_colp := NIL;
    (*ENDIF*) 
    ix := ix + 1
    END;
(*ENDWHILE*) 
count := 0;
WITH newbaserec DO
    BEGIN
    blenfixedcol := blenfixedcol + longcoloffset;
    FOR ci := bfirstindex TO blastindex DO
        BEGIN
&       ifdef trace
        a061td_colinfo (bcolumn[ci]^, ci);
&       endif
        WITH bcolumn[ci]^ DO
            BEGIN
            bextcolindex[cextcolno] := count;
            count  := count + 1;
            CASE ccolstack.etype OF
                st_fixcol :
                    IF  NOT (cdatatyp in [dstra, dstre, dstrb, dstruni,
                        dlonga, dlonge, dlonguni, dlongb])
                    THEN
                        ccolstack.epos := ccolstack.epos + longcoloffset;
                    (*ENDIF*) 
                OTHERWISE ;
                END;
            (*ENDCASE*) 
&           ifdef trace
            ;
            t01stackentry (ak_sem, ccolstack, 1);
&           endif
            END;
        (*ENDWITH*) 
        END;
    (*ENDFOR*) 
    END;
(*ENDWITH*) 
IF  acv.a_returncode = 0
THEN
    BEGIN
    keypos := 1;
    WITH oldbaserec DO
        BEGIN
        old_colp := bcolumn[bfirstcolind];
        FOR ix := 1 TO bkeycolcount DO
            BEGIN
            WITH ext_map[old_colp^.cextcolno].em_new_colp^ DO
                BEGIN
                ccolstack.epos := keypos;
                keypos         := keypos + cinoutlen;
                IF  keypos - 1 > mxsp_key
                THEN
                    a07_b_put_error (acv,
                          e_too_long_key, 1)
                (*ENDIF*) 
                END;
            (*ENDWITH*) 
            IF  ix < bkeycolcount
            THEN
                old_colp := bcolumn[old_colp^.cnextind]
            (*ENDIF*) 
            END;
        (*ENDFOR*) 
        END;
    (*ENDWITH*) 
    END;
(*ENDIF*) 
IF  acv.a_returncode = 0
THEN
    a11sort (newbaserec);
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a13_new_catalog_desc (
            VAR acv        : tak_all_command_glob;
            VAR a11v       : tak_a11_glob;
            VAR old_p      : tak_syspointerarr;
            VAR extcol_map : tgg03_extcol_map;
            VAR new_base   : boolean);
 
VAR
      is_found      : boolean;
      keypos        : tsp00_Int2;
      ix            : integer;
      iy            : integer;
      reclen        : tsp00_Int4;
      map           : tak_colinteger;
      new_colp      : tak00_colinfo_ptr;
      ext_map       : tak13ext_mapping;
      viewscandummy : tak_viewscan_par;
 
BEGIN
new_base                   := false;
viewscandummy.vsc_filevers := acv.a_p_arr1.pbasep^.
      sbase.btreeid.fileVersion_gg00;
IF  acv.a_returncode = 0
THEN
    ak13new_base_record (acv, a11v, viewscandummy, old_p,
          NOT c_new_file_version);
(*ENDIF*) 
IF  acv.a_returncode = 0
THEN
    BEGIN
    new_base := true;
    reclen := cgg_rec_key_offset;
    keypos := 1;
    FOR ix := 1 TO c_max_ext_map DO
        BEGIN
        ext_map[ ix ].em_new_colp := NIL;
        ext_map[ ix ].em_old_colp := NIL
        END;
    (*ENDFOR*) 
    ak13new_catalog_desc (acv, acv.a_p_arr1.pbasep^.sbase,
          old_p.pbasep^.sbase, reclen, keypos, map, ext_map);
    END;
(*ENDIF*) 
IF  acv.a_returncode = 0
THEN
    BEGIN (* build map:                                         *)
    (* new extcolno -> colind in old baserecord (em_old_colind) *)
    (* old extcolno -> colind in new baserecord (em_new_colind) *)
    ix := old_p.pbasep^.sbase.bfirstcolind;
    WHILE ix <> 0 DO
        WITH old_p.pbasep^.sbase DO
            BEGIN
            new_colp := ext_map[bcolumn[ix]^.cextcolno].em_new_colp;
            IF  new_colp <> NIL
            THEN
                BEGIN
                extcol_map[ new_colp^.cextcolno ].em_old_colind := ix;
                iy := acv.a_p_arr1.pbasep^.sbase.bfirstcolind;
                is_found := false;
                WHILE (iy <> 0) AND NOT is_found DO
                    IF  acv.a_p_arr1.pbasep^.sbase.bcolumn[ iy ] = new_colp
                    THEN
                        is_found := true
                    ELSE
                        iy := acv.a_p_arr1.pbasep^.sbase.bcolumn[iy]^.cnextind;
                    (*ENDIF*) 
                (*ENDWHILE*) 
&               ifdef TRACE
                IF  iy = 0
                THEN
                    a07ak_system_error (acv, 13, 2);
&               endif
                (*ENDIF*) 
                extcol_map[ bcolumn[ix]^.cextcolno ].em_new_colind := iy;
                END;
            (*ENDIF*) 
            ix := bcolumn[ ix ]^.cnextind;
            END;
        (*ENDWITH*) 
    (*ENDWHILE*) 
    END;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak13build_mapping_stack(
            VAR acv           : tak_all_command_glob;
            VAR old_p         : tak_syspointerarr;
            VAR map           : tak_colinteger;
            VAR ext_map       : tak13ext_mapping;
            mult_desc_ptr     : tgg00_StackListPtr;
            mult_desc_cnt     : integer;
            VAR index_treeid  : tgg00_FileId;
            change_key        : boolean;
            VAR b_err         : tgg00_BasisError);
 
CONST
      c_exit_loop = csp_maxint2;
 
VAR
      i              : integer;
      colind         : integer;
      colno          : integer;
      pos            : integer;
      col_pos        : integer;
      res_pos        : integer;
      jx             : integer;
      new_st         : tgg00_StEntryAddr;
      old_st         : tgg00_StEntryAddr;
      old_colp       : tak00_colinfo_ptr;
      varkey_col_off : integer; (* PTS 1115359 M.Ki *)
 
BEGIN
(* builds the stack entries needed by vbd37 to map the record structure of a *)
(* modified table to one of a 'clean' record as it would have been produced  *)
(* by a 'Create Table' statement                                             *)
IF  b_err = e_ok
THEN
    BEGIN
    WITH acv, a_p_arr1.pbasep^.sbase DO
        BEGIN
        colind := bfirstcolind
        END;
    (*ENDWITH*) 
    acv.a_mblock.mb_qual^.mcol_pos    := 1;
    acv.a_mblock.mb_qual^.mstring_cnt :=
          acv.a_p_arr1.pbasep^.sbase.bstringcount;
    s10mv (sizeof (old_p.pbasep^.sbase.btreeid),
          acv.a_mblock.mb_data_size, @old_p.pbasep^.sbase.btreeid, 1,
          @acv.a_mblock.mb_data^.mbp_buf, 1,
          sizeof (old_p.pbasep^.sbase.btreeid));
&   ifdef trace
    t01treeid (ak_sem, 'old treeid  ',
          old_p.pbasep^.sbase.btreeid);
&   endif
    pos := sizeof (old_p.pbasep^.sbase.btreeid) + 3;
    (* new table stack entries into mb_st starting at mcol_pos     *)
    (* old table stack entries into mb_st starting at mresqual_pos *)
    WITH acv, a_mblock, mb_qual^ DO
        BEGIN
        WHILE colind <> 0 DO
            WITH a_p_arr1.pbasep^.sbase.bcolumn[colind]^ DO
                BEGIN
                mcol_cnt          := mcol_cnt + 1;
                mb_st^ [mcol_cnt] := ccolstack;
                WITH mb_st^[mcol_cnt] DO
                    IF  (cdatatyp = dfixed) AND cbinary
                    THEN
                        IF  cdatalen = 10
                        THEN
                            ecol_tab[2] := chr(ord(dinteger))
                        ELSE
                            ecol_tab[2] := chr(ord(dsmallint))
                        (*ENDIF*) 
                    ELSE
                        ecol_tab[2] := chr(ord(cdatatyp));
                    (*ENDIF*) 
                (*ENDWITH*) 
                mb_st^ [mcol_cnt].eop := op_none;
                IF  (ccolstack.etype = st_varkey) AND
                    (a_p_arr1.pbasep^.sbase.btablekind = twithoutkey)
                    AND
                    (a_p_arr1.pbasep^.sbase.btablekind <>
                    old_p.pbasep^.sbase.btablekind)
                THEN
                    BEGIN
                    (* describe system key construction *)
                    a_work_st_addr^ [mcol_cnt].etype       := st_rowno;
                    a_work_st_addr^ [mcol_cnt].eop         := op_none;
                    a_work_st_addr^ [mcol_cnt].epos        := 0;
                    a_work_st_addr^ [mcol_cnt].elen_var    := 0;
                    a_work_st_addr^ [mcol_cnt].ecol_tab[1] := chr(0);
                    a_work_st_addr^ [mcol_cnt].ecol_tab[2] := chr(ord(dchb))
                    END
                ELSE
                    BEGIN
                    i := map[cextcolno];
&                   ifdef trace
                    t01buf (ak_sem,
                          a_p_arr1.pbasep^.sbase.
                          bcolumn[colind]^, 1, 44);
                    t01stackentry (ak_sem, ccolstack, mcol_cnt);
                    t01stackentry (ak_sem,
                          ext_map[i].em_old_colp^.ccolstack, 1);
&                   endif
                    IF  (ctopt in ext_map[i].em_old_colp^.ccolpropset)
                        AND (NOT (ctopt in ccolpropset))
                    THEN
                        mb_st^ [mcol_cnt].eop := op_not_null;
                    (*ENDIF*) 
                    a_work_st_addr^ [mcol_cnt] :=
                          ext_map[i].em_old_colp^.ccolstack;
                    WITH mb_st^[mcol_cnt] DO
                        IF  (ext_map[i].em_old_colp^.cdatatyp = dfixed)
                            AND
                            ext_map[i].em_old_colp^.cbinary
                        THEN
                            IF  ext_map[i].em_old_colp^.cdatalen = 10
                            THEN
                                a_work_st_addr^ [mcol_cnt].ecol_tab[2] :=
                                      chr(ord(dinteger))
                            ELSE
                                a_work_st_addr^ [mcol_cnt].ecol_tab[2] :=
                                      chr(ord(dsmallint))
                            (*ENDIF*) 
                        ELSE
                            a_work_st_addr^ [mcol_cnt].ecol_tab[2] :=
                                  chr(ord( ext_map[i].em_old_colp^.cdatatyp));
                        (*ENDIF*) 
                    (*ENDWITH*) 
                    IF  change_key OR
                        (cdatatyp in [dstra, dstre, dstrb, dstruni,
                        dlonga, dlonge, dlonguni, dlongb])
                    THEN (* no index must be renamed *)
                        BEGIN
                        a_work_st_addr^ [mcol_cnt].ecol_tab[1] := chr(0);
                        mb_st^[mcol_cnt].ecol_tab[1]           := chr(0);
                        END;
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
                colind := cnextind;
                END;
            (*ENDWITH*) 
        (*ENDWHILE*) 
        mfirst_free := mcol_cnt + 1
        END;
    (*ENDWITH*) 
    END;
(*ENDIF*) 
IF  b_err = e_ok
THEN
    WITH acv, a_mblock, mb_qual^ DO
        IF  mfirst_free + mcol_cnt - 1 > mb_st_max
        THEN
            b_err := e_too_many_mb_stackentries;
        (*ENDIF*) 
    (*ENDWITH*) 
(*ENDIF*) 
IF  b_err = e_ok
THEN
    BEGIN
    WITH acv, a_mblock, mb_qual^ DO
        BEGIN
        varkey_col_off := 0; (* PTS 1115359 M.Ki *)
        mresqual_pos := mfirst_free;
        mresqual_cnt := mcol_cnt;
        g10mv ('VAK13 ',   8,    
              a_work_st_max * sizeof (tgg00_StackEntry),
              mb_st_size,
              @a_work_st_addr^, 1,
              @mb_st^, (mresqual_pos - 1) * sizeof (tgg00_StackEntry) + 1,
              mresqual_cnt * sizeof (tgg00_StackEntry), b_err);
        col_pos := mcol_pos;
        res_pos := mresqual_pos;
        WHILE col_pos <= mcol_pos + mcol_cnt - 1 DO
            BEGIN
            new_st  := @mb_st^[col_pos];
            old_st  := @mb_st^[res_pos];
&           ifdef trace
            t01stackentry (ak_sem, new_st^, col_pos);
            t01stackentry (ak_sem, old_st^, res_pos);
&           endif
            col_pos := col_pos + 1;
            res_pos := res_pos + 1;
            IF  (new_st^.epos        = old_st^.epos       ) AND
                (new_st^.etype       = old_st^.etype      ) AND
                (new_st^.ecol_tab[2] = old_st^.ecol_tab[2]) AND
                (old_st^.ecol_tab[1] = chr (0)) (* h.b. PTS 1001447 *)
            THEN
                BEGIN
                IF  (new_st^.etype = st_varkey) AND
                    (new_st^.elen_var = old_st^.elen_var) (* PTS 1106744 *)
                THEN
                    BEGIN (* key is unchanged *)
                    mb_st^[mcol_pos] := new_st^;
                    WITH mb_st^[mcol_pos] DO
                        BEGIN
                        etype := st_old_varkey;
                        eop   := op_none;
                        END;
                    (*ENDWITH*) 
                    mb_st^[mresqual_pos] := mb_st^[mcol_pos];
                    jx := mcol_pos;
                    FOR i := col_pos TO mcol_pos + mcol_cnt - 1 DO
                        BEGIN
                        jx         := jx + 1;
                        mb_st^[jx] := mb_st^[i]
                        END;
                    (*ENDFOR*) 
                    mcol_cnt := jx - mcol_pos + 1;
                    varkey_col_off := col_pos - mcol_pos - 1; (* PTS 1115359 M.Ki *)
                    jx       := mresqual_pos;
                    FOR i := res_pos TO mresqual_pos + mresqual_cnt - 1 DO
                        BEGIN
                        jx         := jx + 1;
                        mb_st^[jx] := mb_st^[i]
                        END;
                    (*ENDFOR*) 
                    mresqual_cnt := jx - mresqual_pos + 1;
                    col_pos      := c_exit_loop
                    END
                ELSE
                    IF  new_st^.etype <> st_fixkey
                    THEN
                        col_pos := c_exit_loop
                    (*ENDIF*) 
                (*ENDIF*) 
                END
            ELSE
                col_pos := c_exit_loop
            (*ENDIF*) 
            END;
        (*ENDWHILE*) 
        mfirst_free := mfirst_free + mresqual_cnt;
        mqual_pos   := mfirst_free;
        (* describe columns with decreased length *)
        IF  NOT change_key
        THEN
            BEGIN
            colind := a_p_arr1.pbasep^.sbase.bfirstcolind;
            colno  := 0;
            WHILE (colind <> 0) AND (b_err = e_ok) DO
                WITH a_p_arr1.pbasep^.sbase.bcolumn[colind]^ DO
                    BEGIN
                    colno := colno + 1;
                    old_colp :=
                          ext_map[map[cextcolno]].em_old_colp;
                    IF  (cdatatyp = dfixed)           AND
                        (old_colp^.cdatatyp = dfixed) AND
                        ((cdatafrac < old_colp^.cdatafrac) OR
                        ( cdatalen - cdatafrac <
                        old_colp^.cdatalen - old_colp^.cdatafrac))
                    THEN
                        BEGIN
                        IF  mfirst_free > mb_st_max
                        THEN
                            b_err := e_too_many_mb_stackentries
                        ELSE
                            WITH mb_st^ [mfirst_free] DO
                                BEGIN
                                etype       := st_op;
                                eop         := op_fixed;
                                epos        := cdatalen;
                                elen_var    := cdatafrac;
                                ecol_pos    := colno - varkey_col_off; (* PTS 1115359 M.Ki *)
                                mqual_cnt   := mqual_cnt + 1;
                                mfirst_free := mfirst_free + 1
                                END;
                            (*ENDWITH*) 
                        (*ENDIF*) 
                        END
                    ELSE
                        IF  cdatalen < old_colp^.cdatalen
                        THEN
                            IF  mfirst_free > mb_st_max
                            THEN
                                b_err := e_too_many_mb_stackentries
                            ELSE
                                WITH mb_st^ [mfirst_free] DO
                                    BEGIN
                                    etype       := st_op;
                                    eop         := op_trunc;
                                    IF  (old_colp^.cdatatyp = dunicode)
                                        AND
                                        (cdatatyp <> dunicode)
                                    THEN
                                        epos := (cinoutlen - 1) * 2 + 1
                                    ELSE
                                        epos := cinoutlen;
                                    (*ENDIF*) 
                                    elen_var    := 0;
                                    ecol_pos    := colno - varkey_col_off; (* PTS 1115359 M.Ki *)
                                    mqual_cnt   := mqual_cnt + 1;
                                    mfirst_free := mfirst_free + 1
                                    END;
                                (*ENDWITH*) 
                            (*ENDIF*) 
                        (*ENDIF*) 
                    (*ENDIF*) 
                    colind := cnextind
                    END;
                (*ENDWITH*) 
            (*ENDWHILE*) 
            END;
&       ifdef trace
        (*ENDIF*) 
        t01treeid (ak_sem, 'index_treeid', index_treeid);
&       endif
        g10mv ('VAK13 ',   9,    
              sizeof (index_treeid), a_mblock.mb_data_size,
              @index_treeid, 1, @a_mblock.mb_data^.mbp_buf, pos,
              sizeof (index_treeid), b_err);
        pos          := pos + sizeof (index_treeid);
        mb_data_len  := pos - 1;
        IF  (mult_desc_ptr <> NIL) AND (mult_desc_cnt > 0) AND
            (b_err = e_ok)
        THEN
            WITH mb_qual^ DO
                BEGIN
                (* add index descriptions of indexes *)
                (* to be renamed                     *)
                IF  mfirst_free + mult_desc_cnt - 1 > mb_st_max
                THEN
                    b_err := e_too_many_mb_stackentries
                ELSE
                    BEGIN
                    mmult_pos := mfirst_free;
                    mmult_cnt := mult_desc_cnt;
                    FOR i := 1 TO mult_desc_cnt DO
                        mb_st^ [mmult_pos+i-1] := mult_desc_ptr^[i];
                    (*ENDFOR*) 
                    mfirst_free := mmult_pos + mmult_cnt
                    END
                (*ENDIF*) 
                END;
            (*ENDWITH*) 
        (*ENDIF*) 
        END;
    (*ENDWITH*) 
    END;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a13_build_mapping_stack (
            VAR acv        : tak_all_command_glob;
            VAR a11v       : tak_a11_glob;
            VAR src_st_ptr : tgg00_StackListPtr;
            VAR tar_st_ptr : tgg00_StackListPtr;
            VAR src_col_cnt: tsp00_Int2;
            VAR new_base   : boolean);
 
CONST
      c_change_key    = false;
      c_mult_desc_ptr = NIL;
      c_mult_desc_cnt = 0;
 
VAR
      keypos        : tsp00_Int2;
      ix            : integer;
      reclen        : tsp00_Int4;
      dummy_fileId  : tgg00_FileId;
      map           : tak_colinteger;
      old_p         : tak_syspointerarr;
      ext_map       : tak13ext_mapping;
      b_err         : tgg00_BasisError;
      viewscandummy : tak_viewscan_par;
 
BEGIN
new_base                   := false;
viewscandummy.vsc_filevers := acv.a_p_arr1.pbasep^.sbase.
      btreeid.fileVersion_gg00;
IF  acv.a_returncode = 0
THEN
    ak13new_base_record (acv, a11v, viewscandummy, old_p,
          NOT c_new_file_version);
(*ENDIF*) 
IF  acv.a_returncode = 0
THEN
    BEGIN
    new_base := true;
    b_err    := e_ok;
    reclen   := cgg_rec_key_offset;
    keypos   := 1;
    FOR ix := 1 TO c_max_ext_map DO
        BEGIN
        ext_map[ ix ].em_new_colp := NIL;
        ext_map[ ix ].em_old_colp := NIL
        END;
    (*ENDFOR*) 
    ak13new_catalog_desc (acv, acv.a_p_arr1.pbasep^.sbase,
          old_p.pbasep^.sbase, reclen,
          keypos, map, ext_map);
    END;
(*ENDIF*) 
IF  acv.a_returncode = 0
THEN
    BEGIN
    dummy_fileId.fileTabId_gg00 := cgg_zero_id;
    a06a_mblock_init (acv, m_change, mm_table,
          acv.a_p_arr1.pbasep^.sbase.btreeid);
    ak13build_mapping_stack (acv, old_p, map, ext_map, c_mult_desc_ptr,
          c_mult_desc_cnt, dummy_fileId,
          NOT c_change_key, b_err);
    IF  b_err <> e_ok
    THEN
        a07_b_put_error (acv, b_err, 1)
    ELSE
        BEGIN
        src_st_ptr  := @acv.a_mblock.mb_st^[acv.a_mblock.mb_qual^.mresqual_pos];
        tar_st_ptr  := acv.a_mblock.mb_st;
        src_col_cnt := acv.a_mblock.mb_qual^.mresqual_cnt;
        END;
    (*ENDIF*) 
    END;
(*ENDIF*) 
END;
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
.PA 
