.nf
 
 
    ========== licence begin  GPL
    Copyright (C) 2000 SAP AG
 
    This program is free software; you can redistribute it and/or
    modify it under the terms of the GNU General Public License
    as published by the Free Software Foundation; either version 2
    of the License, or (at your option) any later version.
 
    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.
 
    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
    ========== licence end
 
.fo
*****************************************************
Copyright by SAP AG, 1999
SAP Database Technology
 
Release :      Date : 2000-11-24
*****************************************************
modname : VAK37
changed : 2000-11-24
module  : AK_warm_utility_functions
 
Author  : ThomasA
Created : 1985-02-06
*****************************************************
 
Purpose : Behandlung von DBS_Utility-Auftr?age im warmen Betrieb.
 
Define  :
 
        PROCEDURE
              a37_call_semantic (
                    VAR acv               : tak_all_command_glob;
                    VAR util_cmd_id       : tgg00_UtilCmdId);
 
        PROCEDURE
              a37blocksize (
                    VAR acv  : tak_all_command_glob;
                    VAR a30v : tak_a30_utility_glob);
 
        PROCEDURE
              a37event_state (
                    VAR acv  : tak_all_command_glob;
                    VAR a41v : tak40_show_glob);
 
        PROCEDURE
              a37get_surrogate (
                    VAR acv       : tak_all_command_glob;
                    ti            : integer;
                    VAR surrogate : tgg_surrogate);
 
        FUNCTION
              a37hex2char (
                    VAR acv : tak_all_command_glob;
                    hexpos : integer) : char;
 
        PROCEDURE
              a37return_hostname (VAR acv : tak_all_command_glob);
 
        PROCEDURE
              a37init_util_record (
                    VAR acv : tak_all_command_glob;
                    m_type  : tgg_message_type;
                    mm_type : tgg_message2_type);
 
        PROCEDURE
              a37media_name (
                    VAR acv  : tak_all_command_glob;
                    VAR ti   : tsp_int2;
                    VAR qual : tgg_qual_buf);
 
        PROCEDURE
              a37multi_tape_info (
                    VAR acv  : tak_all_command_glob;
                    kw_index : integer);
 
        PROCEDURE
              a37put_count_to_messbuf (
                    VAR acv   : tak_all_command_glob;
                    VAR a30v  : tak_a30_utility_glob);
 
        PROCEDURE
              a37state_get (
                    VAR acv  : tak_all_command_glob;
                    kw_index : integer);
 
        PROCEDURE
              a37state_vtrace (VAR acv : tak_all_command_glob);
 
        PROCEDURE
              a37user_command (VAR acv : tak_all_command_glob);
 
        PROCEDURE
              a37vtrace (VAR acv : tak_all_command_glob);
 
        PROCEDURE
              a37utilprot_needed (
                    VAR acv           : tak_all_command_glob;
                    VAR prot_needed   : boolean;
                    VAR with_tapeinfo : boolean);
 
        PROCEDURE
              a37ddl (
                    VAR acv : tak_all_command_glob;
                    ddl_id : tak30_ddl_kind);
 
.CM *-END-* define --------------------------------------
***********************************************************
 
Use     :
 
        FROM
              AK_User_Password : VAK21;
 
        PROCEDURE
              a21_call_semantic  (VAR acv : tak_all_command_glob);
 
      ------------------------------ 
 
        FROM
              AK_Index : VAK24;
 
        PROCEDURE
              a24get_indexname (
                    VAR acv        : tak_all_command_glob;
                    indexbuf       : tak_sysbufferaddress;
                    index          : integer;
                    VAR index_name : tsp_knl_identifier);
 
      ------------------------------ 
 
        FROM
              Kernel_Sink_1 : VAK341;
 
        FUNCTION
              ak341SetOmsTraceLevel(VAR lvl : tsp00_KnlIdentifier;
                    enable : boolean) : boolean;
 
        PROCEDURE
              ak341HeapCallStackMonitoring (level : integer);
 
        PROCEDURE
              ak341Shutdown;
 
      ------------------------------ 
 
        FROM
              AK_data_dictionary : VAK38;
 
        PROCEDURE
              a38create_parameter_file (VAR acv : tak_all_command_glob);
 
        PROCEDURE
              a38insert_parameters (
                    VAR acv        : tak_all_command_glob;
                    key_prefix     : tsp_int4;
                    VAR objecttype : tsp_name;
                    VAR username   : tsp_knl_identifier;
                    VAR name1      : tsp_knl_identifier;
                    VAR name2      : tsp_knl_identifier;
                    VAR name3      : tsp_knl_identifier);
 
      ------------------------------ 
 
        FROM
              DML_Help_Procedures : VAK542;
 
        PROCEDURE
              a542internal_packet (
                    VAR acv                 : tak_all_command_glob;
                    release_internal_packet : boolean;
                    required_len            : tsp_int4);
 
        PROCEDURE
              a542move_to_packet (
                    VAR acv    : tak_all_command_glob;
                    const_addr : tsp_moveobj_ptr;
                    const_len  : tsp_int4);
 
        PROCEDURE
              a542pop_packet (VAR acv : tak_all_command_glob);
 
      ------------------------------ 
 
        FROM
              diagnose monitor : VAK545;
 
        PROCEDURE
              a545clear_monitor (VAR acv : tak_all_command_glob);
 
        PROCEDURE
              a545sm_data_tree (
                    VAR acv          : tak_all_command_glob;
                    VAR mondata_tree : tgg00_FileId);
 
        PROCEDURE
              a545sm_reset (VAR monitor_tree : tgg00_FileId);
 
        PROCEDURE
              a545sm_set_rowno (maxrowno : tsp_int4);
 
      ------------------------------ 
 
        FROM
              diagnose analyze : VAK544;
 
        PROCEDURE
              a544semantik_diag_analyze (VAR acv : tak_all_command_glob);
 
      ------------------------------ 
 
        FROM
              GG_allocator_interface : VGG941;
 
        PROCEDURE
              Kernel_CheckSwitch (VAR TopicStr : tsp_moveobj (*ptocSynonym const char**);
                    TopicStrLen : integer);
 
        PROCEDURE
              Kernel_TraceSwitch (VAR TopicStr : tsp_moveobj (*ptocSynonym const char**);
                    TopicStrLen : integer);
&       ifdef TRACE
 
      ------------------------------ 
 
        FROM
              Test_Procedures : vta01;
 
        PROCEDURE
              t01int4 (
                    layer : tgg00_Debug;
                    nam : tsp00_Sname;
                    int : tsp00_Int4);
 
        PROCEDURE
              t01moveobj (
                    layer       : tgg00_Debug;
                    VAR moveobj : tsp00_MoveObj;
                    start_pos   : tsp00_Int4;
                    end_pos     : tsp00_Int4);
 
        PROCEDURE
              t01minbuf (min_wanted : boolean);
 
        PROCEDURE
              t01multiswitch (
                    VAR s20  : tsp00_C20;
                    VAR s201 : tsp00_C20 );
 
        PROCEDURE
              t01lmulti_switch (
                    VAR s20      : tsp00_C20;
                    VAR s201     : tsp00_C20;
                    VAR on_text  : tsp00_C16;
                    VAR off_text : tsp00_C16;
                    on_count     : integer);
 
        PROCEDURE
              t01setmaxbuflength (max_len : tsp00_Int4);
 
        PROCEDURE
              t01c18 (debug : tgg00_Debug; msg : tsp11_ConfParamName);
 
        PROCEDURE
              t01buf (
                    debug    : tgg00_Debug;
                    VAR buf  : tsp11_ConfParamValue;
                    startpos : integer;
                    endpos   : integer);
&       endif
 
      ------------------------------ 
 
        FROM
              Utilityprocess  : VAK94;
 
        VAR
              a94mode : tgg_usemode;
 
      ------------------------------ 
 
        FROM
              AK_Lock_Commit_Rollback  : VAK52;
 
        PROCEDURE
              a52_call_semantik (
                    VAR acv : tak_all_command_glob;
                    subproc : tsp_int2);
 
        PROCEDURE
              a52_ex_commit_rollback (
                    VAR acv                   : tak_all_command_glob;
                    m_type                    : tgg_message_type;
                    n_rel                     : boolean;
                    normal_release            : boolean);
 
      ------------------------------ 
 
        FROM
              AK_Connect  : VAK51;
 
        PROCEDURE
              a51_connect (
                    VAR acv         : tak_all_command_glob;
                    utility_connect : boolean);
 
      ------------------------------ 
 
        FROM
              AK_Show_statistics : VAK42;
 
        PROCEDURE
              a42index_inf_to_messbuf(
                    VAR acv         : tak_all_command_glob;
                    VAR mblock      : tgg00_MessBlock;
                    VAR a41v        : tak40_show_glob;
                    VAR indexn      : tsp00_KnlIdentifier;
                    VAR selectivity : boolean;
                    diagnose_index  : boolean);
 
        PROCEDURE
              a42get_tablename (
                    VAR t      : tgg00_TransContext;
                    VAR tabid  : tgg00_Surrogate;
                    VAR authid : tsp00_KnlIdentifier;
                    VAR tablen : tsp00_KnlIdentifier;
                    VAR b_err  : tgg00_BasisError);
 
        PROCEDURE
              a42_start_semantic (VAR acv : tak_all_command_glob);
 
        PROCEDURE
              a42name_and_val_statistic (
                    VAR acv  : tak_all_command_glob;
                    VAR a41v : tak40_show_glob;
                    VAR vkw  : tak_keyword;
                    value    : tsp00_Int4;
                    VAR nam  : tsp00_Sname);
 
      ------------------------------ 
 
        FROM
              AK_cold_utility_functions : VAK36;
 
        PROCEDURE
              a36after_systable_load (VAR acv : tak_all_command_glob);
 
        PROCEDURE
              a36devname (
                    VAR acv     : tak_all_command_glob;
                    tree_index  : integer;
                    VAR dname   : tsp00_VFilename;
                    dlen        : integer);
 
        PROCEDURE
              a36filename (
                    VAR acv     : tak_all_command_glob;
                    tree_index  : integer;
                    VAR fname   : tsp_vfilename;
                    fnlen       : integer);
 
        PROCEDURE
              a36hex_surrogate (
                    VAR acv       : tak_all_command_glob;
                    VAR surrogate : tgg_surrogate);
 
        FUNCTION
              a36filetype (
                    VAR acv      : tak_all_command_glob;
                    tree_index   : tsp_int2;
                    VAR filetype : tsp_vf_type) : boolean;
 
      ------------------------------ 
 
        FROM
              AK_distributor : VAK35;
 
        PROCEDURE
              a35_asql_statement (VAR acv : tak_all_command_glob);
 
        PROCEDURE
              a35_vtracen (VAR acv : tak_all_command_glob);
 
      ------------------------------ 
 
        FROM
              AK_SERVERDB : VAK31;
 
        PROCEDURE
              a31alter_serverdb (VAR acv : tak_all_command_glob);
 
        PROCEDURE
              a31create_serverdb (
                    VAR acv    : tak_all_command_glob;
                    VAR dbname : tsp_dbname);
 
      ------------------------------ 
 
        FROM
              AK_VIEW_SCAN : VAK27;
 
        PROCEDURE
              a27init_viewscanpar (
                    VAR acv         : tak_all_command_glob;
                    VAR viewscanpar : tak_save_viewscan_par;
                    v_type          : tak_viewscantype);
 
      ------------------------------ 
 
        FROM
              AK_save_scheme : VAK15;
 
        PROCEDURE
              a15restore_catalog (
                    VAR acv         : tak_all_command_glob;
                    VAR treeid      : tgg00_FileId;
                    VAR viewscanpar : tak_save_viewscan_par);
 
        PROCEDURE
              a15catalog_save (
                    VAR acv         : tak_all_command_glob;
                    VAR viewscanpar : tak_save_viewscan_par);
 
      ------------------------------ 
 
        FROM
              AK_Table : VAK11;
 
        PROCEDURE
              a11get_check_table (
                    VAR acv          : tak_all_command_glob;
                    new_table        : boolean;
                    basetable        : boolean;
                    unload_allowed   : boolean;
                    required_priv    : tgg_privilege_set;
                    any_priv         : boolean;
                    all_base_rec     : boolean;
                    d_state          : tak_directory_state;
                    VAR act_tree_ind : tsp_int4;
                    VAR authid       : tsp_knl_identifier;
                    VAR tablen       : tsp_knl_identifier;
                    VAR d_sparr      : tak_syspointerarr);
 
        PROCEDURE
              a11del_usage_entry (
                    VAR acv       : tak_all_command_glob;
                    VAR usa_tabid : tgg_surrogate;
                    VAR del_tabid : tgg_surrogate);
 
        PROCEDURE
              a11drop_table  (
                    VAR acv       : tak_all_command_glob;
                    VAR tableid   : tgg_surrogate;
                    tablkind      : tgg_tablekind;
                    succ_filevers : boolean);
 
      ------------------------------ 
 
        FROM
              Systeminfo_cache   : VAK10;
 
        PROCEDURE
              a10_fix_len_get_sysinfo (
                    VAR acv      : tak_all_command_glob;
                    VAR syskey   : tgg_sysinfokey;
                    dstate       : tak_directory_state;
                    required_len : integer;
                    plus         : integer;
                    VAR syspoint : tak_sysbufferaddress;
                    VAR b_err    : tgg_basis_error);
 
        PROCEDURE
              a10_add_repl_sysinfo (
                    VAR acv      : tak_all_command_glob;
                    VAR syspoint : tak_sysbufferaddress;
                    add_sysinfo  : boolean;
                    VAR b_err    : tgg_basis_error);
 
        PROCEDURE
              a10_del_tab_sysinfo  (
                    VAR acv     : tak_all_command_glob;
                    VAR tableid : tgg_surrogate;
                    VAR qual    : tak_del_tab_qual;
                    temp_table  : boolean;
                    VAR b_err   : tgg_basis_error);
 
        PROCEDURE
              a10_cache_delete  (
                    VAR acv     : tak_all_command_glob;
                    is_rollback : boolean);
 
        PROCEDURE
              a10del_sysinfo (
                    VAR acv      : tak_all_command_glob;
                    VAR syskey   : tgg_sysinfokey;
                    VAR b_err    : tgg_basis_error);
 
        PROCEDURE
              a10get_sysinfo (
                    VAR acv      : tak_all_command_glob;
                    VAR syskey   : tgg_sysinfokey;
                    dstate       : tak_directory_state;
                    VAR syspoint : tak_sysbufferaddress;
                    VAR b_err    : tgg_basis_error);
 
        PROCEDURE
              a10next_sysinfo (
                    VAR acv       : tak_all_command_glob;
                    VAR syskey    : tgg_sysinfokey;
                    stop_prefix   : integer;
                    dstate        : tak_directory_state;
                    rec_kind      : tsp_c2;
                    VAR syspoint  : tak_sysbufferaddress;
                    VAR b_err     : tgg_basis_error);
 
        PROCEDURE
              a10rel_sysinfo (syspointer : tak_sysbufferaddress);
 
      ------------------------------ 
 
        FROM
              AK_error_handling : VAK07;
 
        PROCEDURE
              a07ak_system_error (
                    VAR acv  : tak_all_command_glob;
                    modul_no : integer;
                    id       : integer);
 
        PROCEDURE
              a07_b_put_error (
                    VAR acv  : tak_all_command_glob;
                    b_err    : tgg_basis_error;
                    err_code : tsp_int4);
 
        PROCEDURE
              a07_hex_uni_error (
                    VAR acv     : tak_all_command_glob;
                    uni_err     : tsp8_uni_error;
                    err_code    : tsp_int4;
                    to_unicode  : boolean;
                    bytestr     : tsp_moveobj_ptr;
                    len         : tsp_int4 );
 
        PROCEDURE
              a07_kw_put_error (
                    VAR acv  : tak_all_command_glob;
                    b_err    : tgg_basis_error;
                    err_code : tsp_int4;
                    kw       : integer);
 
        FUNCTION
              a07_return_code (
                    b_err   : tgg_basis_error;
                    sqlmode : tsp_sqlmode) : tsp_int2;
 
      ------------------------------ 
 
        FROM
              AK_universal_semantic_tools : VAK06;
 
        PROCEDURE
              a06char_retpart_move (
                    VAR acv     : tak_all_command_glob;
                    moveobj_ptr : tsp_moveobj_ptr;
                    move_len    : tsp_int4);
 
        PROCEDURE
              a06colname_retpart_move (
                    VAR acv     : tak_all_command_glob;
                    moveobj_ptr : tsp_moveobj_ptr;
                    move_len    : tsp_int4;
                    src_codeset : tsp_int2);
 
        PROCEDURE
              a06get_username (
                    VAR acv        : tak_all_command_glob;
                    VAR tree_index : integer;
                    VAR username   : tsp_knl_identifier);
 
        PROCEDURE
              a06inc_linkage (VAR linkage : tsp_c2);
 
        PROCEDURE
              a06init_curr_retpart (VAR acv : tak_all_command_glob);
 
        PROCEDURE
              a06det_user_id (
                    VAR acv      : tak_all_command_glob;
                    VAR authname : tsp_knl_identifier;
                    VAR authid   : tgg_surrogate);
 
        PROCEDURE
              a06_c_send_mess_buf (
                    VAR acv    : tak_all_command_glob;
                    VAR b_err  : tgg_basis_error);
 
        PROCEDURE
              a06determine_username (
                    VAR acv       : tak_all_command_glob;
                    VAR userid    : tgg_surrogate;
                    VAR user_name : tsp_knl_identifier);
 
        PROCEDURE
              a06finish_curr_retpart (
                    VAR acv   : tak_all_command_glob;
                    part_kind : tsp1_part_kind;
                    arg_count : tsp_int2);
 
        PROCEDURE
              a06lsend_mess_buf (
                    VAR acv         : tak_all_command_glob;
                    VAR mblock      : tgg_mess_block;
                    call_from_rsend : boolean;
                    VAR e           : tgg_basis_error);
 
        PROCEDURE
              a06retpart_move (
                    VAR acv     : tak_all_command_glob;
                    moveobj_ptr : tsp_moveobj_ptr;
                    move_len    : tsp_int4);
 
        PROCEDURE
              a06a_mblock_init (
                    VAR acv         : tak_all_command_glob;
                    mtype           : tgg_message_type;
                    m2type          : tgg_message2_type;
                    VAR tree        : tgg00_FileId);
 
        FUNCTION
              a06_table_exist (
                    VAR acv      : tak_all_command_glob;
                    dstate       : tak_directory_state;
                    VAR authid   : tsp_knl_identifier;
                    VAR tablen   : tsp_knl_identifier;
                    VAR d_sparr  : tak_syspointerarr;
                    get_all      : boolean) : boolean;
 
        PROCEDURE
              a06_systable_get (
                    VAR acv     : tak_all_command_glob;
                    dstate      : tak_directory_state;
                    VAR tableid : tgg_surrogate;
                    VAR base_ptr: tak_sysbufferaddress;
                    get_all     : boolean;
                    VAR ok      : boolean);
 
      ------------------------------ 
 
        FROM
              AK_Identifier_Handling : VAK061;
 
        FUNCTION
              a061identifier_len (VAR id : tsp_knl_identifier) : integer;
 
      ------------------------------ 
 
        FROM
              AK_semantic_scanner_tools : VAK05;
 
        PROCEDURE
              a05_constant_get (
                    VAR acv       : tak_all_command_glob;
                    ni            : integer;
                    VAR colinfo   : tak00_columninfo;
                    may_be_longer : boolean;
                    mv_dest       : integer;
                    VAR dest      : tsp_c18;
                    destpos       : integer;
                    VAR actlen    : integer);
 
        PROCEDURE
              a05_identifier_get (
                    VAR acv     : tak_all_command_glob;
                    tree_index  : integer;
                    obj_len     : integer;
                    VAR moveobj : tsp_moveobj);
 
        PROCEDURE
              a05_unsigned_int2_get (
                    VAR acv  : tak_all_command_glob;
                    pos      : integer;
                    l        : tsp_int2;
                    err_code : tsp_int4;
                    VAR int  : tsp_int2);
 
        PROCEDURE
              a05_int4_unsigned_get (
                    VAR acv : tak_all_command_glob;
                    pos     : integer;
                    l       : tsp_int2;
                    VAR int : tsp_int4);
 
        PROCEDURE
              a05int4_get (
                    VAR acv            : tak_all_command_glob;
                    pos                : integer;
                    l                  : tsp_int2;
                    VAR int            : tsp_int4);
 
        PROCEDURE
              a05identifier_get (
                    VAR acv     : tak_all_command_glob;
                    tree_index  : integer;
                    obj_len     : integer;
                    VAR moveobj : tsp_knl_identifier);
 
        PROCEDURE
              a05_string_literal_get (
                    VAR acv     : tak_all_command_glob;
                    tree_index  : integer;
                    datatyp     : tsp_data_type;
                    obj_len     : integer;
                    VAR moveobj : tgg00_MediaName);
 
        PROCEDURE
              a05string_literal_get (
                    VAR acv     : tak_all_command_glob;
                    tree_index  : integer;
                    datatyp     : tsp_data_type;
                    VAR moveobj : tsp_moveobj;
                    obj_pos     : integer;
                    obj_len     : integer);
 
        PROCEDURE
              a05_str_literal_get (
                    VAR acv     : tak_all_command_glob;
                    tree_index  : integer;
                    datatyp     : tsp00_DataType;
                    VAR moveobj : tak_map_set;
                    obj_pos     : integer;
                    obj_len     : integer);
 
      ------------------------------ 
 
        FROM
              Scanner : VAK01;
 
        VAR
              a01diag_monitor_on   : boolean;
              a01diag_moni_parseid : boolean;
              a01sm_collect_data   : boolean;
              a01sm_reads          : tsp_int4;
              a01sm_milliseconds   : tsp_int4;
              a01sm_selectivity    : tsp_int4;
              a01char_size         : integer;
              a01kw                : tak_keywordtab;
              a01defaultkey        : tgg_sysinfokey;
              a01_i_sysmonitor     : tsp_knl_identifier;
              a01_i_sysmondata     : tsp_knl_identifier;
              a01_i_sysparseid     : tsp_knl_identifier;
              a01_i_syscmd_analyze : tsp_knl_identifier;
              a01_i_sysdata_analyze: tsp_knl_identifier;
              a01_il_b_identifier  : tsp_knl_identifier;
 
        PROCEDURE
              a01_next_symbol (VAR acv : tak_all_command_glob);
 
        PROCEDURE
              a01_get_keyword (
                    VAR acv   : tak_all_command_glob;
                    VAR index : integer;
                    VAR reserved : boolean);
 
        FUNCTION
              a01mandatory_keyword (
                    VAR acv          : tak_all_command_glob;
                    required_keyword : integer) : boolean;
 
      ------------------------------ 
 
        FROM
              Deal-With-User-Commands : VAK92;
 
        PROCEDURE
              a92next_monitor_pcount (
                    VAR acv   : tak_all_command_glob;
                    VAR parsk : tak_parskey);
 
      ------------------------------ 
 
        FROM
              KB_headmaster : VKB38;
 
        PROCEDURE
              k38get_state (
                    buf_size         : tsp00_Int4;
                    VAR buf_len      : tsp00_Int4;
                    VAR buffer       : tsp00_MoveObj);
 
      ------------------------------ 
 
        FROM
              KB_backup_tasks : VKB39;
 
        PROCEDURE
              k39SetEventBackupPages (
                    taskId   : tsp00_TaskId;
                    distance : tsp00_Int4);
 
        PROCEDURE
              k39GetEvents (VAR events : tsp31_short_event_desc);
 
      ------------------------------ 
 
        FROM
              KB_transaction : VKB53;
 
        PROCEDURE
              k53wait (VAR t  : tgg00_TransContext;
                    MessType  : tgg00_MessType;
                    MessType2 : tgg00_MessType2);
 
      ------------------------------ 
 
        FROM
              KB_Logging : VKB560;
 
        PROCEDURE
              kb560StartSavepoint (VAR Trans : tgg00_TransContext;
                    MessType2 : tgg00_MessType2);
 
        PROCEDURE
              kb560ExecuteFreeLogForPipe(
                    taskId               : tsp00_TaskId;
                    firstSavedIOsequence : tsp00_Uint4;
                    lastSavedIOsequence  : tsp00_Uint4;
                    VAR trError          : tgg00_BasisError);
 
        PROCEDURE
              k560ResumeLogWriterByUser;
 
        FUNCTION
              kb560SuspendAndGetLastWrittenIOSequence (taskid : tsp00_TaskId;
                    VAR iosequence : tsp00_Uint4) : boolean;
 
        PROCEDURE
              kb560SetLogAutoOverwrite (taskid : tsp00_TaskId;
                    isAdminMode : boolean;
                    on          : boolean);
 
      ------------------------------ 
 
        FROM
              KB_RedoManager_interface : VKB811;
 
        PROCEDURE
              kb811GetRedoProgressInfo (
                    VAR transread   : tsp00_Int4;
                    VAR transredone : tsp00_Int4);
 
      ------------------------------ 
 
        FROM
              filesysteminterface_2 : VBD02;
 
        PROCEDURE
              b02repl_record (
                    VAR t          : tgg00_TransContext;
                    VAR file_id    : tgg00_FileId;
                    VAR b          : tgg00_Rec);
 
      ------------------------------ 
 
        FROM
              Trace : VBD120;
 
        PROCEDURE
              b120ClearTrace (TaskId : tsp00_TaskId);
 
      ------------------------------ 
 
        FROM
              task_temp_data_cache : VBD21;
 
        PROCEDURE
              b21m_parse_again (
                    temp_cache_ptr  : tgg00_TempDataCachePtr;
                    VAR parse_again : tsp00_C3);
 
        PROCEDURE
              b21mp_parse_again_put (
                    temp_cache_ptr : tgg00_TempDataCachePtr;
                    parse_again : tsp00_C3);
 
      ------------------------------ 
 
        FROM
              Codetransformation_and_Coding : VGG02;
 
        VAR
              g02codetables : tgg_code_tables;
 
        PROCEDURE
              g02pascii_pos_ebcdic(
                    VAR source : tak_map_set;
                    srcind     : tsp_int4;
                    VAR dest   : tak_map_set;
                    destind    : tsp_int4;
                    length     : tsp_int4);
 
      ------------------------------ 
 
        FROM
              Configuration_Parameter : VGG01;
 
        VAR
              g01code               : tgg_code_globals;
              g01localsite          : tgg_serverdb_no;
              g01stand_alone        : boolean;
              g01diag_moni_parse_on : boolean;
              g01tabid              : tgg_tabid_globals;
              g01vtrace             : tgg_vtrace_state;
              g01unicode            : boolean;
              g01glob               : tgg_kernel_globals;
 
        PROCEDURE
              g01event_init (VAR new_event : tsp31_event_description);
 
        PROCEDURE
              g01refresh_param (VAR b_err : tgg_basis_error);
 
      ------------------------------ 
 
        FROM
              Check-Date-Time : VGG03;
 
        PROCEDURE
              g03dchange_format_date (
                    VAR sbuf : tsp_moveobj;
                    VAR dbuf  : tsp_moveobj;
                    spos      : tsp_int4;
                    dpos      : tsp_int4;
                    format    : tgg_datetimeformat;
                    VAR b_err : tgg_basis_error);
 
        PROCEDURE
              g03tchange_format_time (
                    VAR sbuf : tsp_moveobj;
                    VAR dbuf  : tsp_moveobj;
                    spos      : tsp_int4;
                    dpos      : tsp_int4;
                    format    : tgg_datetimeformat;
                    VAR b_err : tgg_basis_error);
 
      ------------------------------ 
 
        FROM
              Regions_and_Longwaits : VGG08;
 
        VAR
              g08monitor : tsp_region_id;
 
      ------------------------------ 
 
        FROM
              Kernel_move_and_fill : VGG10;
 
        PROCEDURE
              g10mv1   (
                    mod_id         : tsp_c6;
                    mod_intern_num : tsp_int4;
                    source_upb     : tsp_int4;
                    destin_upb     : tsp_int4;
                    VAR source     : tsp_moveobj;
                    source_pos     : tsp_int4;
                    VAR destin     : tsp_moveobj;
                    destin_pos     : tsp_int4;
                    length         : tsp_int4;
                    VAR e          : tgg_basis_error);
 
        PROCEDURE
              g10mv2   (
                    mod_id         : tsp_c6;
                    mod_intern_num : tsp_int4;
                    source_upb     : tsp_int4;
                    destin_upb     : tsp_int4;
                    VAR source     : tsp_moveobj;
                    source_pos     : tsp_int4;
                    VAR destin     : tsp_c8;
                    destin_pos     : tsp_int4;
                    length         : tsp_int4;
                    VAR e          : tgg_basis_error);
 
        PROCEDURE
              g10mv3   (
                    mod_id         : tsp_c6;
                    mod_intern_num : tsp_int4;
                    source_upb     : tsp_int4;
                    destin_upb     : tsp_int4;
                    VAR source     : tsp_c18;
                    source_pos     : tsp_int4;
                    VAR destin     : tsp_c8;
                    destin_pos     : tsp_int4;
                    length         : tsp_int4;
                    VAR e          : tgg_basis_error);
 
        PROCEDURE
              g10mv4   (
                    mod_id         : tsp_c6;
                    mod_intern_num : tsp_int4;
                    source_upb     : tsp_int4;
                    destin_upb     : tsp_int4;
                    VAR source     : tsp31_event_text;
                    source_pos     : tsp_int4;
                    VAR destin     : tsp31_event_text;
                    destin_pos     : tsp_int4;
                    length         : tsp_int4;
                    VAR e          : tgg_basis_error);
 
      ------------------------------ 
 
        FROM
              GG_edit_routines : VGG17;
 
        PROCEDURE
              g17hexto_line (
                    c          : char;
                    VAR ln_len : integer;
                    VAR ln     : tsp_knl_identifier);
 
        PROCEDURE
              g17int4to_line (
                    int4      : tsp00_Int4;
                    with_zero : boolean;
                    int_len   : integer;
                    ln_pos    : integer;
                    VAR ln    : tsp00_C12);
 
      ------------------------------ 
 
        FROM
              filesysteminterface_1 : VBD01;
 
        VAR
              b01niltree_id     : tgg00_FileId;
              b01blankfilename  : tsp00_VFilename;
 
        PROCEDURE
              b01destroy_file (
                    VAR t       : tgg00_TransContext;
                    VAR file_id : tgg00_FileId);
 
        PROCEDURE
              b01filestate (
                    VAR t       : tgg00_TransContext;
                    VAR file_id : tgg00_FileId);
 
        PROCEDURE
              b01tcreate_file (
                    VAR t       : tgg00_TransContext;
                    VAR file_id : tgg00_FileId);
 
        PROCEDURE
              b01vstate_fileversion (
                    VAR t       : tgg00_TransContext;
                    VAR file_id : tgg00_FileId);
 
        PROCEDURE
              b01del_event (
                    EventId   : tsp31_event_ident;
                    Threshold : integer);
 
        PROCEDURE
              b01get_events (VAR events : tsp31_short_event_desc);
 
        PROCEDURE
              b01set_event (
                    EventId   : tsp31_event_ident;
                    Threshold : integer;
                    Priority  : tsp31_event_prio);
 
      ------------------------------ 
 
        FROM
              RTE_kernel : VEN101;
 
        PROCEDURE
              vbegexcl (
                    pid     : tsp_process_id;
                    region  : tsp_region_id);
 
        PROCEDURE
              vendexcl (
                    pid     : tsp_process_id;
                    region  : tsp_region_id);
 
        PROCEDURE
              vinsert_event (VAR event : tsp31_event_description );
 
        PROCEDURE
              vconf_param_put (VAR conf_param_name : tsp11_ConfParamName;
                    VAR conf_param_value  : tsp11_ConfParamValue;
                    is_numeric            : boolean;
                    VAR errtext           : tsp00_ErrText;
                    VAR conf_param_ret    : tsp11_ConfParamReturnValue);
 
      ------------------------------ 
 
        FROM
              RTE-Extension-10 : VSP10;
 
        PROCEDURE
              s10mv1 (
                    size1      : tsp_int4;        size2      : tsp_int4;
                    VAR source : tgg_surrogate;   source_pos : tsp_int4;
                    VAR destin : tsp_buf;         destin_pos : tsp_int4;
                    length     : tsp_int4);
 
        PROCEDURE
              s10mv2 (
                    size1      : tsp_int4;        size2      : tsp_int4;
                    VAR source : tsp_c30;         source_pos : tsp_int4;
                    VAR destin : tsp_buf;         destin_pos : tsp_int4;
                    length     : tsp_int4);
 
      ------------------------------ 
 
        FROM
              Packet_handling : VSP26;
 
        FUNCTION
              s26size_new_part (
                    packet_ptr : tsp1_packet_ptr;
                    VAR segm : tsp1_segment) : tsp_int4;
 
      ------------------------------ 
 
        FROM
              RTE-Extension-30 : VSP30;
 
        PROCEDURE
              s30map (
                    VAR code_t   : tsp_ctable;
                    VAR source   : tsp_moveobj;
                    source_pos   : tsp_int4;
                    VAR destin   : tsp_moveobj;
                    destin_pos   : tsp_int4;
                    length       : tsp_int4);
 
      ------------------------------ 
 
        FROM
              PUT-Conversions : VSP41;
 
        PROCEDURE
              s41p4int (
                    VAR buf : tsp00_ResNum;
                    pos     : tsp_int4;
                    source  : tsp_int4;
                    VAR res : tsp_num_error);
 
        PROCEDURE
              s41pluns (
                    VAR buf : tsp00_ResNum;
                    pos     : tsp_int4;
                    len     : integer;
                    frac    : integer;
                    source  : tsp_int4;
                    VAR res : tsp_num_error);
 
      ------------------------------ 
 
        FROM
              RTE-Extension-80 : VSP80;
 
        PROCEDURE
              s80uni_trans
                    (src_ptr        : tsp_moveobj_ptr;
                    src_len         : tsp_int4;
                    src_codeset     : tsp_int2;
                    dest_ptr        : tsp_moveobj_ptr;
                    VAR dest_len    : tsp_int4;
                    dest_codeset    : tsp_int2;
                    trans_options   : tsp8_uni_opt_set;
                    VAR rc          : tsp8_uni_error;
                    VAR err_char_no : tsp_int4);
 
.CM *-END-* use -----------------------------------------
***********************************************************
 
Synonym :
 
        PROCEDURE
              a27init_viewscanpar;
 
              tak_viewscan_par tak_save_viewscan_par
 
        PROCEDURE
              a05_constant_get;
 
              tsp_moveobj tsp_c18
 
        PROCEDURE
              a05identifier_get;
 
              tsp_moveobj  tsp_knl_identifier
 
        PROCEDURE
              a05_string_literal_get;
 
              tsp_moveobj  tgg00_MediaName
 
        PROCEDURE
              a05_str_literal_get;
 
              tsp00_MoveObj tak_map_set
              (* PTS 1108247 E.Z. *)
 
        PROCEDURE
              g17hexto_line;
 
              tsp00_Line tsp_knl_identifier
 
        PROCEDURE
              g17int4to_line;
 
              tsp00_Line tsp00_C12
 
        PROCEDURE
              g01refresh_param;
 
              tgg00_BasisError tgg_basis_error
 
        PROCEDURE
              g02pascii_pos_ebcdic;
 
              tsp_moveobj    tak_map_set;
 
        PROCEDURE
              g10mv2;
 
              tsp_moveobj    tsp_c8
 
        PROCEDURE
              g10mv3;
 
              tsp_moveobj    tsp_c18
              tsp_moveobj    tsp_c8
 
        PROCEDURE
              g10mv4;
 
              tsp_moveobj tsp31_event_text
 
        PROCEDURE
              s10mv1;
 
              tsp_moveobj    tgg_surrogate
              tsp_moveobj    tsp_buf
 
        PROCEDURE
              s10mv2;
 
              tsp_moveobj    tsp_c30
              tsp_moveobj    tsp_buf
 
        PROCEDURE
              s41p4int;
 
              tsp_moveobj    tsp00_ResNum
 
        PROCEDURE
              s41pluns;
 
              tsp_moveobj    tsp00_ResNum
&             ifdef TRACE
 
        PROCEDURE
              t01c18;
 
              tsp00_C18 tsp11_ConfParamName
 
        PROCEDURE
              t01buf;
 
              tsp00_Buf tsp11_ConfParamValue
&             endif
 
.CM *-END-* synonym -------------------------------------
 
Specification:
 
.cp 11
PROCEDURE  A37_CALL_SEMANTIC :
.sp;.fo
Die Prozedur ist ein Verteiler f?ur die Utility-Befehle im laufenden
Betrieb (warme Utilities). Das erste Element des Syntaxbaumes
spezifiziert den durchzuf?uhrenden Befehl.
Utility-Befehle, die ein Hostfile ben?otigen k?onnen optional
'Direct' betrieben werden, d.h. der Kern schreibt bzw. liest
selbst in bzw. aus dem angegebenen Hostfile. Dies bewirkt Performance-
verbesserungen in Umgebungen, die das virtuelle File auch f?ur den
Kern bereitstellen.
Wenn 'Direct' spezifiziert ist, besitzt n_pos im ersten
Syntaxbaumelement den Wert Befehlsindikator + 1000.
.sp 4
.cp 5
.cp 11
PROCEDURE  A37PUT_COUNT_TO_MESSBUF
.sp
Falls 'Direct' spezifiziert ist, wird der Hostfilename in Part2
des Message-Buffers geschrieben, ansonsten wird dieser Teil
mit Blank gef?ullt. Falls eine Anzahl von maximal auszugebenden
Pages spezifiziert ist wird dieser Count hinter den Hostfilenamen
geschrieben.
Der Hostfilename wird im Codetyp des Hostrechners
in den Auftrag.part1 geschrieben.
.sp 4
.cp 5
PROCEDURE  SEND_MESSBUFFER
.sp
Der Message-Buffer wird mit den ?ubergebenen Message-Typen
initialisiert und an der aktuellen Location an KB gesendet.
.sp 4
.cp 6
PROCEDURE  SET_BUFFER
.sp
Die verschieden Set Buffer Befehle werden mit dieser Prozedur
an KB gesendet. Die gew?unschte Anzahl wird in Part1.pagefill
?ubergeben.
.sp 4
.cp 11
PROCEDURE  SAVE_ALL
.sp
Die Prozedur wird f?ur die Befehle Save Datebase und Save Pages
aufgerufen. Der Name des Files, auf das gesichert werden soll,
wird durch in a30v gelesen.
Der Part2 des Message-Buffers wird durch ==> a37put_count_to_messbuf
korrekt belegt. Der Auftrag wird an Kb geschickt und der
Hostfilename wird im Auftragssegment an den Hostrechner zur?uckgegeben.
.sp 4
.nf
.sp
.cp 16
Part1 :
.sp
+--------+--------+--+--+--+--+--+--+--+--...--+
| authid | tablen |  |00|00|00|00|nn|00|       |
+--------+--------+-|+-|+-|+-|+--+-|+-|+--...--+
                    |  |  |  |     |  |    |
   count_col_desc --+  |  |  |     |  |    |
   count_mult_inv -----+  |  |     |  |    |
   count_qual_desc -------+  |     |  |    |
   count_qual2_desc ---------+     |  |    |
   pagefill -----------------------+  |    |
   count_str_desc    -----------------+    |
   ISAM-Index Beschreibungen --------------+
.sp2
.cp 15
Part2 :
.sp
i)   +---------------------+
     |   Blankhostname     |
     +---------------------+
.sp
     leer, falls weder direct noch count spezifiziert.
.sp
ii)  +---------------------+--------+
     |   Blankhostname     | count  |
     +---------------------+--------+
.sp
     falls direct nicht und count spezifiziert.
.sp
iii) +---------------------+--------+
     |   Hostfilename      | count  |
     +---------------------+--------+
.sp
     falls direct und count spezifiziert.
.sp;.fo
.cp 9
Der Hostfilename wird in a30v
gelesen. Falls ein F?ullungsgrad spezifiziert ist, wird dieser aus
dem Var_Part gelesen.
Die ISAM-Index-Stackentries werden in den Message-Buffer
geschrieben (==> isam_index_stack_get).
Der Part2 des Message-Buffers wird aufgebaut
(==> a37_put_count_to_mess_buf).
Der gew?unschte F?ullungsgrad nn wird in pagefill eingetragen und der
Messsage-Buffer wird anschlie?zend an KB gesendet.
.sp 4
.cp 5
PROCEDURE  UTILITY_TABLE
.sp;.fo
Die Prozedur baut den an KB zu sendenden Message-Buffer f?ur
die Befehle Reload, Unload, Save und Restore Table auf.
Der Message_Buffer besitzt folgendes Aussehen :
.nf
.sp
.cp 16
Part1 :
.sp
+--------+--------+--+--+--+--+--+--+--+--...--+--...--+--...--+
| authid | tablen |  |  |00|00|00|nn|  |       |       |       |
+--------+--------+-|+-|+-|+-|+--+-|+-|+--...--+--...--+--...--+
                    |  |  |  |     |  |    |       |       |
   count_col_desc --+  |  |  |     |  |    |       |       |
   count_mult_inv -----+  |  |     |  |    |       |       |
   count_qual_desc -------+  |     |  |    |       |       |
   count_qual2_desc ---------+     |  |    |       |       |
   pagefill -----------------------+  |    |       |       |
   count_str_desc    -----------------+    |       |       |
   Single-Index Spaltenbeschreibungen -----+       |       |
   Multiple-Index Spaltenbeschreibungen -----------+       |
   String Spaltenbeschreibungen ---------------------------+
.sp2
.cp 15
Part2 :
.sp
i)   +---------------------+
     |   Blankhostname     |
     +---------------------+
.sp
     leer, falls weder direct noch count spezifiziert.
.sp
ii)  +---------------------+--------+
     |   Blankhostname     | count  |
     +---------------------+--------+
.sp
     falls direct nicht und count spezifiziert.
.sp
iii) +---------------------+--------+
     |   Hostfilename      | count  |
     +---------------------+--------+
.sp
     falls direct und count spezifiziert.
.sp;.fo
.cp 9
Der Hostfilename wird durch in a30v
gelesen. Falls ein F?ullungsgrad spezifiziert ist, wird dieser aus
dem Var_Part gelesen. Im Basisrecord der Tabelle wird ggf. das
Unloaded-Flag aktualisiert. Die Index-Stackentries der Tabelle
sowie die Stackentries der String-Felder werden in den Message-Buffer
geschrieben (==> index_stack_get, ==> a37s_get_string_cols).
Der Part2 des Message-Buffers wird aufgebaut
(==> a37_put_count_to_mess_buf).
Der gew?unschte F?ullungsgrad nn wird in pagefill eingetragen und der
Messsage-Buffer wird anschlie?zend an KB gesendet.
.sp 4
.cp 6
PROCEDURE  EXIST_GET_FILENAME
.sp
Die Prozedur liest den Namen der String bzw. ISAM-Datei in a30v
und liest die Systeminformationen in den Cache. Falls die Datei
nicht existiert wird die Fehlermeldung Unknown_Tablename gesetzt.
.sp4
.cp 8
PROCEDURE  EXIST_GET_TABLE
.sp
Die Prozedur liest den Namen der Tabelle in a30v
und liest die Systeminformationen in den Cache. Falls die Tabelle
nicht existiert wird die Fehlermeldung Unknown_Tablename gesetzt.
Andernfalls wird gepr?uft, ob es sich um eine Basistabelle
handelt und ob der aktuelle Benutzer das Owner-Privileg besitzt.
.sp 4
.cp 6
PROCEDURE  INDEX_STACK_GET
.sp
Die Prozedur schreibt die Stackentries aller invertierten Spalten
der durch a30v spezifizierten Tabelle in den Part1 des
Message-Buffers.
.sp 4
.cp 6
PROCEDURE  ISAM_INDEX_STACK_GET
.sp
Die Prozedur schreibt die Stackentries aller ISAM-Indexe
der durch a30v spezifizierten ISAM-Datei in den Part1 des
Message-Buffers.
.sp 4
.cp 7
PROCEDURE  UPDATE_STATISTICS
.sp
Die Prozedur liest den Tabellenname der Tabelle, deren Statistik
aktualisiert werden soll und pr?uft die Zul?assigkeit des
Kommandos. Falls alle Bedingnungen erf?ullt sind, wird
==> table_upd_statistics aufgerufen.
.sp 4
.cp 12
PROCEDURE  TABLE_UPD_STATISTICS
.sp
Die Anzahl der durch die Tabelle belegten Pages sowie die Anzahl der
belegten Pages jedes Single-Indexes der Tabelle werden von KB geliefert.
Diese Werte werden im Basisrecord zusammen mit dem aktuellen Zeitpunkt
vermerkt. Die bestimmten Anzahlen werden in den Systeminformationen
aller von der Basistabelle abh?angigen Views aktualisiert
==> a27view_scan.
Die Index-Statistiken der Indexe, die auf der Tabelle
definiert sind, werden aktualisiert ==> index_upd_statistics.
Die Systeminformationen der Basistabelle werden zur?uckgeschrieben.
.sp 4
.cp 5
PROCEDURE  INDEX_UPD_STATISTICS
.sp
Die Anzahl der Pages jedes auf der durch a30v spezifizierten
Tabelle definierten Indexes wird bestimmt und in den Systeminformationen
aktualisiert.
.sp 4
.cp 8
PROCEDURE  DIAGNOSE INDEX
.sp
Die Beschreibung der Indexspalte(n) wird durch a42index_inf_to_messbuf
in den Message-Buffer ?ubertragen und der Befehl wird mit m_diagnose,
mm_index an KB gesendet. KB liefert in Part1 des Message-Buffers die
Anzahl der Eint?age, die durch das Kommando in den Index eingef?ugt
wurden. Diese Anzahl wird als Number in Part2 des Auftragssegmentes
geschrieben.
.CM *-END-* specification -------------------------------
***********************************************************
.CM -lll-
Code    :
 
 
CONST
      (* PTS 1103853 E.Z. *)
      sysparse1  = 'CREATE TABLE SYSPARSEID  ("PARSEID" CHAR';
      sysparse2  = '(12) BYTE,LINKAGE FIXED(1),SELECT_PARSEI';
      sysparse3  = 'D CHAR(12) BYTE,OWNER CHAR(64) ASCII  ,S';
      sysparse4  = 'QL_STATEMENT CHAR(7800) ASCII  , JOB CHA';
      sysparse5  = 'R(40) ASCII, LINE FIXED(10), CONSTRAINT ';
      sysparse6  = ' SYSP_PK PRIMARY KEY("PARSEID",LINKAGE))';
      (* *)
      sysuparse3 = 'D CHAR(12) BYTE,OWNER CHAR(32) UNICODE,S';
      sysuparse4 = 'QL_STATEMENT CHAR(3900) UNICODE, JOB CHA';
      sysuparse5 = 'R(20) UNICODE, LINE FIXED(10),CONSTRAINT';
      (* *)
      sysmon1   = 'CREATE TABLE SYSMONITOR (SYSK CHAR(8) BY';
      sysmon2   = 'TE,"LINKAGE" CHAR(1) BYTE, "PARSEID" CHA';
      sysmon3   = 'R(12) BYTE, ROWS_READ FIXED(20), ROWS_QU';
      sysmon4   = 'AL FIXED(20), VIRTUAL_READS FIXED(20),  ';
      sysmon5   = 'SUBREQUESTS FIXED(20),STRATEGY CHAR(40) ';
      sysmon6   = 'ASCII  ,RUNTIME FIXED(20,6),VWAITS FIXED';
      sysmon7   = '(20),VSUSPENDS FIXED(20), PHYSICAL_IO FI';
      sysmon8   = 'XED(20),ROWS_FETCHED FIXED (20), FETCH_C';
      sysmon9   = 'ALLS FIXED (20), ROOT1 FIXED(10), ROOT2 ';
      sysmon10  = 'FIXED(10),ROOT3 FIXED(10),ROOT4 FIXED(10';
      sysmon11  = '),ROOT5 FIXED(10),ROOT6 FIXED(10),      ';
      sysmon12  = 'RESULT_COPIED CHAR(3)                   ';
      sysmon13  = 'ASCII  ,DATETIME TIMESTAMP, TERMID CHAR(';
      sysmon14  = '18) ASCII, USERNAME CHAR(64) ASCII  ,   ';
      sysmon15  = 'APPL_PROCESS FIXED(10), APPL_NODE CHAR(6';
      sysmon16  = '4) ASCII, CONSTRAINT SYSMONITOR_PK      ';
      sysmon17  = 'PRIMARY KEY (SYSK, "LINKAGE"))          ';
      (* *)
      sysumon14 = '18) ASCII, USERNAME CHAR(32) UNICODE,   ';
      (* *)
      sysmondt1  = 'CREATE TABLE SYSMONDATA (SYSK CHAR(8)   ';
      sysmondt2  = 'BYTE, PARAMNO FIXED(5), CONSTRAINT      ';
      sysmondt3  = 'SYSMONDATA_PK PRIMARY KEY (SYSK,PARAMNO)';
      sysmondt4  = ', DATA_TYPE CHAR(12) ASCII,             ';
      sysumondt4 = ', DATA_TYPE CHAR(6)  UNICODE,           ';
      sysmondt5  = 'DATA CHAR(4000) ASCII)                  ';
      sysumondt5 = 'DATA CHAR(2000) UNICODE)                ';
      (* *)
      syscmd1    = 'CREATE TABLE SYSCMD_ANALYZE (JOB  CHAR (';
      syscmd2    = '40) ASCII  ,LINE FIXED(10),CMDID CHAR(8)';
      syscmd3    = ' BYTE,LINKAGE FIXED(1),SQL_STATEMENT    ';
      syscmd4    = 'CHAR(7800) ASCII  , CMDHASH FIXED(10),  ';
      syscmd5    = 'HASHLISTPOS FIXED(5),  CONSTRAINT       ';
      syscmd6    = 'SYSCMD_ANALYZE_PK PRIMARY KEY           ';
      syscmd7    = '(JOB,LINE,CMDHASH,LINKAGE,HASHLISTPOS)) ';
      (* *)
      sysucmd2   = '20) UNICODE,LINE FIXED(10),CMDID CHAR(8)';
      sysucmd4   = 'CHAR(3900) UNICODE,CMDHASH FIXED(10),   ';
      (* *)
      sysdata1   = 'CREATE TABLE SYSDATA_ANALYZE (CMDID CHAR';
      sysdata2   = '(8) BYTE,SESSION CHAR (4) BYTE,         ';
      sysdata3   = 'CALL_COUNT FIXED(20),                   ';
      sysdata4   = 'ROWS_READ FIXED(20),ROWS_QUAL FIXED(20),';
      sysdata5   = 'VIRTUAL_READS FIXED(20),   RUNTIME FIXED';
      sysdata6   = '(20,6),MIN_RUNTIME FIXED(20,6),MAX_RUNTI';
      sysdata7   = 'ME FIXED (20,6),VWAITS FIXED (20),VSUSPE';
      sysdata8   = 'NDS FIXED(20),PHYSICAL_IO FIXED(20),ROWS';
      sysdata9   = '_FETCHED FIXED(20), CONSTRAINT          ';
      sysdata10  = 'SYSDATA_ANALYZEPK PRIMARY KEY           ';
      sysdata11  = '(CMDID, SESSION))                       ';
      (* *)
      cak_may_be_longer   = true (* a05_constant_get *);
      cak_call_from_rsend = true (* a06lsend_mess_buf *);
      c_trans_to_uni    = true (* a07_hex_uni_error  *);
      c_unicode_wid     = 2    (* a07_hex_uni_error  *);
      c_is_rollback     = true;
      (* PTS 1112983 E.Z. *)
      cak_logsave_numlen = 11;
 
TYPE
      tak37verify_errors = (
            ve_index,
            ve_file_missing,
            ve_multi_missing,
            ve_ref,
            ve_single_missing,
            ve_tableref,
            ve_version,
            ve_single_invalid);
 
      tak37verify_msg = RECORD
            CASE integer OF
                1 :
                    (name      : tsp_knl_identifier);
                2 :
                    (surrogate : tgg_surrogate);
                3 :
                    (number    : tsp_int4);
                END;
            (*ENDCASE*) 
            (* PTS 1111040 E.Z. *)
 
 
 
(*------------------------------*) 
 
PROCEDURE
      ak37add_devspace (
            VAR acv          : tak_all_command_glob;
            add_log_devspace : boolean);
 
VAR
      b_err  : tgg_basis_error;
      ti     : integer;
      ti_int : integer;
 
BEGIN
WITH acv DO
    BEGIN
    IF  add_log_devspace
    THEN
        a37init_util_record (acv, m_insert, mm_log)
    ELSE
        a37init_util_record (acv, m_insert, mm_device);
    (*ENDIF*) 
    ti := a_ap_tree^[ 0 ].n_lo_level;
    ti_int := a_ap_tree^[ ti ].n_sa_level;
    ti := a_ap_tree^[ ti ].n_lo_level;
    a36devname (acv, ti,
          a_mblock.mb_qual^.mut_dev,
          sizeof(a_mblock.mb_qual^.mut_dev));
    ti := a_ap_tree^[ti].n_lo_level;
    IF  ti <> 0
    THEN
        a36devname (acv, ti,
              a_mblock.mb_qual^.mut_dev2,
              sizeof(a_mblock.mb_qual^.mut_dev2))
    ELSE
        a_mblock.mb_qual^.mut_dev2 :=
              a_mblock.mb_qual^.mut_dev;
    (*ENDIF*) 
    (* PAGES *)
    WITH a_ap_tree^[ ti_int ] DO
        a05_int4_unsigned_get (acv, n_pos, n_length,
              a_mblock.mb_qual^.mut_count);
    (*ENDWITH*) 
    ti_int := a_ap_tree^[ ti_int ].n_sa_level;
    (* DEVNO *)
    WITH a_ap_tree^[ ti_int ] DO
        a05_unsigned_int2_get (acv, n_pos, n_length,
              e_invalid_unsign_integer, a_mblock.mb_qual^.mut_index_no);
    (*ENDWITH*) 
    IF  a94mode = umUtility_egg00
    THEN
        a06_c_send_mess_buf (acv, b_err)
    ELSE
        BEGIN
        a_mblock.mb_qual^.mut_config := true;
        a06lsend_mess_buf (acv, a_mblock,
              NOT cak_call_from_rsend, b_err)
        END;
    (*ENDIF*) 
    IF  b_err <> e_ok
    THEN
        a07_b_put_error (acv, b_err, 1)
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak37autosave (VAR acv : tak_all_command_glob);
 
VAR
      e         : tgg_basis_error;
      a30v      : tak_a30_utility_glob;
      multi_buf : tgg_qual_buf;
      colinfo   : tak00_columninfo;
      before    : tsp_c18;
      beforelen : integer;
 
BEGIN
WITH acv, a30v DO
    BEGIN
    e := e_ok;
    a37init_util_record (acv, m_autosave, mm_nil);
    a_mblock.mb_data_len := 0;
    CASE a_ap_tree^[a_ap_tree^[ 0 ].n_lo_level].n_length OF
        cak_i_on :
            WITH a_mblock.mb_qual^, multi_buf.msave_restore DO
                BEGIN
                a3ti := a_ap_tree^[a_ap_tree^[ 0 ].n_lo_level].n_lo_level;
                ak37init_save_restore_input_param (multi_buf.msave_restore);
                REPEAT
                    sripHostTapeNum_gg00 := sripHostTapeNum_gg00 + 1;
                    (* PTS 1112983 E.Z. *)
                    sripHostTapenames_gg00 [sripHostTapeNum_gg00] := b01blankfilename;
                    a36filename (acv, a3ti,
                          sripHostTapenames_gg00 [sripHostTapeNum_gg00],
                          sizeof(sripHostTapenames_gg00 [sripHostTapeNum_gg00])
                          (* PTS 1112983 E.Z. *)
                          - cak_logsave_numlen);
                    a3ti := a_ap_tree^[a3ti].n_lo_level;
                    sripHostTapecount_gg00 [sripHostTapeNum_gg00] := csp_maxint4;
                    IF  a36filetype (acv, a3ti,
                        sripHostFiletypes_gg00 [sripHostTapeNum_gg00])
                    THEN
                        a3ti := a_ap_tree^[a3ti].n_lo_level
                    (*ENDIF*) 
                UNTIL
                    a3ti = 0;
                (*ENDREPEAT*) 
                a3ti := a_ap_tree^[a_ap_tree^[ 0 ].n_lo_level].n_sa_level;
                a37media_name (acv, a3ti, multi_buf);
                IF  (a3ti <> 0) AND
                    (a_ap_tree^[a3ti].n_subproc = cak_i_date)
                THEN
                    BEGIN (* before date *)
                    colinfo.cdatatyp  := ddate;
                    colinfo.cdatalen  := mxsp_extdate;
                    colinfo.cinoutlen := mxsp_date+1;
                    a05_constant_get (acv,a_ap_tree^[ a3ti ].n_lo_level,
                          colinfo, NOT cak_may_be_longer,
                          sizeof (before), before, 1, beforelen);
                    IF  a_return_segm^.sp1r_returncode = 0
                    THEN
                        g10mv3 ('VAK37 ',   1,    
                              sizeof (before), sizeof(sripUntilDate_gg00),
                              before, 2, sripUntilDate_gg00, 1,beforelen-1,
                              a_return_segm^.sp1r_returncode);
                    (*ENDIF*) 
                    a3ti := a_ap_tree^[a3ti].n_sa_level
                    END;
                (*ENDIF*) 
                a37get_count_int4 (acv, a30v, (* PTS 1109215 UH 2001-02-05 *)
                      sripHostTapecount_gg00[sripHostTapeNum_gg00]);
                IF  (a3ti <> 0) AND
                    (a_ap_tree^[a3ti].n_subproc = cak_i_fversion)
                THEN
                    BEGIN
                    sripFileVersion_gg00 := 1;
                    a3ti                 := a_ap_tree^[a3ti].n_sa_level
                    END
                ELSE
                    sripFileVersion_gg00 := -1;
                (*ENDIF*) 
                sripIsAutoLoad_gg00 := false;
                IF  a3ti <> 0
                THEN
                    WITH a_ap_tree^[a3ti] DO
                        IF  (n_proc = a37) AND
                            (n_subproc = cak_i_cascade)
                        THEN
                            sripIsAutoLoad_gg00 := true;
                        (*ENDIF*) 
                    (*ENDWITH*) 
                (*ENDIF*) 
                a_mblock.mb_qual^.msave_restore :=
                      multi_buf.msave_restore;
                a_mblock.mb_qual_len :=
                      sizeof (a_mblock.mb_qual^.msave_restore);
                END;
            (*ENDWITH*) 
        cak_i_end :
            BEGIN
            a_mblock.mb_type2  := mm_last;
            a_mblock.mb_struct := mbs_nil;
            END;
        cak_i_cancel :
            BEGIN
            a_mblock.mb_type2  := mm_clear;
            a_mblock.mb_struct := mbs_nil;
            END;
        cak_i_show :
            a_mblock.mb_type2 := mm_outcopy;
        OTHERWISE
            e := e_invalid_command;
        END;
    (*ENDCASE*) 
    IF  (e = e_ok) AND (a_return_segm^.sp1r_returncode = 0)
    THEN
        a06lsend_mess_buf (acv, a_mblock,
              NOT cak_call_from_rsend, e);
    (*ENDIF*) 
    IF  e <> e_ok
    THEN
        a07_b_put_error (acv, e, 1)
    ELSE
        IF  a_ap_tree^[a_ap_tree^[ 0 ].n_lo_level].n_length = cak_i_show
        THEN
            a37multi_tape_info (acv, cak_i_no_keyword)
        (*ENDIF*) 
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak37determine_tabid (VAR acv : tak_all_command_glob);
 
VAR
      ti       : tsp_int4;
      authname : tsp_knl_identifier;
      tablen   : tsp_knl_identifier;
      sparr    : tak_syspointerarr;
 
BEGIN
ti := 2;
a11get_check_table (acv, false, false, true, [  ], false,
      false, d_release, ti, authname, tablen, sparr);
IF  acv.a_return_segm^.sp1r_returncode = 0
THEN
    a36hex_surrogate (acv, sparr.pbasep^.syskey.stableid)
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak37determine_userid (VAR acv : tak_all_command_glob);
 
VAR
      ti       : integer;
      owner    : tsp_knl_identifier;
      userid   : tgg_surrogate;
 
BEGIN
WITH acv DO
    BEGIN
    ti := 2;
    a06get_username (acv, ti, owner);
    a06det_user_id  (acv, owner, userid);
    IF  userid <> cgg_zero_id
    THEN
        a36hex_surrogate (acv, userid)
    ELSE
        a07_b_put_error (acv, e_unknown_user, 1)
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak37diagnose_index (VAR acv : tak_all_command_glob);
 
VAR
      selectivity : boolean;
      indexname   : tsp_knl_identifier;
      a41v        : tak40_show_glob;
 
BEGIN
WITH acv, a_mblock DO
    BEGIN
    a41v.a4ti   := 1;
    a41v.a4coln := a01_il_b_identifier;
    selectivity := false;
    a06a_mblock_init (acv, m_nil, mm_nil, b01niltree_id);
    a42index_inf_to_messbuf (acv,
          a_mblock, a41v, indexname, selectivity, true);
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        BEGIN
        a06retpart_move (acv, @a_mblock.mb_qual^.buf,
              3 * mxsp_resnum);
        a06finish_curr_retpart (acv, sp1pk_data, 1)
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak37inquire_tablename (VAR acv : tak_all_command_glob);
 
VAR
      aux         : tsp_c1;
      b_err       : tgg_basis_error;
      error       : tsp8_uni_error;
      namelen     : integer;
      err_char_no : tsp_int4;
      length      : tsp_int4;
      tabid       : tgg_surrogate;
      owner       : tsp_knl_identifier;
      tablen      : tsp_knl_identifier;
      auxname     : tsp_knl_identifier;
 
BEGIN
WITH acv DO
    BEGIN
    a37get_surrogate (acv, 2, tabid);
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        BEGIN
        a42get_tablename (acv.a_transinf.tri_trans, tabid,
              owner, tablen, b_err);
        IF  (b_err <> e_ok) OR
            ((a_current_user_kind <> usuperdba)
            AND
            ((a_current_user_kind <> usysdba) OR
            ( a_current_auth_site <> g01localsite))
            AND
            (owner <> a_curr_user_name))
        THEN
            a07_b_put_error (acv, e_unknown_tablename, 1)
        ELSE
            (* PTS 1000276 E.Z. *)
            IF  g01unicode
            THEN
                BEGIN
                namelen := a061identifier_len (owner);
                length := (namelen DIV 2) * a_max_codewidth;
                s80uni_trans (@owner, namelen, csp_unicode, @auxname, length,
                      a_out_packet^.sp1_header.sp1h_mess_code,
                      [ ], error, err_char_no);
                IF  error <> uni_ok
                THEN
                    a07_hex_uni_error (acv, error, 1, NOT c_trans_to_uni,
                          @owner [err_char_no], c_unicode_wid)
                ELSE
                    BEGIN
                    a06char_retpart_move (acv, @auxname, length);
                    aux[1] := '.';
                    a06char_retpart_move (acv, @aux[1], 1);
                    namelen := a061identifier_len (tablen);
                    length := (namelen DIV 2) * a_max_codewidth;
                    s80uni_trans (@tablen, namelen, csp_unicode, @auxname, length,
                          a_out_packet^.sp1_header.sp1h_mess_code,
                          [ ], error, err_char_no);
                    IF  error <> uni_ok
                    THEN
                        a07_hex_uni_error (acv, error, 1, NOT c_trans_to_uni,
                              @tablen [err_char_no], c_unicode_wid)
                    ELSE
                        BEGIN
                        a06char_retpart_move (acv, @auxname, length);
                        a06finish_curr_retpart (acv, sp1pk_data, 1)
                        END
                    (*ENDIF*) 
                    END
                (*ENDIF*) 
                END
            ELSE
                BEGIN
                a06char_retpart_move (acv, @owner, a061identifier_len (owner));
                aux[1] := '.';
                a06char_retpart_move (acv, @aux[1], 1);
                a06char_retpart_move (acv, @tablen, a061identifier_len (tablen));
                a06finish_curr_retpart (acv, sp1pk_data, 1)
                END;
            (*ENDIF*) 
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak37inquire_username (VAR acv : tak_all_command_glob);
 
VAR
      error       : tsp8_uni_error;
      namelen     : integer;
      err_char_no : tsp_int4;
      length      : tsp_int4;
      userid      : tgg_surrogate;
      username    : tsp_knl_identifier;
      auxname     : tsp_knl_identifier;
 
BEGIN
WITH acv DO
    BEGIN
    a37get_surrogate (acv, 2, userid);
    username := a01_il_b_identifier ;
    a06determine_username (acv, userid, username);
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        IF  username = a01_il_b_identifier
        THEN
            BEGIN
            a_return_segm^.sp1r_returncode := 0;
            a07_b_put_error (acv, e_unknown_user, 1)
            END
        ELSE
            (* PTS 1000276 E.Z. *)
            IF  g01unicode
            THEN
                BEGIN
                namelen := a061identifier_len (username);
                length := (namelen DIV 2) * a_max_codewidth;
                s80uni_trans (@username, namelen, csp_unicode, @auxname, length,
                      a_out_packet^.sp1_header.sp1h_mess_code,
                      [ ], error, err_char_no);
                IF  error <> uni_ok
                THEN
                    a07_hex_uni_error (acv, error, 1, NOT c_trans_to_uni,
                          @username [err_char_no], c_unicode_wid)
                ELSE
                    BEGIN
                    a06char_retpart_move (acv, @auxname, length);
                    a06finish_curr_retpart (acv, sp1pk_data, 1)
                    END
                (*ENDIF*) 
                END
            ELSE
                BEGIN
                a06char_retpart_move   (acv, @username, sizeof (username));
                a06finish_curr_retpart (acv, sp1pk_data, 1)
                END;
            (*ENDIF*) 
        (*ENDIF*) 
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a37get_surrogate (
            VAR acv       : tak_all_command_glob;
            ti            : integer;
            VAR surrogate : tgg_surrogate);
 
CONST
      max_hex = 16; (* 2 * mx_surrogate *)
 
VAR
      i         : integer;
      j         : integer;
      pos       : integer;
      val       : integer;
      v         : integer;
      hex_input : ARRAY[ 1..max_hex ] OF char;
 
BEGIN
WITH acv DO
    BEGIN
    FOR i := 1 TO max_hex DO
        hex_input[ i ] := '0';
    (*ENDFOR*) 
    WITH a_ap_tree^[ ti ] DO
        IF  g01unicode
        THEN
            IF  n_length > 2 * 2 * mxgg_surrogate
            THEN
                a07_b_put_error (acv, e_invalid_parameter, 1)
            ELSE
                BEGIN
                pos := 2 * mxgg_surrogate;
                i := n_pos + n_length - 1;
                WHILE i >= n_pos DO
                    BEGIN
                    IF  NOT (a_cmd_part^.sp1p_buf[ i ] in [ '0'..'9','A'..'F' ])
                        OR
                        (a_cmd_part^.sp1p_buf[ i-1 ] <> csp_unicode_mark)
                    THEN
                        a07_b_put_error (acv, e_invalid_parameter, 1)
                    ELSE
                        BEGIN
                        hex_input[ pos ] := a_cmd_part^.sp1p_buf[ i ];
                        pos              := pred(pos)
                        END;
                    (*ENDIF*) 
                    i := i - 2
                    END
                (*ENDWHILE*) 
                END
            (*ENDIF*) 
        ELSE
            IF  n_length > 2 * mxgg_surrogate
            THEN
                a07_b_put_error (acv, e_invalid_parameter, 1)
            ELSE
                BEGIN
                pos := 2 * mxgg_surrogate;
                FOR i := n_pos + n_length - 1 DOWNTO n_pos DO
                    IF  NOT (a_cmd_part^.sp1p_buf[ i ] in [ '0'..'9','A'..'F' ])
                    THEN
                        a07_b_put_error (acv, e_invalid_parameter, 1)
                    ELSE
                        BEGIN
                        hex_input[ pos ] := a_cmd_part^.sp1p_buf[ i ];
                        pos              := pred(pos)
                        END;
                    (*ENDIF*) 
                (*ENDFOR*) 
                END;
            (*ENDIF*) 
        (*ENDIF*) 
    (*ENDWITH*) 
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        BEGIN
        pos := 1;
        FOR i := 1 TO mxgg_surrogate DO
            BEGIN
            FOR j := 1 TO 2 DO
                BEGIN
                IF  hex_input[ pos ] in [ 'A'..'F' ]
                THEN
                    v := (ord(hex_input[ pos ]) - ord('A') + 10)
                ELSE
                    v := (ord(hex_input[ pos ]) - ord('0'));
                (*ENDIF*) 
                IF  j = 1
                THEN
                    val := v * 16
                ELSE
                    val := val + v;
                (*ENDIF*) 
                pos := succ(pos)
                END;
            (*ENDFOR*) 
            surrogate[ i ] := chr(val)
            END;
        (*ENDFOR*) 
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak37save (
            VAR acv         : tak_all_command_glob;
            VAR a30v        : tak_a30_utility_glob;
            VAR util_cmd_id : tgg00_UtilCmdId);
 
VAR
      is_parallel    : boolean;
      b_err          : tgg_basis_error;
      qual           : tgg_qual_buf;
 
BEGIN
WITH acv, a30v DO
    BEGIN
    a37init_util_record (acv, m_save, mm_nil);
    ak37init_save_restore_input_param (qual.msave_restore);
    CASE a_ap_tree^[ a_ap_tree^[ 0 ].n_lo_level ].n_subproc OF
        cak_x_save_database :
            a_mblock.mb_type2 := mm_database;
        cak_x_save_pages :
            a_mblock.mb_type2 := mm_pages;
        cak_x_save_log :
            a_mblock.mb_type2 := mm_log;
        END;
    (*ENDCASE*) 
    IF  NOT (
        (a_mblock.mb_type2 = mm_pages)    OR
        (a_mblock.mb_type2 = mm_log))
    THEN
        a_mblock.mb_type2 := mm_database;
    (*ENDIF*) 
    a3ti := 2;
    WITH a_ap_tree^[ a3ti ] DO
        IF  (n_proc = a37) AND (n_subproc = cak_i_quick)
        THEN
            BEGIN
            a3ti             := n_sa_level;
            a_mblock.mb_type := m_save_parallel
            END;
        (*ENDIF*) 
    (*ENDWITH*) 
    is_parallel := a_mblock.mb_type = m_save_parallel;
    (* PTS 1112983 E.Z. *)
    ak37multi_tapes (acv, a30v, qual, a_mblock.mb_type2);
    IF  (a3ti <> 0) AND
        (a_ap_tree^[a3ti].n_subproc = cak_i_fversion)
    THEN
        BEGIN
        qual.msave_restore.sripFileVersion_gg00 := 1;
        a3ti := a_ap_tree^[a3ti].n_sa_level
        END
    ELSE
        qual.msave_restore.sripFileVersion_gg00 := -1;
    (*ENDIF*) 
    a37blocksize (acv, a30v);
    a37put_count_to_messbuf (acv, a30v);
    qual.msave_restore.sripUtilCmdId_gg00  := util_cmd_id; (* PTS 1104845 UH 02-12-1999 *)
    qual.msave_restore.sripIsAutoLoad_gg00 := false;
    IF  a3ti <> 0
    THEN
        WITH a_ap_tree^[a3ti] DO
            IF  (n_proc = a37) AND (n_subproc = cak_i_cascade)
            THEN
                BEGIN
                qual.msave_restore.sripIsAutoLoad_gg00 := true;
                a3ti := a_ap_tree^[a3ti].n_sa_level
                END;
            (* PTS 2040 *)
            (*ENDIF*) 
        (*ENDWITH*) 
    (*ENDIF*) 
    qual.msave_restore.sripWithCheckpoint_gg00 := true;
    IF  a3ti <> 0
    THEN
        WITH a_ap_tree^[a3ti] DO
            IF  (n_proc = a37) AND (n_subproc = cak_i_no)
            THEN
                BEGIN
                qual.msave_restore.sripWithCheckpoint_gg00 := false;
                a3ti := n_sa_level
                END;
            (*ENDIF*) 
        (*ENDWITH*) 
    (*ENDIF*) 
    a37media_name (acv, a3ti, qual);
    qual.msave_restore.sripBlocksize_gg00 := a_mblock.mb_qual^.mut_pool_size;
    IF  NOT is_parallel
    THEN
        BEGIN
        qual.msave_restore.sripBlocksize_gg00 :=
              s26size_new_part(a_out_packet, a_return_segm^) DIV
              mxsp_buf;
        qual.msave_restore.sripHostTapeNum_gg00       := 1;
        qual.msave_restore.sripHostFiletypes_gg00 [1] := vf_t_unknown;
        qual.msave_restore.sripHostTapecount_gg00 [1] := csp_maxint4;
        qual.msave_restore.sripHostTapenames_gg00 [1] := b01blankfilename
        END;
    (*ENDIF*) 
    a_mblock.mb_qual^     := qual;
    a_mblock.mb_qual_len  :=
          sizeof (a_mblock.mb_qual^.msave_restore);   (*++ JA ++*)
    a_mblock.mb_struct    := mbs_save_restore;        (*++ JA ++*)
    a_mblock.mb_data_len  := 0;                       (*++ UH ++*)
    IF  a94mode = umUtility_egg00
    THEN
        a06_c_send_mess_buf (acv, b_err)
    ELSE
        a06lsend_mess_buf (acv, a_mblock,
              NOT cak_call_from_rsend, b_err);
    (*ENDIF*) 
    IF  b_err = e_wait_for_lock_release
    THEN
        BEGIN
        k53wait (a_transinf.tri_trans, m_lock, mm_nil);   (* PTS 1106270 JA 2000-04-06 *)
        b_err := a_transinf.tri_trans.trError_gg00;       (* PTS 1106270 JA 2000-04-06 *)
        END;
    (*ENDIF*) 
    IF  NOT is_parallel
    THEN
        b_err := e_invalid
    ELSE
        IF  b_err <> e_ok
        THEN
            BEGIN
            a07_b_put_error (acv, b_err, 1);
            IF  ((b_err = e_new_hostfile_required) OR
                ( b_err = e_wrong_hostfile       ))
            THEN
                a37multi_tape_info (acv, cak_i_no_keyword);
            (*ENDIF*) 
            END
        ELSE
            a37multi_tape_info (acv, cak_i_no_keyword) (* PTS 1111717 MB 2001-09-14 *)
        (*ENDIF*) 
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak37get_data_page (
            VAR acv   : tak_all_command_glob;
            diag_kind : tgg_diag_type);
 
VAR
      b_err : tgg_basis_error;
 
BEGIN
WITH acv DO
    BEGIN
    a37init_util_record (acv, m_diagnose, mm_nil);
    IF  diag_kind = diagPages_egg00
    THEN
        WITH a_ap_tree^ [3] DO
            a05_int4_unsigned_get (acv, n_pos, n_length, a_mblock.mb_qual^.mut_pno);
        (*ENDWITH*) 
    (*ENDIF*) 
    a_mblock.mb_qual^.mut_diag_type := diag_kind;
&   ifdef TRACE
    t01int4 (ak_sem, 'data_pno    ', a_mblock.mb_qual^.mut_pno);
&   endif
    a06_c_send_mess_buf (acv, b_err);
    IF  b_err <> e_ok
    THEN
        a07_b_put_error (acv, b_err, 1)
    ELSE
        BEGIN
        IF  a_mblock.mb_data_len > 0
        THEN
            BEGIN
            IF  a_curr_retpart = NIL
            THEN
                a06init_curr_retpart (acv);
            (*ENDIF*) 
            a_curr_retpart^.sp1p_buf_len:= a_mblock.mb_data_len;
            g10mv1 ('VAK37 ',   2,    
                  a_mblock.mb_data_size, a_curr_retpart^.sp1p_buf_size,
                  a_mblock.mb_data^.mbp_buf, 1,
                  a_curr_retpart^.sp1p_buf, 1,
                  a_mblock.mb_data_len, a_return_segm^.sp1r_returncode);
            a06finish_curr_retpart (acv, sp1pk_page, 1)
            END
        (*ENDIF*) 
        END
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak37diag_monitor (VAR acv : tak_all_command_glob);
 
VAR
      int4      : tsp_int4;
      command   : integer;
 
BEGIN
IF  NOT (acv.a_current_user_kind in [ucontroluser, usysdba, udba])
THEN
    a07_kw_put_error (acv, e_missing_privilege, 1, cak_i_dba)
ELSE
    BEGIN
    vbegexcl (acv.a_transinf.tri_trans.trTaskId_gg00, g08monitor);
    command := acv.a_ap_tree^[ acv.a_ap_tree^[ 0 ].n_lo_level ].n_length;
    WITH acv DO
        CASE  command OF
            cak_i_off :
                BEGIN (* h.b. PTS 1106105 *)
                IF  a01diag_monitor_on
                THEN
                    BEGIN
                    a01diag_monitor_on      := false;
                    a01sm_collect_data      := false;
                    a_ap_tree^[a_ap_tree^[ 0 ].n_lo_level].n_subproc := cak_i_off;
                    a42_start_semantic (acv);
                    IF  NOT a01diag_moni_parseid
                    THEN
                        g01diag_moni_parse_on := false;
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
                END;
            cak_i_call :
                BEGIN
                WITH a_ap_tree^[a_ap_tree^[a_ap_tree^[ 0 ].n_lo_level].n_sa_level] DO
                    a05_int4_unsigned_get (acv, n_pos, n_length, int4);
                (*ENDWITH*) 
                ak341HeapCallStackMonitoring(int4);
                END;
            cak_i_clear :
                a545clear_monitor (acv);
            cak_i_data :
                a01sm_collect_data :=
                      (a_ap_tree^[a_ap_tree^[ 0 ].n_lo_level].n_pos = cak_i_on)
                      AND a01diag_monitor_on;
            cak_i_parseid :
                BEGIN
                CASE a_ap_tree^[ a_ap_tree^[ 0 ].n_lo_level ].n_pos OF
                    cak_i_on:
                        BEGIN
                        a01diag_moni_parseid := true;
                        a37ddl (acv, create_sys_parsid);
                        END;
                    cak_i_off:
                        BEGIN
                        IF  NOT a01diag_monitor_on
                        THEN
                            g01diag_moni_parse_on := false;
                        (*ENDIF*) 
                        a01diag_moni_parseid := false
                        END;
                    END;
                (*ENDCASE*) 
                END;
            OTHERWISE
                IF  a_ap_tree^[a_ap_tree^[ 0 ].n_lo_level].n_sa_level = 0
                THEN
                    BEGIN (* turn off *)
                    CASE command OF
                        cak_i_read :
                            a01sm_reads        := csp_maxint4;
                        cak_i_time : (* h.b. PTS 1104675 *)
                            a01sm_milliseconds := csp_maxint4;
                        cak_i_selectivity :
                            a01sm_selectivity  := cak_is_undefined;
                        OTHERWISE;
                        END
                    (*ENDCASE*) 
                    END
                ELSE
                    BEGIN
                    WITH a_ap_tree^[a_ap_tree^[a_ap_tree^[ 0 ].n_lo_level].n_sa_level] DO
                        a05_int4_unsigned_get (acv, n_pos, n_length, int4);
                    (*ENDWITH*) 
                    CASE command OF
                        cak_i_selectivity, cak_i_read, cak_i_time :
                            BEGIN
                            IF  NOT g01diag_moni_parse_on
                            THEN
                                a37ddl (acv, create_sys_parsid);
                            (*ENDIF*) 
                            IF  (a_return_segm^.sp1r_returncode = 0) AND
                                NOT a01diag_monitor_on
                            THEN
                                BEGIN
                                a37ddl (acv, create_sys_monitor);
                                IF  a_return_segm^.sp1r_returncode = 0
                                THEN
                                    a37ddl (acv, create_sys_mondata)
                                (*ENDIF*) 
                                END;
                            (*ENDIF*) 
                            a01sm_collect_data := true
                            END;
                        OTHERWISE ;
                        END;
                    (*ENDCASE*) 
                    CASE command OF
                        cak_i_selectivity :
                            IF  int4 > 1000
                            THEN
                                a07_b_put_error (acv,
                                      e_invalid_number_variable, 1)
                            ELSE
                                a01sm_selectivity := int4;
                            (*ENDIF*) 
                        cak_i_read :
                            a01sm_reads := int4;
                        cak_i_rowno :
                            a545sm_set_rowno (int4);
                        cak_i_time :
                            a01sm_milliseconds := int4;
                        END;
                    (*ENDCASE*) 
                    END;
                (*ENDIF*) 
            END;
        (*ENDCASE*) 
    (*ENDWITH*) 
    vendexcl (acv.a_transinf.tri_trans.trTaskId_gg00, g08monitor)
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a37media_name (
            VAR acv  : tak_all_command_glob;
            VAR ti   : tsp_int2;
            VAR qual : tgg_qual_buf);
 
VAR
      lo_level : integer;
 
BEGIN
WITH qual, msave_restore DO
    BEGIN
    sripMedianame_gg00 := bsp_c64;
    IF  (ti <> 0) AND
        (acv.a_ap_tree^[ti].n_subproc = cak_i_medianame)
    THEN
        BEGIN (* medianame *)
        lo_level := acv.a_ap_tree^[ti].n_lo_level;
        a05_string_literal_get (acv, lo_level, dcha,
              sizeof (sripMedianame_gg00), sripMedianame_gg00);
        ti := acv.a_ap_tree^[ti].n_sa_level
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a37multi_tape_info (
            VAR acv  : tak_all_command_glob;
            kw_index : integer);
 
TYPE
 
      t_redo_trans_info = RECORD (* PTS 1000243 UH 27-10-1999 *)
            CountRead : tsp00_ResNum;
            CountDone : tsp00_ResNum;
      END;
 
      t_redo_trans_info_ptr = ^t_redo_trans_info; (* PTS 1000243 UH 27-10-1999 *)
 
VAR
      e           : tgg_basis_error;
      get_state   : boolean;
      state_kind  : tsp_int2;
      pos         : integer;
      ix          : integer;
      colno       : integer;
      shortinfo   : tak_shortinforecord;
      TransRead   : tsp00_Int4;            (* PTS 1000243 UH 27-10-1999 *)
      TransReDone : tsp00_Int4;            (* PTS 1000243 UH 27-10-1999 *)
      RedoInfo    : t_redo_trans_info_ptr; (* PTS 1000243 UH 27-10-1999 *)
      dummy_err   : tsp00_NumError;        (* PTS 1000243 UH 27-10-1999 *)
      name        : tsp_c18;
 
BEGIN
WITH acv DO
    BEGIN
    e          := e_ok;
    get_state  := kw_index <> cak_i_no_keyword;
    IF  get_state
    THEN
        CASE kw_index OF
            cak_i_restore, cak_i_save :
                state_kind := 1;
            OTHERWISE
                state_kind := 2;
            END;
        (*ENDCASE*) 
    (*ENDIF*) 
    a_user_defined_error := true;
    IF  a_return_segm^.sp1r_returncode <> 0
    THEN
        IF  (a_return_segm^.sp1r_returncode <>
            a07_return_code (e_new_hostfile_required, a_sqlmode)) AND
            (a_return_segm^.sp1r_returncode <>
            a07_return_code (e_wrong_hostfile, a_sqlmode))
        THEN
            a_user_defined_error := false;
        (*ENDIF*) 
    (*ENDIF*) 
    colno := 1;
    (* PTS 1113268 E.Z. *)
    name := 'DATE              ';
    a06colname_retpart_move (acv, @name, 4, csp_ascii);
    WITH shortinfo.siinfo[colno] DO
        BEGIN (* save date *)
        sp1i_mode       := [ sp1ot_mandatory ];
        sp1i_io_type    := sp1io_output;
        sp1i_data_type  := ddate;
        sp1i_frac       := 0;
        sp1i_length     := mxsp_extdate;
        sp1i_in_out_len := mxsp_extdate+1;
        sp1i_bufpos     := 1;
        pos             := 1 + mxsp_extdate + 1
        END;
    (*ENDWITH*) 
    colno                   := colno + 1;
    name   := 'TIME              ';
    a06colname_retpart_move (acv, @name, 4, csp_ascii);
    shortinfo.siinfo[colno] := shortinfo.siinfo[1];
    WITH shortinfo.siinfo[colno] DO
        BEGIN (* save time *)
        sp1i_data_type  := dtime;
        sp1i_length     := mxsp_exttime;
        sp1i_in_out_len := mxsp_exttime+1;
        sp1i_bufpos     := pos;
        pos             := pos + sp1i_in_out_len
        END;
    (*ENDWITH*) 
    colno                   := colno + 1;
    name   := 'SERVERDB          ';
    a06colname_retpart_move (acv, @name, 8, csp_ascii);
    shortinfo.siinfo[colno] := shortinfo.siinfo[1];
    WITH shortinfo.siinfo[colno] DO
        BEGIN (* serverdb *)
        IF  g01code.ctype = csp_ebcdic
        THEN
            sp1i_data_type  := dche
        ELSE
            sp1i_data_type  := dcha;
        (*ENDIF*) 
        sp1i_length     := mxsp_dbname;
        sp1i_in_out_len := mxsp_dbname+1;
        sp1i_bufpos     := pos;
        pos             := pos + sp1i_in_out_len
        END;
    (*ENDWITH*) 
    colno                   := colno + 1;
    name   := 'SERVERNODE        ';
    a06colname_retpart_move (acv, @name, 10, csp_ascii);
    shortinfo.siinfo[colno] := shortinfo.siinfo[colno - 1];
    WITH shortinfo.siinfo[colno] DO
        BEGIN (* servernode *)
        sp1i_length     := mxsp_nodeid;
        sp1i_in_out_len := mxsp_nodeid+1;
        sp1i_bufpos     := pos;
        pos             := pos + sp1i_in_out_len
        END;
    (*ENDWITH*) 
    colno                   := colno + 1;
    name   := 'KERNEL VERSION    ';
    a06colname_retpart_move (acv, @name, 14, csp_ascii);
    shortinfo.siinfo[colno] := shortinfo.siinfo[colno - 1];
    WITH shortinfo.siinfo[colno] DO
        BEGIN (* kernel version *)
        sp1i_length     := mxsp_c40;
        sp1i_in_out_len := mxsp_c40+1;
        sp1i_bufpos     := pos;
        pos             := pos + sp1i_in_out_len
        END;
    (*ENDWITH*) 
    colno                   := colno + 1;
    name   := 'PAGES TRANSFERRED ';
    a06colname_retpart_move (acv, @name, 17, csp_ascii);
    shortinfo.siinfo[colno] := shortinfo.siinfo[1];
    WITH shortinfo.siinfo[colno] DO
        BEGIN (* pages transferred *)
        sp1i_data_type  := dfixed;
        sp1i_length     := csp_resnum_deflen;
        sp1i_in_out_len := mxsp_resnum;
        sp1i_bufpos     := pos;
        pos             := pos + sp1i_in_out_len
        END;
    (*ENDWITH*) 
    colno                   := colno + 1;
    name   := 'PAGES LEFT        ';
    a06colname_retpart_move (acv, @name, 10, csp_ascii);
    shortinfo.siinfo[colno] := shortinfo.siinfo[colno -1];
    WITH shortinfo.siinfo[colno] DO
        BEGIN (* pages left *)
        sp1i_length     := csp_resnum_deflen;
        sp1i_in_out_len := mxsp_resnum;
        sp1i_bufpos     := pos;
        pos             := pos + sp1i_in_out_len
        END;
    (*ENDWITH*) 
    colno                   := colno + 1;
    name   := 'NO OF VOLUMES     ';
    a06colname_retpart_move (acv, @name, 13, csp_ascii);
    shortinfo.siinfo[colno] := shortinfo.siinfo[colno -1];
    WITH shortinfo.siinfo[colno] DO
        BEGIN (* no of volumes *)
        sp1i_length     := csp_resnum_deflen;
        sp1i_in_out_len := mxsp_resnum;
        sp1i_bufpos     := pos;
        pos             := pos + sp1i_in_out_len
        END;
    (*ENDWITH*) 
    colno                   := colno + 1;
    name   := 'MEDIA NAME        ';
    a06colname_retpart_move (acv, @name, 10, csp_ascii);
    shortinfo.siinfo[colno] := shortinfo.siinfo[3];
    WITH shortinfo.siinfo[colno] DO
        BEGIN (* tape (hostfile)name *)
        IF  g01code.ctype = csp_ebcdic
        THEN
            sp1i_data_type  := dche
        ELSE
            sp1i_data_type  := dcha;
        (*ENDIF*) 
        sp1i_length     := sizeof (tgg00_MediaName);
        sp1i_in_out_len := sizeof (tgg00_MediaName) + 1;
        sp1i_bufpos     := pos;
        pos             := pos + sp1i_in_out_len
        END;
    (*ENDWITH*) 
    colno                   := colno + 1;
    name   := 'TAPE NAME         ';
    a06colname_retpart_move (acv, @name, 9, csp_ascii);
    shortinfo.siinfo[colno] := shortinfo.siinfo[3];
    WITH shortinfo.siinfo[colno] DO
        BEGIN (* tape (hostfile)name *)
        IF  g01code.ctype = csp_ebcdic
        THEN
            sp1i_data_type  := dche
        ELSE
            sp1i_data_type  := dcha;
        (*ENDIF*) 
        sp1i_length     := mxsp_vfilename;
        sp1i_in_out_len := mxsp_vfilename + 1;
        sp1i_bufpos     := pos;
        pos             := pos + sp1i_in_out_len
        END;
    (*ENDWITH*) 
    colno                   := colno + 1;
    name   := 'TAPE ERRORTEXT    ';
    a06colname_retpart_move (acv, @name, 14, csp_ascii);
    shortinfo.siinfo[colno] := shortinfo.siinfo[3];
    WITH shortinfo.siinfo[colno] DO
        BEGIN (* tape errortext *)
        sp1i_length     := mxsp_errtext;
        sp1i_in_out_len := mxsp_errtext + 1;
        sp1i_bufpos     := pos;
        pos             := pos + sp1i_in_out_len
        END;
    (*ENDWITH*) 
    colno                   := colno + 1;
    name   := 'TAPE LABEL        ';
    a06colname_retpart_move (acv, @name, 10, csp_ascii);
    shortinfo.siinfo[colno] := shortinfo.siinfo[3];
    WITH shortinfo.siinfo[colno] DO
        BEGIN (* tape label *)
        sp1i_length     := sizeof (tsp_c10);
        sp1i_in_out_len := sizeof (tsp_c10) + 1;
        sp1i_bufpos     := pos;
        pos             := pos + sp1i_in_out_len
        END;
    (*ENDWITH*) 
    colno                 := colno + 1;
    name := 'IS CONSISTENT     ';
    a06colname_retpart_move (acv, @name, 13, csp_ascii);
    shortinfo.siinfo[colno] := shortinfo.siinfo[1];
    WITH shortinfo.siinfo[colno] DO
        BEGIN
        sp1i_data_type  := dboolean;
        sp1i_length     := 1;
        sp1i_in_out_len := 1 + 1;
        sp1i_bufpos     := pos;
        pos             := pos + sp1i_in_out_len
        END;
    (*ENDWITH*) 
    colno                   := colno + 1;
    name   := 'FIRST LPNO        ';
    a06colname_retpart_move (acv, @name, 10, csp_ascii);
    shortinfo.siinfo[colno] := shortinfo.siinfo[7];
    WITH shortinfo.siinfo[colno] DO
        BEGIN
        sp1i_bufpos     := pos;
        pos             := pos + sp1i_in_out_len
        END;
    (*ENDWITH*) 
    colno                   := colno + 1;
    name   := 'LAST LPNO         ';
    a06colname_retpart_move (acv, @name, 9, csp_ascii);
    shortinfo.siinfo[colno] := shortinfo.siinfo[7];
    WITH shortinfo.siinfo[colno] DO
        BEGIN
        sp1i_bufpos     := pos;
        pos             := pos + sp1i_in_out_len
        END;
    (*ENDWITH*) 
    colno                   := colno + 1;
    name   := 'DBSTAMP1 DATE     ';
    a06colname_retpart_move (acv, @name, 13, csp_ascii);
    shortinfo.siinfo[colno] := shortinfo.siinfo[1];
    WITH shortinfo.siinfo[colno] DO
        BEGIN
        sp1i_bufpos     := pos;
        pos             := pos + sp1i_in_out_len
        END;
    (*ENDWITH*) 
    colno                   := colno + 1;
    name   := 'DBSTAMP1 TIME     ';
    a06colname_retpart_move (acv, @name, 13, csp_ascii);
    shortinfo.siinfo[colno] := shortinfo.siinfo[2];
    WITH shortinfo.siinfo[colno] DO
        BEGIN
        sp1i_data_type  := dtime;
        sp1i_length     := mxsp_exttime;
        sp1i_in_out_len := mxsp_exttime+1;
        sp1i_bufpos     := pos;
        pos             := pos + sp1i_in_out_len
        END;
    (*ENDWITH*) 
    colno                   := colno + 1;
    name   := 'DBSTAMP2 DATE     ';
    a06colname_retpart_move (acv, @name, 13, csp_ascii);
    shortinfo.siinfo[colno] := shortinfo.siinfo[1];
    WITH shortinfo.siinfo[colno] DO
        BEGIN
        sp1i_bufpos     := pos;
        pos             := pos + sp1i_in_out_len
        END;
    (*ENDWITH*) 
    colno                   := colno + 1;
    name   := 'DBSTAMP2 TIME     ';
    a06colname_retpart_move (acv, @name, 13, csp_ascii);
    shortinfo.siinfo[colno] := shortinfo.siinfo[2];
    WITH shortinfo.siinfo[colno] DO
        BEGIN
        sp1i_data_type  := dtime;
        sp1i_length     := mxsp_exttime;
        sp1i_in_out_len := mxsp_exttime+1;
        sp1i_bufpos     := pos;
        pos             := pos + sp1i_in_out_len
        END;
    (*ENDWITH*) 
    colno                   := colno + 1;
    name   := 'BD PAGE COUNT     ';
    a06colname_retpart_move (acv, @name, 13, csp_ascii);
    shortinfo.siinfo[colno] := shortinfo.siinfo[7];
    WITH shortinfo.siinfo[colno] DO
        BEGIN
        sp1i_bufpos     := pos;
        pos             := pos + sp1i_in_out_len
        END;
    (*ENDWITH*) 
    colno                   := colno + 1;
    name   := 'TAPEDEVICES USED  ';
    a06colname_retpart_move (acv, @name, 16, csp_ascii);
    shortinfo.siinfo[colno] := shortinfo.siinfo[7];
    WITH shortinfo.siinfo[colno] DO
        BEGIN
        sp1i_bufpos     := pos;
        pos             := pos + sp1i_in_out_len
        END;
    (*ENDWITH*) 
    (* PTS 1000449 UH 19980909 begin *)
    colno                   := colno + 1;
    name   := 'DB_IDENT          ';
    a06colname_retpart_move (acv, @name, 8, csp_ascii);
    shortinfo.siinfo[colno] := shortinfo.siinfo[3];
    WITH shortinfo.siinfo[colno] DO
        BEGIN (* db_ident *)
        sp1i_length     := mxsp_line;
        sp1i_in_out_len := mxsp_line + 1;
        sp1i_bufpos     := pos;
        pos             := pos + sp1i_in_out_len
        END;
    (*ENDWITH*) 
    (* PTS 1105071 UH 17-01-2000 begin *)
    colno                   := colno + 1;
    name   := 'MAX USED DATA PNO ';
    a06colname_retpart_move (acv, @name, 17, csp_ascii);
    shortinfo.siinfo[colno] := shortinfo.siinfo[7];
    WITH shortinfo.siinfo[colno] DO
        BEGIN
        sp1i_bufpos     := pos;
        pos             := pos + sp1i_in_out_len
        END;
    (*ENDWITH*) 
    (* PTS 1105071 UH 17-01-2000 end *)
    IF  get_state (* PTS 1000243 UH 27-10-1999 *)
    THEN
        BEGIN
        colno                   := colno + 1;
        name   := 'REDO TRANS READ   ';
        a06colname_retpart_move (acv, @name, 15, csp_ascii);
        shortinfo.siinfo[colno] := shortinfo.siinfo[7];
        WITH shortinfo.siinfo[colno] DO
            BEGIN
            sp1i_bufpos     := pos;
            pos             := pos + sp1i_in_out_len
            END;
        (*ENDWITH*) 
        (* *)
        colno                   := colno + 1;
        name   := 'REDO TRANS DONE   ';
        a06colname_retpart_move (acv, @name, 15, csp_ascii);
        shortinfo.siinfo[colno] := shortinfo.siinfo[7];
        WITH shortinfo.siinfo[colno] DO
            BEGIN
            sp1i_bufpos     := pos;
            pos             := pos + sp1i_in_out_len
            END;
        (*ENDWITH*) 
        END;
    (* PTS 1000449 UH 19980909 end *)
    (*ENDIF*) 
    a06finish_curr_retpart (acv, sp1pk_columnnames, colno);
    shortinfo.sicount := colno;
    a06retpart_move (acv, @shortinfo.siinfo,
          shortinfo.sicount * sizeof (shortinfo.siinfo[1]));
    a06finish_curr_retpart (acv, sp1pk_shortinfo, colno);
    IF  get_state
    THEN
        BEGIN
        a06init_curr_retpart (acv);
        IF  a_curr_retpart <> NIL
        THEN
            WITH a_curr_retpart^ DO
                BEGIN
                (* PTS 1000397 UH *)
                k38get_state (sp1p_buf_size, sp1p_buf_len, sp1p_buf);
                (* PTS 1000243 UH 27-10-1999 begin *)
                (* PTS 1116085 UH 2002-08-16 *)
                kb811GetRedoProgressInfo (TransRead, TransReDone);
                RedoInfo := @sp1p_buf[sp1p_buf_len+1];
                RedoInfo^.CountRead[1] := csp_defined_byte;
                RedoInfo^.CountDone[1] := csp_defined_byte;
                s41p4int (RedoInfo^.CountRead, 2, TransRead,   dummy_err);
                s41p4int (RedoInfo^.CountDone, 2, TransReDone, dummy_err);
                sp1p_buf_len := sp1p_buf_len + sizeof (t_redo_trans_info);
                (* PTS 1000243 UH 27-10-1999 end*)
                END
            (*ENDWITH*) 
        ELSE
            a_transinf.tri_trans.trError_gg00 :=  e_too_small_packet_size;
        (*ENDIF*) 
        IF  a_transinf.tri_trans.trError_gg00 <> e_ok
        THEN
            a07_b_put_error (acv, a_transinf.tri_trans.trError_gg00, 1)
        (*ENDIF*) 
        END
    ELSE
        (*-------------- put values into part2 ------------------------*)
        FOR ix := 1 TO shortinfo.sicount DO
            WITH shortinfo.siinfo[ix] DO
                IF  sp1i_data_type in
                    [ddate, dtime, dche, dcha]
                THEN
                    a06char_retpart_move (acv,
                          @a_mblock.mb_qual^.buf[sp1i_bufpos],
                          sp1i_in_out_len)
                ELSE
                    a06retpart_move (acv,
                          @a_mblock.mb_qual^.buf[sp1i_bufpos],
                          sp1i_in_out_len);
                (*ENDIF*) 
            (*ENDWITH*) 
        (*ENDFOR*) 
    (*ENDIF*) 
    FOR ix := 1 TO shortinfo.sicount DO
        WITH shortinfo.siinfo[ix] DO
            CASE sp1i_data_type OF
                ddate :
                    g03dchange_format_date (a_curr_retpart^.sp1p_buf,
                          a_curr_retpart^.sp1p_buf, sp1i_bufpos, sp1i_bufpos,
                          a_dt_format, e);
                dtime :
                    g03tchange_format_time (a_curr_retpart^.sp1p_buf,
                          a_curr_retpart^.sp1p_buf, sp1i_bufpos, sp1i_bufpos,
                          a_dt_format, e);
                OTHERWISE;
                END;
            (*ENDCASE*) 
        (*ENDWITH*) 
    (*ENDFOR*) 
    a06finish_curr_retpart (acv, sp1pk_data, colno);
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak37user_save_reaction (
            VAR acv  : tak_all_command_glob;
            VAR a30v : tak_a30_utility_glob;
            reaction : integer);
 
VAR
      b_err   : tgg_basis_error;
      m2type  : tgg_message2_type;
 
BEGIN
CASE reaction OF
    cak_i_ignore :
        m2type := mm_ignore;
    cak_i_cancel :
        m2type := mm_abort;
    cak_i_replace :
        m2type := mm_newtape;
    END;
(*ENDCASE*) 
a06a_mblock_init (acv,
      m_save_parallel, m2type, b01niltree_id);
WITH acv, a_mblock, mb_qual^, a30v, a_ap_tree^[a3ti] DO
    BEGIN
    a_mblock.mb_struct := mbs_save_restore; (*+++ JA +++*)
    mb_qual^.msave_restore.sripMedianame_gg00 := bsp_c64;
    a3ti := a_ap_tree^[a3ti].n_sa_level;
    mb_qual^.msave_restore.sripHostTapenames_gg00 [1] := b01blankfilename;
    IF  (a3ti <> 0) AND (a_ap_tree^[a3ti].n_symb = s_hostfilename)
    THEN
        BEGIN
        a36filename (acv, a3ti,
              mb_qual^.msave_restore.sripHostTapenames_gg00 [1],
              sizeof (mb_qual^.msave_restore.sripHostTapenames_gg00 [1]));
        a3ti := a_ap_tree^[a3ti].n_sa_level;
        IF  a36filetype (acv, a3ti,
            mb_qual^.msave_restore.sripHostFiletypes_gg00 [1])
        THEN
            a3ti := a_ap_tree^[a3ti].n_sa_level
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    a37get_count_int4 (acv, a30v,
          mb_qual^.msave_restore.sripHostTapecount_gg00 [1]);
    mb_qual^.msave_restore.sripIsAutoLoad_gg00        := false;
    IF  a3ti <> 0
    THEN
        WITH a_ap_tree^[a3ti] DO
            IF  (n_proc = a37) AND (n_subproc = cak_i_cascade)
            THEN
                mb_qual^.msave_restore.sripIsAutoLoad_gg00 := true;
            (*ENDIF*) 
        (*ENDWITH*) 
    (*ENDIF*) 
    mb_data_len := 0; (* +++ UH +++ *)
    IF  a94mode = umUtility_egg00
    THEN
        a06_c_send_mess_buf (acv, b_err)
    ELSE
        a06lsend_mess_buf (acv, acv.a_mblock,
              NOT cak_call_from_rsend, b_err);
    (*ENDIF*) 
    IF  b_err <> e_ok
    THEN
        BEGIN
        a07_b_put_error (acv, b_err, 1);
        IF  (b_err = e_new_hostfile_required) OR   (* JA 1996-04-10 *)
            (b_err = e_wrong_hostfile       )
        THEN
            a37multi_tape_info (acv, cak_i_no_keyword)
        (*ENDIF*) 
        END
    ELSE
        IF  reaction <> cak_i_cancel (* JA 1996-04-10 *)
        THEN
            a37multi_tape_info (acv, cak_i_no_keyword)
        (*ENDIF*) 
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a37return_hostname (VAR acv : tak_all_command_glob);
 
VAR
      arg_count : integer;
 
BEGIN
WITH acv DO
    BEGIN
    a06retpart_move (acv, @a_mblock.mb_qual^.mut_hostfn,
          sizeof (a_mblock.mb_qual^.mut_hostfn));
    arg_count := 1;
    a06finish_curr_retpart (acv, sp1pk_data, arg_count)
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a37init_util_record (
            VAR acv : tak_all_command_glob;
            m_type  : tgg_message_type;
            mm_type : tgg_message2_type);
 
BEGIN
a06a_mblock_init (acv,
      m_type, mm_type, b01niltree_id);
WITH acv, a_mblock.mb_qual^ DO
    BEGIN
    acv.a_mblock.mb_struct := mbs_util;
    IF  m_type <> m_majority
    THEN
        IF  m_type in [m_save, m_autosave]
        THEN
            BEGIN
            acv.a_mblock.mb_struct := mbs_save_restore;
            ak37init_save_restore_input_param (msave_restore);
            END
        ELSE
            BEGIN
            mut_diag_type  := diagNil_egg00;
            mut_config     := false;
            mut_pool_size  := 0;
            mut_index_no   := 0;
            mut_pno        := NIL_PAGE_NO_GG00;
            mut_pno2       := NIL_PAGE_NO_GG00;
            mut_count      := -1;
            mut_dump_state := [];
            mut_surrogate  := cgg_zero_id;
            mut_authname   := a01_il_b_identifier ;
            mut_tabname    := a01_il_b_identifier ;
            mut_dev        := b01blankfilename;
            mut_dev2       := b01blankfilename;
            mut_hostfn     := b01blankfilename;
            acv.a_mblock.mb_qual_len  :=
                  sizeof (b01niltree_id ) + sizeof (mut_diag_type ) +
                  sizeof (mut_config    ) + sizeof (mut_pool_size ) +
                  sizeof (mut_index_no  ) + sizeof (mut_pno       ) +
                  sizeof (mut_pno2      ) + sizeof (mut_count     ) +
                  sizeof (mut_dump_state) + sizeof (mut_surrogate ) +
                  sizeof (mut_authname  ) +
                  sizeof (mut_tabname   ) + sizeof (mut_dev       ) +
                  sizeof (mut_dev2      ) + sizeof (mut_hostfn    )
            END
        (*ENDIF*) 
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak37init_save_restore_input_param (VAR newParam : tgg00_SaveRestoreInputParam);
 
BEGIN
WITH newParam DO
    BEGIN
    sripBlocksize_gg00       := 0;
    sripHostTapeNum_gg00     := 0;
    sripFileVersion_gg00     := 0;
    sripIsAutoLoad_gg00      := false;
    sripWithCheckpoint_gg00  := false;
    sripIsRestoreConfig_gg00 := false;
    sripFiller1_gg00         := false;
    sripMedianame_gg00       := bsp_c64;
    sripUntilDate_gg00       := bsp_date;
    sripUntilTime_gg00       := bsp_time;
    sripUtilCmdId_gg00.utidId_gg00     := bsp_c12; (* PTS 1108625 UH 2000-12-11 *)
    sripUtilCmdId_gg00.utidLineNo_gg00 := 0;       (* PTS 1108625 UH 2000-12-11 *)
    sripConfigDbName_gg00    := bsp_dbname;
    sripFiller2_gg00         := 0
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak37multi_tapes (
            VAR acv      : tak_all_command_glob;
            VAR a30v     : tak_a30_utility_glob;
            VAR qual     : tgg_qual_buf;
            messtype2    : tgg00_MessType2);
 
VAR
      ix         : integer;
 
BEGIN
WITH acv, a30v, qual, msave_restore DO
    BEGIN
    sripBlocksize_gg00   := 0;
    sripHostTapeNum_gg00 := 0;
    FOR ix := 1 TO MAX_TAPES_GG00 DO
        BEGIN
        sripHostTapecount_gg00 [ix] := csp_maxint4;
        sripHostTapenames_gg00 [ix] := b01blankfilename;
        END;
    (*ENDFOR*) 
    sripMedianame_gg00 := bsp_c64;
    WHILE a_ap_tree^[a3ti].n_symb = s_hostfilename DO
        BEGIN
        sripHostTapeNum_gg00 := sripHostTapeNum_gg00 + 1;
        (* PTS 1112983 E.Z. *)
        IF  messtype2 = mm_log
        THEN
            a36filename (acv, a3ti,
                  sripHostTapenames_gg00 [sripHostTapeNum_gg00],
                  sizeof(sripHostTapenames_gg00 [sripHostTapeNum_gg00])
                  - cak_logsave_numlen)
        ELSE
            a36filename (acv, a3ti,
                  sripHostTapenames_gg00 [sripHostTapeNum_gg00],
                  sizeof(sripHostTapenames_gg00 [sripHostTapeNum_gg00]));
        (*ENDIF*) 
        a3ti := a_ap_tree^[a3ti].n_sa_level;
        IF  a36filetype (acv, a3ti,
            sripHostFiletypes_gg00 [sripHostTapeNum_gg00])
        THEN
            a3ti := a_ap_tree^[a3ti].n_sa_level;
        (*ENDIF*) 
        a37get_count_int4 (acv, a30v,
              sripHostTapecount_gg00 [sripHostTapeNum_gg00]);
&       ifdef trace
        t01int4 (ak_sem, 'a3ti        ', a3ti);
&       endif
        END
    (*ENDWHILE*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak37send_messbuffer (
            VAR acv    : tak_all_command_glob;
            m_type     : tgg_message_type;
            mm_type    : tgg_message2_type);
 
VAR
      b_err  : tgg_basis_error;
      a30v   : tak_a30_utility_glob;
 
BEGIN
WITH acv, a30v, a_mblock DO
    IF  a_return_segm^.sp1r_returncode  = 0
    THEN
        BEGIN
        a37init_util_record (acv, m_type, mm_type);
        a3ti := 1;
        IF  m_type = m_commit
        THEN
            BEGIN
            s10mv1 (sizeof(a_acc_user_id), a_mblock.mb_qual_size,
                  a_acc_user_id, 1,
                  a_mblock.mb_qual^.buf, 1, sizeof(a_acc_user_id));
            a_mblock.mb_qual_len  := mxgg_surrogate
            END;
        (* PTS 1115982 E.Z. *)
        (*ENDIF*) 
        IF  m_type = m_diagnose
        THEN
            BEGIN (* read hostfilename into mess_buf, return *)
            (* hostfilename to utility                       *)
            a36filename (acv, 2,
                  a_mblock.mb_qual^.mut_hostfn,
                  sizeof(a_mblock.mb_qual^.mut_hostfn));
            a37return_hostname (acv)
            END;
        (*ENDIF*) 
        IF  a94mode = umUtility_egg00
        THEN
            a06_c_send_mess_buf (acv, b_err)
        ELSE
            a06lsend_mess_buf (acv, a_mblock,
                  NOT cak_call_from_rsend, b_err);
        (*ENDIF*) 
        IF  b_err <> e_ok
        THEN
            a07_b_put_error (acv, b_err, 1);
        (*ENDIF*) 
        END
    (*ENDIF*) 
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a37ddl (
            VAR acv : tak_all_command_glob;
            ddl_id : tak30_ddl_kind);
 
CONST
      c_release_packet = true;
 
VAR
      init_user_kind : tak_usertyp;
      init_sqlmode   : tsp_sqlmode; (* h.b. PTS 1105040 *)
      char_size      : integer;
      i              : integer;
      init_auth_id   : tgg_surrogate;
      init_auth_name : tsp_knl_identifier;
      stmt_cnt       : integer;
      p_arr          : tak_syspointerarr;
      tablename      : tsp_knl_identifier;
      create_stmt    : ARRAY[1..17] OF tsp_c40;
      c3   : tsp_c3;
 
BEGIN
WITH acv DO
    BEGIN
    init_user_kind := a_current_user_kind;
    init_auth_id   := a_curr_user_id;
    init_auth_name := a_curr_user_name;
    a_curr_user_name := g01glob.sysuser_name;
    a_curr_user_id   := g01glob.sysuser_id;
    CASE ddl_id OF
        create_sys_parsid :
            tablename := a01_i_sysparseid;
        create_sys_monitor :
            tablename := a01_i_sysmonitor;
        create_sysdata_analyze :
            tablename := a01_i_sysdata_analyze;
        create_syscmd_analyze :
            tablename := a01_i_syscmd_analyze;
        OTHERWISE
            tablename := a01_i_sysmondata;
        END;
    (*ENDCASE*) 
    IF  NOT a06_table_exist ( acv, d_release, a_curr_user_name,
        tablename, p_arr, false)
    THEN
        BEGIN
        CASE ddl_id OF
            create_sys_parsid :
                BEGIN
                (* create table sys_parseid *)
                create_stmt[1] := sysparse1;
                create_stmt[2] := sysparse2;
                IF  g01unicode
                THEN
                    BEGIN
                    create_stmt[3] := sysuparse3;
                    create_stmt[4] := sysuparse4;
                    create_stmt[5] := sysuparse5;
                    END
                ELSE
                    BEGIN
                    create_stmt[3] := sysparse3;
                    create_stmt[4] := sysparse4;
                    create_stmt[5] := sysparse5;
                    END;
                (*ENDIF*) 
                create_stmt[6] := sysparse6;
                stmt_cnt       := 6
                END;
            create_sys_monitor :
                BEGIN
                (* create table sysmonitor *)
                create_stmt[1]  := sysmon1;
                create_stmt[2]  := sysmon2;
                create_stmt[3]  := sysmon3;
                create_stmt[4]  := sysmon4;
                create_stmt[5]  := sysmon5;
                create_stmt[6]  := sysmon6;
                create_stmt[7]  := sysmon7;
                create_stmt[8]  := sysmon8;
                create_stmt[9]  := sysmon9;
                create_stmt[10] := sysmon10;
                create_stmt[11] := sysmon11;
                create_stmt[12] := sysmon12;
                create_stmt[13] := sysmon13;
                IF  g01unicode
                THEN
                    create_stmt[14] := sysumon14
                ELSE
                    create_stmt[14] := sysmon14;
                (*ENDIF*) 
                create_stmt[15] := sysmon15;
                create_stmt[16] := sysmon16;
                create_stmt[17] := sysmon17;
                stmt_cnt        := 17
                END;
            create_syscmd_analyze:
                BEGIN
                (* create table syscmd_analyze *)
                create_stmt[1] := syscmd1;
                IF  g01unicode
                THEN
                    BEGIN
                    create_stmt[2] := sysucmd2;
                    create_stmt[4] := sysucmd4;
                    END
                ELSE
                    BEGIN
                    create_stmt[2] := syscmd2;
                    create_stmt[4] := syscmd4;
                    END;
                (*ENDIF*) 
                create_stmt[3] := syscmd3;
                create_stmt[5] := syscmd5;
                create_stmt[6] := syscmd6;
                create_stmt[7] := syscmd7;
                stmt_cnt       := 7
                END;
            create_sysdata_analyze:
                BEGIN
                (* create table sys_data *)
                create_stmt[1]  := sysdata1;
                create_stmt[2]  := sysdata2;
                create_stmt[3]  := sysdata3;
                create_stmt[4]  := sysdata4;
                create_stmt[5]  := sysdata5;
                create_stmt[6]  := sysdata6;
                create_stmt[7]  := sysdata7;
                create_stmt[8]  := sysdata8;
                create_stmt[9]  := sysdata9;
                create_stmt[10] := sysdata10;
                create_stmt[11] := sysdata11;
                stmt_cnt        := 11
                END;
            create_sys_mondata :
                BEGIN
                (* create table sysmonitor *)
                create_stmt[1]  := sysmondt1;
                create_stmt[2]  := sysmondt2;
                create_stmt[3]  := sysmondt3;
                IF  g01unicode
                THEN
                    create_stmt[4]  := sysumondt4
                ELSE
                    create_stmt[4] := sysmondt4;
                (*ENDIF*) 
                IF  g01unicode
                THEN
                    create_stmt[5]  := sysumondt5
                ELSE
                    create_stmt[5] := sysmondt5;
                (*ENDIF*) 
                stmt_cnt        := 5
                END;
            END;
        (*ENDCASE*) 
        IF  g01unicode
        THEN
            char_size := 2
        ELSE
            char_size := 1;
        (*ENDIF*) 
        a542internal_packet (acv, NOT c_release_packet,
              char_size * stmt_cnt * sizeof (create_stmt[1]));
        IF  a_return_segm^.sp1r_returncode = 0
        THEN
            BEGIN
            init_sqlmode := a_sqlmode; (* h.b. PTS 1105040 *)
            a_sqlmode    := sqlm_adabas;
            a_cmd_part^.sp1p_buf_len := 0;
            FOR i := 1 TO stmt_cnt DO
                a542move_to_packet (acv,
                      @create_stmt[i], sizeof (create_stmt[i]));
            (*ENDFOR*) 
            a_current_user_kind := udba;
            a_command_kind      := internal_create_tab_command;
&           ifdef trace
            t01moveobj (ak_sem,
                  a_cmd_part^.sp1p_buf, 1, a_cmd_part^.sp1p_buf_len);
&           endif
            a35_asql_statement (acv);
            a542pop_packet (acv);
            a_command_kind := single_command;
            a_sqlmode      := init_sqlmode; (* h.b. PTS 1105040 *)
            END;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        IF  a06_table_exist ( acv, d_release, a_curr_user_name,
            tablename, p_arr, false )
        THEN
            BEGIN
            b01filestate (a_transinf.tri_trans,
                  p_arr.pbasep^.sbase.btreeid);
            (* temp tables doesn't exists after RESTART *)
            (* but catalog information already exists   *)
            IF  a_transinf.tri_trans.trError_gg00 = e_file_not_found
            THEN
                b01tcreate_file (a_transinf.tri_trans,
                      p_arr.pbasep^.sbase.btreeid);
            (*ENDIF*) 
            IF  a_transinf.tri_trans.trError_gg00 = e_ok
            THEN
                BEGIN
                p_arr.pbasep^.sbase.btreeid.fileHandling_gg00 :=
                      p_arr.pbasep^.sbase.btreeid.fileHandling_gg00 + [hsNoLog_egg00];
                CASE ddl_id OF
                    create_sys_parsid:
                        g01tabid.sys_diag_parse :=
                              p_arr.pbasep^.sbase.btreeid;
                    create_sys_monitor :
                        a545sm_reset (p_arr.pbasep^.sbase.btreeid);
                    create_sys_mondata :
                        a545sm_data_tree (acv, p_arr.pbasep^.sbase.btreeid);
                    create_syscmd_analyze :
                        g01tabid.sys_cmd_analyze :=
                              p_arr.pbasep^.sbase.btreeid;
                    create_sysdata_analyze :
                        g01tabid.sys_data_analyze :=
                              p_arr.pbasep^.sbase.btreeid;
                    END;
                (*ENDCASE*) 
                END
            ELSE
                a07_b_put_error (acv, a_transinf.tri_trans.trError_gg00, 1)
            (*ENDIF*) 
            END;
        (*ENDIF*) 
    (*ENDIF*) 
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        a52_ex_commit_rollback (acv, m_commit, false, false);
    (*ENDIF*) 
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        IF  ddl_id = create_sys_parsid
        THEN
            g01diag_moni_parse_on := true
        ELSE
            IF  ddl_id = create_sys_monitor
            THEN
                BEGIN  (* h.b. PTS 1106105 *)
                a01diag_monitor_on      := true;
                IF  a_transinf.tri_trans.trBdTcachePtr_gg00 <> NIL
                THEN
                    BEGIN
                    b21m_parse_again (a_transinf.tri_trans.trBdTcachePtr_gg00,
                          c3);
                    IF  c3 = '   '
                    THEN
                        BEGIN
                        WITH a_pars_last_key DO
                            BEGIN
                            (* PTS 1109291 E.Z. *)
                            a92next_monitor_pcount (acv, a_pars_last_key);
                            p_id   := chr(0);
                            p_kind := m_nil;
                            p_no   := 0
                            END;
                        (*ENDWITH*) 
                        b21mp_parse_again_put (acv.a_transinf.tri_trans.trBdTcachePtr_gg00,
                              a_pars_last_key.p_count);
                        END
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
                END;
            (*ENDIF*) 
        (*ENDIF*) 
    (*ENDIF*) 
    a_internal_sql       := no_internal_sql;
    a_current_user_kind  := init_user_kind;
    a_curr_user_id       := init_auth_id;
    a_curr_user_name     := init_auth_name
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak37read_label (VAR acv : tak_all_command_glob);
 
VAR
      b_err     : tgg_basis_error;
      file_node : tsp_int2;
      dont_care : boolean;
 
BEGIN
a06a_mblock_init (acv,
      m_save_parallel, mm_fread, b01niltree_id);
WITH acv, a_mblock, mb_qual^, msave_restore DO
    BEGIN
    a_mblock.mb_struct   := mbs_save_restore;
    sripHostTapeNum_gg00 := 1;
    file_node          :=
          a_ap_tree^[ a_ap_tree^[ 0 ].n_lo_level ].n_lo_level;
    a36filename (acv, file_node,
          sripHostTapenames_gg00 [sripHostTapeNum_gg00],
          sizeof (sripHostTapenames_gg00 [sripHostTapeNum_gg00]));
    file_node := a_ap_tree^[ file_node ].n_sa_level;
    dont_care := a36filetype (acv, file_node,
          sripHostFiletypes_gg00 [sripHostTapeNum_gg00]);
    mb_qual_len  := mb_qual_size;
    IF  a94mode = umUtility_egg00
    THEN
        a06_c_send_mess_buf (acv, b_err)
    ELSE
        a06lsend_mess_buf (acv, a_mblock,
              NOT cak_call_from_rsend, b_err);
    (*ENDIF*) 
    IF  b_err <> e_ok
    THEN
        a07_b_put_error (acv, b_err, 1)
    ELSE
        a37multi_tape_info (acv, cak_i_no_keyword)
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(* PTS 1115978 E.Z. *)
(*------------------------------*) 
 
PROCEDURE
      ak37table_set_write_on_off (
            VAR acv      : tak_all_command_glob;
            set_write_on : boolean);
 
VAR
      mm_type  : tgg_message2_type;
      b_err    : tgg_basis_error;
      ti       : tsp_int4;
      authname : tsp_knl_identifier;
      tablen   : tsp_knl_identifier;
      d_sparr  : tak_syspointerarr;
 
BEGIN
ti := 2;
IF  set_write_on
THEN
    mm_type := mm_write_on
ELSE
    mm_type := mm_write_off;
(*ENDIF*) 
a11get_check_table (acv, false, true, true, [  ], false,
      false, d_release, ti, authname, tablen, d_sparr);
IF  (authname <> acv.a_curr_user_name)
    AND
    (acv.a_current_user_kind <> ucontroluser)
    AND
    ((acv.a_current_user_kind <> usysdba) OR
    ( acv.a_current_auth_site <> g01localsite))
THEN
    a07_b_put_error (acv, e_missing_privilege, 1)
ELSE
    WITH acv DO
        BEGIN
        a06a_mblock_init (acv,
              m_set, mm_type, d_sparr.pbasep^.sbase.btreeid);
        a_mblock.mb_struct := mbs_util;
        a06lsend_mess_buf (acv, a_mblock,
              NOT cak_call_from_rsend, b_err);
        IF  b_err <> e_ok
        THEN
            a07_b_put_error (acv, b_err, 1)
        (*ENDIF*) 
        END;
    (*ENDWITH*) 
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak37verify (VAR acv : tak_all_command_glob);
 
BEGIN
WITH acv DO
    BEGIN
    CASE a_ap_tree^[a_ap_tree^[ 0 ].n_lo_level].n_length OF
        cak_i_catalog, cak_i_modify :
            ak37verify_catalog (acv,
                  a_ap_tree^[a_ap_tree^[ 0 ].n_lo_level].n_length = cak_i_modify);
        (* PTS 1120781 E.Z. *)
        cak_i_index :
            ak37send_messbuffer (acv, m_verify, mm_index);
        OTHERWISE
            ak37send_messbuffer (acv, m_verify, mm_nil);
        END;
    (*ENDCASE*) 
    IF  (a_return_segm^.sp1r_returncode <> 0) AND
        (a_mblock.mb_qual_len  > 0)
    THEN
        BEGIN
        a06retpart_move (acv, @a_mblock.mb_qual^.buf[1],
              a_mblock.mb_qual_len );
        a06finish_curr_retpart (acv, sp1pk_errortext, 1);
        a_user_defined_error := true
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(* PTS 1120248 E.Z. *)
(*------------------------------*) 
 
PROCEDURE
      ak37set_parameter (VAR acv : tak_all_command_glob);
 
VAR
      _moveobj_ptr     : tsp_moveobj_ptr;
      _value_len       : integer;
      _param_n         : tsp_int2;
      _value_n         : tsp_int2;
      _ident_len       : tsp_int4;
      _errtext         : tsp_errtext;
      _cp_name         : tsp11_ConfParamName;
      _cp_value        : tsp11_ConfParamValue;
      _cp_ret          : tsp11_ConfParamReturnValue;
      _b_err           : tgg_basis_error;
      _is_numeric      : boolean;
      _uni_identifier  : tsp_knl_identifier;
      _error           : tsp8_uni_error;
      _err_char_no     : tsp_int4;
 
BEGIN
IF  NOT (acv.a_current_user_kind in [ucontroluser, usysdba, udba])
    OR (acv.a_comp_type <> at_db_manager)
THEN
    a07_kw_put_error (acv, e_missing_privilege, 1, cak_i_dba)
ELSE
    WITH acv DO
        BEGIN
        _param_n := a_ap_tree^[a_ap_tree^[0].n_lo_level].n_lo_level;
        WHILE (_param_n <> 0) AND
              (a_return_segm^.sp1r_returncode = 0) DO
            BEGIN
            (* PTS 1107610 E.Z. *)
            IF  g01unicode
            THEN
                BEGIN
                _moveobj_ptr := @_uni_identifier;
                a05_identifier_get (acv, _param_n,
                      sizeof (_cp_name) * a01char_size, _moveobj_ptr^);
                IF  (a_return_segm^.sp1r_returncode = 0)
                THEN
                    s80uni_trans (@_uni_identifier, sizeof (_cp_name) * a01char_size,
                          csp_unicode, @_cp_name, _ident_len,
                          csp_ascii, [ ], _error, _err_char_no);
                (*ENDIF*) 
                IF  _error <> uni_ok
                THEN
                    a07_hex_uni_error (acv, _error, 1, NOT c_trans_to_uni,
                          @_uni_identifier [_err_char_no], c_unicode_wid)
                ELSE
                    IF  _ident_len <> sizeof (_cp_name)
                    THEN
                        a07_b_put_error (acv, e_identifier_too_long, 1)
                    (*ENDIF*) 
                (*ENDIF*) 
                END
            ELSE
                BEGIN
                _moveobj_ptr := @_cp_name;
                a05_identifier_get (acv, _param_n,
                      sizeof (_cp_name), _moveobj_ptr^);
                END;
            (*ENDIF*) 
            (* END PTS 1107610 E.Z. *)
            IF  (a_return_segm^.sp1r_returncode = 0)
            THEN
                BEGIN
                _value_n    := a_ap_tree^[_param_n].n_lo_level;
                _is_numeric := (a_ap_tree^[_param_n].n_symb <> s_string_literal);
                _moveobj_ptr := @_cp_value;
                a05string_literal_get (acv, _value_n, dcha,
                      _moveobj_ptr^, 1, sizeof(_cp_value));
                END;
            (*ENDIF*) 
            _param_n := a_ap_tree^[_param_n].n_sa_level;
            IF  (a_return_segm^.sp1r_returncode = 0)
            THEN
                WITH acv.a_mblock, mb_data^ DO
                    BEGIN
                    _value_len := sizeof (_cp_value);
                    WHILE (_value_len > 0) AND
                          (_cp_value[_value_len] = bsp_c1) DO
                        _value_len := _value_len - 1;
                    (*ENDWHILE*) 
                    vconf_param_put (_cp_name, _cp_value, _is_numeric,
                          _errtext, _cp_ret);
                    IF  (_cp_ret <> ok_sp11)
                    THEN
                        a07_b_put_error (acv, e_invalid, 1);
                    (*ENDIF*) 
                    END;
                (*ENDWITH*) 
            (*ENDIF*) 
            END;
        (*ENDWHILE*) 
        IF  (a_return_segm^.sp1r_returncode = 0)
        THEN
            BEGIN
            g01refresh_param (_b_err);
            IF  _b_err <> e_ok
            THEN
                a07_b_put_error (acv, _b_err, 1);
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        END;
    (*ENDWITH*) 
(*ENDIF*) 
END;
 
(* PTS 1108247 E.Z. *)
(*------------------------------*) 
 
PROCEDURE
      ak37delete_log_from_to (VAR acv : tak_all_command_glob);
 
VAR
      node     : integer;
      frompage : tsp00_Int4;
      topage   : tsp00_Int4;
 
BEGIN
WITH acv DO
    BEGIN
    node := a_ap_tree^[a_ap_tree^[0].n_lo_level].n_lo_level;
    a05_int4_unsigned_get (acv, a_ap_tree^[ node ].n_pos,
          a_ap_tree^[ node ].n_length, frompage);
    node := a_ap_tree^[node].n_sa_level;
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        a05_int4_unsigned_get (acv, a_ap_tree^[ node ].n_pos,
              a_ap_tree^[ node ].n_length, topage);
    (*ENDIF*) 
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        BEGIN
        kb560ExecuteFreeLogForPipe(             (* PTS 1114791 mb 2002-08-22 *)
              acv.a_transinf.tri_trans.trTaskId_gg00,
              frompage,                         (* frompage means the first IOSequence *)
              topage,                           (* topage means the last IOSequence *)
              a_transinf.tri_trans.trError_gg00);
        END;
    (*ENDIF*) 
    IF  a_transinf.tri_trans.trError_gg00 <> e_ok
    THEN
        a07_b_put_error (acv, a_transinf.tri_trans.trError_gg00, 1)
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak37verify_catalog (
            VAR acv   : tak_all_command_glob;
            do_repair : boolean);
 
VAR
      b_err     : tgg_basis_error;
      e         : tgg_basis_error;
      i         : integer;
      pos       : integer;
      err_count : integer;
      msg       : tsp_c30;
      cnt       : tsp_c12;
      sysk      : tgg_sysinfokey;
 
BEGIN
WITH acv DO
    BEGIN
    a10_cache_delete (acv, NOT c_is_rollback);
    a38create_parameter_file (acv);
    sysk := a01defaultkey;
    REPEAT
        a10next_sysinfo (acv, sysk, 0, d_fix,
              cak_etable, a_p_arr1.pbasep, b_err);
        IF  b_err = e_ok
        THEN
            BEGIN
            WITH a_p_arr1.pbasep^.sbase DO
                IF  (btablekind = twithkey) OR
                    (btablekind = twithoutkey)
                THEN
                    BEGIN
                    ak37scan (acv, sysk.stableid, do_repair);
                    ak37verify_base_table (acv,
                          sysk.stableid, do_repair);
                    END;
                (*ENDIF*) 
            (*ENDWITH*) 
            sysk.slinkage[2] := chr(3);
            a10rel_sysinfo (a_p_arr1.pbasep)
            END;
        (*ENDIF*) 
    UNTIL
        (b_err <> e_ok) OR (a_return_segm^.sp1r_returncode <> 0);
    (*ENDREPEAT*) 
    IF  b_err = e_ok
    THEN
        BEGIN
        sysk           := a01defaultkey;
        sysk.sentrytyp := cak_efuncref;
        REPEAT
            a10next_sysinfo (acv, sysk, 0, d_release,
                  cak_efuncref, a_p_arr1.pbasep, b_err);
            IF  b_err = e_ok
            THEN
                WITH a_p_arr1.pbasep^.sfuncref DO
                    IF  fct_proc_cnt > 1
                    THEN
                        BEGIN
                        fct_proc_cnt := 1;
                        a10_add_repl_sysinfo (acv,
                              a_p_arr1.pbasep, false, e);
                        IF  e <> e_ok
                        THEN
                            b_err := e
                        (*ENDIF*) 
                        END;
                    (*ENDIF*) 
                (*ENDWITH*) 
            (*ENDIF*) 
        UNTIL
            b_err <> e_ok;
        (*ENDREPEAT*) 
        END;
    (*ENDIF*) 
    IF  b_err <> e_no_next_record
    THEN
        a07_b_put_error (acv, b_err, 1);
    (*ENDIF*) 
    a_mblock.mb_qual_len  := 0;
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        BEGIN
        IF  a_show_data_cnt > 0
        THEN
            BEGIN
            a07_b_put_error (acv, e_range_violation, 1);
            msg       := 'INCONSISTENCIES FOUND :       ';
            err_count := a_show_data_cnt;
            i         := sizeof (cnt);
            WHILE err_count > 0 DO
                BEGIN
                cnt[i]    := chr (err_count MOD 10 + ord ('0'));
                err_count := err_count DIV 10;
                i         := i - 1
                END;
            (*ENDWHILE*) 
            s10mv2 (sizeof (msg), a_mblock.mb_qual_size,
                  msg, 1, a_mblock.mb_qual^.buf, 1,
                  sizeof (msg));
            pos := 24;
            REPEAT
                i   := i + 1;
                pos := pos + 1;
                a_mblock.mb_qual^.buf[pos] := cnt[i];
            UNTIL
                i = sizeof (cnt);
            (*ENDREPEAT*) 
            a_mblock.mb_qual_len  := pos;
            END
        ELSE
            b01destroy_file (a_transinf.tri_trans, a_usage_curr)
        (*ENDIF*) 
        END
    ELSE
        a_part_rollback := true
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak37scan (
            VAR acv       : tak_all_command_glob;
            tabid         : tgg_surrogate;
            do_repair     : boolean);
 
VAR
      ok          : boolean;
      b_err       : tgg_basis_error;
      usage_index : integer;
      linkage     : tsp_c2;
      udef        : tak_usagedef;
      error_msg   : tak37verify_msg;
      sysk        : tgg_sysinfokey;
 
BEGIN
WITH acv DO
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        BEGIN
        usage_index := 0;
        linkage     := a01defaultkey.slinkage;
        REPEAT
            sysk           := a01defaultkey;
            sysk.stableid  := tabid;
            sysk.sentrytyp := cak_eusage;
            sysk.slinkage  := linkage;
            a10get_sysinfo (acv,
                  sysk, d_release, a_ptr1, b_err);
            IF  b_err = e_ok
            THEN
                BEGIN
                usage_index := usage_index + 1;
                IF  usage_index > a_ptr1^.susage.usagecount
                THEN
                    IF  a_ptr1^.susage.usagenext_exist
                    THEN
                        BEGIN
                        a06inc_linkage (linkage);
                        usage_index := 0
                        END
                    ELSE
                        b_err := e_sysinfo_not_found
                    (*ENDIF*) 
                ELSE
                    WITH a_ptr1^.susage.usagedef[usage_index] DO
                        IF  NOT usa_empty
                        THEN
                            BEGIN
                            udef :=
                                  a_ptr1^.susage.usagedef[usage_index];
                            ak37check_table (acv,
                                  udef.usa_tableid, ok);
                            IF  NOT ok
                            THEN
                                BEGIN
                                IF  do_repair
                                THEN
                                    BEGIN
                                    a11del_usage_entry (acv, tabid,
                                          udef.usa_tableid);
                                    usage_index := usage_index - 1;
                                    END;
                                (*ENDIF*) 
                                error_msg.surrogate :=
                                      udef.usa_tableid;
                                ak37put_errmsg (acv,
                                      ve_ref, sysk.stableid,
                                      error_msg);
                                END
                            ELSE
                                ak37scan (acv, usa_tableid,
                                      do_repair)
                            (*ENDIF*) 
                            END;
                        (*ENDIF*) 
                    (*ENDWITH*) 
                (*ENDIF*) 
                END;
            (*ENDIF*) 
        UNTIL
            (b_err <> e_ok) OR (a_return_segm^.sp1r_returncode <> 0);
        (*ENDREPEAT*) 
        IF  b_err <> e_sysinfo_not_found
        THEN
            a07_b_put_error (acv, b_err, 1)
        (*ENDIF*) 
        END;
    (*ENDIF*) 
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak37put_errmsg (
            VAR acv       : tak_all_command_glob;
            error_kind    : tak37verify_errors;
            VAR tabid     : tgg_surrogate;
            VAR verifymsg : tak37verify_msg);
 
VAR
      b_err : tgg_basis_error;
      ptr   : tak_sysbufferaddress;
      i     : integer;
      pos   : integer;
      msg   : tsp_name;
      owner : tsp_knl_identifier;
      name3 : tsp_knl_identifier;
      sysk  : tgg_sysinfokey;
 
BEGIN
WITH acv DO
    BEGIN
    sysk          := a01defaultkey;
    sysk.stableid := tabid;
    a10get_sysinfo (acv, sysk, d_release, ptr, b_err);
    IF  b_err = e_ok
    THEN
        BEGIN
        name3 := a01_il_b_identifier;
        CASE error_kind OF
            ve_index :
                msg := 'INVALID INDEX INFO';
            ve_file_missing :
                BEGIN
                msg := 'FILE MISSING      ';
                pos := 0;
                FOR i := 1 TO sizeof (tabid) DO
                    g17hexto_line (tabid[i], pos, name3)
                (*ENDFOR*) 
                END;
            ve_multi_missing :
                BEGIN
                msg   := 'MULTI IND MISSING ';
                name3 := verifymsg.name
                END;
            ve_ref :
                BEGIN
                msg   := 'UNRESOLVED VIEWREF';
                pos   := 0;
                FOR i := 1 TO sizeof (verifymsg.surrogate) DO
                    g17hexto_line (verifymsg.surrogate[i], pos, name3);
                (*ENDFOR*) 
                END;
            ve_single_missing :
                BEGIN
                msg   := 'SINGLE IND MISSING';
                name3 := verifymsg.name
                END;
            ve_tableref :
                BEGIN
                msg := 'INVALID TABLE REF ';
                pos := 0;
                FOR i := 1 TO sizeof (tabid) DO
                    g17hexto_line (tabid[i], pos, name3)
                (*ENDFOR*) 
                END;
            ve_version :
                msg := 'WRONG TAB VERSION ';
            ve_single_invalid :
                BEGIN
                msg   := 'WRONG ECOL_TAB    ';
                name3 := verifymsg.name
                END;
            OTHERWISE
                msg := bsp_name;
            END;
        (*ENDCASE*) 
        a06determine_username (acv,
              ptr^.sbase.bauthid, owner);
        a38insert_parameters (acv, a_show_data_cnt,
              msg, owner, ptr^.sbase.btablen^, name3, a01_il_b_identifier)
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak37check_table (
            VAR acv   : tak_all_command_glob;
            VAR tabid : tgg_surrogate;
            VAR ok    : boolean);
 
VAR
      b_err    : tgg_basis_error;
      ptr      : tak_sysbufferaddress;
      tab_kind : tgg_tablekind;
      sysk     : tgg_sysinfokey;
 
BEGIN
WITH acv DO
    BEGIN
    sysk          := a01defaultkey;
    sysk.stableid := tabid;
    a10get_sysinfo (acv, sysk, d_release, ptr, b_err);
    ok := b_err <> e_sysinfo_not_found;
    IF  ok
    THEN
        IF  ptr^.sbase.btablekind in [tonebase, tview]
        THEN
            BEGIN (* check, if viewqual record does exist *)
            tab_kind       := ptr^.sbase.btablekind;
            sysk.sentrytyp := cak_eviewqual_basis;
            a10get_sysinfo (acv, sysk, d_release, ptr, b_err);
            IF  b_err = e_sysinfo_not_found
            THEN
                BEGIN
                a11drop_table (acv, tabid, tab_kind, false);
                ok := false;
                END;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak37verify_base_table (
            VAR acv   : tak_all_command_glob;
            VAR tabid : tgg_surrogate;
            do_repair : boolean);
 
VAR
      ok          : boolean;
      multi_error : boolean;
      replace     : boolean;
      tab_dropped : boolean;
      b_err       : tgg_basis_error;
      i           : integer;
      j           : integer;
      dropped     : integer;
      aux_root    : tsp_page_no;
      ptr         : tak_sysbufferaddress;
      error_msg   : tak37verify_msg;
      colset      : tak_columnset;
      drop_index  : SET OF 1..MAX_COL_PER_INDEX_GG00;
      qual        : tak_del_tab_qual;
      index_tree  : tgg00_FileId;
      sysk        : tgg_sysinfokey;
 
BEGIN
WITH acv DO
    BEGIN
    (* the following inconsistencies are analyzed and repaired : *)
    (* 1. difference between bd and ak file version              *)
    (* 2. missing base table file (==> drop table)               *)
    (* 3. missing index files     (==> drop Index)               *)
    (* 4. invalid index information in catalog                   *)
    (* 5. Tableref referencing another table                     *)
    a06_systable_get (acv, d_fix, tabid,
          a_p_arr1.pbasep, true, ok);
    IF  ok
    THEN
        BEGIN
        tab_dropped := false;
        sysk              := a01defaultkey;
        sysk.sauthid      := a_p_arr1.pbasep^.sbase.bauthid;
        sysk.sentrytyp    := cak_etableref;
        sysk.sidentifier  := a_p_arr1.pbasep^.sbase.btablen^;
        sysk.skeylen      := mxak_standard_sysk + sizeof (sysk.sidentifier);
        a10get_sysinfo (acv, sysk,
              d_release, ptr, b_err);
        IF  b_err = e_ok
        THEN
            IF  ptr^.stableref.rtableid <> tabid
            THEN
                BEGIN
                ok := false;
                ak37put_errmsg (acv, ve_tableref, tabid, error_msg);
                IF  do_repair
                THEN
                    BEGIN
                    qual.del_colno := 0;
                    a10_del_tab_sysinfo  (acv, tabid, qual,
                          false, b_err);
                    IF  b_err <> e_ok
                    THEN
                        a07_b_put_error (acv, b_err, 1)
                    (*ENDIF*) 
                    END
                ELSE
                    a10rel_sysinfo (a_p_arr1.pbasep);
                (*ENDIF*) 
                END;
            (*ENDIF*) 
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  ok
    THEN
        BEGIN
        replace  := false;
        (* check file existence and file version *)
        b01filestate (a_transinf.tri_trans,
              a_p_arr1.pbasep^.sbase.btreeid);
        b_err := a_transinf.tri_trans.trError_gg00;
        IF  b_err = e_ok
        THEN
            BEGIN
            b01vstate_fileversion (a_transinf.tri_trans,
                  a_p_arr1.pbasep^.sbase.btreeid);
            IF  a_transinf.tri_trans.trError_gg00 = e_old_fileversion
            THEN
                BEGIN
                ak37put_errmsg (acv, ve_version, tabid, error_msg);
                IF  do_repair
                THEN
                    BEGIN
                    replace := true;
                    END;
                (*ENDIF*) 
                END
            (*ENDIF*) 
            END
        ELSE
            IF  b_err = e_file_not_found
            THEN
                BEGIN
                ak37put_errmsg (acv, ve_file_missing, tabid, error_msg);
                IF  do_repair
                THEN
                    BEGIN
                    a_ap_tree^[a_ap_tree^[ 0 ].n_lo_level].n_proc := a37;
                    aux_root                   := a_usage_curr.fileRoot_gg00;
                    a_usage_curr.fileRoot_gg00 := NIL_PAGE_NO_GG00;
                    WITH a_p_arr1.pbasep^.sbase DO
                        a11drop_table (acv, tabid,
                              btablekind, false);
                    (*ENDWITH*) 
                    tab_dropped                := true;
                    a_usage_curr.fileRoot_gg00 := aux_root
                    END;
                (*ENDIF*) 
                END
            ELSE
                IF  (b_err <> e_file_unloaded) AND
                    (b_err <> e_file_read_only)
                THEN
                    a07_b_put_error (acv, b_err, 1);
                (*ENDIF*) 
            (*ENDIF*) 
        (*ENDIF*) 
        IF  (a_return_segm^.sp1r_returncode = 0) AND NOT tab_dropped
        THEN
            BEGIN
            colset         := [];
            drop_index     := [];
            sysk           := a_p_arr1.pbasep^.syskey;
            sysk.sentrytyp := cak_emindex;
            a10get_sysinfo (acv, sysk,
                  d_release, ptr, b_err);
            IF  b_err = e_ok
            THEN
                IF  a_p_arr1.pbasep^.sbase.bindexexist
                THEN
                    WITH ptr^.smindex DO
                        FOR i := 1 TO indexcount DO
                            WITH indexdef[i] DO
                                BEGIN
                                (* PTS 1116586 E.Z. *)
                                index_tree :=
                                      a_p_arr1.pbasep^.sbase.btreeid;
                                index_tree.fileTfn_gg00 := tfnMulti_egg00;
                                index_tree.fileTfnNo_gg00[1] :=
                                      chr (indexno);
                                index_tree.fileRoot_gg00 := NIL_PAGE_NO_GG00;
                                b01filestate(a_transinf.tri_trans,
                                      index_tree);
                                IF  a_transinf.tri_trans.trError_gg00 =
                                    e_file_not_found
                                THEN
                                    BEGIN
                                    drop_index := drop_index + [i];
                                    a24get_indexname (acv, ptr, i,
                                          error_msg.name);
                                    ak37put_errmsg (acv,
                                          ve_multi_missing, tabid, error_msg)
                                    END;
                                (*ENDIF*) 
                                IF  NOT (i in drop_index)
                                THEN
                                    FOR j := 1 TO icount DO
                                        colset :=
                                              colset + [icolseq[j]]
                                    (*ENDFOR*) 
                                (*ENDIF*) 
                                END;
                            (*ENDWITH*) 
                        (*ENDFOR*) 
                    (*ENDWITH*) 
                (*ENDIF*) 
            (*ENDIF*) 
            END
        ELSE
            IF  (b_err = e_sysinfo_not_found) AND
                a_p_arr1.pbasep^.sbase.bindexexist
            THEN
                BEGIN
                a_p_arr1.pbasep^.sbase.bindexexist := false;
                replace := true
                END
            ELSE
                IF  b_err = e_ok
                THEN
                    a07_b_put_error (acv, b_err, 1);
                (*ENDIF*) 
            (*ENDIF*) 
        (*ENDIF*) 
        IF  (drop_index <> []) AND do_repair AND
            NOT tab_dropped AND (a_return_segm^.sp1r_returncode = 0)
        THEN
            WITH ptr^.smindex DO
                BEGIN
                (* Indexes in catalog without bd files have been *)
                (* found, remove them from catalog               *)
                replace := true;
                dropped := 0;
                FOR i := 1 TO MAX_COL_PER_INDEX_GG00 DO
                    IF  i in drop_index
                    THEN
                        BEGIN
                        indexdef[i-dropped] := indexdef[indexcount];
                        dropped             := dropped + 1;
                        indexcount          := indexcount - 1
                        END;
                    (*ENDIF*) 
                (*ENDFOR*) 
                IF  indexcount = 0
                THEN
                    BEGIN
                    a_p_arr1.pbasep^.sbase.bindexexist := false;
                    a10del_sysinfo (acv, sysk, b_err)
                    END
                ELSE
                    a10_add_repl_sysinfo (acv,
                          ptr, false, b_err);
                (*ENDIF*) 
                IF  b_err <> e_ok
                THEN
                    a07_b_put_error (acv, b_err, 1)
                (*ENDIF*) 
                END;
            (*ENDWITH*) 
        (*ENDIF*) 
        multi_error := false;
        IF  (a_return_segm^.sp1r_returncode = 0) AND NOT tab_dropped
        THEN
            WITH a_p_arr1.pbasep^.sbase DO
                FOR j := bfirstindex TO blastindex DO
                    WITH bcolumn[j]^ DO
                        BEGIN
                        IF  (ctmulti in ccolpropset) AND
                            NOT (cextcolno in colset)
                        THEN
                            BEGIN
                            ccolpropset := ccolpropset - [ctmulti];
                            multi_error := true
                            END
                        ELSE
                            IF  (cextcolno in colset) AND
                                NOT (ctmulti in ccolpropset)
                            THEN
                                BEGIN
                                ccolpropset :=
                                      ccolpropset + [ctmulti];
                                multi_error := true
                                END;
                            (*ENDIF*) 
                        (*ENDIF*) 
                        END;
                    (*ENDWITH*) 
                (*ENDFOR*) 
            (*ENDWITH*) 
        (*ENDIF*) 
        IF  multi_error
        THEN
            BEGIN
            ak37put_errmsg (acv, ve_index, tabid, error_msg);
            replace := true
            END;
        (*ENDIF*) 
        IF  do_repair AND replace AND (a_return_segm^.sp1r_returncode = 0)
        THEN
            BEGIN
            a10_add_repl_sysinfo (acv,
                  a_p_arr1.pbasep, false, b_err);
            IF  b_err <> e_ok
            THEN
                a07_b_put_error (acv, b_err, 1);
            (*ENDIF*) 
            IF  a_return_segm^.sp1r_returncode = 0
            THEN
                ak37recreate_views (acv)
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        IF  NOT tab_dropped
        THEN
            a10rel_sysinfo (a_p_arr1.pbasep);
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak37recreate_views (VAR acv : tak_all_command_glob);
 
VAR
      aux_root    : tsp_page_no;
      viewscanpar : tak_save_viewscan_par;
 
BEGIN
WITH acv, viewscanpar DO
    BEGIN
    a27init_viewscanpar (acv, viewscanpar, v_intern_save_scheme);
    a_internal_sql             := sql_alter_table;
    vsc_save_into              := false;
    vsc_cmd_cnt                := 0;
    vsc_first_save             := true;
    vsc_last_save              := true;
    vsc_base_tabid             := a_p_arr1.pbasep^.syskey.stableid;
    aux_root                   := a_usage_curr.fileRoot_gg00;
    a_usage_curr.fileRoot_gg00 := NIL_PAGE_NO_GG00;
    a15catalog_save    (acv, viewscanpar);
    a15restore_catalog (acv,
          a_p_arr1.pbasep^.sbase.btreeid, viewscanpar);
    a_usage_curr.fileRoot_gg00 := aux_root;
    a_internal_sql             := no_internal_sql
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      a37hex2char (
            VAR acv : tak_all_command_glob;
            hexpos : integer) : char;
 
VAR
      hexhi, hexlo : char;
      inthi, intlo : integer;
 
BEGIN
hexhi := acv.a_cmd_part^.sp1p_buf[ hexpos + a01char_size - 1];
hexlo := acv.a_cmd_part^.sp1p_buf[ hexpos + a01char_size + a01char_size - 1];
IF  (hexhi in [ 'a'..'f' ])
THEN
    hexhi := chr(ord('A') + ord(hexhi) - ord('a'));
(*ENDIF*) 
IF  (hexlo in [ 'a'..'f' ])
THEN
    hexlo := chr(ord('A') + ord(hexlo) - ord('a'));
(*ENDIF*) 
IF  (hexhi in [ '0'..'9', 'A'..'F' ]) AND
    (hexlo in [ '0'..'9', 'A'..'F' ])
THEN
    BEGIN
    IF  (hexhi in [ '0'..'9' ])
    THEN
        inthi := ord(hexhi) - ord('0')
    ELSE
        inthi := 10 + ord(hexhi) - ord('A');
    (*ENDIF*) 
    IF  (hexlo in [ '0'..'9' ])
    THEN
        intlo := ord(hexlo) - ord('0')
    ELSE
        intlo := 10 + ord(hexlo) - ord('A');
    (*ENDIF*) 
    a37hex2char := chr(inthi * 16 + intlo);
    END
ELSE
    BEGIN
    a07_b_put_error (acv, e_invalid_number_variable, hexpos);
    a37hex2char := ' ';
    END;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak37termset (
            VAR acv        : tak_all_command_glob;
            VAR setname    : tsp_knl_identifier;
            VAR tree_index : tsp_int2;
            indicator      : integer);
 
VAR
      b_err          : tgg_basis_error;
      activate       : boolean;
      i              : integer;
      j              : integer;
      set_cnt        : integer;
      hexpos         : integer;
      var_index      : tsp_int2;
      value_cnt      : integer;
      sysk           : tgg_sysinfokey;
      ascii_set      : tak_charset;
      ebcdic_set     : tak_charset;
      basic_code     : tak_keyword;
      descriptions   : ARRAY [1..cgg_termset_entries] OF tgg00_TermDesc;
 
BEGIN
CASE acv.a_ap_tree^[tree_index].n_symb OF
    s_ascii :
        basic_code := a01kw[cak_i_ascii];
    s_ebcdic :
        basic_code := a01kw[cak_i_ebcdic];
    s_unicode :
        basic_code := a01kw[cak_i_unicode];
    OTHERWISE :
        basic_code := a01kw[cak_i_ascii];
    END;
(*ENDCASE*) 
ascii_set  := [
      chr(0),
      csp_ascii_blank,
      csp_ascii_close_bracket,
      cgg_ascii_colon,
      cgg_ascii_comma,
      csp_ascii_double_quote,
      cgg_ascii_equal,
      cgg_ascii_greater,
      csp_ascii_hyphen,
      cgg_ascii_less,
      csp_ascii_open_bracket,
      csp_ascii_percent,
      cgg_ascii_period,
      cgg_ascii_plus,
      csp_ascii_quote,
      cgg_ascii_slash,
      csp_ascii_star,
      csp_ascii_underline,
      chr( 97) .. chr(122), (* a..z *)
      chr( 65) .. chr( 90), (* A..Z *)
      chr( 48) .. chr( 57)  (* 0..9 *) ];
ebcdic_set := [
      chr(0),
      csp_ebcdic_blank,
      csp_ebcdic_close_bracket,
      cgg_ebcdic_colon,
      cgg_ebcdic_comma,
      csp_ebcdic_double_quote,
      cgg_ebcdic_equal,
      cgg_ebcdic_greater,
      csp_ebcdic_hyphen,
      cgg_ebcdic_less,
      csp_ebcdic_open_bracket,
      csp_ebcdic_percent,
      cgg_ebcdic_period,
      cgg_ebcdic_plus,
      csp_ebcdic_quote,
      cgg_ebcdic_slash,
      csp_ebcdic_star,
      csp_ebcdic_underline,
      chr(129) .. chr(137), (* a..i *)
      chr(145) .. chr(153), (* j..r *)
      chr(162) .. chr(169), (* s..z *)
      chr(193) .. chr(201), (* A..I *)
      chr(209) .. chr(217), (* J..R *)
      chr(226) .. chr(233), (* S..Z *)
      chr(240) .. chr(249)  (* 0..9 *) ];
WITH acv DO
    BEGIN
    (*== activate ? =======================================*)
    activate := false;
    IF  a_ap_tree^[ tree_index ].n_lo_level <> 0
    THEN
        BEGIN
        tree_index := a_ap_tree^[ tree_index ].n_lo_level;
        activate   := true;
        END;
    (*== get hex codes and check them =====================*)
    (*ENDIF*) 
    i         := 1;
    value_cnt := 0;
    WHILE (i <= cgg_termset_entries) AND
          (a_return_segm^.sp1r_returncode = 0) DO
        WITH descriptions[ i ] DO
            BEGIN
            IF  a_ap_tree^[ tree_index ].n_sa_level <> 0
            THEN
                BEGIN
                tree_index       := a_ap_tree^[ tree_index ].n_sa_level;
                hexpos           := a_ap_tree^[ tree_index ].n_pos;
                td_internal[ 1 ] := a37hex2char(acv, hexpos);
                var_index        := a_ap_tree^[ tree_index ].n_lo_level;
                hexpos           := a_ap_tree^[ var_index ].n_pos;
                td_external[ 1 ] := a37hex2char(acv, hexpos);
                (*== check hex values =========================*)
                IF  a_return_segm^.sp1r_returncode = 0
                THEN
                    BEGIN
                    IF  basic_code = a01kw[cak_i_ascii]
                    THEN (* ascii character set *)
                        BEGIN
                        IF  (td_internal[ 1 ] in ascii_set) OR
                            (td_external[ 1 ] in ascii_set)
                        THEN
                            a07_b_put_error (acv,
                                  e_hex0_column_tail,
                                  a_ap_tree^[ tree_index ].n_pos);
                        (*ENDIF*) 
                        END
                    ELSE (* ebcdic character set *)
                        BEGIN
                        IF  (td_internal[ 1 ] in ebcdic_set) OR
                            (td_external[ 1 ] in ebcdic_set)
                        THEN
                            a07_b_put_error (acv,
                                  e_hex0_column_tail,
                                  a_ap_tree^[ tree_index ].n_pos);
                        (*ENDIF*) 
                        END;
                    (*ENDIF*) 
                    FOR j := 1 TO value_cnt DO
                        IF  (td_internal[ 1 ] =
                            descriptions[ j ].td_internal[ 1 ]) OR
                            (td_external[ 1 ] =
                            descriptions[ j ].td_external[ 1 ])
                        THEN
                            a07_b_put_error (acv, e_duplicate_value,
                                  a_ap_tree^[ tree_index ].n_pos);
                        (*ENDIF*) 
                    (*ENDFOR*) 
                    td_comment := bsp_c8;
                    IF  a_ap_tree^[ var_index ].n_lo_level <> 0
                    THEN (* comment specified *)
                        WITH a_ap_tree^[
                             a_ap_tree^[ var_index ].n_lo_level ] DO
                            g10mv2 ('VAK37 ',   3,    
                                  a_cmd_part^.sp1p_buf_size,
                                  sizeof(td_comment),
                                  a_cmd_part^.sp1p_buf, n_pos,
                                  td_comment, 1, n_length,
                                  a_return_segm^.sp1r_returncode);
                        (*ENDWITH*) 
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
                value_cnt := i;
                END
            ELSE
                BEGIN
                td_internal[ 1 ] := bsp_c1;
                td_external[ 1 ] := bsp_c1;
                td_comment       := bsp_c8;
                END;
            (*ENDIF*) 
            i := succ(i);
            END;
        (*ENDWITH*) 
    (*ENDWHILE*) 
    (*== check if there are less then 8 termchar sets =====*)
    sysk           := a01defaultkey;
    sysk.sentrytyp := cak_etermset;
    sysk.skeylen   := mxgg_surrogate + 2;
    set_cnt        := 0;
    REPEAT
        a10next_sysinfo (acv, sysk, mxgg_surrogate+2, d_release,
              cak_etermset, a_ptr1, b_err);
        IF  b_err = e_ok
        THEN
            WITH a_ptr1^, stermset DO
                BEGIN
                IF  (setname = term_name)
                    AND
                    (indicator = cak_x_create_termset)
                THEN
                    a07_b_put_error (acv, e_duplicate_name, 1)
                ELSE
                    IF  term_valid
                        AND
                        activate
                    THEN (* termset is valid for current serverdb *)
                        set_cnt := set_cnt + 1
                    (*ENDIF*) 
                (*ENDIF*) 
                END;
            (*ENDWITH*) 
        (*ENDIF*) 
    UNTIL
        (b_err       <> e_ok) OR
        (a_return_segm^.sp1r_returncode <> 0)    OR
        (set_cnt     >  cgg_end_termsets - cgg_begin_termsets);
    (*ENDREPEAT*) 
    IF  set_cnt > cgg_end_termsets - cgg_begin_termsets
    THEN (* too many termsets *)
        a07_b_put_error (acv, e_too_many_termsets, 1);
    (*ENDIF*) 
    IF  (a_return_segm^.sp1r_returncode = 0) AND
        (b_err = e_no_next_record)
    THEN (* it is possible to create one more termchar set *)
        BEGIN
        sysk             := a01defaultkey;
        sysk.sentrytyp   := cak_etermset;
        sysk.slinkage    := cak_init_linkage;
        sysk.sidentifier := setname;
        sysk.skeylen     :=
              sizeof (sysk.stableid) + sizeof (sysk.sentrytyp) +
              sizeof (sysk.slinkage) + sizeof (sysk.sidentifier);
        a10_fix_len_get_sysinfo (acv, sysk, d_release,
              sizeof (tgg00_TermsetRecord), 0, a_ptr1, b_err);
        IF  a_return_segm^.sp1r_returncode = 0
        THEN
            IF  (b_err = e_sysinfo_not_found) AND
                (indicator = cak_x_alter_termset)
            THEN
                a07_b_put_error (acv, e_unknown_termset, 1);
            (*ENDIF*) 
        (*ENDIF*) 
        IF  a_return_segm^.sp1r_returncode = 0
        THEN
            WITH  a_ptr1^, stermset DO
                BEGIN
                term_segmentid := cgg_public_segment_id;
                IF  basic_code = a01kw[cak_i_ascii]
                THEN
                    term_code := csp_ascii
                ELSE
                    term_code := csp_ebcdic;
                (*ENDIF*) 
                IF  indicator = cak_x_create_termset
                THEN
                    term_valid := false;
                (*ENDIF*) 
                IF  activate
                THEN
                    term_valid := true
                ELSE
                    term_valid := false;
                (*ENDIF*) 
                term_count := value_cnt;
                FOR i := 1 TO term_count DO
                    term_desc[i] := descriptions[ i ];
                (*ENDFOR*) 
                END;
            (*ENDWITH*) 
        (*ENDIF*) 
        IF  a_return_segm^.sp1r_returncode = 0
        THEN
            BEGIN
            a_ptr1^.b_sl := sizeof (tgg00_TermsetRecord) -
                  sizeof (a_ptr1^.stermset.term_desc) +
                  a_ptr1^.stermset.term_count * sizeof (tgg00_TermDesc);
            a10_add_repl_sysinfo (acv, a_ptr1,
                  (indicator = cak_x_create_termset), b_err);
            IF  b_err <> e_ok
            THEN
                a07_b_put_error (acv, b_err, 1);
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak37mapset (
            VAR acv        : tak_all_command_glob;
            VAR setname    : tsp_knl_identifier;
            VAR tree_index : tsp_int2;
            indicator      : integer);
 
VAR
      b_err       : tgg_basis_error;
      i           : integer;
      j           : integer;
      hexpos      : integer;
      var_index   : tsp_int2;
      sysk        : tgg_sysinfokey;
 
BEGIN
WITH acv DO
    BEGIN
    sysk             := a01defaultkey;
    sysk.sentrytyp   := cak_emapset;
    sysk.slinkage    := cak_init_linkage;
    sysk.sidentifier := setname;
    sysk.skeylen     :=
          sizeof (sysk.stableid) + sizeof (sysk.sentrytyp) +
          sizeof (sysk.slinkage) + sizeof (sysk.sidentifier);
    a10_fix_len_get_sysinfo (acv, sysk, d_release,
          mxak_mapset_rec, 0, a_ptr1, b_err);
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        IF  b_err = e_ok
        THEN
            BEGIN
            IF  indicator = cak_x_create_mapset
            THEN
                a07_b_put_error (acv, e_duplicate_name, 1)
            (*ENDIF*) 
            END
        ELSE
            IF  indicator = cak_x_alter_mapset
            THEN
                a07_b_put_error (acv, e_unknown_mapset, 1);
            (*ENDIF*) 
        (*ENDIF*) 
    (*ENDIF*) 
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        WITH  a_ptr1^, smapset DO
            BEGIN
            map_count := 0;
            CASE a_ap_tree^[tree_index].n_symb OF
                s_ascii :
                    map_code := csp_ascii;
                s_ebcdic :
                    map_code := csp_ebcdic;
                s_unicode :
                    map_code := csp_unicode;
                OTHERWISE :
                    map_code := csp_ascii;
                END;
            (*ENDCASE*) 
            i := 1;
            WHILE  (a_ap_tree^[ tree_index ].n_sa_level <> 0) AND
                  (a_return_segm^.sp1r_returncode = 0) DO
                BEGIN
                tree_index    := a_ap_tree^[ tree_index ].n_sa_level;
                hexpos        := a_ap_tree^[ tree_index ].n_pos;
                map_set [ i ] := a37hex2char(acv, hexpos);
                IF  map_code = csp_unicode
                THEN
                    BEGIN
                    map_set [ i+1 ] := a37hex2char(acv, hexpos + 2 * a01char_size);
                    FOR j := 1 TO map_count DO
                        IF  (map_set[ i   ] = map_set[ j * 6 - 5 ]) AND
                            (map_set[ i+1 ] = map_set[ j * 6 - 4 ])
                        THEN
                            a07_b_put_error (acv, e_duplicate_value,
                                  a_ap_tree^[ tree_index ].n_pos);
                        (*ENDIF*) 
                    (*ENDFOR*) 
                    END
                ELSE
                    FOR j := 1 TO map_count DO
                        IF  map_set[ i ] = map_set[ j * 3 - 2 ]
                        THEN
                            a07_b_put_error (acv, e_duplicate_value,
                                  a_ap_tree^[ tree_index ].n_pos);
                        (*ENDIF*) 
                    (*ENDFOR*) 
                (*ENDIF*) 
                map_count := succ(map_count);
                var_index := a_ap_tree^[ tree_index ].n_lo_level;
                WITH a_ap_tree^[ var_index ] DO
                    BEGIN
                    IF  n_symb = s_byte_string
                    THEN
                        BEGIN
                        IF  map_code = csp_unicode
                        THEN
                            BEGIN
                            map_set [ i + 2 ] := a37hex2char(acv, n_pos);
                            map_set [ i + 3 ] := a37hex2char(acv, n_pos + 2 * a01char_size);
                            IF  n_length = 4
                            THEN
                                BEGIN
                                map_set [ i + 4 ] := csp_unicode_mark;
                                map_set [ i + 5 ] := csp_ascii_blank
                                END
                            ELSE
                                BEGIN
                                map_set [ i + 4 ] := a37hex2char(acv, n_pos + 4 * a01char_size);
                                map_set [ i + 5 ] := a37hex2char(acv, n_pos + 6 * a01char_size);
                                END;
                            (*ENDIF*) 
                            i := i + 6;
                            END
                        ELSE
                            BEGIN
                            map_set [ i + 1 ] := a37hex2char(acv, n_pos);
                            IF  n_length = 4
                            THEN
                                map_set [ i + 2 ] :=
                                      a37hex2char(acv, n_pos + 2 * a01char_size)
                            ELSE
                                IF  map_code = csp_ebcdic
                                THEN
                                    map_set [ i + 2 ] := csp_ebcdic_blank
                                ELSE
                                    map_set [ i + 2 ] := csp_ascii_blank;
                                (*ENDIF*) 
                            (*ENDIF*) 
                            i := i + 3;
                            END
                        (*ENDIF*) 
                        END
                    ELSE
                        BEGIN
                        IF  map_code = csp_unicode
                        THEN
                            BEGIN
                            a05_str_literal_get (acv, var_index, dunicode,
                                  map_set, i+2, 4);
                            i := i + 6
                            END
                        ELSE
                            BEGIN
                            a05_str_literal_get (acv, var_index, dcha,
                                  map_set, i+1, 2);
                            IF  map_code = csp_ebcdic
                            THEN
                                g02pascii_pos_ebcdic (map_set, i+1, map_set, i+1, 2);
                            (*ENDIF*) 
                            i := i + 3;
                            END
                        (*ENDIF*) 
                        END;
                    (*ENDIF*) 
                    END
                (*ENDWITH*) 
                END;
            (*ENDWHILE*) 
            IF  a_return_segm^.sp1r_returncode = 0
            THEN
                BEGIN
                map_segmentid := cgg_public_segment_id;
                IF  map_code = csp_unicode
                THEN
                    a_ptr1^.b_sl  := sizeof (smapset) - sizeof (map_set) +
                          map_count * 6
                ELSE
                    a_ptr1^.b_sl  := sizeof (smapset) - sizeof (map_set) +
                          map_count * 3;
                (*ENDIF*) 
                a10_add_repl_sysinfo (acv, a_ptr1,
                      indicator = cak_x_create_mapset, b_err);
                IF  b_err <> e_ok
                THEN
                    a07_b_put_error (acv, b_err, 1);
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            END;
        (*ENDWITH*) 
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak37alter_create_set (
            VAR acv   : tak_all_command_glob;
            indicator : integer);
 
VAR
      tree_index   : tsp_int2;
      setname      : tsp_knl_identifier;
      moveobj_ptr  : tsp_moveobj_ptr;
 
BEGIN
WITH acv DO
    BEGIN
    IF  a_return_segm^.sp1r_returncode  = 0
    THEN
        BEGIN
        (*== get setname ======================================*)
        tree_index := 2;
        a05identifier_get (acv, tree_index, sizeof (setname), setname);
        (*== get basic code (ASCII/EBCDIC/UNICODE) ============*)
        tree_index := a_ap_tree^[tree_index].n_lo_level;
        IF  (indicator = cak_x_create_termset) OR
            (indicator = cak_x_alter_termset)
        THEN
            ak37termset (acv, setname, tree_index, indicator)
        ELSE
            ak37mapset (acv, setname, tree_index, indicator);
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  a_return_segm^.sp1r_returncode <> 0
    THEN
        a_part_rollback := true;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak37drop_set (
            VAR acv   : tak_all_command_glob;
            indicator : integer);
 
VAR
      b_err      : tgg_basis_error;
      sysk       : tgg_sysinfokey;
      setname    : tsp_knl_identifier;
 
BEGIN
WITH acv DO
    IF  a_return_segm^.sp1r_returncode  = 0
    THEN
        BEGIN
        (*== get set name ======================================*)
        a05identifier_get (acv, 2, sizeof (setname), setname);
        (*== delete from catalog ==============================*)
        sysk             := a01defaultkey;
        IF  indicator = cak_x_drop_termset
        THEN
            sysk.sentrytyp := cak_etermset
        ELSE
            sysk.sentrytyp := cak_emapset;
        (*ENDIF*) 
        sysk.slinkage    := cak_init_linkage;
        sysk.sidentifier := setname;
        sysk.skeylen     :=
              sizeof (sysk.stableid) + sizeof (sysk.sentrytyp) +
              sizeof (sysk.slinkage) + sizeof (sysk.sidentifier);
        a10del_sysinfo (acv, sysk, b_err);
        IF  b_err <> e_ok
        THEN
            IF  b_err = e_sysinfo_not_found
            THEN
                BEGIN
                IF  indicator = cak_x_drop_termset
                THEN
                    a07_b_put_error (acv, e_unknown_termset, 1)
                ELSE
                    a07_b_put_error (acv, e_unknown_mapset, 1);
                (*ENDIF*) 
                END
            ELSE
                a07_b_put_error (acv, b_err, 1);
            (*ENDIF*) 
        (*ENDIF*) 
        END;
    (*ENDIF*) 
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak37char2hex (
            input      : char;
            VAR output : tsp_c2);
 
VAR
      i        : integer;
      dec      : integer;
      hex_byte : ARRAY [ 1..2 ] OF integer;
 
BEGIN
dec           := ord (input);
hex_byte[ 1 ] := dec DIV 16;
hex_byte[ 2 ] := dec MOD 16;
FOR i := 1 TO 2 DO
    IF  hex_byte[ i ] > 9
    THEN
        output [ i ] := chr(ord('A') - 10 + hex_byte[ i ])
    ELSE
        output [ i ] := chr(ord('0') + hex_byte[ i ]);
    (*ENDIF*) 
(*ENDFOR*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a37event_state (
            VAR acv  : tak_all_command_glob;
            VAR a41v : tak40_show_glob);
 
VAR
      curr_event       : integer;
      keywordindex     : integer;
      prioname         : tsp00_Sname;
      curr_event_ident : tsp31_event_ident;
      events           : tsp31_short_event_desc;
 
BEGIN
(* PTS 1104572 E.Z. *)
FOR curr_event_ident := sp31ei_alive TO
      sp31ei_error DO
    BEGIN
    events.sp31sed_ident    := curr_event_ident;
    events.sp31sed_eventcnt := 0;
    events.sp31sed_eventarr[ 1 ].sp31oei_value_1 := MAX_INT4_SP00;
    CASE curr_event_ident OF
        sp31ei_backup_pages :
            BEGIN
            k39GetEvents (events);
            keywordindex := cak_i_backup_pages;
            END;
        sp31ei_db_filling_above_limit,
        sp31ei_db_filling_below_limit:
            BEGIN
            b01get_events (events);
            CASE curr_event_ident OF
                sp31ei_db_filling_above_limit :
                    keywordindex := cak_i_db_above_limit;
                sp31ei_db_filling_below_limit :
                    keywordindex := cak_i_db_below_limit;
                END
            (*ENDCASE*) 
            END;
        sp31ei_log_above_limit :
            BEGIN
            (*++++++++++*)
            keywordindex := cak_i_log_above_limit
            END;
        OTHERWISE
            BEGIN
            END
        END;
    (*ENDCASE*) 
    FOR curr_event := 1 TO events.sp31sed_eventcnt DO
        WITH events.sp31sed_eventarr[ curr_event ] DO
            IF  sp31oei_priority <> sp31ep_nil
            THEN
                BEGIN
                CASE sp31oei_priority OF
                    sp31ep_low :
                        prioname := 'LOW         ';
                    sp31ep_medium :
                        prioname := 'MEDIUM      ';
                    sp31ep_high :
                        prioname := 'HIGH        ';
                    END;
                (*ENDCASE*) 
                a42name_and_val_statistic (acv, a41v, a01kw[ keywordindex ],
                      sp31oei_value_1, prioname);
                END
            (*ENDIF*) 
        (*ENDWITH*) 
    (*ENDFOR*) 
    END
(*ENDFOR*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak37event (
            VAR acv   : tak_all_command_glob;
            indicator : integer);
 
CONST
      c_with_zero = true;
 
VAR
      curr_n             : tsp_int2;
      subproc            : tsp_int2;
      inval              : tsp_int4;
      value              : integer;
      priority           : tsp31_event_prio;
      ei_val             : tsp31_event_ident;
 
      event_text       : RECORD
            CASE boolean OF
                true :
                    (etext : tsp31_event_text);
                false :
                    (word1     : tsp00_C6;
                    eventname : tak_keyword;
                    word2     : tsp00_C14;
                    prioname  : tsp00_C6;
                    word3     : tsp00_C12;
                    word4     : tsp00_C12;
                    cvalue    : tsp00_C12)
                END;
            (*ENDCASE*) 
 
      event_description  : tsp31_event_description;
 
BEGIN
WITH acv DO
    BEGIN
    ei_val := sp31ei_nil;
    priority := sp31ep_nil;
    value := MAX_INT4_SP00;
    inval := MAX_INT4_SP00;
    curr_n  := a_ap_tree^[ 0 ].n_lo_level;
    curr_n  := a_ap_tree^[ curr_n ].n_lo_level;
    subproc := a_ap_tree^[ curr_n ].n_subproc;
    (* PTS 1103402 E.Z. *)
    IF  indicator = cak_x_delete_event
    THEN
        priority := sp31ep_nil
    ELSE
        BEGIN
        curr_n  := a_ap_tree^[ curr_n ].n_sa_level;
        CASE a_ap_tree^[ curr_n ].n_subproc OF
            cak_i_high :
                priority := sp31ep_high;
            cak_i_low :
                priority := sp31ep_low;
            cak_i_medium :
                priority := sp31ep_medium;
            OTHERWISE
                a07_b_put_error (acv, e_invalid_command, 1);
            END;
        (*ENDCASE*) 
        END;
    (*ENDIF*) 
    curr_n := a_ap_tree^[ curr_n ].n_sa_level;
    CASE subproc OF
        cak_i_backup_pages :
            IF  indicator = cak_x_set_event
            THEN
                BEGIN
                WITH a_ap_tree^[ curr_n ] DO
                    a05int4_get (acv, n_pos, n_length, inval);
                (*ENDWITH*) 
                IF  a_return_segm^.sp1r_returncode  = 0
                THEN
                    IF  inval <= 0
                    THEN
                        a07_b_put_error (acv, e_invalid_number_variable, 1)
                    ELSE
                        BEGIN
                        ei_val := sp31ei_backup_pages;
                        k39SetEventBackupPages (a_transinf.tri_trans.trTaskId_gg00, inval)
                        END
                    (*ENDIF*) 
                (*ENDIF*) 
                END
            ELSE
                k39SetEventBackupPages (a_transinf.tri_trans.trTaskId_gg00, 0);
            (*ENDIF*) 
        cak_i_db_above_limit,
        cak_i_db_below_limit :
            BEGIN
            WITH a_ap_tree^[ curr_n ] DO
                a05int4_get (acv, n_pos, n_length, inval);
            (*ENDWITH*) 
            IF  a_return_segm^.sp1r_returncode  = 0
            THEN
                IF  (inval <= 0) OR (inval > 100)
                THEN
                    a07_b_put_error (acv, e_invalid_number_variable, 1)
                ELSE
                    BEGIN
                    value := inval;
                    CASE subproc OF
                        cak_i_db_above_limit :
                            ei_val := sp31ei_db_filling_above_limit;
                        cak_i_db_below_limit :
                            ei_val := sp31ei_db_filling_below_limit;
                        END;
                    (*ENDCASE*) 
                    (* CRS 1103110 AK 20/07/99 *)
                    IF  indicator = cak_x_set_event
                    THEN
                        IF  subproc = cak_i_db_above_limit
                        THEN
                            b01set_event (sp31ei_db_filling_above_limit, value, priority)
                        ELSE
                            b01set_event (sp31ei_db_filling_below_limit, value, priority)
                        (*ENDIF*) 
                    ELSE
                        IF  subproc = cak_i_db_above_limit
                        THEN
                            b01del_event (sp31ei_db_filling_above_limit, value)
                        ELSE
                            b01del_event (sp31ei_db_filling_below_limit, value);
                        (*ENDIF*) 
                    (*ENDIF*) 
                    (* END CRS 1103110 AK 20/07/99 *)
                    END
                (*ENDIF*) 
            (*ENDIF*) 
            END;
        OTHERWISE
            a07_b_put_error (acv, e_invalid_command, 1);
        END;
    (*ENDCASE*) 
    IF  a_return_segm^.sp1r_returncode = 0
    THEN
        BEGIN
        g01event_init (event_description);
        WITH event_description, event_text DO
            BEGIN
            sp31ed_ident      := sp31ei_event;
            sp31ed_value_1    := inval;
            sp31ed_value_2    := ord(priority);
            sp31ed_priority   := sp31ep_low;
            word1     := 'event ';
            eventname := a01kw[subproc];
            word2     := 'with priority ';
            CASE priority OF
                sp31ep_low :
                    prioname := 'LOW   ';
                sp31ep_medium :
                    prioname := 'MEDIUM';
                sp31ep_high :
                    prioname := 'HIGH  ';
                sp31ep_nil :
                    BEGIN
                    prioname := '      ';
                    word2     := '              ';
                    END;
                END;
            (*ENDCASE*) 
            IF  indicator = cak_x_set_event
            THEN
                word3 := ' was set    '
            ELSE
                word3 := ' was deleted';
            (*ENDIF*) 
            sp31ed_text_len := sizeof (word1) + sizeof (eventname)
                  + sizeof (word2) + sizeof (prioname) + sizeof (word3);
            IF  inval <> MAX_INT4_SP00
            THEN
                BEGIN
                word4 := ' with value ';
                cvalue := bsp_c12;
                g17int4to_line (inval, NOT c_with_zero, 10, 1, cvalue);
                sp31ed_text_len := sp31ed_text_len + sizeof (word4) + sizeof(cvalue);
                END;
            (*ENDIF*) 
            g10mv4 ('VAK37 ',   4,    
                  sizeof(etext), sizeof(sp31ed_text_value),
                  etext, 1, sp31ed_text_value, 1,
                  sp31ed_text_len, acv.a_return_segm^.sp1r_returncode);
            END;
        (*ENDWITH*) 
        vinsert_event (event_description)
        END;
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak37get_set (
            VAR acv   : tak_all_command_glob;
            indicator : integer);
 
VAR
      aux         : tsp_c1;
      i           : integer;
      j           : integer;
      b_err       : tgg_basis_error;
      hex         : tsp_c2;
      basic_code  : tsp_c18;
      setname     : tsp_knl_identifier;
      sysk        : tgg_sysinfokey;
 
BEGIN
WITH acv DO
    IF  a_return_segm^.sp1r_returncode  = 0
    THEN
        BEGIN
        sysk             := a01defaultkey;
        IF  indicator = cak_x_get_termset
        THEN
            sysk.sentrytyp := cak_etermset
        ELSE
            sysk.sentrytyp := cak_emapset;
        (*ENDIF*) 
        (*== get set name ======================================*)
        a05identifier_get (acv, 2, sizeof (setname), setname);
        (*== get record from catalog ==========================*)
        sysk.slinkage    := cak_init_linkage;
        sysk.sidentifier := setname;
        sysk.skeylen     :=
              sizeof (sysk.stableid) + sizeof (sysk.sentrytyp) +
              sizeof (sysk.slinkage) + sizeof (sysk.sidentifier);
        a10get_sysinfo (acv, sysk, d_release, a_ptr1, b_err);
        IF  b_err <> e_ok
        THEN
            IF  b_err = e_sysinfo_not_found
            THEN
                BEGIN
                IF  indicator = cak_x_get_termset
                THEN
                    a07_b_put_error (acv, e_unknown_termset, 1)
                ELSE
                    a07_b_put_error (acv, e_unknown_mapset, 1);
                (*ENDIF*) 
                END
            ELSE
                a07_b_put_error (acv, b_err, 1)
            (*ENDIF*) 
        ELSE (* set_rec found *)
            BEGIN
            IF  indicator = cak_x_get_termset
            THEN
                WITH a_ptr1^, stermset DO
                    BEGIN
                    IF  term_code = csp_ascii
                    THEN
                        basic_code := 'ASCII             '
                    ELSE
                        IF  term_code = csp_ebcdic
                        THEN
                            basic_code := 'EBCDIC            '
                        ELSE
                            a07ak_system_error (acv, 37, 1);
                        (*ENDIF*) 
                    (*ENDIF*) 
                    (*== put basic code ==================*)
                    a06char_retpart_move (acv,
                          @basic_code, sizeof (basic_code));
                    (*== put activate ====================*)
                    IF  term_valid
                    THEN
                        aux[1] := 'Y'
                    ELSE
                        aux[1] := 'N';
                    (*ENDIF*) 
                    a06char_retpart_move (acv, @aux[1], 1);
                    (*== put hex values and comments =====*)
                    FOR i := 1 TO cgg_termset_entries DO
                        IF  i <= term_count
                        THEN
                            WITH term_desc[ i ] DO
                                BEGIN
                                ak37char2hex (td_internal[ 1 ], hex);
                                a06char_retpart_move (acv, @hex[1], 2);
                                ak37char2hex (td_external[ 1 ], hex);
                                a06char_retpart_move (acv, @hex[1], 2);
                                a06char_retpart_move (acv, @td_comment,
                                      sizeof (td_comment));
                                END
                            (*ENDWITH*) 
                        ELSE
                            BEGIN
                            a06char_retpart_move (acv,
                                  @a01_il_b_identifier, 12)
                            END;
                        (*ENDIF*) 
                    (*ENDFOR*) 
                    END
                (*ENDWITH*) 
            ELSE (* map set *)
                WITH a_ptr1^, smapset DO
                    BEGIN
                    IF  map_code = csp_ascii
                    THEN
                        basic_code := 'ASCII             '
                    ELSE
                        IF  map_code = csp_ebcdic
                        THEN
                            basic_code := 'EBCDIC            '
                        ELSE
                            a07ak_system_error (acv, 37, 2);
                        (*ENDIF*) 
                    (*ENDIF*) 
                    (*== put basic code  ==================*)
                    a06char_retpart_move (acv,
                          @basic_code, sizeof (basic_code));
                    (*== put values ======================*)
                    j         := 1;
                    FOR i := 1 TO cgg_mapset_entries DO
                        IF  i <= map_count
                        THEN
                            BEGIN
                            (*== internal hex value ===============*)
                            ak37char2hex (map_set[ j ], hex);
                            a06char_retpart_move (acv, @hex[1], 2);
                            (*== external character ===============*)
                            a06char_retpart_move (acv,
                                  @map_set [ j+1 ], 1);
                            a06char_retpart_move (acv,
                                  @map_set [ j+2 ], 1);
                            (*== external hex values ==============*)
                            ak37char2hex (map_set [ j+1 ], hex);
                            a06char_retpart_move (acv, @hex[1], 2);
                            ak37char2hex (map_set [ j+2 ], hex);
                            a06char_retpart_move (acv, @hex[1], 2);
                            j := j + 3
                            END
                        ELSE
                            BEGIN
                            a06char_retpart_move (acv,
                                  @a01_il_b_identifier, 8)
                            END;
                        (*ENDIF*) 
                    (*ENDFOR*) 
                    END;
                (*ENDWITH*) 
            (*ENDIF*) 
            a06finish_curr_retpart (acv, sp1pk_data, 1);
            END;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
(*ENDWITH*) 
END;
 
(* PTS 1111229 E.Z. *)
(*------------------------------*) 
 
PROCEDURE
      ak37prepare_standby (VAR acv : tak_all_command_glob);
 
VAR
      moveobj_ptr : tsp_moveobj_ptr;
      new_standby : tsp_nodeid;
 
BEGIN
WITH acv DO
    BEGIN
    IF  a_return_segm^.sp1r_returncode  = 0
    THEN
        BEGIN
        moveobj_ptr := @new_standby;
        a05string_literal_get (acv,
              a_ap_tree^[a_ap_tree^[0].n_lo_level].n_sa_level, dcha,
              moveobj_ptr^, 1, sizeof(new_standby));
        END;
    (*ENDIF*) 
    IF  a_return_segm^.sp1r_returncode  = 0
    THEN
        BEGIN
        (* RTEHSS_InfoRequest (new_standby);*)
        (* trigger a savepoint *)
        kb560StartSavepoint (a_transinf.tri_trans, mm_standby);
        (* RTEHSS_Split (new_standby);*)
        END
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak37register_standby (VAR acv : tak_all_command_glob);
 
VAR
      moveobj_ptr : tsp_moveobj_ptr;
      new_standby : tsp_nodeid;
      curr_n      : tsp_int2;
 
      logpos : RECORD
            CASE boolean OF
                true :
                    (c4 : tsp00_C4);
                false :
                    (i4 : tsp_int4);
                END;
            (*ENDCASE*) 
 
      i           : integer;
      shortinfo   : tak_shortinforecord;
      pos         : tsp_int4;
      name        : tsp00_C18;
      c           : tsp_c1;
 
BEGIN
WITH acv DO
    BEGIN
    IF  a_return_segm^.sp1r_returncode  = 0
    THEN
        BEGIN
        moveobj_ptr := @new_standby;
        curr_n := a_ap_tree^[a_ap_tree^[0].n_lo_level].n_sa_level;
        a05string_literal_get (acv,
              curr_n, dcha, moveobj_ptr^, 1, sizeof(new_standby));
        END;
    (*ENDIF*) 
    IF  a_return_segm^.sp1r_returncode  = 0
    THEN
        BEGIN
        curr_n := a_ap_tree^[curr_n].n_sa_level;
        WITH a_ap_tree^[curr_n] DO
            BEGIN
            (* n_symb = s_byte_string *)
            IF  n_length <> 8 * a01char_size
            THEN
                a07_b_put_error (acv, e_missing_string_literal, n_pos)
            ELSE
                BEGIN
                IF  g01unicode
                THEN
                    FOR i := 1 TO 4 DO
                        IF  acv.a_cmd_part^.sp1p_buf[ n_pos + (i - 1) * a01char_size ] <> csp_unicode_mark
                        THEN
                            a07_b_put_error (acv, e_missing_string_literal, n_pos);
                        (*ENDIF*) 
                    (*ENDFOR*) 
                (*ENDIF*) 
                FOR i := 1 TO 4 DO
                    logpos.c4[i] := a37hex2char(acv, n_pos + (i - 1) * a01char_size);
                (*ENDFOR*) 
                END
            (*ENDIF*) 
            END
        (*ENDWITH*) 
        END;
    (*ENDIF*) 
    IF  a_return_segm^.sp1r_returncode  = 0
    THEN
        BEGIN
        (* tja, und was ruf ich nu und was schick ich zurck ?   *)
        (* avoid differences *punix prepared on Windows to *prot *)
        (* on not-swapped machine                                *)
        IF  g01code.kernel_swap = sw_full_swapped
        THEN
            logpos.i4 := 1953720653
        ELSE
            logpos.i4 := 1298756468;
        (*ENDIF*) 
        pos := 1;
        name := 'LOGPOS            ';
        (* PTS 1113268 E.Z. *)
        a06colname_retpart_move (acv, @name, 6, csp_ascii);
        WITH shortinfo.siinfo[1] DO
            BEGIN
            sp1i_mode       := [ sp1ot_mandatory ];
            sp1i_io_type    := sp1io_output;
            sp1i_data_type  := dchb;
            sp1i_frac       := 0;
            sp1i_length     := 4;
            sp1i_in_out_len := succ(sp1i_length);
            sp1i_bufpos     := pos;
            pos             := pos + sp1i_in_out_len
            END;
        (*ENDWITH*) 
        a06finish_curr_retpart (acv, sp1pk_columnnames, 1);
        shortinfo.sicount := 1;
        a06retpart_move (acv, @shortinfo.siinfo,
              shortinfo.sicount * sizeof (shortinfo.siinfo[1]));
        a06finish_curr_retpart (acv, sp1pk_shortinfo, shortinfo.sicount);
        c[1] := csp_defined_byte;
        a06retpart_move (acv, @c[1], 1);
        a06retpart_move (acv, @logpos.i4, sizeof(logpos.i4));
        a06finish_curr_retpart (acv, sp1pk_data, 1)
        END
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak37get_config (VAR acv : tak_all_command_glob);
 
VAR
      mess_double_buf : tgg_double_buf;
 
BEGIN
ak37get_config2 (acv, mess_double_buf)
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak37get_config2 (
            VAR acv            : tak_all_command_glob;
            mess_double_buf    : tgg_double_buf);
 
VAR
      b_err         : tgg_basis_error;
      aux_data_size : tsp_int4;
      aux_data_ptr  : tgg_datapart_ptr;
 
BEGIN
WITH acv DO
    BEGIN
    a37init_util_record (acv, m_get, mm_config);
    aux_data_ptr            := a_mblock.mb_data;
    aux_data_size           := a_mblock.mb_data_size;
    a_mblock.mb_data      := @mess_double_buf;
    a_mblock.mb_data_size := sizeof (mess_double_buf);
    a06lsend_mess_buf (acv, a_mblock,
          NOT cak_call_from_rsend, b_err);
    IF  b_err <> e_ok
    THEN
        a07_b_put_error (acv, b_err, 1)
    ELSE
        BEGIN
        a06char_retpart_move (acv, @a_mblock.mb_data^.mbp_buf,
              a_mblock.mb_data_len);
        a06finish_curr_retpart (acv, sp1pk_data, 1)
        END;
    (*ENDIF*) 
    a_mblock.mb_data      := aux_data_ptr;
    a_mblock.mb_data_size := aux_data_size
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a37_call_semantic (
            VAR acv               : tak_all_command_glob;
            VAR util_cmd_id       : tgg00_UtilCmdId);
 
VAR
      commit          : boolean;
      create_serverdb : boolean;
      diag_kind       : tgg_diag_type;
      i               : integer;
      dbname          : tsp_dbname;
      a30v            : tak_a30_utility_glob;
 
BEGIN
WITH acv, a_mblock, a30v, a_ap_tree^[ a_ap_tree^[ 0 ].n_lo_level ]  DO
    IF  a_return_segm^.sp1r_returncode  = 0
    THEN
        BEGIN
        a_drop_serverdb_ptr := NIL;
        commit              := NOT (n_proc in [a36, a37]) OR
              (n_subproc in
              [cak_x_alter_mapset,
              cak_x_alter_termset,
              cak_x_alter_serverdb,
              cak_x_create_mapset,
              cak_x_create_termset,
              cak_x_drop_mapset,
              cak_x_drop_termset,
              cak_x_create_serverdb]);
        create_serverdb     := false;
        a3ti                := 1;
        IF  (a_is_ddl <> no_ddl)              AND
            (a_is_ddl <> ddl_create_serverdb)
        THEN (* create file for show data for domain *)
            a38create_parameter_file (acv);
        (*ENDIF*) 
        CASE n_subproc OF
            cak_x_alter_mapset,    cak_x_create_mapset,
            cak_x_drop_mapset,     cak_x_get_mapset,
            cak_x_alter_termset,   cak_x_create_termset,
            cak_x_drop_termset,    cak_x_get_termset,
            cak_x_get_config,
            cak_x_create_serverdb,
            cak_x_alter_serverdb,
            cak_x_set_nolog_off,
            cak_x_add_devspace,          (* PTS 1115982 E.Z. *)
            cak_x_init_after_load,
            (* PTS 1111229 E.Z. *)
            cak_x_prepare_standby,
            cak_x_register_standby,
            (* PTS 1120105 E.Z. *)
            cak_x_auto_overwrite_on,
            cak_x_auto_overwrite_off :
                IF  ((a_current_user_kind <> usysdba) OR
                    ( a_current_auth_site  <> g01localsite))
                    AND
                    (a_current_user_kind <> ucontroluser)
                THEN
                    a07_b_put_error (acv, e_missing_privilege, 1);
                (* PTS 1111289 E.Z. *)
                (*ENDIF*) 
            cak_x_shutdown,
            cak_x_on_diag_parse,   cak_x_off_diag_parse,
            cak_x_autosave,        cak_x_force_checkpoint :
                IF  ((a_current_user_kind = unoprivate) OR
                    (a_current_user_kind  = uprivate))
                    AND
                    (a_current_user_kind <> ucontroluser)
                THEN
                    a07_b_put_error (acv, e_missing_privilege, 1);
                (*ENDIF*) 
            cak_x_save_log_cold, cak_x_save_log,
            cak_x_save_database, cak_x_save_pages,
            (* PTS 1115978 E.Z. *)
            cak_x_vtrace_on, cak_x_vtrace_off, cak_x_diag_dump,
            cak_x_commit_trans,
            cak_x_rollback_trans  , cak_x_verify :
                IF  (a_current_user_kind = unoprivate) OR
                    (a_current_user_kind = uprivate)
                THEN
                    a07_b_put_error (acv, e_missing_privilege, 1);
                (*ENDIF*) 
            OTHERWISE
            END;
        (*ENDCASE*) 
        a_part_rollback := false;
        IF  (a_return_segm^.sp1r_returncode = 0) AND
            (n_proc in [ a36, a37 ])
        THEN
            CASE n_subproc OF
                cak_x_add_devspace :
                    ak37add_devspace (acv, n_length = cak_i_log);
                cak_x_autosave :
                    ak37autosave (acv);
                cak_x_alter_mapset :
                    ak37alter_create_set (acv, cak_x_alter_mapset);
                cak_x_alter_termset :
                    ak37alter_create_set (acv, cak_x_alter_termset);
                cak_x_alter_serverdb :
                    a31alter_serverdb (acv);
                cak_x_create_mapset :
                    ak37alter_create_set (acv, cak_x_create_mapset);
                cak_x_create_termset :
                    ak37alter_create_set (acv, cak_x_create_termset);
                cak_x_delete_event :
                    ak37event (acv, cak_x_delete_event);
                cak_x_drop_mapset :
                    ak37drop_set (acv, cak_x_drop_mapset);
                cak_x_drop_termset :
                    ak37drop_set (acv, cak_x_drop_termset);
                cak_x_force_checkpoint :
                    ak37send_messbuffer (acv,
                          m_shutdown, mm_checkpoint);
                cak_x_get_mapset :
                    ak37get_set (acv, cak_x_get_mapset);
                cak_x_get_termset :
                    ak37get_set (acv, cak_x_get_termset);
                cak_x_get_config :
                    ak37get_config (acv);
                cak_x_init_after_load :
                    a36after_systable_load(acv);
                cak_x_create_serverdb :
                    BEGIN
                    create_serverdb := true;
                    a31create_serverdb (acv, dbname)
                    END;
                cak_x_save_log, cak_x_save_log_cold,
                cak_x_save_database, cak_x_save_pages :
                    BEGIN
&                   ifdef trace
                    t01int4 (ak_sem, 'n_length    ', n_length);
&                   endif
                    IF  (n_length = cak_i_ignore) OR
                        (n_length = cak_i_cancel) OR
                        (n_length = cak_i_replace)
                    THEN
                        ak37user_save_reaction (acv, a30v, n_length)
                    ELSE
                        ak37save (acv, a30v, util_cmd_id);
                    (*ENDIF*) 
                    END;
                cak_x_connect :
                    BEGIN
                    a_ap_tree^[ a_ap_tree^[ 0 ].n_lo_level ] := a_ap_tree^[ 2 ];
                    a51_connect (acv, true);
                    a_sqlmode := sqlm_adabas
                    END;
                cak_x_util_commit :
                    BEGIN
                    a_ap_tree^[ a_ap_tree^[ 0 ].n_lo_level ] := a_ap_tree^[ 2 ];
                    a52_call_semantik (acv, 1);
                    END;
                cak_x_util_rollback :
                    BEGIN
                    a_ap_tree^[ a_ap_tree^[ 0 ].n_lo_level ].n_lo_level :=
                          a_ap_tree^[ 2 ].n_lo_level;
                    a52_call_semantik (acv, 2);
                    END;
                (* PTS 1115982 E.Z. *)
                (* PTS 1111289 E.Z. *)
                cak_x_shutdown :
                    BEGIN
                    ak37send_messbuffer (acv, m_commit, mm_nil);
                    ak37send_messbuffer (acv, m_shutdown, mm_nil);
                    IF  a_return_segm^.sp1r_returncode = 0 (* PTS 1106544 *)
                    THEN
                        BEGIN
                        ak341Shutdown;
                        a_transinf.tri_trans.trBdTcachePtr_gg00 := NIL
                        END;
                    (*ENDIF*) 
                    END;
                cak_x_read_label :
                    ak37read_label (acv);
                cak_x_tab_on_write, cak_x_tab_off_write :
                    ak37table_set_write_on_off (acv,
                          n_subproc = cak_x_tab_on_write);
                cak_x_set_nolog_off :
                    ak37send_messbuffer (acv, m_set, mm_end_read_only);
                (* PTS 1120105 E.Z. *)
                (* PTS 1111229 E.Z. *)
                cak_x_prepare_standby :
                    ak37prepare_standby (acv);
                cak_x_register_standby :
                    ak37register_standby (acv);
                (* PTS 1115978 E.Z. *)
                cak_x_vtrace_on, cak_x_vtrace_off :
                    a37vtrace (acv);
                cak_x_diag_index :
                    ak37diagnose_index (acv);
                cak_x_diag_dump :
                    ak37dump (acv);
                cak_x_on_diag_parse :
                    BEGIN
                    a01diag_moni_parseid := true;
                    a37ddl (acv, create_sys_parsid);
                    END;
                cak_x_off_diag_parse :
                    BEGIN
                    IF  NOT a01diag_monitor_on
                    THEN
                        g01diag_moni_parse_on := false;
                    (*ENDIF*) 
                    a01diag_moni_parseid := false
                    END;
                cak_x_monitor :
                    ak37diag_monitor (acv);
                cak_x_diagnose_analyze :
                    a544semantik_diag_analyze (acv);
                cak_x_diagnose :
                    BEGIN
                    diag_kind := diagNil_egg00;
                    FOR i := 1 TO a_ap_tree^[ a_ap_tree^[ 0 ].n_lo_level ].n_length DO
                        diag_kind := succ(diag_kind);
                    (*ENDFOR*) 
                    CASE diag_kind OF
                        diagTabIdGet_egg00 :
                            ak37determine_tabid (acv);
                        diagUserIdGet_egg00 :
                            ak37determine_userid (acv);
                        diagTabNameGet_egg00 :
                            ak37inquire_tablename (acv);
                        diagUserNameGet_egg00 :
                            ak37inquire_username (acv);
                        diagPages_egg00, diagRestart_egg00, diagLoginfoPage_egg00:
                            ak37get_data_page (acv, diag_kind);
                        OTHERWISE
                            a07_b_put_error (acv, e_invalid_command, 1);
                        END;
                    (*ENDCASE*) 
                    END;
                cak_x_set_event :
                    ak37event (acv, cak_x_set_event);
                cak_x_timeout_on :
                    a_use_timeout := true;
                cak_x_timeout_off :
                    a_use_timeout := false;
                (* PTS 1115978 E.Z. *)
&               ifdef NOTUSED
                cak_x_updstat_on :
                    a01sys_upd_stat_on := true;
                cak_x_updstat_off :
                    a01sys_upd_stat_on := false;
&               endif
                cak_x_verify :
                    ak37verify (acv);
                cak_x_set_parameter :
                    ak37set_parameter (acv);
                (* PTS 1108247 E.Z. *)
                cak_x_delete_log_from_to :
                    ak37delete_log_from_to (acv);
&               ifdef TRACE
                cak_x_switch :
                    ak37switch_semantic (acv);
&               endif
                (* PTS 1120105 E.Z. *)
                cak_x_auto_overwrite_on,
                cak_x_auto_overwrite_off :
                    kb560SetLogAutoOverwrite (acv.a_transinf.tri_trans.trTaskId_gg00,
                          (a94mode = umUtility_egg00),
                          (n_subproc = cak_x_auto_overwrite_on));
                cak_i_suspend :
                    ak37suspend_semantic (acv);
                cak_i_resume :
                    k560ResumeLogWriterByUser;
                OTHERWISE
                    a07_b_put_error (acv, e_invalid_command, 1);
                END
            (*ENDCASE*) 
        ELSE
            BEGIN
            IF  (n_proc = a21) AND (a_current_user_kind = usuperdba)
            THEN (* alter password of system user *)
                a21_call_semantic (acv)
            ELSE
                a07_b_put_error (acv, e_invalid_command, 1)
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        IF  a_is_ddl <> no_ddl
        THEN
            BEGIN
            a_is_ddl := no_ddl
            END;
        (*ENDIF*) 
        IF  commit AND (a_return_segm^.sp1r_returncode = 0)
        THEN
            BEGIN
            a52_ex_commit_rollback (acv, m_commit, false, false);
            IF  (a_return_segm^.sp1r_returncode = 0) AND
                create_serverdb AND g01stand_alone
            THEN
                g01stand_alone := false
            (*ENDIF*) 
            END
        (*ENDIF*) 
        END;
    (*ENDIF*) 
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a37user_command (VAR acv : tak_all_command_glob);
 
VAR
      b_err : tgg_basis_error;
 
BEGIN
CASE acv.a_ap_tree^[acv.a_ap_tree^[ 0 ].n_lo_level].n_subproc OF
    cak_i_restart :
        IF  (acv.a_current_user_kind = unoprivate) OR
            (acv.a_current_user_kind = uprivate)
        THEN
            a07_b_put_error (acv, e_missing_privilege, 1)
        ELSE
            ak37send_messbuffer (acv, m_restart, mm_index);
        (*ENDIF*) 
    cak_x_save_database :
        WITH acv DO
            BEGIN
            a37init_util_record (acv, m_save, mm_database);
            ak37init_save_restore_input_param (a_mblock.mb_qual^.msave_restore);
            a_mblock.mb_struct   := mbs_save_restore;
            a_mblock.mb_qual_len :=
                  sizeof (a_mblock.mb_qual^.msave_restore);
            a_mblock.mb_data_len := 0;
            WITH a_mblock.mb_qual^.msave_restore DO
                BEGIN
                sripHostTapeNum_gg00 := 1;
                sripHostTapecount_gg00 [sripHostTapeNum_gg00] := 0;
                sripHostFiletypes_gg00 [sripHostTapeNum_gg00] := vf_t_pipe;
                a36filename (acv, 2,
                      sripHostTapenames_gg00 [sripHostTapeNum_gg00],
                      sizeof(sripHostTapenames_gg00 [sripHostTapeNum_gg00]))
                END;
            (*ENDWITH*) 
            a06lsend_mess_buf (acv, a_mblock,
                  NOT cak_call_from_rsend, b_err);
            IF  b_err <> e_ok
            THEN
                a07_b_put_error (acv, b_err, 1);
            (*ENDIF*) 
            END;
        (*ENDWITH*) 
    cak_x_diagnose_analyze :
        a544semantik_diag_analyze (acv);
&   ifdef TRACE
    cak_x_switch :
        ak37switch_semantic (acv);
&   endif
    cak_x_vtrace_on, cak_x_vtrace_off :
        a37vtrace (acv);
    cak_x_set_parameter :
        ak37set_parameter(acv);
    OTHERWISE
        ak37diag_monitor (acv);
    END;
(*ENDCASE*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a37utilprot_needed (
            VAR acv           : tak_all_command_glob;
            VAR prot_needed   : boolean;
            VAR with_tapeinfo : boolean);
 
BEGIN
WITH acv.a_ap_tree^[ acv.a_ap_tree^[ 0 ].n_lo_level ] DO
    BEGIN
    prot_needed := ((n_proc in [ a36, a37 ]) AND (n_subproc in [
          cak_x_add_devspace,
          cak_x_alter_serverdb,
          cak_x_force_checkpoint,
          cak_x_create_serverdb,
          cak_x_save_log,
          cak_x_save_log_cold,
          cak_x_save_database,
          cak_x_save_pages,
          (* PTS 1115982 E.Z. *)
          cak_x_shutdown,           (* PTS 1111289 E.Z. *)
          cak_x_delete_log_from_to, (* PTS 1108247 E.Z. *)
          cak_x_prepare_standby,    (* PTS 1111229 E.Z. *)
          cak_x_verify,
          cak_x_auto_overwrite_on,  (* PTS 1120105 E.Z. *)
          cak_x_auto_overwrite_off  (* PTS 1120105 E.Z. *)
          ]))
          OR
          ((n_proc    = a37) AND
          ( n_subproc = cak_x_autosave) AND
          ( n_length <> cak_i_show));
    with_tapeinfo := prot_needed AND (n_subproc in [
          (* PTS 1000360 UH *)
          (* PTS 1000360 UH *)
          (* PTS 1000360 UH *)
          cak_x_save_database,
          cak_x_save_pages
          ])
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a37blocksize (
            VAR acv  : tak_all_command_glob;
            VAR a30v : tak_a30_utility_glob);
 
VAR
      ti        : integer;
      blocksize : tsp_int4;
 
BEGIN
WITH acv, a30v DO
    BEGIN
&   ifdef TRACE
    t01int4 (ak_sem, 'a3ti=       ', a3ti);
&   endif
    blocksize := 1;
    IF  (a3ti <> 0) AND (a_ap_tree^[ a3ti ].n_proc = a37)
        AND (a_ap_tree^[ a3ti ].n_subproc = cak_i_blocksize)
    THEN
        BEGIN
        ti   := a_ap_tree^[ a3ti ].n_lo_level;
        a05_int4_unsigned_get (acv, a_ap_tree^[ ti ].n_pos,
              a_ap_tree^[ ti ].n_length, blocksize);
        a3ti := a_ap_tree^[ a3ti ].n_sa_level;
        IF  blocksize <= 0
        THEN
            a07_b_put_error (acv, e_invalid_blocksize, 1)
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    a_mblock.mb_qual^.mut_pool_size := blocksize
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a37put_count_to_messbuf (
            VAR acv   : tak_all_command_glob;
            VAR a30v  : tak_a30_utility_glob);
 
VAR
      ti      : integer;
 
BEGIN
WITH acv, a30v DO
    BEGIN
&   ifdef TRACE
    t01int4 (ak_sem, 'a3ti=       ', a3ti);
&   endif
    IF  (a3ti <> 0) AND (a_ap_tree^[ a3ti ].n_proc = a37)
        AND (a_ap_tree^[ a3ti ].n_subproc = cak_i_count)
    THEN
        BEGIN
        ti   := a_ap_tree^[ a3ti ].n_lo_level;
        a05_int4_unsigned_get (acv, a_ap_tree^[ ti ].n_pos,
              a_ap_tree^[ ti ].n_length, a_mblock.mb_qual^.mut_count);
        a3ti := a_ap_tree^[ a3ti ].n_sa_level
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a37get_count_int4 (
            VAR acv   : tak_all_command_glob;
            VAR a30v  : tak_a30_utility_glob;
            VAR i4    : tsp_int4);
 
VAR
      ti      : integer;
 
BEGIN
WITH acv, a30v DO
    BEGIN
    i4 := csp_maxint4;
&   ifdef TRACE
    t01int4 (ak_sem, 'a3ti=       ', a3ti);
&   endif
    IF  (a3ti <> 0) AND (a_ap_tree^[ a3ti ].n_proc = a37)
        AND (a_ap_tree^[ a3ti ].n_subproc = cak_i_count)
    THEN
        BEGIN
        ti   := a_ap_tree^[ a3ti ].n_lo_level;
        a05_int4_unsigned_get (acv, a_ap_tree^[ ti ].n_pos,
              a_ap_tree^[ ti ].n_length, i4);
        a3ti := a_ap_tree^[ a3ti ].n_sa_level
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a37state_get (
            VAR acv  : tak_all_command_glob;
            kw_index : integer);
 
VAR
      res_kw    : boolean;
      dt_format : tgg_datetimeformat;
 
BEGIN
dt_format := acv.a_dt_format;
IF  acv.a_cmd_part <> NIL
THEN
    BEGIN
    a01_next_symbol (acv);
    IF  acv.a_scv.sc_symb <> s_eof
    THEN
        IF  a01mandatory_keyword (acv, cak_i_format)
        THEN
            BEGIN
            a01_get_keyword (acv, kw_index, res_kw);
            CASE kw_index OF
                cak_i_normal :
                    acv.a_dt_format := dtf_normal;
                cak_i_iso    :
                    acv.a_dt_format := dtf_iso;
                cak_i_usa    :
                    acv.a_dt_format := dtf_usa;
                cak_i_eur    :
                    acv.a_dt_format := dtf_eur;
                cak_i_jis    :
                    acv.a_dt_format := dtf_jis;
                (* PTS 1112472 E.Z. *)
                OTHERWISE ;
                END;
            (*ENDCASE*) 
            END;
        (*ENDIF*) 
    (*ENDIF*) 
    END;
(*ENDIF*) 
a06init_curr_retpart (acv);
IF  acv.a_curr_retpart <> NIL
THEN
    a37multi_tape_info (acv, kw_index);
(*ENDIF*) 
acv.a_dt_format := dt_format
END;
 
(*------------------------------*) 
 
PROCEDURE
      a37state_vtrace (VAR acv : tak_all_command_glob);
 
CONST
      c_vtrace_columns = 23;
 
TYPE
 
      tname_info = RECORD
            CASE boolean OF
                true :
                    (len  : char);
                false :
                    (name : tsp_c16);
                END;
            (*ENDCASE*) 
 
 
VAR
      ix         : integer;
      pos        : integer;
      on_off     : ARRAY[boolean] OF tsp_c4;
      shortinfo  : tak_shortinforecord;
      colnames   : ARRAY[1..c_vtrace_columns] OF tname_info;
 
BEGIN
colnames[1 ].name := ' AK             ';
colnames[1 ].len  := chr(2);
colnames[2 ].name := ' DELETE         ';
colnames[2 ].len  := chr(6);
colnames[3 ].name := ' INSERT         ';
colnames[3 ].len  := chr(6);
colnames[4 ].name := ' ORDER          ';
colnames[4 ].len  := chr(5);
colnames[5 ].name := ' SELECT         ';
colnames[5 ].len  := chr(6);
colnames[6 ].name := ' ORDER STANDARD ';
colnames[6 ].len  := chr(14);
colnames[7 ].name := ' UPDATE         ';
colnames[7 ].len  := chr(6);
colnames[8 ].name := ' INDEX          ';
colnames[8 ].len  := chr(5);
colnames[9 ].name := ' TABLE          ';
colnames[9 ].len  := chr(5);
colnames[10].name := ' LONG           ';
colnames[10].len  := chr(4);
colnames[11].name := ' CONSOLE        ';
colnames[11].len  := chr(7);
colnames[12].name := ' PAGES          ';
colnames[12].len  := chr(5);
colnames[13].name := ' LOCK           ';
colnames[13].len  := chr(4);
colnames[14].name := ' OPTIMIZE       ';
colnames[14].len  := chr(8);
colnames[15].name := ' TIME           ';
colnames[15].len  := chr(4);
(* PTS 1111576 E.Z. *)
colnames[16].name := ' SESSION        ';
colnames[16].len  := chr(7);
colnames[17].name := ' CHECK          ';
colnames[17].len  := chr(5);
colnames[18].name := ' OBJECT         ';
colnames[18].len  := chr(6);
colnames[19].name := ' OBJECT ADD     ';
colnames[19].len  := chr(10);
colnames[20].name := ' OBJECT GET     ';
colnames[20].len  := chr(10);
colnames[21].name := ' OBJECT ALTER   ';
colnames[21].len  := chr(12);
colnames[22].name := ' OBJECT FREEPAGE';
colnames[22].len  := chr(15);
colnames[23].name := ' STOP           ';
colnames[23].len  := chr(4);
pos := 1;
FOR ix := 1 TO c_vtrace_columns DO
    BEGIN
    a06retpart_move (acv, @colnames[ix].name, ord(colnames[ix].len) + 1);
    WITH shortinfo.siinfo[ix] DO
        BEGIN
        sp1i_mode       := [ sp1ot_mandatory ];
        sp1i_io_type    := sp1io_output;
        sp1i_data_type  := dcha;
        sp1i_frac       := 0;
        sp1i_length     := 3;
        sp1i_in_out_len := 3+1;
        sp1i_bufpos     := pos;
        pos             := pos + sp1i_in_out_len
        END;
    (*ENDWITH*) 
    END;
(*ENDFOR*) 
a06finish_curr_retpart (acv, sp1pk_columnnames, c_vtrace_columns);
shortinfo.sicount := c_vtrace_columns;
a06retpart_move (acv, @shortinfo.siinfo,
      shortinfo.sicount * sizeof (shortinfo.siinfo[1]));
a06finish_curr_retpart (acv, sp1pk_shortinfo, c_vtrace_columns);
on_off[false] := ' OFF';
on_off[true ] := ' ON ';
WITH g01vtrace DO
    BEGIN
    a06retpart_move (acv, @on_off[vtrAk_gg00           ], 4);
    a06retpart_move (acv, @on_off[vtrAkDelete_gg00     ], 4);
    a06retpart_move (acv, @on_off[vtrAkInsert_gg00     ], 4);
    a06retpart_move (acv, @on_off[vtrAkPacket_gg00     ], 4);
    a06retpart_move (acv, @on_off[vtrAkSelect_gg00     ], 4);
    a06retpart_move (acv, @on_off[vtrAkShortPacket_gg00], 4);
    a06retpart_move (acv, @on_off[vtrAkUpdate_gg00     ], 4);
    a06retpart_move (acv, @on_off[vtrBdIndex_gg00      ], 4);
    a06retpart_move (acv, @on_off[vtrBdPrim_gg00       ], 4);
    a06retpart_move (acv, @on_off[vtrBdString_gg00     ], 4);
    (* PTS 1107617 E.Z. *)
    a06retpart_move (acv, @on_off[vtrIoTrace_gg00      ], 4);
    a06retpart_move (acv, @on_off[vtrKbLock_gg00       ], 4);
    a06retpart_move (acv, @on_off[vtrStrategy_gg00     ], 4);
    a06retpart_move (acv, @on_off[vtrTime_gg00         ], 4);
    a06retpart_move (acv, @on_off[vtrSession_gg00.ci4_gg00 <> cgg_nil_session], 4);
    a06retpart_move (acv, @on_off[vtrCheck_gg00        ], 4);
    a06retpart_move (acv, @on_off[vtrBdObject_gg00     ], 4);
    a06retpart_move (acv, @on_off[vtrOmsNew_gg00       ], 4);
    a06retpart_move (acv, @on_off[vtrOmsGet_gg00       ], 4);
    a06retpart_move (acv, @on_off[vtrOmsUpd_gg00       ], 4);
    a06retpart_move (acv, @on_off[vtrOmsFree_gg00      ], 4);
    a06retpart_move (acv, @on_off[vtrStopRetcode_gg00 <> 0 ], 4);
    a06finish_curr_retpart (acv, sp1pk_data, 1)
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a37vtrace (VAR acv : tak_all_command_glob);
 
VAR
      vtrace_on_off : boolean;
      i             : integer;
      ti            : integer;
      oms_ti        : integer;
      len           : integer;
      inval         : tsp_int4;
      c18           : tsp_c18;
      oms_trace_lvl : tsp00_KnlIdentifier;
      colinfo       : tak00_columninfo;
      _moveobj_ptr  : tsp_moveobj_ptr;
      _c256         : tsp00_C256;
 
BEGIN
WITH acv DO
    BEGIN
    vbegexcl (acv.a_transinf.tri_trans.trTaskId_gg00, g08monitor);
    vtrace_on_off :=
          a_ap_tree^[ a_ap_tree^[ 0 ].n_lo_level ].n_subproc = cak_x_vtrace_on;
    ti            := 1;
    REPEAT
        ti := a_ap_tree^[ ti ].n_sa_level;
        CASE a_ap_tree^[ ti ].n_subproc OF
            cak_i_add:
                g01vtrace.vtrOmsNew_gg00 := vtrace_on_off;
            cak_i_alter:
                g01vtrace.vtrOmsUpd_gg00 := vtrace_on_off;
            cak_i_analyze:
                g01vtrace.vtrAk_gg00         := vtrace_on_off;
            (* PTS 1111576 E.Z. *)
            cak_i_session :
                BEGIN
                ti := a_ap_tree^[ti].n_sa_level;
                IF  a_ap_tree^[ti].n_symb = s_asterisk
                THEN
                    g01vtrace.vtrSession_gg00.ci4_gg00 :=
                          cgg_nil_session
                ELSE
                    IF  a_ap_tree^[ti].n_symb = s_equal
                    THEN
                        g01vtrace.vtrSession_gg00 :=
                              a_transinf.tri_trans.trSessionId_gg00
                    ELSE
                        BEGIN
                        colinfo.cdatatyp  := dchb;
                        colinfo.cdatalen  := 4;
                        colinfo.cinoutlen := 5;
                        a05_constant_get (acv, ti, colinfo,
                              NOT cak_may_be_longer, succ(mxsp_c4), c18, 1, len);
                        FOR i := 1 TO sizeof (g01vtrace.vtrSession_gg00) DO
                            g01vtrace.vtrSession_gg00.ci4_gg00[i] := chr(0);
                        (*ENDFOR*) 
                        i := 4;
                        WHILE (len > 1) AND (i > 0) DO
                            BEGIN
                            g01vtrace.vtrSession_gg00.ci4_gg00[i] := c18[len];
                            len := len - 1;
                            i   := i - 1
                            END;
                        (*ENDWHILE*) 
                        END;
                    (*ENDIF*) 
                (*ENDIF*) 
                END;
            (* PTS 1110976 E.Z. *)
            cak_i_check :
                BEGIN
                _moveobj_ptr := @_c256;
                a05string_literal_get (acv,
                      acv.a_ap_tree^[ ti ].n_lo_level,
                      dcha, _moveobj_ptr^, 1, sizeof(_c256));
                s30map (g02codetables.tables[ cgg_up_ascii ],
                      _moveobj_ptr^, 1, _moveobj_ptr^, 1, sizeof(_c256));
                Kernel_CheckSwitch (_moveobj_ptr^, sizeof(_c256));
                END;
            cak_i_constraint:
                g01vtrace.vtrCheck_gg00          := vtrace_on_off;
            cak_i_clear:
                b120ClearTrace (a_transinf.tri_trans.trTaskId_gg00);
            cak_i_default :
                (* PTS 1115025 E.Z. *)
                g01vtrace.vtrAll_gg00            := vtrace_on_off;
            cak_i_delete :
                g01vtrace.vtrAkDelete_gg00       := vtrace_on_off;
            cak_i_freepage:
                g01vtrace.vtrOmsFree_gg00        := vtrace_on_off;
            cak_i_get:
                g01vtrace.vtrOmsGet_gg00         := vtrace_on_off;
            cak_i_index :
                g01vtrace.vtrBdIndex_gg00        := vtrace_on_off;
            cak_i_insert :
                g01vtrace.vtrAkInsert_gg00       := vtrace_on_off;
            cak_i_lock :
                g01vtrace.vtrKbLock_gg00         := vtrace_on_off;
            cak_i_long :
                g01vtrace.vtrBdString_gg00       := vtrace_on_off;
            cak_i_object :
                BEGIN
                oms_ti := a_ap_tree^[ ti ].n_lo_level;
                IF  oms_ti <> 0
                THEN
                    WHILE oms_ti <> 0 DO
                        BEGIN
                        a05identifier_get (acv, oms_ti, sizeof (oms_trace_lvl), oms_trace_lvl);
                        IF  NOT ak341SetOmsTraceLevel (oms_trace_lvl, vtrace_on_off)
                        THEN
                            BEGIN
                            a07_b_put_error (acv, e_missing_keyword,
                                  a_ap_tree^[oms_ti].n_pos);
                            oms_ti := 0
                            END
                        ELSE
                            oms_ti := a_ap_tree^[oms_ti].n_sa_level
                        (*ENDIF*) 
                        END
                    (*ENDWHILE*) 
                ELSE
                    BEGIN
                    g01vtrace.vtrBdObject_gg00 := vtrace_on_off;
                    g01vtrace.vtrOmsNew_gg00   := vtrace_on_off;
                    g01vtrace.vtrOmsGet_gg00   := vtrace_on_off;
                    g01vtrace.vtrOmsUpd_gg00   := vtrace_on_off;
                    g01vtrace.vtrOmsFree_gg00  := vtrace_on_off;
                    END;
                (*ENDIF*) 
                END;
            cak_i_optimize :
                g01vtrace.vtrStrategy_gg00       := vtrace_on_off;
            cak_i_order :
                g01vtrace.vtrAkPacket_gg00       := vtrace_on_off;
            cak_i_pages :
                g01vtrace.vtrIoTrace_gg00        := vtrace_on_off;
            cak_i_select :
                g01vtrace.vtrAkSelect_gg00       := vtrace_on_off;
            cak_i_standard :
                g01vtrace.vtrAkShortPacket_gg00 := vtrace_on_off;
            cak_i_stop :
                BEGIN
                i := a_ap_tree^[ ti ].n_lo_level;
                WITH a_ap_tree^[ i ] DO
                    a05int4_get (acv, n_pos, n_length, inval);
                (*ENDWITH*) 
                (* PTS 1105974 E.Z. *)
                IF  inval = 0
                THEN
                    g01vtrace.vtrRetcodeCheck_gg00 := false
                ELSE
                    IF  (inval < 32000) AND (inval > -32000)
                    THEN
                        BEGIN
                        g01vtrace.vtrStopRetcode_gg00  := inval;
                        g01vtrace.vtrRetcodeCheck_gg00 := true;
                        END
                    ELSE
                        a07_b_put_error (acv, e_num_invalid, 1);
                    (*ENDIF*) 
                (*ENDIF*) 
                END;
            cak_i_table :
                g01vtrace.vtrBdPrim_gg00         := vtrace_on_off;
            cak_i_time :
                g01vtrace.vtrTime_gg00            := vtrace_on_off;
            (* PTS 1110976 E.Z. *)
            cak_i_topic :
                BEGIN
                _moveobj_ptr := @_c256;
                a05string_literal_get (acv,
                      acv.a_ap_tree^[ ti ].n_lo_level,
                      dcha, _moveobj_ptr^, 1, sizeof(_c256));
                s30map (g02codetables.tables[ cgg_up_ascii ],
                      _moveobj_ptr^, 1, _moveobj_ptr^, 1, sizeof(_c256));
                Kernel_TraceSwitch (_moveobj_ptr^, sizeof(_c256));
                END;
            cak_i_update :
                g01vtrace.vtrAkUpdate_gg00       := vtrace_on_off;
            cak_i_flush:
                BEGIN
                a35_vtracen( acv );
                END;
            END;
        (*ENDCASE*) 
    UNTIL
        a_ap_tree^[ ti ].n_sa_level = 0;
    (*ENDREPEAT*) 
&   ifdef TRACE
    (* SLOW KERNEL: do not switch off vtrCheck_gg00 *)
    g01vtrace.vtrCheck_gg00 := true;
&   endif
    WITH g01vtrace DO
        vtrAny_gg00 :=
              (vtrAll_gg00            OR
              vtrAk_gg00              OR
              vtrAkDelete_gg00       OR
              vtrAkInsert_gg00       OR
              vtrAkPacket_gg00       OR
              vtrAkSelect_gg00       OR
              vtrAkShortPacket_gg00 OR
              vtrAkUpdate_gg00       OR
              vtrBdIndex_gg00        OR
              vtrBdObject_gg00       OR
              vtrBdPrim_gg00         OR
              vtrBdString_gg00       OR
              vtrIoTrace_gg00        OR
              vtrKbLock_gg00         OR
              vtrStrategy_gg00        OR
              vtrTime_gg00            OR
              vtrOmsNew_gg00      OR
              vtrOmsGet_gg00      OR
              vtrOmsUpd_gg00      OR
              vtrOmsFree_gg00     );
    (*ENDWITH*) 
    vendexcl (acv.a_transinf.tri_trans.trTaskId_gg00, g08monitor);
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak37dump (VAR acv : tak_all_command_glob);
 
VAR
      curr_n : integer;
      b_err  : tgg_basis_error;
      a30v   : tak_a30_utility_glob;
 
BEGIN
WITH acv, a30v, a_mblock, mb_qual^,
     a_ap_tree^[ a_ap_tree^[ 0 ].n_lo_level ] DO
    IF  a_return_segm^.sp1r_returncode  = 0
    THEN
        BEGIN
        a37init_util_record (acv, m_diagnose, mm_dump);
        a3ti := 1;
        a36filename (acv, 2, mut_hostfn, sizeof(mut_hostfn));
        curr_n := 1;
        WHILE (a_ap_tree^[ curr_n ].n_sa_level <> 0) DO
            BEGIN
            curr_n := a_ap_tree^[ curr_n ].n_sa_level;
            CASE a_ap_tree^[ curr_n ].n_subproc OF
                cak_i_connect :
                    mut_dump_state := mut_dump_state + [dumpA51dump_egg00];
                cak_i_pages :
                    mut_dump_state := mut_dump_state + [dumpBdLocklist_egg00];
                cak_i_config :
                    mut_dump_state := mut_dump_state + [dumpConfiguration_egg00];
                cak_i_psm :
                    mut_dump_state := mut_dump_state + [dumpConverter_egg00];
                cak_i_buffer :
                    mut_dump_state := mut_dump_state + [dumpConverterCache_egg00];
                cak_i_data :
                    mut_dump_state := mut_dump_state + [dumpDataCache_egg00];
                cak_i_write :
                    mut_dump_state := mut_dump_state + [dumpPagerWriter_egg00];
                cak_i_freepage :
                    mut_dump_state := mut_dump_state + [dumpFbm_egg00];
                cak_i_autosave :
                    mut_dump_state := mut_dump_state + [dumpBackup_egg00];
                cak_i_lock :
                    mut_dump_state := mut_dump_state + [dumpKbLocklist_egg00];
                cak_i_log :
                    mut_dump_state := mut_dump_state + [dumpLogWriter_egg00];
                cak_i_caches :
                    mut_dump_state := mut_dump_state + [dumpLogCache_egg00];
                cak_i_serverdb :
                    mut_dump_state := mut_dump_state + [dumpNetServer_egg00];
                cak_i_restart :
                    mut_dump_state := mut_dump_state + [dumpRestartRec_egg00];
                cak_i_version :
                    mut_dump_state := mut_dump_state + [dumpRte_egg00];
                cak_i_translate :
                    mut_dump_state := mut_dump_state + [dumpTransformation_egg00];
                cak_i_adabas :
                    mut_dump_state := mut_dump_state + [dumpUtility_egg00];
                cak_i_release :
                    mut_dump_state := mut_dump_state + [dumpGarbcoll_egg00];
                cak_i_object :
                    mut_dump_state := mut_dump_state + [dumpObjFirDir_egg00];
                OTHERWISE :
                END
            (*ENDCASE*) 
            END;
        (*ENDWHILE*) 
        IF  mut_dump_state = []
        THEN
            mut_dump_state := [dumpAll_egg00];
        (*ENDIF*) 
        a37return_hostname (acv);
        IF  a94mode = umUtility_egg00
        THEN
            a06_c_send_mess_buf (acv, b_err)
        ELSE
            a06lsend_mess_buf (acv, a_mblock,
                  NOT cak_call_from_rsend, b_err);
        (*ENDIF*) 
        IF  b_err <> e_ok
        THEN
            a07_b_put_error (acv, b_err, 1);
        (*ENDIF*) 
        END
    (*ENDIF*) 
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak37suspend_semantic (VAR acv : tak_all_command_glob);
 
VAR
      shortinfo       : tak_shortinforecord;
      name            : tsp00_C18;
      iosequence      : tsp00_Uint4;
      NumInfo         : ^tsp00_ResNum;
      num_err         : tsp00_NumError;
 
BEGIN
IF  kb560SuspendAndGetLastWrittenIOSequence (acv.a_transinf.tri_trans.trTaskId_gg00, iosequence)
THEN
    BEGIN
    name := 'LOGPOS            ';
    a06colname_retpart_move (acv, @name, 6, csp_ascii);
    a06finish_curr_retpart (acv, sp1pk_columnnames, 1);
    shortinfo.siinfo[1].sp1i_mode       := [ sp1ot_mandatory ];
    shortinfo.siinfo[1].sp1i_data_type  := dfixed;
    shortinfo.siinfo[1].sp1i_length     := csp_resnum_deflen;
    shortinfo.siinfo[1].sp1i_frac       := 0;
    shortinfo.siinfo[1].sp1i_in_out_len := mxsp_resnum;
    shortinfo.siinfo[1].sp1i_bufpos     := 1;
    shortinfo.sicount := 1;
    a06retpart_move (acv, @shortinfo.siinfo, sizeof (shortinfo.siinfo[1]));
    a06finish_curr_retpart (acv, sp1pk_shortinfo, 1);
    a06init_curr_retpart (acv);
    IF  acv.a_curr_retpart <> NIL
    THEN
        WITH acv.a_curr_retpart^ DO
            BEGIN
            NumInfo := @sp1p_buf[sp1p_buf_len+1];
            NumInfo^[1] := csp_defined_byte;
            s41pluns (NumInfo^, 2, 10, 0, iosequence, num_err);
            sp1p_buf_len := mxsp_resnum + 1;
            a06finish_curr_retpart (acv, sp1pk_data, 1);
            END
        (*ENDWITH*) 
    ELSE
        a07_b_put_error (acv, e_too_small_packet_size, 1)
    (*ENDIF*) 
    END
ELSE
    a07_b_put_error (acv, e_invalid_command, 1);
(*ENDIF*) 
END;
 
&ifdef TRACE
(*------------------------------*) 
 
PROCEDURE
      ak37switch_semantic (VAR acv : tak_all_command_glob);
 
VAR
      _value        : tsp00_Int4;
      _moveobj_ptr  : tsp_moveobj_ptr;
      _on_text      : tsp00_C16;
      _off_text     : tsp00_C16;
      _layer        : tsp00_C20;
      _debug        : tsp00_C20;
      _topic_debug  : tsp00_C20;
      _curr_n       : tsp00_Int2;
 
BEGIN
vbegexcl (acv.a_transinf.tri_trans.trTaskId_gg00, g08monitor);
_value       := 0;
_layer       := bsp_c20;
_debug       := bsp_c20;
_topic_debug := bsp_c20;
_on_text     := bsp_c16;
_off_text    := bsp_c16;
_curr_n      := acv.a_ap_tree^[ 0 ].n_lo_level;
CASE acv.a_ap_tree^[ _curr_n ].n_length OF
    cak30_x_switch_off:
        t01lmulti_switch (_layer, _debug, _on_text, _off_text, _value);
    cak30_x_switch_minbuf:
        t01minbuf (true);
    cak30_x_switch_maxbuf:
        t01minbuf (false);
    cak30_x_switch_buflimit:
        BEGIN
        _curr_n := acv.a_ap_tree^[ _curr_n ].n_sa_level;
        a05_int4_unsigned_get (acv, acv.a_ap_tree^[ _curr_n ].n_pos,
              acv.a_ap_tree^[ _curr_n ].n_length, _value );
        t01setmaxbuflength (_value);
        END;
    cak30_x_switch_trace, cak30_x_switch_debug, cak30_x_switch_topic_debug:
        BEGIN
        IF  (_curr_n > 0) AND (acv.a_ap_tree^[ _curr_n ].n_length = cak30_x_switch_trace )
        THEN
            BEGIN
            _moveobj_ptr := @_layer;
            a05string_literal_get (acv,
                  acv.a_ap_tree^[ _curr_n ].n_sa_level,
                  dcha, _moveobj_ptr^, 1, sizeof(_layer));
            s30map (g02codetables.tables[ cgg_up_ascii ],
                  _moveobj_ptr^, 1, _moveobj_ptr^, 1, sizeof(_layer));
            _curr_n := acv.a_ap_tree^[ _curr_n ].n_lo_level
            END;
        (*ENDIF*) 
        IF  (_curr_n > 0) AND (acv.a_ap_tree^[ _curr_n ].n_length = cak30_x_switch_debug )
        THEN
            BEGIN
            _moveobj_ptr := @_debug;
            a05string_literal_get (acv,
                  acv.a_ap_tree^[ _curr_n ].n_sa_level,
                  dcha, _moveobj_ptr^, 1, sizeof(_debug));
            s30map (g02codetables.tables[ cgg_up_ascii ],
                  _moveobj_ptr^, 1, _moveobj_ptr^, 1, sizeof(_debug));
            _curr_n := acv.a_ap_tree^[ _curr_n ].n_lo_level;
            END;
        (*ENDIF*) 
        IF  (_curr_n > 0) AND (acv.a_ap_tree^[ _curr_n ].n_length = cak30_x_switch_topic_debug )
        THEN
            BEGIN
            _moveobj_ptr := @_topic_debug;
            a05string_literal_get (acv,
                  acv.a_ap_tree^[ _curr_n ].n_sa_level,
                  dcha, _moveobj_ptr^, 1, sizeof(_topic_debug));
            s30map (g02codetables.tables[ cgg_up_ascii ],
                  _moveobj_ptr^, 1, _moveobj_ptr^, 1, sizeof(_topic_debug));
            _curr_n := acv.a_ap_tree^[ _curr_n ].n_lo_level
            END;
        (*ENDIF*) 
        Kernel_TraceSwitch (_moveobj_ptr^, sizeof(_topic_debug));
        IF  (_curr_n > 0) AND
            (acv.a_ap_tree^[ _curr_n ].n_length = cak30_x_switchlimit_start )
        THEN
            BEGIN
            _moveobj_ptr := @_on_text;
            a05string_literal_get (acv,
                  acv.a_ap_tree^[ _curr_n ].n_sa_level,
                  dcha, _moveobj_ptr^, 1, sizeof(_on_text));
            s30map (g02codetables.tables[ cgg_up_ascii ],
                  _moveobj_ptr^, 1, _moveobj_ptr^, 1, sizeof(_on_text));
            _curr_n := acv.a_ap_tree^[ _curr_n ].n_lo_level;
            IF  (_curr_n > 0) AND
                (acv.a_ap_tree^[ _curr_n ].n_length = cak30_x_switchlimit_count )
            THEN
                BEGIN
                a05_int4_unsigned_get (acv, acv.a_ap_tree^[ _curr_n ].n_pos,
                      acv.a_ap_tree^[ _curr_n ].n_length, _value );
                _curr_n := acv.a_ap_tree^[ _curr_n ].n_lo_level;
                END
            ELSE
                _value := 1;
            (*ENDIF*) 
            IF  (_curr_n > 0) AND
                (acv.a_ap_tree^[ _curr_n ].n_length = cak30_x_switchlimit_stop )
            THEN
                BEGIN
                _moveobj_ptr := @_off_text;
                a05string_literal_get (acv,
                      acv.a_ap_tree^[ _curr_n ].n_sa_level,
                      dcha, _moveobj_ptr^, 1, sizeof(_off_text));
                s30map (g02codetables.tables[ cgg_up_ascii ],
                      _moveobj_ptr^, 1, _moveobj_ptr^, 1, sizeof(_off_text));
                END;
            (*ENDIF*) 
            t01lmulti_switch (_layer, _debug, _on_text, _off_text, _value);
            END
        ELSE
            t01multiswitch (_layer, _debug)
        (*ENDIF*) 
        END;
    END;
(*ENDCASE*) 
vendexcl (acv.a_transinf.tri_trans.trTaskId_gg00, g08monitor);
END;
 
&endif
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
.PA 
