.ad 8
.ll 73
.pb '~'
.bm 8
.fm 4
.bt $Copyright (c) 2000-2004 SAP AG$$Page %$
.tm 12
.hm 6
.hs 3
.tt 1 $SQL$Project Distributed Database System$VKB71$
.tt 2 $$$
.tt 3 $JuergenA$KB_get$$$2000-11-28$
***********************************************************
.nf
 
 
    ========== licence begin  GPL
    Copyright (c) 2000-2004 SAP AG
 
    This program is free software; you can redistribute it and/or
    modify it under the terms of the GNU General Public License
    as published by the Free Software Foundation; either version 2
    of the License, or (at your option) any later version.
 
    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.
 
    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
    ========== licence end
 
.fo
.nf
.sp
Module  :  KB_get
=========
.sp
Purpose :  SELECT ROW and GET processing and qualification handling
.CM *-END-* purpose -------------------------------------
.sp
.cp 3
Define  :
 
        VAR
              k71serial_seq_info : tgg00_SeqInfo;
 
        PROCEDURE
              k71code_operand (
                    VAR sel              : tgg00_SelectFieldsParam;
                    wanted_code          : char;
                    VAR operand_addr     : tsp00_MoveObjPtr;
                    VAR len              : integer;
                    operand_st_addr      : tgg00_StEntryAddr;
                    VAR e                : tgg00_BasisError);
 
        PROCEDURE
              k71col_select (
                    VAR t           : tgg00_TransContext;
                    VAR sel         : tgg00_SelectFieldsParam;
                    VAR stack_desc  : tgg00_StackDesc;
                    VAR rec_buf     : tgg00_Rec;
                    VAR unqualified : boolean);
 
        PROCEDURE
              k71column_statistic (VAR m : tgg00_MessBlock);
 
        PROCEDURE
              k71file_statistic (VAR m : tgg00_MessBlock);
 
        PROCEDURE
              k71get (VAR m : tgg00_MessBlock);
 
        PROCEDURE
              k71get_operand (
                    VAR sel             : tgg00_SelectFieldsParam;
                    check_spec_null     : boolean;
                    VAR operand_addr    : tsp00_MoveObjPtr;
                    VAR len             : integer;
                    VAR e               : tgg00_BasisError);
 
        PROCEDURE
              k71init;
 
        PROCEDURE
              k71inv_col_select (
                    VAR t           : tgg00_TransContext;
                    VAR sel         : tgg00_SelectFieldsParam;
                    VAR stack_desc  : tgg00_StackDesc;
                    sec_key         : tsp00_KeyAddr (*ptocSynonym tsp00_KeyPtr*);
                    sec_key_len     : tsp00_Int2;
                    prim_key        : tsp00_KeyAddr (*ptocSynonym tsp00_KeyPtr*);
                    prim_key_len    : tsp00_Int2;
                    VAR unqualified : boolean);
 
        PROCEDURE
              k71join_comparison (
                    VAR sel     : tgg00_SelectFieldsParam;
                    op          : tgg00_StackOpType;
                    VAR workbuf : tkb07_buffer_description;
                    buf1        : tsp00_MoveObjPtr (* ptocSynonym void **);
                    pos1        : tsp00_Int4;
                    len1        : integer;
                    buf2        : tsp00_MoveObjPtr (* ptocSynonym void **);
                    pos2        : tsp00_Int4;
                    len2        : integer;
                    VAR ok      : integer);
 
        PROCEDURE
              k71num_err_to_b_err (
                    num_err : tsp00_NumError;
                    VAR e : tgg00_BasisError);
 
        PROCEDURE
              k71qualification_test (
                    VAR m           : tgg00_MessBlock;
                    first_qual      : boolean;
                    result_wanted   : boolean;
                    check_new_rec   : boolean;
                    VAR rec         : tgg00_Rec;
                    result_ptr      : tsp00_MoveObjPtr;
                    result_size     : tsp00_Int4;
                    VAR result_len  : integer);
 
        PROCEDURE
              k71qual_handling (
                    VAR t             : tgg00_TransContext;
                    VAR sel           : tgg00_SelectFieldsParam;
                    with_view         : boolean;
                    check_new_rec     : boolean;
                    VAR stack_desc    : tgg00_StackDesc;
                    VAR err_st_ptr    : tgg00_StEntryAddr;
                    VAR unqualified   : boolean);
 
        PROCEDURE
              k71sel_qualification_test (
                    VAR m          : tgg00_MessBlock;
                    VAR sel        : tgg00_SelectFieldsParam;
                    check_new_rec  : boolean;
                    VAR rec        : tgg00_Rec);
 
        PROCEDURE
              k71select (VAR m : tgg00_MessBlock);
 
        PROCEDURE
              k71sub_value_get (
                    VAR t   : tgg00_TransContext;
                    VAR op  : tgg00_StackEntry;
                    dataptr : tsp00_MoveObjPtr;
                    datasize: integer);
 
        PROCEDURE
              k71trigger_qualification_test (
                    VAR m       : tgg00_MessBlock;
                    VAR new_rec : tgg00_Rec;
                    VAR old_rec : tgg00_Rec);
 
.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :
 
        FROM
              RTE_kernel : VEN101;
 
        PROCEDURE
              vclock (
                    VAR sec      : tsp00_Int4;
                    VAR microsec : tsp00_Int4);
 
        PROCEDURE
              vmonitor (
                    pid          : tsp00_TaskId;
                    VAR phys_ios : tsp00_Int4;
                    VAR suspends : tsp00_Int4;
                    VAR waits    : tsp00_Int4);
 
        FUNCTION
              vcos  (
                    value     : tsp00_Longreal;
                    VAR error : tsp00_NumError) : tsp00_Longreal;
 
        FUNCTION
              vcosh  (
                    value     : tsp00_Longreal;
                    VAR error : tsp00_NumError) : tsp00_Longreal;
 
        FUNCTION
              vacos  (
                    value     : tsp00_Longreal;
                    VAR error : tsp00_NumError) : tsp00_Longreal;
 
        FUNCTION
              vsin  (
                    value     : tsp00_Longreal;
                    VAR error : tsp00_NumError) : tsp00_Longreal;
 
        FUNCTION
              vsinh  (
                    value     : tsp00_Longreal;
                    VAR error : tsp00_NumError) : tsp00_Longreal;
 
        FUNCTION
              vasin  (
                    value     : tsp00_Longreal;
                    VAR error : tsp00_NumError) : tsp00_Longreal;
 
        FUNCTION
              vtan  (
                    value     : tsp00_Longreal;
                    VAR error : tsp00_NumError) : tsp00_Longreal;
 
        FUNCTION
              vtanh  (
                    value     : tsp00_Longreal;
                    VAR error : tsp00_NumError) : tsp00_Longreal;
 
        FUNCTION
              vatan  (
                    value     : tsp00_Longreal;
                    VAR error : tsp00_NumError) : tsp00_Longreal;
 
        FUNCTION
              vatan2 (
                    y : tsp00_Longreal;
                    x : tsp00_Longreal;
                    VAR error : tsp00_NumError) : tsp00_Longreal;
 
        FUNCTION
              vlog10 (
                    value     : tsp00_Longreal;
                    VAR error : tsp00_NumError) : tsp00_Longreal;
 
        FUNCTION
              vexp   (
                    value     : tsp00_Longreal;
                    VAR error : tsp00_NumError) : tsp00_Longreal;
 
        FUNCTION
              vln    (
                    value     : tsp00_Longreal;
                    VAR error : tsp00_NumError) : tsp00_Longreal;
 
      ------------------------------ 
 
        FROM
              KB_index_handling : VKB33;
 
        PROCEDURE
              k33mult_inv_key (
                    VAR t         : tgg00_TransContext;
                    VAR prim_tree : tgg00_FileId;
                    VAR inv_tree  : tgg00_FileId;
                    init_inv_tree : boolean;
                    st_addr       : tgg00_StackListPtr;
                    rec_buf_ptr   : tgg00_RecPtr;
                    first_st      : integer;
                    last_st       : integer;
                    VAR inv_key   : tgg00_Lkey;
                    VAR bIsUndef  : boolean;
                    VAR move_err  : tgg00_BasisError);
 
      ------------------------------ 
 
        FROM
              KB_transaction : VKB53;
 
        PROCEDURE
              k53lock (
                    VAR t            : tgg00_TransContext;
                    VAR lock_tabid   : tgg00_Surrogate;
                    VAR k            : tgg00_Lkey;
                    wanted_mode      : tgg00_LockReqMode;
                    wanted_state     : tgg00_LockReqState;
                    nowait           : boolean;
                    collision_test   : boolean;
                    VAR granted_mode : tgg00_LockReqMode);
 
        PROCEDURE
              k53row_lock (
                    VAR t            : tgg00_TransContext;
                    VAR file_id      : tgg00_FileId;
                    VAR k            : tgg00_Lkey;
                    VAR rec_buf      : tsp00_Buf;
                    rec_pos          : integer;
                    mess_type        : tgg00_MessType;
                    result_count     : tsp00_Int4;
                    VAR granted_mode : tgg00_LockReqMode);
 
        PROCEDURE
              k53temp_unlock (
                    VAR t           : tgg00_TransContext;
                    VAR lock_tabid  : tgg00_Surrogate;
                    VAR k           : tgg00_Lkey;
                    lock_mode       : tgg00_LockReqMode);
 
        PROCEDURE
              k53key_unlock (
                    VAR t          : tgg00_TransContext;
                    UnlockMode     : tgg00_LockReqMode;
                    TabId          : tgg00_Surrogate;
                    VAR k          : tgg00_Lkey);
 
        PROCEDURE
              k53wait (
                    VAR t     : tgg00_TransContext;
                    MessType  : tgg00_MessType;
                    MessType2 : tgg00_MessType2);
 
      ------------------------------ 
 
        FROM
              KB_restart_record : VKB57;
 
        PROCEDURE
              k57nextval (
                    VAR t          : tgg00_TransContext;
                    buf_addr       : tsp00_MoveObjPtr;
                    buf_size       : tsp00_Int4;
                    firstpos       : tsp00_Int4;
                    resultbuf_addr : tsp00_MoveObjPtr;
                    resultbuf_size : tsp00_Int4;
                    resultpos      : tsp00_Int4;
                    VAR res_len    : tsp00_Int4);
 
        PROCEDURE
              k57overall_currval (
                    VAR t          : tgg00_TransContext;
                    buf_addr       : tsp00_MoveObjPtr;
                    buf_size       : tsp00_Int4;
                    firstpos       : integer;
                    resultbuf_addr : tsp00_MoveObjPtr;
                    resultbuf_size : tsp00_Int4;
                    resultpos      : integer;
                    VAR res_len    : tsp00_Int4);
 
        PROCEDURE
              k57put_sequence_value (
                    VAR t             : tgg00_TransContext;
                    VAR seq_surrogate : tgg00_Surrogate;
                    VAR val_buf       : tsp00_MoveObj;
                    val_buf_size      : tsp00_Int4;
                    val_buf_pos       : tsp00_Int4;
                    val_len           : tsp00_Int4);
 
        PROCEDURE
              k57table_key_get (
                    pid             : tsp00_TaskId;
                    VAR trans_state : tgg00_TransState;
                    VAR syskey : tgg00_Lkey);
 
      ------------------------------ 
 
        FROM
              Single_Select : VKB720;
 
        PROCEDURE
              k720_test_subquery (
                    VAR trans   : tgg00_TransContext;
                    VAR datapart: tgg00_DataPart;
                    datapartsize: tsp00_Int4;
                    VAR mdesc   : tgg00_StackDesc;
                    VAR rec     : tsp00_Buf);
 
        PROCEDURE
              k720monitor (
                    VAR trans         : tgg00_TransContext;
                    VAR sel           : tgg00_SelectFieldsParam;
                    start_sec         : tsp00_Int4;
                    start_microsec    : tsp00_Int4;
                    start_phys_ios    : tsp00_Int4;
                    start_suspends    : tsp00_Int4;
                    start_waits       : tsp00_Int4;
                    put_strat         : boolean;
                    arr_index         : tgg00_RefInfoIndex;
                    strat_cnt         : boolean);
 
      ------------------------------ 
 
        FROM
              KB_build_in_func : VKB78;
 
        PROCEDURE
              k78build_in_func (
                    VAR op    : tgg00_StackEntry;
                    VAR sel   : tgg00_SelectFieldsParam;
                    VAR e     : tgg00_BasisError);
 
        PROCEDURE
              k78currval (
                    VAR t   : tgg00_TransContext;
                    VAR op  : tgg00_StackEntry;
                    VAR sel : tgg00_SelectFieldsParam);
 
        PROCEDURE
              k78unicode_transform (
                    VAR op             : tgg00_StackEntry;
                    VAR sel            : tgg00_SelectFieldsParam;
                    operand_addr       : tsp00_MoveObjPtr;
                    len                : integer;
                    VAR e              : tgg00_BasisError);
 
      ------------------------------ 
 
        FROM
              KB_date_time : VKB79;
 
        FUNCTION
              k79date_time (
                    VAR t         : tgg00_TransContext;
                    VAR sel       : tgg00_SelectFieldsParam;
                    VAR st        : tgg00_StackEntry) : tgg00_BasisError;
 
      ------------------------------ 
 
        FROM
              Scanner : VAK01;
 
        VAR
              a01diag_monitor_on : boolean;
              a01diag_analyze_on : boolean;
 
      ------------------------------ 
 
        FROM
              SQLManager : VAK101;
 
        FUNCTION
              a101_DebuggerActive(
                    VAR transContext : tgg00_TransContext) : boolean;
 
        PROCEDURE
              a101_DebuggerCheckDebugBreak (
                    VAR transContext       : tgg00_TransContext;
                    VAR interpreterContext : tgg00_SelectFieldsParam;
                    currStackEntry         : integer;
                    pVariables             : tsp00_MoveObjPtr;
                    codePos                : integer;
                    codeLength             : integer);
 
        PROCEDURE
              a101_ExecuteSqlStatement (
                    acv_addr        : tsp00_Addr;
                    VAR sel         : tgg00_SelectFieldsParam;
                    retcode_addr    : tsp00_MoveObjPtr;
                    VAR StackList   : tgg00_StackList;
                    VAR qual_ptr    : tsp00_Int4;
                    VAR e           : tgg00_BasisError);
 
        PROCEDURE
              a101_UserDefinedFunctionCall  (
                    VAR transContext       : tgg00_TransContext;
                    VAR interpreterContext : tgg00_SelectFieldsParam;
                    VAR functionCode       : tgg00_StackEntry (* ptocConst *);
                    VAR functionId         : tgg00_StackEntry (* ptocConst *);
                    VAR error              : tgg00_BasisError);
 
      ------------------------------ 
 
        FROM
              AK_semantic_scanner_tools : VAK05;
 
        PROCEDURE
              a05get_err_tabid (
                    VAR tree    : tgg00_FileId;
                    VAR tableid : tgg00_Surrogate);
 
        PROCEDURE
              a05temp_nextval (
                    VAR data_part    : tsp00_MoveObj;
                    data_size        : tsp00_Int4;
                    VAR st_entry     : tgg00_StackEntry;
                    VAR seq_info     : tgg00_SeqInfo;
                    VAR moveobj      : tsp00_MoveObj;
                    VAR moveobj_size : tsp00_Int4;
                    result_pos       : tsp00_Int4;
                    VAR result_len   : integer);
 
        FUNCTION
              a05lnr_space_defbyte (
                    acv       : tsp00_Addr;
                    VAR str   : tsp00_MoveObjPtr;
                    defbyte   : char;
                    start_pos : tsp00_Int4;
                    length    : tsp00_Int4) : tsp00_Int4;
 
        PROCEDURE
              a05luc_space (
                    acv          : tsp00_Addr;
                    VAR buf1     : tsp00_MoveObj;
                    fieldpos1    : tsp00_Int4;
                    fieldlength1 : tsp00_Int4;
                    VAR buf2     : tsp00_MoveObj;
                    fieldpos2    : tsp00_Int4;
                    fieldlength2 : tsp00_Int4;
                    VAR l_result : tsp00_LcompResult);
 
        FUNCTION
              a05space_option (acv : tsp00_Addr) : boolean;
 
      ------------------------------ 
 
        FROM
              AK_Trigger : VAK262;
 
        PROCEDURE
              a262DynamicSQL (
                    acv_addr     : tsp00_Addr;
                    VAR sel      : tgg00_SelectFieldsParam;
                    pStmt        : tsp00_MoveObjPtr;
                    stmtLength   : integer;
                    retcode_addr : tsp00_MoveObjPtr;
                    VAR e        : tgg00_BasisError);
 
        PROCEDURE
              a262InternalFunction(
                    VAR StackEntry       : tgg00_StackEntry;
                    VAR Buf              : tsp00_MoveObj;
                    BufSize              : integer;
                    BufPos               : integer;
                    VAR e                : tgg00_BasisError);
 
        PROCEDURE
              a262ReturnCursor (
                    acv_addr   : tsp00_Addr;
                    param_addr : tsp00_MoveObjPtr;
                    param_len  : tsp00_Int4;
                    VAR e      : tgg00_BasisError);
 
        PROCEDURE
              a262ReturnParam (
                    acv_addr      : tsp00_Addr;
                    paramDataType : tsp00_DataType;
                    param_addr    : tsp00_MoveObjPtr;
                    param_len     : tsp00_Int4;
                    VAR e         : tgg00_BasisError);
 
        PROCEDURE
              a262stop (
                    acv_addr    : tsp00_Addr;
                    rc          : tsp00_Int2;
                    msgtext_len : integer;
                    msgtext     : tsp00_MoveObjPtr);
 
        FUNCTION
              a262StatementBeginStackEntry(
                    acv_addr       : tsp00_Addr;
                    VAR sel        : tgg00_SelectFieldsParam;
                    stackIndex     : integer;
                    VAR codePos    : integer;
                    VAR codeLength : integer) : boolean;
 
      ------------------------------ 
 
        FROM
              AK_update_statistics : VAK28;
 
        PROCEDURE
              a28transfer_statistics (
                    VAR t           : tgg00_TransContext;
                    VAR base_rec    : tgg00_Rec;
                    is_catalog_sel  : boolean);
 
      ------------------------------ 
 
        FROM
              filesysteminterface_1 : VBD01;
 
        VAR
              b01fullkey : tsp00_Key;
 
        PROCEDURE
              b01filestate (
                    VAR t       : tgg00_TransContext;
                    VAR file_id : tgg00_FileId);
 
        PROCEDURE
              b01sfile_statistic (
                    VAR t              : tgg00_TransContext;
                    VAR file_id        : tgg00_FileId;
                    with_shortcol_file : boolean;
                    VAR info           : tgg00_SampleInfo);
 
        PROCEDURE
              b01treset_file (
                    VAR t       : tgg00_TransContext;
                    VAR file_id : tgg00_FileId);
 
        PROCEDURE
              bd01ExtractForeignKey(
                    VAR MessBlock : tgg00_MessBlock;
                    VAR AuxFileId : tgg00_FileId);
 
        PROCEDURE
              bd01MultiColumnStatistic(
                    VAR MessBlock        : tgg00_MessBlock;
                    VAR AuxFileId        : tgg00_FileId;
                    bCalculate           : boolean;
                    NumberOfSampleLeaves : tsp00_Int4;
                    VAR NumberOfLeaves   : tsp00_Int4;
                    VAR NumberOfRecords  : tsp00_Int4;
                    VAR DistinctValues   : tgg00_ColumnDistinctValues);
 
      ------------------------------ 
 
        FROM
              filesysteminterface_2 : VBD02;
 
        PROCEDURE
              b02exists_record (
                    VAR t       : tgg00_TransContext;
                    VAR file_id : tgg00_FileId;
                    VAR rk      : tgg00_Lkey);
 
        PROCEDURE
              b02get_lock_record (
                    VAR t       : tgg00_TransContext;
                    VAR file_id : tgg00_FileId;
                    VAR rk      : tgg00_Lkey;
                    VAR b       : tgg00_Rec);
 
        PROCEDURE
              b02next_record (
                    VAR t           : tgg00_TransContext;
                    VAR file_id     : tgg00_FileId;
                    VAR rk          : tgg00_Lkey;
                    inclusive       : boolean;
                    VAR b           : tgg00_Rec);
 
        PROCEDURE
              b02prev_record (
                    VAR t           : tgg00_TransContext;
                    VAR file_id     : tgg00_FileId;
                    VAR rk          : tgg00_Lkey;
                    inclusive       : boolean;
                    VAR b           : tgg00_Rec);
 
        PROCEDURE
              b02kb_select_rec (
                    VAR t            : tgg00_TransContext;
                    VAR file_id      : tgg00_FileId;
                    VAR RecKey       : tsp00_Key;
                    VAR RecKeyLen    : tsp00_Int2;
                    VAR StopKey      : tsp00_Key;
                    StopKeyLen       : tsp00_Int4;
                    recbuf_size      : tsp00_Int4;
                    recbuf_ptr       : tsp00_MoveObjPtr;
                    ignore_vwait     : boolean;
                    VAR sel          : tgg00_SelectFieldsParam;
                    VAR stack_desc   : tgg00_StackDesc;
                    VAR unqualified  : boolean;
                    VAR granted_lock : tgg00_LockReqMode);
 
      ------------------------------ 
 
        FROM
              filesysteminterface_3 : VBD03;
 
        PROCEDURE
              b03get_inv (
                    VAR t              : tgg00_TransContext;
                    VAR act_tree_id    : tgg00_FileId;
                    VAR lk             : tgg00_Lkey;
                    VAR rk             : tgg00_Lkey;
                    VAR stop_rk        : tgg00_Lkey;
                    VAR CurrentPrimKey : tgg00_Lkey;
                    VAR bd_inv_info    : tgg00_BdInvSet;
                    count_only         : boolean;
                    wanted_lock        : tgg00_LockReqMode;
                    VAR b              : tgg00_KeylistBuf;
                    VAR primkeycnt     : tsp00_Int4;
                    VAR ll             : tsp00_Int4);
 
        PROCEDURE
              b03select_invrec (
                    VAR t             : tgg00_TransContext;
                    VAR file_ids      : tgg00_TwoFileIds;
                    VAR keypair       : tgg00_TwoKeys;
                    VAR stop_keypair  : tgg00_TwoKeys;
                    VAR start_key     : tgg00_Lkey;
                    VAR invrange_set  : tgg00_BdInvSet;
                    recbuf_size       : tsp00_Int4;
                    recbuf_ptr        : tsp00_MoveObjPtr;
                    VAR sel           : tgg00_SelectFieldsParam;
                    VAR stack_desc    : tgg00_StackDesc;
                    VAR granted_lock  : tgg00_LockReqMode;
                    count_usage       : boolean);
 
        PROCEDURE
              bd03InvStatistics (
                    VAR t            : tgg00_TransContext;
                    VAR FiledId      : tgg00_FileId;
                    bWithSelectivity : boolean;
                    VAR StatInfo     : tgg00_SampleInfo);
 
      ------------------------------ 
 
        FROM
              error_text_handling : VBD06;
 
        PROCEDURE
              b06put_errtxt (
                    VAR t          : tgg00_TransContext;
                    pid            : tsp00_TaskId;
                    errlen         : integer;
                    etexttype      : tgg00_ErrorText;
                    b_err_in       : tgg00_BasisError;
                    VAR errtxt     : tsp00_C256;
                    VAR b_err_out  : tgg00_BasisError);
 
      ------------------------------ 
 
        FROM
              task_temp_data_cache : VBD21;
 
        PROCEDURE
              b21mp_root_put (
                    temp_cache_ptr : tgg00_TempDataCachePtr;
                    root : tsp00_PageNo);
 
      ------------------------------ 
 
        FROM
              ref_statistic : VBD73;
 
        VAR
              b73spage_ref_statistic : boolean;
 
      ------------------------------ 
 
        FROM
              Configuration_Parameter : VGG01;
 
        VAR
              g01code      : tgg04_CodeGlobals;
              g01glob      : tgg00_KernelGlobals;
              g01tabid     : tgg04_TabIdGlobals;
 
      ------------------------------ 
 
        FROM
              Codetransformation_and_Coding : VGG02;
 
        VAR
              g02codetables : tgg04_CodeTables;
 
      ------------------------------ 
 
        FROM
              Select_Help_Procedures : VGG04;
 
        PROCEDURE
              g04init_select_fields (
                    VAR sel       : tgg00_SelectFieldsParam;
                    data_addr     : tsp00_MoveObjPtr;
                    data_size     : tsp00_Int4;
                    valarr_addr   : tgg00_ValueListPtr;
                    validx_max    : tsp00_Int4;
                    work_st_addr  : tgg00_StackListPtr;
                    work_st_max   : tsp00_Int2;
                    work_buf_addr : tsp00_MoveObjPtr;
                    work_buf_size : tsp00_Int4;
                    curr_sqlmode  : tsp00_SqlMode);
 
        FUNCTION
              g04inv_tfn (tfn : tgg00_Tfn) : boolean;
 
        PROCEDURE
              g04locate_col (
                    VAR st         : tgg00_StackEntry;
                    rec_buf        : tgg00_RecPtr;
                    VAR varcol_pos : tgg00_VarColPosList;
                    VAR col_pos    : integer;
                    VAR col_len    : integer);
 
      ------------------------------ 
 
        FROM
              Kernel_move_and_fill : VGG101;
 
        PROCEDURE
              SAPDB_PascalOverlappingMove (
                    mod_id      : tsp00_C6;
                    mod_num     : tsp00_Int4;
                    source_upb  : tsp00_Int4;
                    dest_upb    : tsp00_Int4;
                    source      : tsp00_MoveObjPtr;
                    src_pos     : tsp00_Int4;
                    destin      : tsp00_MoveObjPtr;
                    dest_pos    : tsp00_Int4;
                    length      : tsp00_Int4;
                    VAR e       : tgg00_BasisError);
 
        PROCEDURE
              SAPDB_PascalFill (
                    mod_id   : tsp00_C6;
                    mod_num  : tsp00_Int4;
                    obj_upb  : tsp00_Int4;
                    obj      : tsp00_MoveObjPtr;
                    obj_pos  : tsp00_Int4;
                    length   : tsp00_Int4;
                    fillchar : char;
                    VAR e    : tgg00_BasisError);
 
        PROCEDURE
              SAPDB_PascalUnicodeFill (
                    mod_id      : tsp00_C6;
                    mod_num     : tsp00_Int4;
                    obj_upb     : tsp00_Int4;
                    obj         : tsp00_MoveObjPtr;
                    obj_pos     : tsp00_Int4;
                    length      : tsp00_Int4;
                    fillchar    : tsp00_C2;
                    VAR e       : tgg00_BasisError);
 
        PROCEDURE
              SAPDB_PascalMove (
                    mod_id      : tsp00_C6;
                    mod_num     : tsp00_Int4;
                    source_upb  : tsp00_Int4;
                    dest_upb    : tsp00_Int4;
                    source      : tsp00_MoveObjPtr;
                    src_pos     : tsp00_Int4;
                    destin      : tsp00_MoveObjPtr;
                    dest_pos    : tsp00_Int4;
                    length      : tsp00_Int4;
                    VAR e       : tgg00_BasisError);
 
        PROCEDURE
              SAPDB_PascalForcedFill (
                    size     : tsp00_Int4;
                    m        : tsp00_MoveObjPtr;
                    pos      : tsp00_Int4;
                    len      : tsp00_Int4;
                    fillchar : char);
 
        PROCEDURE
              SAPDB_PascalForcedMove (
                    source_upb : tsp00_Int4;
                    destin_upb : tsp00_Int4;
                    source     : tsp00_MoveObjPtr;
                    source_pos : tsp00_Int4;
                    destin     : tsp00_MoveObjPtr;
                    destin_pos : tsp00_Int4;
                    length     : tsp00_Int4);
 
        PROCEDURE
              g10mv (
                    mod_id      : tsp00_C6;
                    mod_num     : tsp00_Int4;
                    source_upb  : tsp00_Int4;
                    dest_upb    : tsp00_Int4;
                    source      : tsp00_MoveObjPtr;
                    src_pos     : tsp00_Int4;
                    destin      : tsp00_MoveObjPtr;
                    dest_pos    : tsp00_Int4;
                    length      : tsp00_Int4;
                    VAR e       : tgg00_BasisError);
 
        PROCEDURE
              s10mv (
                    source_upb  : tsp00_Int4;
                    destin_upb  : tsp00_Int4;
                    source      : tsp00_MoveObjPtr;
                    source_pos  : tsp00_Int4;
                    destin      : tsp00_MoveObjPtr;
                    destin_pos  : tsp00_Int4;
                    length      : tsp00_Int4);
 
      ------------------------------ 
 
        FROM
              RTE-Extension-30 : VSP30;
 
        PROCEDURE
              s30cmp (
                    VAR buf1     : tsp00_MoveObj;
                    fieldpos1    : tsp00_Int4;
                    fieldlength1 : tsp00_Int4;
                    VAR buf2     : tsp00_MoveObj;
                    fieldpos2    : tsp00_Int4;
                    fieldlength2 : tsp00_Int4;
                    VAR l_result : tsp00_LcompResult);
 
        PROCEDURE
              s30luc (
                    VAR buf1     : tsp00_MoveObj;
                    fieldpos1    : tsp00_Int4;
                    fieldlength1 : tsp00_Int4;
                    VAR buf2     : tsp00_MoveObj;
                    fieldpos2    : tsp00_Int4;
                    fieldlength2 : tsp00_Int4;
                    VAR l_result : tsp00_LcompResult);
 
        PROCEDURE
              s30map (
                    VAR code_t   : tsp00_Ctable;
                    VAR source   : tsp00_MoveObj;
                    spos         : tsp00_Int4;
                    VAR dest     : tsp00_MoveObj;
                    dpos         : tsp00_Int4;
                    length       : tsp00_Int4);
 
      ------------------------------ 
 
        FROM
              Pointer-Arithmetik : VSP35;
 
        FUNCTION
              s35add_moveobj_ptr (
                    addr : tsp00_MoveObjPtr;
                    pos : tsp00_Int4): tsp00_MoveObjPtr;
 
        FUNCTION
              s35inc_st (
                    addr : tgg00_StEntryAddr;
                    pos : tsp00_Int4) : tgg00_StEntryAddr;
 
        FUNCTION
              s35le_bufaddr (
                    addr1 : tgg00_StEntryAddr;
                    addr2 : tgg00_StEntryAddr) : boolean;
 
        FUNCTION
              s35gt_bufaddr (
                    addr1 : tgg00_StEntryAddr;
                    addr2 : tgg00_StEntryAddr) : boolean;
 
        FUNCTION
              s35ge_bufaddr (
                    addr1 : tgg00_StEntryAddr;
                    addr2 : tgg00_StEntryAddr) : boolean;
 
        FUNCTION
              s35func_ptr (int_func : tgg00_BasisError) : tsp35proc_ptr;
 
        FUNCTION
              s35op_case (
                    proc_ptr : tsp35proc_ptr;
                    VAR t   : tgg00_TransContext;
                    VAR sel : tgg00_SelectFieldsParam;
                    VAR st  : tgg00_StackEntry) : tgg00_BasisError;
 
      ------------------------------ 
 
        FROM
              GET-Conversions : VSP40;
 
        PROCEDURE
              s40gsint (
                    VAR buf     : tsp00_MoveObj;
                    pos         : tsp00_Int4;
                    len         : integer;
                    VAR dest    : tsp00_Int2;
                    VAR res     : tsp00_NumError);
 
        PROCEDURE
              s40glrel (
                    VAR buf     : tsp00_MoveObj;
                    pos         : tsp00_Int4;
                    len         : integer;
                    VAR dest    : tsp00_Longreal;
                    VAR res     : tsp00_NumError);
 
      ------------------------------ 
 
        FROM
              PUT-Conversions : VSP41;
 
        PROCEDURE
              s41plint (
                    VAR buf     : tsp00_MoveObj;
                    pos         : tsp00_Int4;
                    len         : integer;
                    frac        : integer;
                    source      : tsp00_Int4;
                    VAR res     : tsp00_NumError);
 
        PROCEDURE
              s41psint (
                    VAR buf     : tsp00_MoveObj;
                    pos         : tsp00_Int4;
                    len         : integer;
                    frac        : integer;
                    source      : tsp00_Int2;
                    VAR res     : tsp00_NumError);
 
        PROCEDURE
              s41plrel (
                    VAR buf     : tsp00_MoveObj;
                    pos         : tsp00_Int4;
                    len         : integer;
                    frac        : integer;
                    source      : tsp00_Longreal;
                    VAR res     : tsp00_NumError);
 
      ------------------------------ 
 
        FROM
              PUTSTRING-Conversions : VSP43;
 
        PROCEDURE
              s43pstr (
                    VAR buf    : tsp00_MoveObj;
                    pos        : tsp00_Int4;
                    len        : integer;
                    frac       : integer;
                    VAR source : tsp00_MoveObj;
                    spos       : tsp00_Int4;
                    slen       : integer;
                    VAR res    : tsp00_NumError);
 
        PROCEDURE
              s43lfrac (
                    VAR source  : tsp00_MoveObj;
                    spos        : tsp00_Int4;
                    slen        : integer;
                    VAR diglen  : integer;
                    VAR digfrac : integer;
                    VAR bytelen : integer);
 
      ------------------------------ 
 
        FROM
              Patterns : VSP49;
 
        PROCEDURE
              s49build_pattern (
                    VAR pat_buffer : tsp00_MoveObj;
                    ascii_type  : boolean;
                    start       : tsp00_Int4;
                    stop        : tsp00_Int4;
                    escape_char : char;
                    escape      : boolean;
                    string      : boolean;
                    sqlmode     : tsp00_SqlMode;
                    VAR ok      : boolean);
 
        PROCEDURE
              s49uni_build_pattern (
                    VAR pat_buffer : tsp00_MoveObj;
                    start       : tsp00_Int4;
                    stop        : tsp00_Int4;
                    escape_char : tsp00_C2;
                    escape      : boolean;
                    sqlmode     : tsp00_SqlMode;
                    VAR ok      : boolean);
 
        FUNCTION
              s49patmatch (
                    VAR val        : tsp00_MoveObj;
                    val_offset     : tsp00_Int4;
                    val_len        : tsp00_Int4;
                    VAR pat        : tsp00_MoveObj;
                    pat_offset     : tsp00_Int4;
                    pat_len        : tsp00_Int4;
                    pat_defbyte    : char) : boolean;
 
        FUNCTION
              s49upatmatch (
                    VAR val     : tsp00_MoveObj;
                    val_offset  : tsp00_Int4;
                    val_len     : tsp00_Int4;
                    VAR pat     : tsp00_MoveObj;
                    pat_offset  : tsp00_Int4;
                    pat_len     : tsp00_Int4) : boolean;
 
      ------------------------------ 
 
        FROM
              Number-Arithmetic : VSP51;
 
        PROCEDURE
              s51abs (
                    VAR source     : tsp00_MoveObj;
                    spos           : tsp00_Int4;
                    slen           : integer;
                    VAR result     : tsp00_MoveObj;
                    respos         : tsp00_Int4;
                    reslen         : integer;
                    resfrac        : integer;
                    VAR resbytelen : integer;
                    VAR ret        : tsp00_NumError);
 
        PROCEDURE
              s51add (
                    VAR left       : tsp00_MoveObj;
                    lpos           : tsp00_Int4;
                    llen           : integer;
                    VAR right      : tsp00_MoveObj;
                    rpos           : tsp00_Int4;
                    rlen           : integer;
                    VAR result     : tsp00_MoveObj;
                    respos         : tsp00_Int4;
                    reslen         : integer;
                    resfrac        : integer;
                    VAR resbytelen : integer;
                    VAR ret        : tsp00_NumError);
 
        PROCEDURE
              s51div (
                    VAR left       : tsp00_MoveObj;
                    lpos           : tsp00_Int4;
                    llen           : integer;
                    VAR right      : tsp00_MoveObj;
                    rpos           : tsp00_Int4;
                    rlen           : integer;
                    VAR result     : tsp00_MoveObj;
                    respos         : tsp00_Int4;
                    reslen         : integer;
                    resfrac        : integer;
                    VAR resbytelen : integer;
                    VAR ret        : tsp00_NumError);
 
        PROCEDURE
              s51intdiv (
                    VAR left       : tsp00_MoveObj;
                    lpos           : tsp00_Int4;
                    llen           : integer;
                    VAR right      : tsp00_MoveObj;
                    rpos           : tsp00_Int4;
                    rlen           : integer;
                    VAR result     : tsp00_MoveObj;
                    respos         : tsp00_Int4;
                    reslen         : integer;
                    resfrac        : integer;
                    VAR resbytelen : integer;
                    VAR ret        : tsp00_NumError);
 
        PROCEDURE
              s51isint (
                    VAR source     : tsp00_MoveObj;
                    spos           : tsp00_Int4;
                    slen           : integer;
                    VAR isint      : boolean;
                    VAR ret        : tsp00_NumError);
 
        PROCEDURE
              s51kroun (
                    VAR source     : tsp00_MoveObj;
                    spos           : tsp00_Int4;
                    slen           : integer;
                    VAR result     : tsp00_MoveObj;
                    respos         : tsp00_Int4;
                    reslen         : integer;
                    resfrac        : integer;
                    VAR resbytelen : integer;
                    VAR ret        : tsp00_NumError);
 
        PROCEDURE
              s51mul (
                    VAR left       : tsp00_MoveObj;
                    lpos           : tsp00_Int4;
                    llen           : integer;
                    VAR right      : tsp00_MoveObj;
                    rpos           : tsp00_Int4;
                    rlen           : integer;
                    VAR result     : tsp00_MoveObj;
                    respos         : tsp00_Int4;
                    reslen         : integer;
                    resfrac        : integer;
                    VAR resbytelen : integer;
                    VAR ret        : tsp00_NumError);
 
        PROCEDURE
              s51neg (
                    VAR source     : tsp00_MoveObj;
                    spos           : tsp00_Int4;
                    slen           : integer;
                    VAR result     : tsp00_MoveObj;
                    respos         : tsp00_Int4;
                    reslen         : integer;
                    resfrac        : integer;
                    VAR resbytelen : integer;
                    VAR ret        : tsp00_NumError);
 
        PROCEDURE
              s51round (
                    VAR source     : tsp00_MoveObj;
                    spos           : tsp00_Int4;
                    slen           : integer;
                    round          : integer;
                    VAR result     : tsp00_MoveObj;
                    respos         : tsp00_Int4;
                    reslen         : integer;
                    resfrac        : integer;
                    VAR resbytelen : integer;
                    VAR ret        : tsp00_NumError);
 
        PROCEDURE
              s51sub (
                    VAR left       : tsp00_MoveObj;
                    lpos           : tsp00_Int4;
                    llen           : integer;
                    VAR right      : tsp00_MoveObj;
                    rpos           : tsp00_Int4;
                    rlen           : integer;
                    VAR result     : tsp00_MoveObj;
                    respos         : tsp00_Int4;
                    reslen         : integer;
                    resfrac        : integer;
                    VAR resbytelen : integer;
                    VAR ret        : tsp00_NumError);
 
        PROCEDURE
              s51trunc (
                    VAR source     : tsp00_MoveObj;
                    spos           : tsp00_Int4;
                    slen           : integer;
                    trunc          : integer;
                    VAR result     : tsp00_MoveObj;
                    respos         : tsp00_Int4;
                    reslen         : integer;
                    resfrac        : integer;
                    VAR resbytelen : integer;
                    VAR ret        : tsp00_NumError);
 
        FUNCTION
              s51floatlen (
                    VAR source   : tsp00_MoveObj;
                    spos         : tsp00_Int4;
                    slen         : integer) : integer;
 
        PROCEDURE
              s51sqrt (
                    VAR source     : tsp00_MoveObj;
                    spos           : tsp00_Int4;
                    slen           : integer;
                    VAR result     : tsp00_MoveObj;
                    respos         : tsp00_Int4;
                    reslen         : integer;
                    resfrac        : integer;
                    VAR resbytelen : integer;
                    VAR ret        : tsp00_NumError);
 
        PROCEDURE
              s51power (
                    VAR base       : tsp00_MoveObj;
                    basepos        : tsp00_Int4;
                    baselen        : integer;
                    basefrac       : integer;
                    VAR power      : tsp00_MoveObj;
                    ppos           : tsp00_Int4;
                    plen           : integer;
                    pfrac          : integer;
                    VAR result     : tsp00_MoveObj;
                    respos         : tsp00_Int4;
                    reslen         : integer;
                    resfrac        : integer;
                    VAR resbytelen : integer;
                    VAR ret        : tsp00_NumError);
 
      ------------------------------ 
 
        FROM
              RTE-Extension-81 : VSP81;
 
        PROCEDURE
              sp81UCS2StringToupper(
                    buffer_ptr         : tsp00_MoveObjPtr;
                    buffer_len         : tsp00_Int4);
 
        PROCEDURE
              sp81UCS2StringTolower (
                    buffer_ptr         : tsp00_MoveObjPtr;
                    buffer_len         : tsp00_Int4);
&       ifdef TRACE
 
      ------------------------------ 
 
        FROM
              Test_Procedures : VTA01;
 
        PROCEDURE
              t01key (
                    debug   : tgg00_Debug;
                    nam     : tsp00_Sname;
                    VAR k   : tgg00_Lkey);
 
        PROCEDURE
              t01messtype (
                    debug        : tgg00_Debug;
                    nam          : tsp00_Sname;
                    mess_type    : tgg00_MessType);
 
        PROCEDURE
              t01mess2type (
                    debug         : tgg00_Debug;
                    nam           : tsp00_Sname;
                    mess2_type    : tgg00_MessType2);
 
        PROCEDURE
              t01addr (
                    debug    : tgg00_Debug;
                    nam      : tsp00_Sname;
                    bufaddr  : tgg00_StEntryAddr);
 
        PROCEDURE
              t01basis_error (
                    debug : tgg00_Debug;
                    nam   : tsp00_Sname;
                    b_err : tgg00_BasisError);
 
        PROCEDURE
              t01bool (
                    debug    : tgg00_Debug;
                    nam      : tsp00_Sname;
                    curr_bool: boolean);
 
        PROCEDURE
              t01buf (
                    debug    : tgg00_Debug;
                    VAR buf  : tsp00_Buf;
                    startpos : integer;
                    endpos   : integer);
 
        PROCEDURE
              t01buf1 (
                    debug    : tgg00_Debug;
                    VAR buf  : tsp00_Key;
                    startpos : integer;
                    endpos   : integer);
 
        PROCEDURE
              t01int4 (
                    debug : tgg00_Debug;
                    nam : tsp00_Sname;
                    int : tsp00_Int4);
 
        PROCEDURE
              t01lkey (
                    debug : tgg00_Debug;
                    VAR k : tgg00_Lkey);
 
        PROCEDURE
              t01moveobj (
                    debug    : tgg00_Debug;
                    VAR buf  : tsp00_MoveObj;
                    startpos : tsp00_Int4;
                    endpos   : tsp00_Int4);
 
        PROCEDURE
              t01name (debug : tgg00_Debug; nam : tsp00_Name);
 
        PROCEDURE
              t01op (
                    debug  : tgg00_Debug;
                    nam    : tsp00_Sname;
                    op     : tgg00_StackOpType);
 
        PROCEDURE
              t01p2int4 (
                    debug : tgg00_Debug;
                    nam_1 : tsp00_Sname;
                    int_1 : tsp00_Int4;
                    nam_2 : tsp00_Sname;
                    int_2 : tsp00_Int4);
 
        PROCEDURE
              t01real (
                    debug  : tgg00_Debug;
                    nam    : tsp00_Sname;
                    re     : tsp00_Longreal;
                    digits : integer);
 
        PROCEDURE
              t01sname (debug : tgg00_Debug; nam : tsp00_Sname);
 
        PROCEDURE
              t01stackentry (
                    debug          : tgg00_Debug;
                    VAR st         : tgg00_StackEntry;
                    entry_index    : integer);
 
        FUNCTION
              t01trace (debug : tgg00_Debug) : boolean;
&       endif
 
.CM *-END-* use -----------------------------------------
.sp;.cp 3
Synonym :
 
        FUNCTION
              a05lnr_space_defbyte;
 
              tak_acv_address tsp00_Addr
 
        PROCEDURE
              a05luc_space;
 
              tak_acv_address tsp00_Addr
 
        FUNCTION
              a05space_option;
 
              tak_acv_address tsp00_Addr
 
        PROCEDURE
              a262DynamicSQL;
 
              tak_acv_address tsp00_Addr;
 
        PROCEDURE
              a101_ExecuteSqlStatement;
 
              tak_acv_address tsp00_Addr
 
        PROCEDURE
              a262ReturnParam;
 
              tak_acv_address tsp00_Addr
 
        PROCEDURE
              a262ReturnCursor;
 
              tak_acv_address tsp00_Addr
 
        PROCEDURE
              a262stop;
 
              tak_acv_address tsp00_Addr
 
        FUNCTION
              a262StatementBeginStackEntry;
 
              tak_acv_address tsp00_Addr
 
        PROCEDURE
              a28transfer_statistics;
 
              tak_baserecord tgg00_Rec
 
        PROCEDURE
              b03get_inv;
 
              tgg00_KeylistBuf tsp00_Buf
 
        PROCEDURE
              k720_test_subquery;
 
              tgg00_Rec tsp00_Buf
&             ifdef trace
 
        PROCEDURE
              t01addr;
 
              tsp00_BufAddr tgg00_StEntryAddr
 
        PROCEDURE
              t01buf1;
 
              tsp00_Buf  tsp00_Key;
&             endif
 
        FUNCTION
              s35add_moveobj_ptr;
 
              tsp00_Int4 tsp00_MoveObjPtr;
 
        FUNCTION
              s35le_bufaddr;
 
              tsp00_Addr tgg00_StEntryAddr
 
        FUNCTION
              s35gt_bufaddr;
 
              tsp00_Addr tgg00_StEntryAddr
 
        FUNCTION
              s35ge_bufaddr;
 
              tsp00_Addr tgg00_StEntryAddr
 
        FUNCTION
              s35op_case;
 
              tgg_trans tgg00_TransContext
 
.CM *-END-* synonym -------------------------------------
.sp;.cp 3
Author  :  JuergenA
.sp
.cp 3
Created :  1.06.79
.sp
.cp 3
.sp
.cp 3
Release :      Date : 2000-11-28
.sp
***********************************************************
.sp
.cp 11
.fo
.oc _/1
Specification:
.fo
.sp 2;.cp 3
Procedure K71CODE_OPERAND
.sp
If WANTED_CODE does not match the code of the operand;
then the operand is transformed to the wanted code and
OPERAND_ADDR, POS and LEN are set to the transformed operand located
at the end of the stack.
.sp 2;.cp 5
Procedure K71COL_SELECT
.sp
For the record contained in the record buffer REC_BUF,
the qualification is checked and the result buffer
RESULT_BUF is edited. Checking is done by using the qualification
QUAL_BUF and the pointers to PART1 (identical to QUAL_BUF but readable
only as a buffer), to PART2 of the MESSAGE BUFFER and to the result
buffer that are contained in SEL as 'pointer'.
.sp 2;.cp 5
Procedure K71COLUMN_STATISTIC
.sp
K71COLUMN_STATISTIC is called by means of the tree id
of PART1 of the message buffer.  If the message2 type
is not MM_KEY, the column statistics are created for the
file that has been specified by an appropriate stack entry.
.sp 2;.cp 5
Procedure K71FILE_STATISTIC
.sp
B01SFILE_STATISTIC is called by means of the tree id
of PART1 of the message buffer.  If the message type
is M_INDEX_STATISTIC, the file statistics are created for the
index file that has been specified by an appropriate stack entry.
.sp 2;.cp 4
Procedure K71GET
.sp
On the basis of the mess2-type, this procedure read a record via
B02GET_RECORD~/~B03GET_INV or tests the existence of a record via
B02EXISTS_RECORD.
.sp 2;.cp 3
Procedure K71GET_OPERAND
.sp
For the operand at the top of the stack, the procedure supplies the
address OPERAND_ADDR of the buffer in which
it is located along with its position POS = 1 and its length LEN.
.sp 2;.cp 6
Procedure K71JOIN_COMPARISON
.sp
Calls the procedure COMPARISON with the operator OP and
the two operands contained in BUF1 and BUF2.
.sp 2;.cp 3
Procedure K71NUM_ERR_TO_B_ERR
.sp
Transforms a NUM_ERROR into a BASIS_ERROR.
.sp 2;.cp 6
Procedure K71QUALIFICATION_TEST
.sp
This procedure checks the qualification and sends the result
buffer to RESULT_BUF if RESULT_WANTED is 'true'.
.sp 2;.cp 5
Procedure K71SELECT
.sp
Depending on the mess2_type, the record in the file specified by the
tree id of the message buffer is read by means of
B02SELECT_RECORD or, for the search via index, by means of
B03SELECT_INVREC.  B02SELECT_RECORD or B03SELECT_INVREC calls
the procedure K71COL_SELECT for each record to be checked.  In this
procedure, the qualification is tested and the result buffer is edited.
.br
If an error is set PART1 and PART2 are retained with an unaltered
length. If a record was found, PART2 contains the result buffer.
.sp;.cp 10
The message buffer for SELECT NEXT/PREV/FIRST/LAST
between AK and KB contains in any case a primary startkey. It also
contains a primary stopkey if it could be extracted from the
where-condition of the command.
.br
If the command uses an index (single or multiple), then the message
buffer contains in additon a secondary startkey and (optionally) a
secondary stopkey.
.br
The layout of the message buffer is as follows:
.sp;.cp 10
PART1:
.sp;.of 14
MSTRAT_POS description of primary startkey to be used
.in +14;.hi 11
.br;ETYPE~~~~= ST_STRAT
.br;EPOS~~~~~= position in PART2.BUF where the startkey starts
.br;ELEN_VAR~= length of the startkey
.hi;.in -14
.sp;.of 14
MSTRAT_POS+1 Description of primary stop key to be used
.in +14;.hi 11
.br;ETYPE~~~~= ST_STRAT
.br;EPOS~~~~~= position in PART2.BUF where the stopkey starts
.br;ELEN_VAR~= length of the stopkey (ELEN_VAR~=~0  ==>~no~stopkey)
.hi;.in -14
.sp;.of 14;.cp 9
MCOL_POS Description of single index values (secondary startkey and
stopkey) to be used for evaluation of SELECT_ROW command:
.in +14;.hi 13
.br;ETYPE~~~~~~= ST_VALUE
.br;EOP~~~~~~~~= OP_ORDER_ASC / OP_ORDER_DESC
.br;EPOS~~~~~~~= 1
.br;ELEN_VAR~~~= 1 (first and only field)
.br;ECOL_TAB(1)= single index number
.br;ECOL_TAB(2)= inout length of field
.hi;.in -14
.sp;.of 14;.cp 13
MMULT_POS sequence of descriptions (MMULT_CNT entries) of multiple index
values to be used for evaluation of SELECT_ROW command. Order of
entries corresponds to order of fields in the index definition
and to the order in which the values are stored in PART2 of mess_buffer.
Each entry is of the form:
.in +14;.hi 13
.br;ETYPE~~~~~~= ST_VALUE
.br;EOP~~~~~~~~= OP_ORDER_ASC / OP_ORDER_DESC
.br;EPOS~~~~~~~= 1
.br;ELEN_VAR~~~= field number within index
.br;ECOL_TAB(1)= multiple index number
.br;ECOL_TAB(2)= inout length of field
.hi;.in -14
.sp 2;.cp 12;.nf
PART2:
----|-------|--|------|---|-----|--|---|-----|---|-----|--|---|-----|--
 .. | start |..| stop |len|value|..|len|value|len|value|..|len|value|
 .. | key   | .| key  |1  |  1  |  | i |  i  |i+1| i+1 |  | n |  n  |
____|_______|__|______|___|_____|__|___|_____|___|_____|__|___|_____|__
        |          |     |<- STARTINDEX as    -> <- STOPINDEX as     ->|
        |          |         described at           described at
        |          |         MCOL_POS/MMULT_POS     MCOL_POS/MMULT_POS
        |          |     |<---- all field values with len in front --->|
        |          |
        |          |_________ mst_addr^ [MSTRAT_POS+1].EPOS
        |____________________ mst_addr^ [MSTRAT_POS].EPOS
.fo
.sp 2;.cp 3
Procedure K71TRIGGER_QUALIFICATION
.sp
This procedure checks the qualification in order to call a TRIGGER.
In contrast to K71QUALIFICATION_TEST an old and new record is
used for the test. The result is returned in RESULT_BUF.
.sp 2;.cp 3
Procedure KB71CATALOG_OUTPUT
.sp
xxx
.sp 2;.cp 3
Procedure KB71CODE_TRANSFORM
.sp
Transforms the code of the operand into the code specified by
OP. The result is written at the top of the STACK.
.sp 2;.cp 3
Procedure KB71COMPARISON
.sp
Procedure for comparing two values according to the
operator OP. If one of the values is UNDEF, UNDEF is supplied.
.sp 2;.cp 3
Procedure KB71GET_DIRECT_WITH_LOCK
.sp
Initializes the stack and calls B02SELECT_RECORD.
.sp 2;.cp 3
Procedure KB71MATCHVALUE
.sp
The Procedure creates the string COMPARE containing the
four bytes to handle the SOUND operation.
For the purpose of comparison, the lower-case letters are changed
to upper-case letters. The initial letters must match; the following
characters are considered identical within each group: (D.T), (B.P),
(C.G.K), (F.V) and (S.X.Z).  All subsequent characters that belong to
the following groups are replaced by numbers:
1=(F.B.P.V.W), 2=(C.G.J.K.Q.S.X.Z), 3=(D.T), 4=(L), 5=(M.N) and 6=(R).
Any characters not contained in these groups become blanks. Duplicate
consecutive characters and blanks are now removed from these transformed
strings. The procedure stops when the the first four different
characters are assigned to COMPARE.
.sp 2;.cp 4
Procedure KB71NUMBER_TO_VALUE
.sp
Transforms the numerical operands at the top of the stack into
a value with OP.EPOS places and OP.ELEN_VAR decimal places.
.sp 2;.cp 3
Procedure KB71OP_ALPHA
.sp
Procedure for processing the operator ALPHA. If the string is not
UNDEF, it is converted according to the G01ALPHA_CODEs and changed
to upper-case letters via S30MAP with the G02_CODETABLES.
.sp 2;.cp 4
Procedure KB71OP_ARITH
.sp
Processes the arithmetical operators, i.e. the last or the last
two stack entries are used as operands.  If one of the operands
is UNDEF, the result is also UNDEF.  In the case of MOD and INTDIV,
the operands can consist of integers only.
.in +5;.hi 16;.cp 5
.br;OP_ABS ABS (a)
.br;OP_DIV a / b
.br;OP_INTDIV a DIV b
.br;OP_MINUS a - b
.br;OP_MINUS_MONAD -a
.br;OP_MOD a MOD b
.br;OP_MULT a * b
.br;OP_PLUS a + b
.br;OP_ROUND ROUND(a)
.br;OP_TRUNC TRUNC(a)
.in -5;.hi
.sp 2;.cp 3
Procedure KB71OP_BOOL
.sp
Processes the Boolean operators (without IN or NOT IN), i.e.
the last stack entries are used as operands that must consist of
boolean results for the operators AND, OR and NOT.  For the other
operators, the operands must have pointers to appropriate values.
The operators NULL and NOT NULL consist of two operands; only the
first operand is significant.  The other operators are processed with
the procedure COMPARISON.
.br
If one of the operands is UNDEF, the Boolean result is also UNDEF
(except in the case of the operators NULL, NOT NULL and OR).  The
following truth tables are valid for AND and OR:
.sp;.cp 5;.nf
AND   | true  | false | undef  OR    | true  | false | undef
------+-------+-------+------  ------+-------+-------+------
true  | true  | false | undef  true  | true  | true  | true
false | false | false | undef  false | true  | false | undef
undef | undef | undef | undef  undef | true  | undef | undef
.fo
.in +5;.hi 17;.cp 5
.sp;OP_AND a AND b
.br;OP_BETWEEN a BETWEEN b AND c
.br;OP_EQ a = b
.br;OP_EQ_ALL internal operator (incl. undef byte)
.br;OP_GE a >= b
.br;OP_GT a > b
.br;OP_LE a <= b
.br;OP_LIKE a LIKE b
.br;OP_LT a < b
.br;OP_NE a <> b
.br;OP_NOT NOT A
.br;OP_NOT_BETWEEN a NOT BETWEEN b AND c
.br;OP_NOT_LIKE a NOT LIKE b
.br;OP_NOT_NULL a IS NOT NULL
.br;OP_NOT_SOUNDS a NOT SOUNDS b
.br;OP_NULL a IS NULL
.br;OP_OR a OR b
.cp 5
.br;OP_SOUNDS a SOUNDS b
.br;OP_UPD_VIEW_AND internal 'and' operator with optional second operand
(qual~AND~view, if without view specification then 'qual~AND~TRUE'
is assumed)
.in -5;.hi
.sp 2;.cp 3
Procedure KB71OP_BYTES
.sp
This procedure processes the function HEX or DIGITS. In case of
function DIGITS, a new value is created, if the given value is negativ.
.in +5;.nf
.sp;OP_HEX      HEX('abc')  ==> '818283'
.br;OP_DIGITS   DIGITS(123) ==> '123'
.in -5;.fo
.sp 2;.cp 3
Procedure KB71OP_DESC
.sp
xxx
.sp 2;.cp 3
Procedure KB71OP_FUNC_ARITH
.sp
xxx
.sp 2;.cp 9
Procedure KB71OP_IN
.sp
The procedure processes the IN and NOT~IN operators.
OP.ELEN_VAR indicates the
number of IN elements that are located at the end of the stack.
If one of the operands concerned is UNDEF, the result is UNDEF.
.in +5;.nf
OP_IN       a IN (b, c)
OP_NOT_IN   a NOT IN (b, c)
.in -5;.fo
.sp 2;.cp 3
Procedure KB71OP_INITCAP
.sp
xxx
.sp 2;.cp 5
Procedure KB71OP_LENGTH
.sp
Supplies the length of a string. In the case of UNDEF, the result is
UNDEF.
.in +5;.br;.nf
OP_LENGTH   LENGTH ('abc~~')  ==> 3
.in -5;.fo
.sp 2;.cp 8
Procedure KB71OP_NUM
.sp
Supplies the numerical representation of a string in the internal
float representation with 18 positions.  If the string is UNDEF,
UNDEF is supplied.
.in +5;.br;.nf
op_num   NUM('123')  ==> 123
.in -5;.fo
.sp 2;.cp 3
Procedure KB71OP_REMOVE_REPLACE
.sp
xxx
.sp 2;.cp 3
Procedure KB71OP_SOUNDEX
.sp
xxx
.sp 2;.cp 6
Procedure KB71OP_STAMP
.sp
The procedure processes the STAMP operator. A value is generated
with the current table key from the restart record.
ecol_tab [1] = 1 indicates, that the zero stamp has to be
returned.
.in +5;.br;.nf
OP_STAMP    STAMP     (without operand)
.in -5;.fo
.sp 2;.cp 5
Procedure KB71OP_SUBQUERY
.sp
The appropriate operand on the stack is compared with the keys
of the result subset. This key consists of the value with a
defined/undef byte followed by a 4-byte counter. If the result
subset contains zero values,  ELEN_VAR is less than 0. If an undef value
exists, the result is set to UNDEF if the result is TRUE for the
specification ALL or FALSE for the specification ANY. This procedure is
not called for empty result subsets. Instead, a stack entry
(ST_BOOL) is generated (ALL: true, ANY: false).
.sp;.nf;.in 5;.cp 11
Processing for ALL:
op     | BD call | no_next/prev_rec | identical
-------+---------+------------------+-----------
=  ALL | 1. first| -.- (empty)      |
          | 2. last | -.- (first exist)|
<> ALL | direct  | TRUE             | NOT IN
NOT IN | direct  | TRUE             | <> ALL
>= ALL | last    | UNDEF            |
>  ALL | last    | UNDEF            |
<= ALL | first   | -.- (empty)      |
<  ALL | first   | -.- (empty)      |
.sp;.cp 11
Processing for ANY:
op     | BD call | no_next/prev_rec | identical
-------+---------+------------------+-----------
=  ANY | direct  | FALSE            | IN
IN     | direct  | FALSE            | = ANY
<> ANY | 1. first| -.- (empty)      |
          | 2. last | -.- (first exist)|
>= ANY |  first  | -.- (empty)      |
>  ANY |  first  | -.- (empty)      |
<= ANY |  last   | UNDEF            |
<  ANY |  last   | UNDEF            |
.in;.fo;.sp;.cp 6
BD calls:
.sp;.hi 7;direct B02NEXT_RECORD with a key consisting of the
operand.  (B02NEXT_RECORD because the keys in the result subset
still consist of the value and the counter)
.sp;first B02NEXT_RECORD with zerokey (key.len = 0)
.sp;last B02NEXT_RECORD with fullkey; the first byte is CHR(254)
"CHR(ord(undef_byte)-1)" so that only the defined keys are compared
.hi
.sp;.nf;.in 5;.cp 8
Truth table:
          | TRUE               | FALSE              | UNDEF
-------+--------------------+--------------------+----------
ALL    | all tests true     | one test false     | otherwise
          | result set empty   |                    |
-------+--------------------+--------------------+----------
ANY    | one test true      | all tests false    | otherwise
          |                    | result set empty   |
.in;.fo
.sp 2;.cp 3
Procedure KB71OP_TRANSLATE_STRING
.sp
Procedure for processing the operators ASCII, EBCDIC, LOWCASE and
UPCASE.  If the string is not UNDEF, it is appropriately converted
via S30MAP and the G02_CODETABLES.  If ASCII is changed to ASCII
or EBCDIC to EBCDIC, the original string is supplied.
.in +5;.hi 13
.br;OP_ASCII ASCII (a)
.br;OP_EBCDIC EBCDIC (a)
.br;OP_LOWCASE LOWER ('ABc') ~==> 'abc'
.br;OP_UPCASE  UPPER ('aBc') ~==> 'ABC'
.hi;.in -5
.sp 2;.cp 5
Procedure KB71OUTPUT
.sp
The result buffer RESULT_BUF is edited according to the stack
entry QUAL_ST.  If OP_OUTPUT_VAR is specified as EOP, the value
contained in the stack with a length byte is appended to the end
(RESULT_LEN+1) of the result buffer and RESULT_LEN is incremented
accordingly.  Otherwise, the value is inserted into the result buffer
at the position EPOS with the length ELEN_VAR; when applicable,
it is filled with the characters contained in ECOL_TAB [1].
RESULT_LEN is increased only if the result buffer was edited
after the specified RESULT_LEN.
.sp 2;.cp 5
Funktion KB71PHONMATCH
.sp
Function for checking SOUNDS. VAL specifies the buffer
in which the string starts at the position VAL_POS with the length
VAL_LEN and PAT specifies the buffer in which the pattern
string starts at the position PAT_POS with the length PAT_LEN.
The strings must not contain any undef bytes.
.br
The operands VAL and PAT are transformed into 4 bytes strings using
KB71MATCHVALUES. If these strings are identical the function
supplies 'true'.
.sp 2;.cp 5
Procedure K71QUAL_HANDLING
.sp
For processing the qualification QUAL and building the result buffer
RESULT_BUF, every stack entry is analyzed and either inserted in
the stack for later processing or immediately processed via an
appropriate procedure call.
.br
If the first stack entry of the qualification consists of
ST_JUMP_OUTPUT, the qualification is processed in two runs.  During
the first run, the output stack_entries are ignored and only the
subsequent conditions are checked.  The second run follows with the
output stack entries only if the conditions are fulfilled.
.br
For further optimization, stack entries of the type ST_JUMP_TRUE
or ST_JUMP_FALSE can be contained in the qualification.  In EPOS,
these entries contain the number of subsequent stack entries to
be ignored if the current stack contents are TRUE or FALSE.
.sp 2;.cp 5
Procedure KB71ROWNO
.sp
A number result is created from
the result line number ACT_CNTRESULT contained in SELECT_FIELDS_PARAM.
.sp 2;.cp 3
Procedure KB71TRUTH
.sp
xxx
.CM *-END-* specification -------------------------------
.sp 2
***********************************************************
.sp
.cp 5
.fo
.oc _/1
Description:
 
.CM *-END-* description ---------------------------------
.sp 2
***********************************************************
.sp
.cp 5
.nf
.oc _/1
Structure:
 
.CM *-END-* structure -----------------------------------
.sp 2
**********************************************************
.sp
.cp 40
.nf
.oc _/1
.CM -lll-
Code    :
 
 
CONST
      c_check_new_rec   = true;
      c_check_spec_null = true;
      c_collision_test  = true;
      c_count_only      = true;
      c_escape          = true;
      c_inclusive       = true;
      c_init_inv_tree   = true;
      c_strat_cnt       = true;
      c_string          = true;
      c_with_view       = true;
      c_usage_count     = true; (* h.b. PTS 1104210 *)
      c_m_pi            = 3.141592653589793;
      c_pi2             = '\C1\62\83\18\53\07\17\95\86\47\69\25\28\67\66\55\90\05\76\82';
 
VAR
      kb71cmp_table   : ARRAY[ op_eq..op_ne, tsp00_LcompResult ] OF integer;
      kb71initcap_set : SET OF char;
      kb71op_call     : ARRAY[ tgg00_StackOpType ] OF tsp35proc_ptr;
 
 
(*------------------------------*) 
 
PROCEDURE
      k71code_operand (
            VAR sel          : tgg00_SelectFieldsParam;
            wanted_code      : char;
            VAR operand_addr : tsp00_MoveObjPtr;
            VAR len          : integer;
            operand_st_addr  : tgg00_StEntryAddr;
            VAR e            : tgg00_BasisError);
 
VAR
      code_op  : tgg00_StackOpType;
      dummy_st : tgg00_StackEntry;
 
BEGIN
e := e_ok;
IF  len > 0
THEN
    BEGIN
    code_op := op_none;
    IF  operand_addr^ [1] = csp_ascii_blank
    THEN
        BEGIN
        IF  wanted_code = csp_unicode_def_byte
        THEN
            BEGIN
            WITH dummy_st DO
                BEGIN
                etype         := st_dummy;
                eop           := op_none;
                elen_var      := (len-1) * 2 + 1;
                ecol_tab[ 1 ] := chr(csp_ascii);
                ecol_tab[ 2 ] := chr(csp_unicode);
                END;
            (*ENDWITH*) 
            k78unicode_transform (dummy_st, sel, operand_addr, len, e);
            operand_addr := s35add_moveobj_ptr(sel.sfp_workbuf_addr,
                  sel.sfp_work_st_top^.epos - 1);
            len := sel.sfp_work_st_top^.elen_var;
            sel.sfp_work_st_top :=
                  s35inc_st (sel.sfp_work_st_top, -1)
            END
        ELSE
            IF  wanted_code = csp_ebcdic_blank
            THEN
                code_op := op_ebcdic
            (*ENDIF*) 
        (*ENDIF*) 
        END
    ELSE
        IF  (operand_addr^ [1] = csp_ebcdic_blank) AND
            (wanted_code       = csp_ascii_blank )
        THEN
            code_op := op_ascii;
        (*ENDIF*) 
    (*ENDIF*) 
    IF  code_op <> op_none
    THEN
        BEGIN
        kb71code_transform (code_op, sel, operand_addr, len,
              operand_st_addr, e);
        operand_addr := s35add_moveobj_ptr(sel.sfp_workbuf_addr,
              sel.sfp_work_st_top^.epos - 1);
        len                 := sel.sfp_work_st_top^.elen_var;
        sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, -1)
        END
    (*ENDIF*) 
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      k71col_select (
            VAR t           : tgg00_TransContext;
            VAR sel         : tgg00_SelectFieldsParam;
            VAR stack_desc  : tgg00_StackDesc;
            VAR rec_buf     : tgg00_Rec;
            VAR unqualified : boolean);
 
VAR
      _dummy_st_ptr   : tgg00_StEntryAddr;
      _old_result_len : integer;
 
BEGIN
t.trError_gg00       := e_ok;
unqualified          := false;
_old_result_len      := sel.sfp_result_length;
sel.sfp_rec_addr     := @rec_buf;
sel.sfp_rec_len      := rec_buf.recLen_gg00;
sel.sfp_rec_key_len  := rec_buf.recKeyLen_gg00;
sel.sfp_oldrec_addr  := NIL;
sel.sfp_primkey_addr := NIL;
&ifdef trace
t01buf( kb_qual, rec_buf.buf, 1, sel.sfp_rec_len );
&endif
k71qual_handling( t, sel, ( stack_desc.mview_cnt > 0 ),
      NOT c_check_new_rec, stack_desc, _dummy_st_ptr, unqualified );
IF  ( unqualified )
THEN
    sel.sfp_result_length := _old_result_len;
&ifdef TRACE
(*ENDIF*) 
IF  ( t.trError_gg00 = e_ok ) AND ( sel.sfp_result_length > 0 )
THEN
    t01moveobj( kb_qual, sel.sfp_m_result_addr^, 1, sel.sfp_result_length );
&endif
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      k71column_statistic (VAR m : tgg00_MessBlock);
 
VAR
      aux_file_id : tgg00_FileId;
 
BEGIN
m.mb_trns^.trError_gg00         := e_ok;
m.mb_qual^.mtree.fileRoot_gg00  := NIL_PAGE_NO_GG00;
m.mb_qual^.mtree.fileBdUse_gg00 :=  [];
IF  m.mb_type2 <> mm_key
THEN
    BEGIN
    aux_file_id := m.mb_data^.mbp_sample.sam_tree_id;
    b01treset_file (m.mb_trns^, aux_file_id);
    IF  (m.mb_trns^.trIndex_gg00 = cgg_nil_transindex) AND
        (m.mb_trns^.trError_gg00 = e_ok)
    THEN
        m.mb_trns^.trError_gg00 := e_nil_transindex
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  m.mb_trns^.trError_gg00 = e_ok
THEN
    BEGIN
    CASE  m.mb_type2 OF
        mm_nil:
            bd01ExtractForeignKey( m, aux_file_id );
        mm_clear:
            WITH m.mb_data^.mbp_ColStat DO
                BEGIN
                bd01MultiColumnStatistic( m, aux_file_id, ColStatCalculate_gg00,
                      ColStatNoSampleLeaves_gg00, ColStatNumberOfLeaves_gg00,
                      ColStatNumberOfRecords_gg00, ColStatDistValues_gg00  )
                END;
            (*ENDWITH*) 
        OTHERWISE:
            m.mb_trns^.trError_gg00 := e_not_implemented;
        END;
    (*ENDCASE*) 
    END;
(*ENDIF*) 
IF  m.mb_trns^.trError_gg00 = e_ok
THEN
    BEGIN
    m.mb_type := m_return_result;
    m.mb_struct := mbs_stat_info;
    IF  m.mb_type2 = mm_nil
    THEN
        BEGIN
        m.mb_qual^.mlinktree := aux_file_id;
        m.mb_qual_len        := MB_PART1_HEAD_MXGG00 + FILE_ID_MXGG00
        END
    ELSE
        BEGIN
        m.mb_qual_len  := 0;
        m.mb_data_len  := sizeof (m.mb_data^.mbp_sample)
        END
    (*ENDIF*) 
    END
ELSE
    m.mb_type := m_return_error;
(*ENDIF*) 
m.mb_type2 := mm_nil
END;
 
(*------------------------------*) 
 
PROCEDURE
      k71file_statistic (VAR m : tgg00_MessBlock);
 
VAR
      file_id : tgg00_FileId;
 
BEGIN
m.mb_trns^.trError_gg00 := e_ok;
file_id                 := m.mb_qual^.mtree;
file_id.fileRoot_gg00   := NIL_PAGE_NO_GG00;
file_id.fileBdUse_gg00  := [];
IF  m.mb_type = m_index_statistic
THEN
    BEGIN
    file_id.fileVersion_gg00.ci2_gg00 := cgg_dummy_file_version;
    file_id.fileTfn_gg00      := tfnMulti_egg00;
    file_id.fileName_gg00 [2] := m.mb_st^ [m.mb_qual^.mmult_pos].ecol_tab [1];
    END;
(*ENDIF*) 
IF  m.mb_trns^.trIndex_gg00 = cgg_nil_transindex
THEN
    m.mb_trns^.trError_gg00 := e_nil_transindex;
(*ENDIF*) 
IF  m.mb_trns^.trError_gg00 = e_ok
THEN
    BEGIN
    IF  g04inv_tfn (file_id.fileTfn_gg00)
    THEN
        bd03InvStatistics (m.mb_trns^, file_id, (m.mb_type2 = mm_test), m.mb_data^.mbp_sample)
    ELSE
        b01sfile_statistic (m.mb_trns^, file_id, (m.mb_type2 = mm_nil), m.mb_data^.mbp_sample);
    (*ENDIF*) 
    END;
(*ENDIF*) 
m.mb_type2 := mm_nil;
IF  m.mb_trns^.trError_gg00 = e_ok
THEN
    BEGIN
    m.mb_type      := m_return_result;
    m.mb_struct    := mbs_stat_info;
    m.mb_qual_len  := 0;
    m.mb_data_len  := sizeof (m.mb_data^.mbp_sample)
    END
ELSE
    m.mb_type := m_return_error
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      k71get (VAR m : tgg00_MessBlock);
 
VAR
      dummy_granted : tgg00_LockReqMode;
      bd_inv_info   : tgg00_BdInvSet;
      dummy_int4    : tsp00_Int4;
      dummy1_int4   : tsp00_Int4;
      pos2          : tsp00_Int4;
      k             : tgg00_Lkey;
      rk            : tgg00_Lkey;
      release_lock  : boolean;
      try_again     : boolean;
 
BEGIN
m.mb_trns^.trError_gg00 := e_ok;
k.len := m.mb_data^.mbp_keylen;
IF  (m.mb_data^.mbp_keylen > 0) AND (m.mb_type2 <> mm_test)
THEN
    g10mv ('VKB71 ',   1,    
          m.mb_data_size, sizeof(k.k),
          @m.mb_data^.mbp_buf, cgg_rec_key_offset + 1,
          @k.k, 1, k.len, m.mb_trns^.trError_gg00);
(*ENDIF*) 
IF  m.mb_trns^.trError_gg00 = e_ok
THEN
    CASE m.mb_type2 OF
        mm_direct:
            BEGIN
            IF  g04inv_tfn (m.mb_qual^.mtree.fileTfn_gg00)
            THEN
                BEGIN
&               ifdef TRACE
                b01filestate ( m.mb_trns^, m.mb_qual^.mtree);
                IF  m.mb_trns^.trError_gg00 = e_ok
                THEN
                    BEGIN
&                   endif
                    rk.len := 0;
                    bd_inv_info := [primary_start];
                    b03get_inv (m.mb_trns^, m.mb_qual^.mtree, k, rk, k, rk,
                          bd_inv_info, NOT c_count_only, lckRowShare_egg00,
                          m.mb_data^.mbp_4kbuf, dummy_int4, dummy1_int4);
                    IF  m.mb_trns^.trError_gg00 = e_inv_list_not_found
                    THEN
                        m.mb_trns^.trError_gg00 := e_key_not_found
&                             ifdef TRACE
                    (*ENDIF*) 
                    END
&               endif
                (*ENDIF*) 
                END
            ELSE
                BEGIN
                m.mb_qual^.mtree.fileBdUse_gg00 :=  [];
                (* PTS 1126907 UH 2004-01-07 added release lock handling *)
                release_lock := false;
                REPEAT
                    BEGIN
                    try_again := false;
                    b02get_lock_record (m.mb_trns^, m.mb_qual^.mtree, k,
                          m.mb_data^.mbp_rec);
                    IF  m.mb_trns^.trError_gg00 = e_wait_for_lock_release
                    THEN
                        BEGIN
                        m.mb_trns^.trError_gg00 := e_ok;
                        k53wait (m.mb_trns^, m.mb_type, m.mb_type2);
                        IF  m.mb_trns^.trError_gg00 = e_ok
                        THEN
                            BEGIN
                            try_again    := true;
                            release_lock :=
                                  hsCollisionTest_egg00 IN m.mb_qual^.mtree.fileHandling_gg00;
                            END;
                        (*ENDIF*) 
                        END;
                    (*ENDIF*) 
                    END;
                UNTIL
                    NOT try_again;
                (*ENDREPEAT*) 
                IF  release_lock
                    AND
                    (m.mb_trns^.trError_gg00 = e_ok)
                THEN
                    IF   m.mb_qual^.mtree.fileTabId_gg00 = g01tabid.sys1_cat.fileTabId_gg00
                    THEN
                        k53key_unlock (m.mb_trns^, lckSysShare_egg00, m.mb_qual^.mtree.fileTabId_gg00, k)
                    ELSE
                        k53key_unlock (m.mb_trns^, lckRowShare_egg00, m.mb_qual^.mtree.fileTabId_gg00, k);
                    (*ENDIF*) 
                (* PTS 1126907 UH 2004-01-07 end *)
                (*ENDIF*) 
                IF  (m.mb_trns^.trError_gg00 = e_ok)
                    AND
                    (m.mb_qual^.mtree.fileTabId_gg00 = g01tabid.sys1_cat.fileTabId_gg00)
                THEN
                    BEGIN
                    IF  (m.mb_data^.mbp_info.basesyskey.sentrytyp [2] = chr(1)) AND
                        (m.mb_data^.mbp_info.basesyskey.sentrytyp [1] = chr(0))
                    THEN
                        BEGIN
                        (* tbase catalog record, transfer statistics *)
                        (* and root into tbase record                *)
                        a28transfer_statistics (m.mb_trns^,
                              m.mb_data^.mbp_rec,
                              m.mb_qual^.mtree.fileHandling_gg00 =
                              [hsCollisionTest_egg00, hsNoWait_egg00])
                        END
                    (*ENDIF*) 
                    END
                (*ENDIF*) 
                END
            (*ENDIF*) 
            END;
        mm_test :
            BEGIN
            (* is used for exist check in the course of *)
            (* referential integrity verifying          *)
            pos2 := cgg_rec_key_offset + 1;
            WHILE (m.mb_trns^.trError_gg00 = e_ok) AND (pos2 <= m.mb_data_len ) DO
                BEGIN
                k.len := ord(m.mb_data^.mbp_buf [pos2]) * 256 +
                      ord(m.mb_data^.mbp_buf [pos2+1]);
                pos2  := pos2 + 2;
                g10mv ('VKB71 ',   2,    
                      m.mb_data_size, sizeof(k.k),
                      @m.mb_data^.mbp_buf, pos2,
                      @k.k, 1, k.len, m.mb_trns^.trError_gg00);
                pos2 := pos2 + k.len;
                IF  g04inv_tfn (m.mb_qual^.mtree.fileTfn_gg00)
                THEN
                    BEGIN
                    rk.len := 0;
                    bd_inv_info := [primary_start];
                    b03get_inv (m.mb_trns^, m.mb_qual^.mtree, k, rk, k, rk,
                          bd_inv_info, NOT c_count_only, lckRowShare_egg00,
                          m.mb_data^.mbp_4kbuf, dummy_int4, dummy1_int4);
                    IF  m.mb_trns^.trError_gg00 = e_inv_list_not_found
                    THEN
                        m.mb_trns^.trError_gg00 := e_key_not_found
                    (*ENDIF*) 
                    END
                ELSE
                    BEGIN
                    k53row_lock (m.mb_trns^, m.mb_qual^.mtree, k,
                          m.mb_data^.mbp_4kbuf, 0,
                          m.mb_type, 1, dummy_granted);
                    IF  m.mb_trns^.trError_gg00 = e_wait_for_lock_release
                    THEN
                        k53wait (m.mb_trns^, m.mb_type, m.mb_type2);
                    (*ENDIF*) 
                    IF  m.mb_trns^.trError_gg00 = e_ok
                    THEN
                        BEGIN
                        m.mb_qual^.mtree.fileBdUse_gg00 :=  [];
                        b02exists_record (m.mb_trns^, m.mb_qual^.mtree, k);
                        END;
                    (*ENDIF*) 
                    END
                (*ENDIF*) 
                END
            (*ENDWHILE*) 
            END;
        mm_prev:
            BEGIN
            b02prev_record (m.mb_trns^, m.mb_qual^.mtree, k,
                  NOT c_inclusive, m.mb_data^.mbp_rec);
            IF  m.mb_trns^.trError_gg00 = e_key_not_found
            THEN
                m.mb_trns^.trError_gg00 := e_ok
            (*ENDIF*) 
            END;
        OTHERWISE
            m.mb_trns^.trError_gg00 := e_not_implemented
        END;
    (*ENDCASE*) 
(*ENDIF*) 
m.mb_type2 := mm_nil;
IF  m.mb_trns^.trError_gg00 = e_ok
THEN
    BEGIN
    m.mb_type      := m_return_result;
    m.mb_struct    := mbs_buf;
    m.mb_qual_len  := 0;
    m.mb_data_len  := m.mb_data^.mbp_reclen
    END
ELSE
    BEGIN
    m.mb_type := m_return_error;
    IF  m.mb_trns^.trError_gg00 <> e_wait_for_lock_release
    THEN
        BEGIN
        m.mb_qual_len  := 0;
        m.mb_data_len  := 0
        END
    (*ENDIF*) 
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      k71get_operand (
            VAR sel          : tgg00_SelectFieldsParam;
            check_spec_null  : boolean;
            VAR operand_addr : tsp00_MoveObjPtr;
            VAR len          : integer;
            VAR e            : tgg00_BasisError);
 
VAR
      pos    : integer;
      pParam : tgg00_StEntryAddr;
 
LABEL
      999;
 
BEGIN
e            := e_ok;
operand_addr := g01glob.undef_addr;
len          := 1;
WITH sel.sfp_work_st_top^ DO
    BEGIN
    CASE etype OF
        st_fixkey:
            IF  sel.sfp_primkey_addr <> NIL
            THEN
                BEGIN
                e := e_stack_type_illegal;
                goto 999
                END
            ELSE
                BEGIN
                operand_addr :=
                      s35add_moveobj_ptr(@sel.sfp_rec_addr^,
                      cgg_rec_key_offset + epos - 1);
                len := elen_var
                END;
            (*ENDIF*) 
        st_varkey:
            IF  sel.sfp_primkey_addr <> NIL
            THEN
                BEGIN
                e := e_stack_type_illegal;
                goto 999
                END
            ELSE
                BEGIN
                operand_addr :=
                      s35add_moveobj_ptr(@sel.sfp_rec_addr^,
                      cgg_rec_key_offset + epos - 1);
                len := sel.sfp_rec_key_len + 1 - epos
                END;
            (*ENDIF*) 
        st_fixcol:
            IF  sel.sfp_primkey_addr <> NIL
            THEN
                BEGIN
                e := e_stack_type_illegal;
                goto 999;
                END
            ELSE
                BEGIN
                operand_addr := s35add_moveobj_ptr (@sel.sfp_rec_addr^,
                      cgg_rec_key_offset +
                      sel.sfp_rec_key_len + epos - 1);
                len := elen_var
                END;
            (*ENDIF*) 
        st_varcol :
            IF  sel.sfp_primkey_addr <> NIL
            THEN
                BEGIN
                e := e_stack_type_illegal;
                goto 999
                END
            ELSE
                BEGIN
                g04locate_col (sel.sfp_work_st_top^,
                      @(sel.sfp_rec_addr^), sel.sfp_varcol_pos,
                      pos, len);
                IF  len = 0
                THEN
                    len := 1
                ELSE
                    operand_addr :=
                          s35add_moveobj_ptr(@sel.sfp_rec_addr^, pos - 1)
                (*ENDIF*) 
                END;
            (*ENDIF*) 
        st_fixinv:
            IF  (inv_and_primary = sel.sfp_bd_inv_only) AND
                (sel.sfp_primkey_addr = NIL)
            THEN
                BEGIN
                e := e_stack_type_illegal;
                goto 999
                END
            ELSE
                BEGIN
                operand_addr := s35add_moveobj_ptr(@sel.sfp_rec_addr^,
                      epos - 1);
                len := elen_var
                END;
            (*ENDIF*) 
        st_varinv:
            IF  (inv_and_primary = sel.sfp_bd_inv_only) AND
                (sel.sfp_primkey_addr = NIL)
            THEN
                BEGIN
                e := e_stack_type_illegal;
                goto 999
                END
            ELSE
                BEGIN
                operand_addr := s35add_moveobj_ptr(@sel.sfp_rec_addr^,
                      epos - 1);
                (* sfp_rec_len = sec_key_len *)
                len := sel.sfp_rec_len + 1 - epos
                END;
            (*ENDIF*) 
        st_fixprimkey:
            IF  sel.sfp_primkey_addr = NIL
            THEN
                BEGIN
                e := e_stack_type_illegal;
                goto 999
                END
            ELSE
                BEGIN
                operand_addr := s35add_moveobj_ptr(@sel.sfp_primkey_addr^,
                      epos - 1 );
                len := elen_var
                END;
            (*ENDIF*) 
        st_varprimkey:
            IF  sel.sfp_primkey_addr = NIL
            THEN
                BEGIN
                e := e_stack_type_illegal;
                goto 999
                END
            ELSE
                BEGIN
                operand_addr := s35add_moveobj_ptr(@sel.sfp_primkey_addr^,
                      epos - 1);
                len := sel.sfp_rec_key_len + 1 - epos
                END;
            (*ENDIF*) 
        st_old_fixkey:
            IF  sel.sfp_oldrec_addr = NIL
            THEN
                BEGIN
                e := e_stack_type_illegal;
                goto 999
                END
            ELSE
                BEGIN
                operand_addr := s35add_moveobj_ptr(@sel.sfp_oldrec_addr^,
                      sel.sfp_oldrec_pos - 1 +
                      cgg_rec_key_offset + epos -1 );
                len := elen_var
                END;
            (*ENDIF*) 
        st_old_varkey:
            IF  sel.sfp_oldrec_addr = NIL
            THEN
                BEGIN
                e := e_stack_type_illegal;
                goto 999
                END
            ELSE
                BEGIN
                operand_addr := s35add_moveobj_ptr(@sel.sfp_oldrec_addr^,
                      sel.sfp_oldrec_pos - 1 +
                      cgg_rec_key_offset + epos - 1);
                len := sel.sfp_oldkey_len + 1 - epos
                END;
            (*ENDIF*) 
        st_old_fixcol:
            IF  sel.sfp_oldrec_addr = NIL
            THEN
                BEGIN
                e := e_stack_type_illegal;
                goto 999
                END
            ELSE
                BEGIN
                operand_addr := s35add_moveobj_ptr(@sel.sfp_oldrec_addr^,
                      sel.sfp_oldrec_pos - 1 + cgg_rec_key_offset +
                      sel.sfp_oldkey_len + epos - 1);
                len := elen_var
                END;
            (*ENDIF*) 
        st_old_varcol, st_old_varlongchar :
            IF  sel.sfp_oldrec_addr = NIL
            THEN
                BEGIN
                e := e_stack_type_illegal;
                goto 999
                END
            ELSE
                BEGIN
                g04locate_col (sel.sfp_work_st_top^,
                      @(sel.sfp_oldrec_addr^[sel.sfp_oldrec_pos]),
                      sel.sfp_varcol_pos, pos, len);
                IF  len = 0
                THEN
                    len := 1
                ELSE
                    operand_addr :=
                          s35add_moveobj_ptr(@sel.sfp_oldrec_addr^, pos - 1)
                (*ENDIF*) 
                END;
            (*ENDIF*) 
        st_varlongchar :
            IF  sel.sfp_primkey_addr <> NIL
            THEN
                BEGIN
                e := e_stack_type_illegal;
                goto 999
                END
            ELSE
                BEGIN
                g04locate_col (sel.sfp_work_st_top^,
                      @(sel.sfp_rec_addr^),
                      sel.sfp_varcol_pos, pos, len);
                IF  len = 0
                THEN
                    len := 1
                ELSE
                    operand_addr :=
                          s35add_moveobj_ptr(@sel.sfp_rec_addr^, pos - 1)
                (*ENDIF*) 
                END;
            (*ENDIF*) 
        st_value:
            BEGIN
            operand_addr := s35add_moveobj_ptr(sel.sfp_data_addr, epos - 1);
            len := elen_var
            END;
        st_value_idx:
            BEGIN
            operand_addr := s35add_moveobj_ptr(sel.sfp_data_addr,
                  sel.sfp_valuearr_addr^[epos] - 1);
            len := elen_var
            END;
        st_result:
            BEGIN
            IF  epos < sel.sfp_workbuf_top
            THEN
                sel.sfp_workbuf_top := epos - 1;
            (*ENDIF*) 
            operand_addr :=
                  s35add_moveobj_ptr(sel.sfp_workbuf_addr, epos - 1);
            len := elen_var
            END;
        st_column:
            BEGIN
            IF  sel.sfp_primkey_addr <> NIL
            THEN
                BEGIN
                e := e_stack_type_illegal;
                goto 999
                END
            ELSE
                BEGIN
                g04locate_col (sel.sfp_work_st_top^,
                      @(sel.sfp_rec_addr^), sel.sfp_varcol_pos,
                      pos, len);
                IF  len = 0
                THEN
                    len := 1
                ELSE
                    operand_addr :=
                          s35add_moveobj_ptr(@sel.sfp_rec_addr^, pos - 1)
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            END;
        st_param:
            BEGIN
            pParam := s35inc_st (sel.sfp_work_st_frame, epos);
&           ifdef trace
            t01stackentry (kb_qual, pParam^, 0);
&           endif
            operand_addr :=
                  s35add_moveobj_ptr(sel.sfp_workbuf_addr, pParam^.epos - 1);
            len := pParam^.elen_var
            END;
        OTHERWISE
            BEGIN
            e := e_stack_type_illegal;
            goto 999
            END
        END;
    (*ENDCASE*) 
    END;
(*ENDWITH*) 
IF  check_spec_null
THEN
    IF  operand_addr^ [1] = csp_oflw_byte
    THEN
        BEGIN
        e := e_special_null;
        goto 999
        END;
    (*ENDIF*) 
(*ENDIF*) 
999 : ;
&ifdef TRACE
IF  e = e_ok
THEN
    t01moveobj (kb_qual, operand_addr^, 1, len);
&endif
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      k71init;
 
VAR
      _ix  : integer;
      _op  : tgg00_StackOpType;
      _t   : tgg00_TransContext;
      _res : tsp00_LcompResult;
      _s   : tgg00_SelectFieldsParam;
      _st  : tgg00_StackEntry;
 
BEGIN
FOR _op := op_eq TO op_ne DO
    BEGIN
    FOR _res := l_less TO l_undef DO
        kb71cmp_table[_op, _res]  := cgg04_is_false;
    (*ENDFOR*) 
    kb71cmp_table[_op, l_undef] := cgg04_is_undef
    END;
(*ENDFOR*) 
kb71cmp_table[op_eq,     l_equal  ] := cgg04_is_true;
kb71cmp_table[op_eq_all, l_equal  ] := cgg04_is_true;
kb71cmp_table[op_ge,     l_equal  ] := cgg04_is_true;
kb71cmp_table[op_ge,     l_greater] := cgg04_is_true;
kb71cmp_table[op_gt,     l_greater] := cgg04_is_true;
kb71cmp_table[op_le,     l_equal  ] := cgg04_is_true;
kb71cmp_table[op_le,     l_less   ] := cgg04_is_true;
kb71cmp_table[op_lt,     l_less   ] := cgg04_is_true;
kb71cmp_table[op_ne,     l_less   ] := cgg04_is_true;
kb71cmp_table[op_ne,     l_greater] := cgg04_is_true;
IF  ' ' = csp_ascii_blank
THEN (* initcap_set for ascii *)
    kb71initcap_set := [ 'a'..'z',
          '0'..'9',
          chr(224) .. chr(246),
          chr(248) .. chr(255),
          chr(223) ]
ELSE (* initcap_set for ebcdic *)
    kb71initcap_set := [ 'a'..'i', 'j'..'r', 's'..'z',
          '0'..'9',
          chr(66)..chr(73),
          chr(81)..chr(89),
          chr(112),
          chr(140)..chr(142),
          chr(156),
          chr(203)..chr(207),
          chr(219)..chr(223) ];
(*ENDIF*) 
(* The following is no real PASCAL code.             *)
(* In the generated C code, the array kb71op_call    *)
(* is an array of pointers to functions.             *)
(* The following statements assign the pointer       *)
(* of the function, that implements the operation op *)
(* to kb71op_call[op]                                *)
FOR _op := op_none TO op_dbyte_translate DO
    kb71op_call[_op] := s35func_ptr (kb71invalid (_t,_s,_st));
(*ENDFOR*) 
kb71op_call[op_mapchar] :=
      s35func_ptr (kb71op_mapchar (_t,_s,_st));
kb71op_call[op_ascii] :=
      s35func_ptr (kb71op_trans_string (_t,_s,_st));
kb71op_call[op_dbyte_length] :=
      s35func_ptr (kb71op_length (_t,_s,_st));
kb71op_call[op_digits] :=
      s35func_ptr (kb71op_bytes (_t,_s,_st));
kb71op_call[op_ebcdic] :=
      s35func_ptr (kb71op_trans_string (_t,_s,_st));
kb71op_call[op_fixed] :=
      s35func_ptr (kb71number_to_value (_t,_s,_st));
kb71op_call[op_hex] :=
      s35func_ptr (kb71op_bytes (_t,_s,_st));
kb71op_call[op_in] :=
      s35func_ptr (kb71op_in (_t,_s,_st));
kb71op_call[op_initcap] :=
      s35func_ptr (kb71op_initcap (_t,_s,_st));
kb71op_call[op_length] :=
      s35func_ptr (kb71op_length (_t,_s,_st));
kb71op_call[op_lowcase] :=
      s35func_ptr (kb71op_trans_string (_t,_s,_st));
kb71op_call[op_not_in] :=
      s35func_ptr (kb71op_in (_t,_s,_st));
kb71op_call[op_num] :=
      s35func_ptr (kb71op_num (_t,_s,_st));
kb71op_call[op_order_desc] :=
      s35func_ptr (kb71op_desc (_t,_s,_st));
kb71op_call[op_outer_join] :=
      s35func_ptr (kb71ok (_t,_s,_st));
kb71op_call[op_remove] :=
      s35func_ptr (kb71op_rem_repl (_t,_s,_st));
kb71op_call[op_replace] :=
      s35func_ptr (kb71op_rem_repl (_t,_s,_st));
kb71op_call[op_soundex] :=
      s35func_ptr (kb71op_soundex (_t,_s,_st));
kb71op_call[op_stamp] :=
      s35func_ptr (kb71op_stamp (_t,_s,_st));
kb71op_call[op_unique_desc] :=
      s35func_ptr (kb71op_desc (_t,_s,_st));
kb71op_call[op_upcase] :=
      s35func_ptr (kb71op_trans_string (_t,_s,_st));
kb71op_call[op_translate] :=
      s35func_ptr (kb71translate (_t,_s,_st));
kb71op_call[op_hextoraw] :=
      s35func_ptr (kb71op_hextoraw (_t,_s,_st));
kb71op_call[op_nextval] :=
      s35func_ptr (kb71op_nextval (_t,_s,_st));
kb71op_call[op_scol_upd] :=
      s35func_ptr (kb71op_longcol_update (_t,_s,_st));
(* PTS 1120720 E.Z. *)
kb71op_call[op_dbyte_mapchar] :=
      s35func_ptr (kb71dbyte_mapchar (_t,_s,_st));
kb71op_call[op_longcol_update] :=
      s35func_ptr (kb71op_longcol_update (_t,_s,_st));
FOR _op := op_adddate TO op_weekofyear DO
    kb71op_call[_op] := s35func_ptr ( k79date_time (_t,_s,_st));
(*ENDFOR*) 
FOR _op := op_abs TO op_trunc DO
    kb71op_call[_op] := s35func_ptr (kb71op_func_arith (_t,_s,_st));
(*ENDFOR*) 
FOR _op := op_div TO op_plus DO
    kb71op_call[_op] := s35func_ptr (kb71op_arith (_t,_s,_st));
(*ENDFOR*) 
kb71op_call[op_is_integer] :=
      s35func_ptr (kb71op_bool (_t,_s,_st));
kb71op_call[op_between] :=
      s35func_ptr (kb71op_bool (_t,_s,_st));
kb71op_call[op_not_between] :=
      s35func_ptr (kb71op_bool (_t,_s,_st));
kb71op_call[op_not] :=
      s35func_ptr (kb71bool_arith (_t,_s,_st));
kb71op_call[op_upd_view_and] :=
      s35func_ptr (kb71bool_arith (_t,_s,_st));
kb71op_call[op_and] :=
      s35func_ptr (kb71bool_arith (_t,_s,_st));
kb71op_call[op_or] :=
      s35func_ptr (kb71bool_arith (_t,_s,_st));
kb71op_call[op_like] :=
      s35func_ptr (kb71op_bool (_t,_s,_st));
kb71op_call[op_not_like] :=
      s35func_ptr (kb71op_bool (_t,_s,_st));
kb71op_call[op_not_null] :=
      s35func_ptr (kb71op_bool (_t,_s,_st));
kb71op_call[op_not_sounds] :=
      s35func_ptr (kb71op_bool (_t,_s,_st));
kb71op_call[op_null] :=
      s35func_ptr (kb71op_bool (_t,_s,_st));
kb71op_call[op_sounds] :=
      s35func_ptr (kb71op_bool (_t,_s,_st));
kb71op_call[op_true] :=
      s35func_ptr (kb71op_bool (_t,_s,_st));
kb71op_call[op_false] :=
      s35func_ptr (kb71op_bool (_t,_s,_st));
kb71op_call[op_undef_to_false] :=
      s35func_ptr (kb71bool_arith (_t,_s,_st));
kb71op_call[op_eq] :=
      s35func_ptr (kb71op_compare (_t,_s,_st));
kb71op_call[op_eq_all] :=
      s35func_ptr (kb71op_compare (_t,_s,_st));
kb71op_call[op_ge] :=
      s35func_ptr (kb71op_compare (_t,_s,_st));
kb71op_call[op_gt] :=
      s35func_ptr (kb71op_compare (_t,_s,_st));
kb71op_call[op_le] :=
      s35func_ptr (kb71op_compare (_t,_s,_st));
kb71op_call[op_lt] :=
      s35func_ptr (kb71op_compare (_t,_s,_st));
kb71op_call[op_ne] :=
      s35func_ptr (kb71op_compare (_t,_s,_st));
kb71op_call[op_dbyte_upper] :=
      s35func_ptr (kb71dbyte_upp_low (_t,_s,_st));
kb71op_call[op_dbyte_lower] :=
      s35func_ptr (kb71dbyte_upp_low (_t,_s,_st));
kb71op_call[op_dbyte_initcap] :=
      s35func_ptr (kb71dbyte_initcap (_t,_s,_st));
kb71op_call[op_dbyte_replace] :=
      s35func_ptr (kb71op_rem_repl (_t,_s,_st));
kb71op_call[op_dbyte_remove] :=
      s35func_ptr (kb71op_rem_repl (_t,_s,_st));
kb71op_call[op_dbyte_translate] :=
      s35func_ptr (kb71dbyte_translate (_t,_s,_st));
kb71op_call[op_serial] :=
      s35func_ptr (kb71op_serial (_t, _s, _st));
kb71op_call[op_test_zero] :=
      s35func_ptr (kb71test_zero (_t, _s, _st));
kb71op_call[op_updated] :=
      s35func_ptr (kb71op_updated (_t, _s, _st)); (* PTS 1126557 *)
WITH k71serial_seq_info DO
    BEGIN
    seq_increment[1] := chr(193);      (* increment = 1             *)
    seq_increment[2] := chr(16);
    seq_cachevalue   := seq_increment; (* cache = 1                 *)
    seq_minvalue     := seq_increment; (* minvalue = 1              *)
    seq_maxvalue [1] := chr(202);      (* maxvalue = 9999999999 ... *)
    FOR _ix := 2 TO sizeof (k71serial_seq_info.seq_maxvalue) DO
        seq_maxvalue[_ix] := chr(153);
    (*ENDFOR*) 
    seq_site  := cgg_zero_c2;
    seq_cycle := true;
    seq_first := false;
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      k71inv_col_select (
            VAR t           : tgg00_TransContext;
            VAR sel         : tgg00_SelectFieldsParam;
            VAR stack_desc  : tgg00_StackDesc;
            sec_key         : tsp00_KeyAddr;
            sec_key_len     : tsp00_Int2;
            prim_key        : tsp00_KeyAddr;
            prim_key_len    : tsp00_Int2;
            VAR unqualified : boolean);
 
VAR
      _dummy_st_ptr   : tgg00_StEntryAddr;
      _old_result_len : integer;
 
BEGIN
t.trError_gg00       := e_ok;
unqualified          := false;
_old_result_len      := sel.sfp_result_length;
sel.sfp_rec_addr     := @(sec_key^);
sel.sfp_rec_len      := sec_key_len;
sel.sfp_primkey_addr := prim_key;
sel.sfp_rec_key_len  := prim_key_len;
sel.sfp_oldrec_addr  := NIL;
k71qual_handling( t, sel, ( stack_desc.mview_cnt > 0 ),
      NOT c_check_new_rec, stack_desc, _dummy_st_ptr, unqualified );
IF  ( unqualified )
THEN
    sel.sfp_result_length := _old_result_len;
&ifdef TRACE
(*ENDIF*) 
IF  ( t.trError_gg00 = e_ok ) AND ( sel.sfp_result_length > 0 )
THEN
    t01moveobj( kb_qual, sel.sfp_m_result_addr^, 1, sel.sfp_result_length );
&endif
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      k71join_comparison (
            VAR sel     : tgg00_SelectFieldsParam;
            op          : tgg00_StackOpType;
            VAR workbuf : tkb07_buffer_description;
            buf1        : tsp00_MoveObjPtr;
            pos1        : tsp00_Int4;
            len1        : integer;
            buf2        : tsp00_MoveObjPtr;
            pos2        : tsp00_Int4;
            len2        : integer;
            VAR ok      : integer);
 
BEGIN
workbuf.buffer_len := 0;
kb71comparison (sel, op, workbuf, buf1^ , pos1, len1, buf2^, pos2, len2, ok)
END;
 
(*------------------------------*) 
 
PROCEDURE
      k71num_err_to_b_err (
            num_err : tsp00_NumError;
            VAR e : tgg00_BasisError);
 
BEGIN
CASE num_err OF
    num_ok, num_trunc:
        e := e_ok;
    num_overflow:
        e := e_num_overflow;
    num_invalid:
        e := e_num_invalid;
    OTHERWISE
        e := e_stack_op_illegal
    END
(*ENDCASE*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      k71qualification_test (
            VAR m           : tgg00_MessBlock;
            first_qual      : boolean;
            result_wanted   : boolean;
            check_new_rec   : boolean;
            VAR rec         : tgg00_Rec;
            result_ptr      : tsp00_MoveObjPtr;
            result_size     : tsp00_Int4;
            VAR result_len  : integer);
 
VAR
      sel : tgg00_SelectFieldsParam;
 
BEGIN
g04init_select_fields (sel, @m.mb_data^.mbp_buf, m.mb_data_size,
      m.mb_valuearr, m.mb_validx_max,
      m.mb_work_st, m.mb_work_st_max, m.mb_workbuf, m.mb_workbuf_size,
      m.mb_qual^.msqlmode);
WITH sel DO
    BEGIN
    sfp_bd_mess_type    := m.mb_type;
    sfp_bd_mess2_type   := m.mb_type2;
    sfp_result_wanted   := result_wanted;
    sfp_first_qual      := first_qual;
    IF  result_wanted
    THEN
        BEGIN
        sfp_m_result_addr := result_ptr;
        sfp_m_result_size := result_size
        END
    ELSE
        BEGIN
        sfp_m_result_addr := NIL;
        sfp_m_result_size := 0
        END;
    (*ENDIF*) 
    sfp_acv_addr := m.mb_trns^.trAcvPtr_gg00;   (* PTS 1121403 E.Z. *)
    END;
(*ENDWITH*) 
k71sel_qualification_test (m, sel, check_new_rec, rec);
result_len := sel.sfp_result_length;
END;
 
(*------------------------------*) 
 
PROCEDURE
      k71sel_qualification_test (
            VAR m          : tgg00_MessBlock;
            VAR sel        : tgg00_SelectFieldsParam;
            check_new_rec  : boolean;
            VAR rec        : tgg00_Rec);
 
VAR
      _with_view    : boolean;
      _dummy_bool   : boolean;
      _aux_error    : tgg00_BasisError;
      _dummy_err    : tgg00_BasisError;
      _err_st_ptr   : tgg00_StEntryAddr;
      _err_msg      : tgg04_Err;
 
BEGIN
sel.sfp_result_length := 0;
sel.sfp_rec_addr      := @rec.buf;
sel.sfp_rec_len       := rec.len;
sel.sfp_rec_key_len   := rec.keylen;
IF  NOT sel.sfp_first_qual AND (m.mb_type <> m_update)
THEN
    _with_view := false
ELSE
    _with_view := (m.mb_qual^.mview_cnt > 0);
(*ENDIF*) 
m.mb_qual^.mst_addr := m.mb_st;
m.mb_qual^.mst_max  := m.mb_st_max;
k71qual_handling (m.mb_trns^, sel, _with_view, check_new_rec,
      m.mb_qual^.mstack_desc, _err_st_ptr, _dummy_bool);
IF  (m.mb_trns^.trError_gg00 = e_view_violation) AND check_new_rec
    AND (m.mb_type IN  [m_update, m_insert])
THEN
    m.mb_trns^.trError_gg00 := e_upd_view_violation;
(* to show the Compiler that result_stack ist necessary *)
(*ENDIF*) 
IF  m.mb_trns^.trError_gg00 <> e_ok
THEN
    IF  (_err_st_ptr <> NIL)
        AND
        ((m.mb_type = m_insert       ) OR
        ( m.mb_type = m_insert_select) OR
        ( m.mb_type = m_update       ) OR
        ( m.mb_type = m_delete      ))
    THEN
        WITH _err_msg DO
            BEGIN
            a05get_err_tabid (m.mb_qual^.mtree, errtableid);
            errstack     := _err_st_ptr^;
            errtablesite := cgg_zero_c2;
            errstacktype := tfnTable_egg00;
            _aux_error    := m.mb_trns^.trError_gg00;
            b06put_errtxt (m.mb_trns^, m.mb_trns^.trTaskId_gg00,
                  SURROGATE_MXGG00 + STACK_ENTRY_MXGG00 + 3,
                  errtext_stack, m.mb_trns^.trError_gg00, _err_msg.errt,
                  _dummy_err);
            m.mb_trns^.trError_gg00 := _aux_error
            END;
        (*ENDWITH*) 
    (*ENDIF*) 
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      k71select (VAR m : tgg00_MessBlock);
 
CONST
      c_put_strat    = true;
      c_ignore_vwait = true;
 
VAR
      bIsUndef        : boolean;
      _dummy_bool     : boolean;
      _dummy_granted  : tgg00_LockReqMode;
      _use_stopkey    : boolean;
      _aux_error      : tgg00_BasisError;
      _ic2            : tsp00_IntMapC2;
      _i              : integer;
      _cur_pos        : integer;
      _length         : integer;
      _rec_pos        : integer;
      _rec_key_len    : integer;
      _start_sec      : tsp00_Int4;
      _start_microsec : tsp00_Int4;
      _start_phys_ios : tsp00_Int4;
      _start_suspends : tsp00_Int4;
      _start_waits    : tsp00_Int4;
      _use_info       : tgg00_BdInvSet;
      _lock_mode      : tgg00_LockReqMode;
      _dummy_mode     : tgg00_LockReqMode;
      _lock_state     : tgg00_LockReqState;
      _two_ids        : tgg00_TwoFileIds;
      _start_k        : tgg00_TwoKeys;
      _stop_k         : tgg00_TwoKeys;
      _sel            : tgg00_SelectFieldsParam;
      _result_buf     : tsp00_Buf;
      _pseudo_rec     : tgg00_Rec;
 
BEGIN
&ifdef TRACE
FOR _i := m.mb_data_len + 1 TO m.mb_data_size DO
    m.mb_data^.mbp_buf[ _i ] := chr( 254 );
(*ENDFOR*) 
t01messtype( kb_qual, 'mtype       ', m.mb_type );
t01mess2type( kb_qual, 'm2type      ', m.mb_type2 );
&endif
m.mb_trns^.trError_gg00 := e_ok;
_lock_mode  := lckFree_egg00;
_lock_state :=  [];
(* PTS 1001469 E.Z. *)
IF  ( b73spage_ref_statistic OR a01diag_monitor_on OR a01diag_analyze_on )
THEN
    BEGIN
    vclock( _start_sec, _start_microsec );
    vmonitor( m.mb_trns^.trTaskId_gg00, _start_phys_ios, _start_suspends,
          _start_waits );
    END
(* PTS 1001518 E.Z. *)
ELSE
    _start_sec := 0;
(*ENDIF*) 
IF  ( m.mb_qual^.msubquery )
THEN
    k720_test_subquery( m.mb_trns^, m.mb_data^, m.mb_data_size,
          m.mb_qual^.mstack_desc, _result_buf );
(*ENDIF*) 
IF  ( m.mb_trns^.trError_gg00 = e_ok )
THEN
    BEGIN
    _two_ids.file_id := m.mb_qual^.mtree;
    g04init_select_fields( _sel, @m.mb_data^.mbp_buf, m.mb_data_size,
          m.mb_valuearr, m.mb_validx_max,
          m.mb_work_st, m.mb_work_st_max, m.mb_workbuf, m.mb_workbuf_size,
          m.mb_qual^.msqlmode );
    _sel.sfp_bd_mess_type  := m.mb_type;
    _sel.sfp_bd_mess2_type := m.mb_type2;
    _sel.sfp_result_wanted := true;
    _sel.sfp_m_result_addr := @_result_buf;
    _sel.sfp_m_result_size := sizeof( _result_buf );
    _sel.sfp_acv_addr      := m.mb_trns^.trAcvPtr_gg00;   (* PTS 1121403 E.Z. *)
    IF  ( m.mb_type2 = mm_direct )
    THEN
        BEGIN
        _cur_pos := cgg_rec_key_offset + 1;
        _length  := m.mb_data^.mbp_keylen;
        END
    ELSE
        BEGIN
        (* postion of primary start key *)
        _cur_pos := m.mb_st^[ m.mb_qual^.mstrat_pos ].epos;
        _length  := m.mb_st^[ m.mb_qual^.mstrat_pos ].elen_var;
        END;
    (*ENDIF*) 
&   ifdef trace
    t01int4( kb_qual, 'cur_pos     ', _cur_pos );
    t01int4( kb_qual, 'length      ', _length );
&   endif
    _start_k.reckey.len := _length;
    IF  ( _length > 0 )
    THEN
        BEGIN
        g10mv ('VKB71 ',   3,    
              m.mb_data_size, sizeof( _start_k.reckey.k ),
              @m.mb_data^.mbp_buf, _cur_pos,
              @_start_k.reckey.k, 1, _length, m.mb_trns^.trError_gg00);
        END;
    (*ENDIF*) 
    ;
&   ifdef trace
    t01key( kb_qual, 'start_k     ', _start_k.reckey );
&   endif
    END;
(*ENDIF*) 
IF  ( m.mb_trns^.trError_gg00 = e_ok ) AND ( m.mb_type2 = mm_direct )
THEN
    BEGIN
    _use_stopkey       := false;
    _stop_k.reckey.len := 0;
    IF  ( hsTempLock_egg00 in m.mb_qual^.mtree.fileHandling_gg00 ) OR
        ( hsPermLock_egg00 in m.mb_qual^.mtree.fileHandling_gg00 )
    THEN
        BEGIN
        _lock_mode := lckRowShare_egg00;
        IF  ( hsConsistentLock_egg00 in m.mb_qual^.mtree.fileHandling_gg00 )
        THEN
            BEGIN
            _lock_state :=  [ lrsConsistent_egg00 ];
            _two_ids.file_id.fileHandling_gg00 := _two_ids.file_id.fileHandling_gg00 +
                  [ hsWithoutLock_egg00 ];
            END
        ELSE
            IF  ( hsTempLock_egg00 in m.mb_qual^.mtree.fileHandling_gg00 )
            THEN
                _lock_state :=  [ lrsTemp_egg00 ]
            ELSE
                _lock_state :=  [];
            (*ENDIF*) 
        (*ENDIF*) 
        k53lock( m.mb_trns^, m.mb_qual^.mtree.fileTabId_gg00,
              _start_k.reckey, _lock_mode, _lock_state,
              ( hsNoWait_egg00 in m.mb_qual^.mtree.fileHandling_gg00 ),
              NOT c_collision_test, _dummy_mode );
        IF  (    hsPermLock_egg00   in m.mb_qual^.mtree.fileHandling_gg00) AND
            NOT (hsIntentExcl_egg00 in m.mb_qual^.mtree.fileHandling_gg00)
        THEN
            _two_ids.file_id.fileHandling_gg00 :=
                  _two_ids.file_id.fileHandling_gg00 + [ hsWithoutLock_egg00 ];
        (*ENDIF*) 
        END
    (*ENDIF*) 
    END
ELSE
    BEGIN
    IF  ( m.mb_trns^.trError_gg00 = e_ok )
    THEN
        BEGIN
        IF  ( hsTempLock_egg00 in m.mb_qual^.mtree.fileHandling_gg00 ) OR
            ( hsPermLock_egg00 in m.mb_qual^.mtree.fileHandling_gg00 )
        THEN
            BEGIN
            _lock_mode := lckTabShare_egg00;
            IF  ( hsTempLock_egg00 in m.mb_qual^.mtree.fileHandling_gg00 )
            THEN
                _lock_state :=  [ lrsTemp_egg00 ]
            ELSE
                _lock_state :=  [];
            (*ENDIF*) 
            k53lock( m.mb_trns^, m.mb_qual^.mtree.fileTabId_gg00,
                  _start_k.reckey, _lock_mode, _lock_state,
                  ( hsNoWait_egg00 in m.mb_qual^.mtree.fileHandling_gg00 ),
                  NOT c_collision_test, _dummy_mode );
            IF  (    hsPermLock_egg00   in m.mb_qual^.mtree.fileHandling_gg00 ) AND
                NOT ( hsIntentExcl_egg00 in m.mb_qual^.mtree.fileHandling_gg00 )
            THEN
                _two_ids.file_id.fileHandling_gg00 := _two_ids.file_id.fileHandling_gg00 +
                      [ hsWithoutLock_egg00 ];
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        _use_stopkey := true;
        (* position of primary stopkey *)
        _cur_pos := m.mb_st^[ m.mb_qual^.mstrat_pos + 1 ].epos;
        _length  := m.mb_st^[ m.mb_qual^.mstrat_pos + 1 ].elen_var;
        _stop_k.reckey.len := _length;
        IF  ( _length > 0 )
        THEN
            g10mv ('VKB71 ',   4,    
                  m.mb_data_size, sizeof( _stop_k.reckey.k ),
                  @m.mb_data^.mbp_buf, _cur_pos,
                  @_stop_k.reckey.k, 1, _length, m.mb_trns^.trError_gg00 )
        ELSE
            _use_stopkey := false;
        (*ENDIF*) 
        ;
&       ifdef trace
        t01key( kb_qual, 'stop_k      ', _stop_k.reckey );
&       endif
        (* postion of length of secondary startkey *)
        _cur_pos := _cur_pos + _length;
        END;
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  m.mb_trns^.trError_gg00 = e_wait_for_lock_release
THEN
    k53wait( m.mb_trns^, m.mb_type, m.mb_type2 );
&ifdef TRACE
(*ENDIF*) 
IF  t01trace( kb_qual )
THEN
    BEGIN
    t01name( kb_qual, 'STARTKEY :        ');
    t01lkey( kb_qual, _start_k.reckey );
    IF  ( _use_stopkey )
    THEN
        BEGIN
        t01name( kb_qual, 'STOPKEY  :        ' );
        t01lkey( kb_qual, _stop_k.reckey );
        t01name( kb_qual, 'USE STOP KEY      ' )
        END
    ELSE
        t01name( kb_qual, 'USE NO STOPKEY    ' )
    (*ENDIF*) 
    END;
&endif
(*ENDIF*) 
_sel.sfp_bd_mess_type   := m_select_row;
_sel.sfp_bd_mess2_type  := m.mb_type2;
_sel.sfp_bd_use_stopkey := _use_stopkey;
m.mb_trns^.trRteCommPtr_gg00^.file_root       := NIL_PAGE_NO_GG00;
m.mb_trns^.trRteCommPtr_gg00^.file_record_cnt := 1;
m.mb_qual^.mst_addr := m.mb_st;
m.mb_qual^.mst_max  := m.mb_st_max;
IF  ( m.mb_trns^.trError_gg00 = e_ok )
THEN
    IF  ( m.mb_qual^.mcol_cnt = 0 ) AND ( m.mb_qual^.mmult_cnt = 0 )
    THEN
        BEGIN
        _two_ids.file_id.fileBdUse_gg00 :=  [];
        b02kb_select_rec( m.mb_trns^, _two_ids.file_id,
              _start_k.reckey.keyVal_gg00, _start_k.reckey.keyLen_gg00,
              _stop_k.reckey.keyVal_gg00, _stop_k.reckey.keyLen_gg00,
              0, NIL, NOT c_ignore_vwait, _sel, m.mb_qual^.mstack_desc,
              _dummy_bool, _dummy_granted );
        (* PTS 1001518 E.Z. *)
        IF  ( _start_sec > 0 )
        THEN
            IF  ( m.mb_qual^.mtree.fileTfn_gg00 <> tfnSys_egg00 )
            THEN
                k720monitor( m.mb_trns^, _sel, _start_sec,
                      _start_microsec, _start_phys_ios, _start_suspends,
                      _start_waits, c_put_strat, iprim_key_range, c_strat_cnt );
            (*ENDIF*) 
        (*ENDIF*) 
        END
    ELSE
        BEGIN
        _use_info :=  [];
        IF  ( _use_stopkey )
        THEN
            _use_info := _use_info +  [ primary_stop ];
        (*ENDIF*) 
        _rec_pos := m.mb_st^[ m.mb_qual^.mstrat_pos ].epos - cgg_rec_key_offset;
        _rec_key_len := m.mb_st^[ m.mb_qual^.mstrat_pos + 1 ].epos
              + m.mb_st^[ m.mb_qual^.mstrat_pos + 1 ].elen_var
              - m.mb_st^[ m.mb_qual^.mstrat_pos ].epos;
        (*
              _pseudo_rec.recLen_gg00          :=
              cgg_rec_key_offset + m.mb_data_len + 1 -
              ( m.mb_st^[ m.mb_qual^.mstrat_pos + 1 ].epos
              + m.mb_st^[ m.mb_qual^.mstrat_pos + 1 ].elen_var );
              *)
        IF  ( m.mb_qual^.mst_optimize_pos > 0 )
        THEN
            BEGIN
            _pseudo_rec.recLen_gg00          :=
                  m.mb_qual^.mst_optimize_pos -
                  ( m.mb_st^[ m.mb_qual^.mstrat_pos + 1 ].epos
                  + m.mb_st^[ m.mb_qual^.mstrat_pos + 1 ].elen_var ) +
                  cgg_rec_key_offset;
            END
        ELSE
            BEGIN
            _pseudo_rec.recLen_gg00          :=
                  m.mb_data_len + 1 -
                  ( m.mb_st^[ m.mb_qual^.mstrat_pos + 1 ].epos
                  + m.mb_st^[ m.mb_qual^.mstrat_pos + 1 ].elen_var ) +
                  cgg_rec_key_offset;
            END;
        (*ENDIF*) 
        _pseudo_rec.recKeyLen_gg00       := 0;
        _pseudo_rec.recVarcolOffset_gg00 := 0;
        IF  ( m.mb_qual^.mcol_cnt = 1 )
        THEN
            IF  ( m.mb_st^[ m.mb_qual^.mcol_pos ].etype = st_varlongchar )
            THEN
                _pseudo_rec.recVarcolCnt_gg00 := 0
            ELSE
                _pseudo_rec.recVarcolCnt_gg00 := 1
            (*ENDIF*) 
        ELSE
            IF  m.mb_st^[ m.mb_qual^.mmult_pos ].etype = st_varlongchar
            THEN
                _pseudo_rec.recVarcolCnt_gg00 := 0
            ELSE
                _pseudo_rec.recVarcolCnt_gg00 := m.mb_qual^.mmult_cnt;
            (*ENDIF*) 
        (*ENDIF*) 
        ;
&       ifdef trace
        t01int4( kb_qual, 'rec_pos     ', _rec_pos );
        t01int4( kb_qual, 'rec_key_len ', _rec_key_len );
        t01int4( kb_qual, 'pseudo recLe', _pseudo_rec.recLen_gg00 );
&       endif
        g10mv ('VKB71 ',   5,    
              m.mb_data_size, sizeof( _pseudo_rec ),
              @m.mb_data^.mbp_buf,
              m.mb_st^[ m.mb_qual^.mstrat_pos + 1 ].epos
              + m.mb_st^[ m.mb_qual^.mstrat_pos + 1 ].elen_var,
              @_pseudo_rec.recBuf_gg00, cgg_rec_key_offset + 1,
              _pseudo_rec.recLen_gg00 - cgg_rec_key_offset,
              m.mb_trns^.trError_gg00);
&       ifdef TRACE
        t01buf( kb_qual, _pseudo_rec.recBuf_gg00, 1, _pseudo_rec.recLen_gg00 );
&       endif
        (* ===========================================  *)
        (* _rec_pos     = position of primary start key *)
        (* ===========================================  *)
        IF  ( m.mb_qual^.mcol_cnt = 1 )
        THEN
            (* k33 single_inv_key *)
            m.mb_trns^.trError_gg00 := e_not_implemented
        ELSE
            k33mult_inv_key( m.mb_trns^, _two_ids.file_id, _two_ids.inv_id,
                  c_init_inv_tree,
                  m.mb_st,  @_pseudo_rec, m.mb_qual^.mmult_pos,
                  m.mb_qual^.mmult_pos + m.mb_qual^.mmult_cnt - 1,
                  _start_k.listkey,
                  bIsUndef,
                  m.mb_trns^.trError_gg00 );
        (*ENDIF*) 
        IF  ( m.mb_trns^.trError_gg00 <> e_move_error )
        THEN
            BEGIN
            IF  ( m.mb_qual^.mcol_cnt = 1 )
            THEN
                IF  ( m.mb_st^[ m.mb_qual^.mcol_pos ].etype = st_varlongchar )
                THEN
                    BEGIN
                    _cur_pos := _rec_pos + cgg_rec_key_offset + _rec_key_len;
                    _ic2.mapC2_sp00[ 1 ] := m.mb_data^.mbp_buf[ _cur_pos  ];
                    _ic2.mapC2_sp00[ 2 ] := m.mb_data^.mbp_buf[ _cur_pos + 1 ];
                    _rec_key_len := _rec_key_len + 2 + _ic2.mapInt_sp00;
&                   ifdef trace
                    t01int4( kb_qual, 'add: len + 2', _ic2.mapInt_sp00 + 2 );
                    t01int4( kb_qual, 'rec_key_len ', _rec_key_len );
&                   endif
                    END
                ELSE
                    BEGIN
                    _cur_pos := _rec_pos + cgg_rec_key_offset + _rec_key_len;
                    _rec_key_len := _rec_key_len + 1
                          + ord ( m.mb_data^.mbp_buf[ _cur_pos ] );
&                   ifdef trace
                    t01int4( kb_qual, 'add: len + 1',
                          ord( m.mb_data^.mbp_buf[ _cur_pos ] ) + 1 );
                    t01int4( kb_qual, 'rec_key_len ', _rec_key_len );
&                   endif
                    END
                (*ENDIF*) 
            ELSE
                BEGIN
                FOR _i := 1 TO m.mb_qual^.mmult_cnt DO
                    IF  ( m.mb_st^[ m.mb_qual^.mmult_pos - 1  + _i ].etype =
                        st_varlongchar )
                    THEN
                        BEGIN
                        _cur_pos := _rec_pos + cgg_rec_key_offset + _rec_key_len;
                        _ic2.mapC2_sp00[ 1 ] := m.mb_data^.mbp_buf[ _cur_pos  ];
                        _ic2.mapC2_sp00[ 2 ] := m.mb_data^.mbp_buf[ _cur_pos + 1 ];
                        _rec_key_len := _rec_key_len + 2 + _ic2.mapInt_sp00;
&                       ifdef trace
                        t01int4( kb_qual, 'add: len + 2', _ic2.mapInt_sp00 + 2 );
                        t01int4( kb_qual, 'rec_key_len ', _rec_key_len );
&                       endif
                        END
                    ELSE
                        BEGIN
                        _cur_pos := _rec_pos + cgg_rec_key_offset + _rec_key_len;
                        _rec_key_len := _rec_key_len + 1
                              + ord( m.mb_data^.mbp_buf [ _cur_pos ] );
&                       ifdef trace
                        t01int4( kb_qual, 'add: len + 1',
                              ord( m.mb_data^.mbp_buf[ _cur_pos ] ) + 1 );
                        t01int4( kb_qual, 'rec_key_len ', _rec_key_len );
&                       endif
                        END;
                    (*ENDIF*) 
                (*ENDFOR*) 
                END;
            (*ENDIF*) 
            _cur_pos := _rec_pos + cgg_rec_key_offset + _rec_key_len;
            IF  ( m.mb_qual^.mst_optimize_pos > 0 )
            THEN
                BEGIN
                _pseudo_rec.recLen_gg00 :=
                      cgg_rec_key_offset + m.mb_qual^.mst_optimize_pos -
                      _cur_pos;
                END
            ELSE
                BEGIN
                _pseudo_rec.recLen_gg00 :=
                      cgg_rec_key_offset + m.mb_data_len + 1 - _cur_pos;
                END;
            (*ENDIF*) 
&           ifdef trace
            t01int4( kb_qual, 'rec_pos     ', _rec_pos );
            t01int4( kb_qual, 'rec_key_len ', _rec_key_len );
            t01int4( kb_qual, 'pseudo recLe', _pseudo_rec.recLen_gg00 );
            t01int4( kb_qual, 'curr_pos    ', _cur_pos );
&           endif
            g10mv ('VKB71 ',   6,    
                  m.mb_data_size, sizeof( _pseudo_rec ),
                  @m.mb_data^.mbp_buf, _cur_pos,
                  @_pseudo_rec.recBuf_gg00, cgg_rec_key_offset + 1,
                  _pseudo_rec.recLen_gg00 - cgg_rec_key_offset,
                  m.mb_trns^.trError_gg00);
&           ifdef TRACE
            t01buf( kb_qual, _pseudo_rec.recBuf_gg00, 1, _pseudo_rec.recLen_gg00 );
&           endif
            (* =========================================== *)
            (* rec_pos     = position of primary start key *)
            (* =========================================== *)
            IF  ( m.mb_qual^.mcol_cnt = 1 )
            THEN
                BEGIN
                IF  ( m.mb_qual^.mst_optimize_pos > 0 )
                THEN
                    BEGIN
                    IF  ( _cur_pos + 1 >= m.mb_qual^.mst_optimize_pos )
                    THEN
                        (* Stopkeylen = 0 ==> no secondary stopkey *)
                        _stop_k.listkey.len := 0
                    ELSE
                        _use_info := _use_info +  [ secondary_stop ];
                    (*ENDIF*) 
                    END
                ELSE
                    BEGIN
                    IF  ( _cur_pos + 1 >= m.mb_data_len )
                    THEN
                        (* Stopkeylen = 0 ==> no secondary stopkey *)
                        _stop_k.listkey.len := 0
                    ELSE
                        _use_info := _use_info +  [ secondary_stop ];
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
                IF  ( secondary_stop in _use_info )
                THEN
                    (* k33 single_inv_key *)
                    m.mb_trns^.trError_gg00 := e_not_implemented
                (*ENDIF*) 
                END
            ELSE
                BEGIN
                IF  ( m.mb_qual^.mst_optimize_pos > 0 )
                THEN
                    BEGIN
                    IF  ( _cur_pos = m.mb_qual^.mst_optimize_pos - 1 )
                    THEN
                        (* Stopkeylen = 0 ==> no secondary stopkey *)
                        _stop_k.listkey.len := 0
                    ELSE
                        _use_info := _use_info +  [ secondary_stop ];
                    (*ENDIF*) 
                    END
                ELSE
                    BEGIN
                    IF  ( _cur_pos = m.mb_data_len )
                    THEN
                        (* Stopkeylen = 0 ==> no secondary stopkey *)
                        _stop_k.listkey.len := 0
                    ELSE
                        _use_info := _use_info +  [ secondary_stop ];
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
                IF  ( secondary_stop in _use_info )
                THEN
                    k33mult_inv_key( m.mb_trns^, _two_ids.file_id, _two_ids.inv_id,
                          NOT c_init_inv_tree,
                          m.mb_st, @_pseudo_rec, m.mb_qual^.mmult_pos,
                          m.mb_qual^.mmult_pos + m.mb_qual^.mmult_cnt-1,
                          _stop_k.listkey,
                          bIsUndef,
                          m.mb_trns^.trError_gg00 )
                (*ENDIF*) 
                END;
            (*ENDIF*) 
&           ifdef TRACE
            IF  t01trace( kb_qual )
            THEN
                BEGIN
                t01name( kb_qual, 'STARTINDEX :      ' );
                t01lkey( kb_qual, _start_k.listkey );
                IF  ( secondary_stop in _use_info )
                THEN
                    BEGIN
                    t01name( kb_qual, 'STOPINDEX :       ' );
                    t01lkey( kb_qual, _stop_k.listkey )
                    END
                ELSE
                    t01name( kb_qual, 'USE NO STOPINDEX  ' )
                (*ENDIF*) 
                END;
&           endif
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        IF  ( m.mb_trns^.trError_gg00 <> e_move_error )
        THEN
            BEGIN
            (* h.b. PTS 1104210 *)
            b03select_invrec( m.mb_trns^, _two_ids, _start_k,
                  _stop_k, _start_k.reckey, _use_info, 0, NIL, _sel,
                  m.mb_qual^.mstack_desc, _dummy_mode, c_usage_count );
            IF  ( a01diag_monitor_on )
            THEN
                IF  ( m.mb_trns^.trBdTcachePtr_gg00 <> NIL )    AND
                    ( _two_ids.inv_id.fileRoot_gg00  <> NIL_PAGE_NO_GG00 ) AND
                    ( _two_ids.inv_id.fileTfn_gg00 = tfnMulti_egg00 )
                THEN
                    b21mp_root_put( m.mb_trns^.trBdTcachePtr_gg00,
                          _two_ids.inv_id.fileRoot_gg00 );
                (*ENDIF*) 
            (*ENDIF*) 
            END;
        (* PTS 1001518 E.Z. *)
        (*ENDIF*) 
        IF  ( _start_sec > 0 )
        THEN
            IF  ( m.mb_qual^.mtree.fileTfn_gg00 <> tfnSys_egg00 )
            THEN
                k720monitor( m.mb_trns^, _sel, _start_sec,
                      _start_microsec, _start_phys_ios, _start_suspends,
                      _start_waits, c_put_strat, iindex_range, c_strat_cnt );
            (*ENDIF*) 
        (*ENDIF*) 
        END;
    (*ENDIF*) 
(*ENDIF*) 
IF  ( lrsTemp_egg00 in _lock_state )
THEN
    BEGIN
    _aux_error         := m.mb_trns^.trError_gg00;
    m.mb_trns^.trError_gg00 := e_ok;
    k53temp_unlock( m.mb_trns^, m.mb_qual^.mtree.fileTabId_gg00,
          _start_k.reckey, _lock_mode );
    IF  ( _aux_error <> e_ok )
    THEN
        m.mb_trns^.trError_gg00 := _aux_error
    (*ENDIF*) 
    END;
(*ENDIF*) 
m.mb_type2 := mm_nil;
IF  ( m.mb_trns^.trError_gg00 = e_ok )
THEN
    BEGIN
    m.mb_qual^.mr_resnum  := g01glob.rescnt_1;
    m.mb_qual^.mr_pagecnt := m.mb_trns^.trRteCommPtr_gg00^.file_record_cnt;
    m.mb_qual_len  := MB_PART1_HEAD_MXGG00 + MB_PART1_RETURN_MXGG00;
    m.mb_data_len  := _sel.sfp_result_length;
    g10mv ('VKB71 ',   7,    
          sizeof( _result_buf ), m.mb_data_size,
          @_result_buf, 1,
          @m.mb_data^.mbp_4kbuf, 1, _sel.sfp_result_length,
          m.mb_trns^.trError_gg00);
    m.mb_type := m_return_result;
    m.mb_struct := mbs_stack_addr;
    END
ELSE
    BEGIN
    m.mb_type      := m_return_error;
    IF  ( m.mb_trns^.trError_gg00 = e_no_next_record )
    THEN
        BEGIN
        m.mb_qual_len  := MB_PART1_HEAD_MXGG00 + MB_PART1_RETURN_MXGG00;
        m.mb_qual^.mr_pagecnt := m.mb_trns^.trRteCommPtr_gg00^.file_record_cnt;
        END
    ELSE
        m.mb_qual_len  := 0;
    (*ENDIF*) 
    m.mb_data_len  := 0;
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      k71trigger_qualification_test (
            VAR m       : tgg00_MessBlock;
            VAR new_rec : tgg00_Rec;
            VAR old_rec : tgg00_Rec);
 
VAR
      dummy_bool : boolean;
      aux_error  : tgg00_BasisError;
      dummy_err  : tgg00_BasisError;
      err_st_ptr : tgg00_StEntryAddr;
      err_msg    : tgg04_Err;
      sel        : tgg00_SelectFieldsParam;
 
BEGIN
g04init_select_fields (sel, @m.mb_data^.mbp_buf, m.mb_data_size,
      m.mb_valuearr, m.mb_validx_max,
      m.mb_work_st, m.mb_work_st_max, m.mb_workbuf, m.mb_workbuf_size,
      m.mb_qual^.msqlmode);
WITH sel DO
    BEGIN
    sfp_bd_mess_type  := m.mb_type;
    sfp_bd_mess2_type := m.mb_type2;
    sfp_result_wanted := false;
    sfp_m_result_addr := NIL;
    sfp_m_result_size := 0;
    sfp_rec_addr      := @new_rec.buf;
    sfp_rec_len       := new_rec.len;
    sfp_rec_key_len   := new_rec.keylen;
    sfp_oldrec_addr   := @old_rec.buf;
    sfp_oldrec_pos    := 1;
    sfp_oldrec_len    := old_rec.len;
    sfp_oldkey_len    := old_rec.keylen;
    sfp_acv_addr      := m.mb_trns^.trAcvPtr_gg00;   (* PTS 1121403 E.Z. *)
    END;
(*ENDWITH*) 
m.mb_qual^.mst_addr := m.mb_st;
m.mb_qual^.mst_max  := m.mb_st_max;
k71qual_handling (m.mb_trns^, sel, NOT c_with_view,
      NOT c_check_new_rec, m.mb_qual^.mstack_desc,
      err_st_ptr, dummy_bool);
IF  m.mb_trns^.trError_gg00 <> e_ok
THEN
    IF  err_st_ptr <> NIL
    THEN
        WITH err_msg DO
            BEGIN
            errtableid   := m.mb_qual^.mtree.fileTabId_gg00;
            errstack     := err_st_ptr^;
            errtablesite := cgg_zero_c2;
            errstacktype := tfnTable_egg00;
            aux_error    := m.mb_trns^.trError_gg00;
            b06put_errtxt (m.mb_trns^, m.mb_trns^.trTaskId_gg00,
                  SURROGATE_MXGG00 + STACK_ENTRY_MXGG00 + 3,
                  errtext_stack, m.mb_trns^.trError_gg00, err_msg.errt,
                  dummy_err);
            m.mb_trns^.trError_gg00 := aux_error
            END
        (*ENDWITH*) 
    (*ENDIF*) 
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb71assign (
            VAR sel     : tgg00_SelectFieldsParam;
            VAR qual_st : tgg00_StackEntry;
            resetLen    : integer;
            VAR e       : tgg00_BasisError);
 
VAR
      size          : tsp00_Int4;
      keylen        : integer;
      operand_addr  : tsp00_MoveObjPtr;
      assign_addr   : tsp00_MoveObjPtr;
      pParam        : tgg00_StEntryAddr;
      operand_len   : integer;
      workbuf_len   : integer;
 
BEGIN
&ifdef trace
t01int4 (kb_qual, 'dest pos    ', qual_st.epos);
t01int4 (kb_qual, 'dest len    ', qual_st.elen_var);
t01int4 (kb_qual, 'dest buf    ', ord (qual_st.ecol_tab[1]));
&endif
e := e_ok;
k71get_operand (sel,
      NOT c_check_spec_null, operand_addr, operand_len, e);
IF  e = e_ok
THEN
    BEGIN
    IF  sel.sfp_work_st_top^.etype = st_result
    THEN
        workbuf_len := sel.sfp_work_st_top^.epos - 1
    ELSE
        workbuf_len := sel.sfp_workbuf_len;
    (*ENDIF*) 
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, -1);
    IF  qual_st.ecol_tab[1] = chr(0)
    THEN
        BEGIN
        keylen      := sel.sfp_rec_key_len;
        size        := sel.sfp_rec_len -
              (cgg_rec_key_offset + keylen + qual_st.epos) + 1;
        assign_addr := @sel.sfp_rec_addr^[cgg_rec_key_offset + keylen + qual_st.epos]
        END
    ELSE
        IF  qual_st.ecol_tab[1] = chr(1)
        THEN
            BEGIN
            keylen      := sel.sfp_oldkey_len;
            size        := sel.sfp_oldrec_len -
                  (cgg_rec_key_offset + keylen + qual_st.epos) + 1;
            assign_addr := @sel.sfp_oldrec_addr^[cgg_rec_key_offset + keylen + qual_st.epos];
            END
        ELSE
            BEGIN
            pParam := s35inc_st (sel.sfp_work_st_frame, qual_st.epos);
&           ifdef trace
            t01stackentry (kb_qual, pParam^, 0);
&           endif
            assign_addr :=
                  s35add_moveobj_ptr(sel.sfp_workbuf_addr, pParam^.epos - 1);
            size := pParam^.elen_var;
            END;
        (*ENDIF*) 
    (*ENDIF*) 
    IF  operand_addr^[1] = csp_undef_byte
    THEN
        BEGIN
        assign_addr^[1] := csp_undef_byte;
        SAPDB_PascalFill ('VKB71 ',   8,    
              size, @assign_addr^, 2, qual_st.elen_var - 1, chr(0), e)
        END
    ELSE
        BEGIN
        IF  operand_len > qual_st.elen_var
        THEN
            BEGIN
            operand_len := 1 +
                  a05lnr_space_defbyte (sel.sfp_acv_addr,
                  operand_addr, operand_addr^[1], 2, operand_len - 1);
            IF  operand_len > qual_st.elen_var
            THEN
                e :=  e_column_trunc;
            (*ENDIF*) 
            END;
&       ifdef trace
        (*ENDIF*) 
        t01moveobj (kb_qual, operand_addr^, 1, operand_len);
&       endif
        IF  e = e_ok
        THEN
            BEGIN
            g10mv ('VKB71 ',   9,    
                  sizeof(operand_addr^), size,
                  @operand_addr^, 1,
                  @assign_addr^, 1, operand_len, e);
            IF  operand_len < qual_st.elen_var
            THEN
                IF  operand_addr^[1] = csp_unicode_def_byte
                THEN
                    SAPDB_PascalUnicodeFill ('VKB71 ',  10,    
                          size, @assign_addr^,
                          operand_len + 1, qual_st.elen_var - operand_len,
                          csp_unicode_blank, e)
                ELSE
                    SAPDB_PascalFill ('VKB71 ',  11,    
                          size, @assign_addr^,
                          operand_len + 1, qual_st.elen_var - operand_len, assign_addr^[1], e);
                (*ENDIF*) 
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    sel.sfp_workbuf_len := resetLen;
&   ifdef TRACE
    t01sname (kb_qual, '=== result: ');
    WITH sel.sfp_work_st_top^ DO
        t01moveobj (kb_qual, assign_addr^, 1, qual_st.elen_var);
    (*ENDWITH*) 
&   endif
    END;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb71catalog_column (
            VAR qual_st : tgg00_StackEntry;
            VAR sel  : tgg00_SelectFieldsParam;
            VAR e    : tgg00_BasisError);
 
VAR
      move_len : integer;
 
BEGIN
IF  sel.sfp_workbuf_len + 1 + qual_st.elen_var > sel.sfp_workbuf_size
THEN
    e := e_stack_overflow
ELSE
    BEGIN
    sel.sfp_workbuf_addr^[sel.sfp_workbuf_len+1] := qual_st.ecol_tab[1];
    IF  qual_st.elen_var > 0
    THEN
        move_len := qual_st.elen_var
    ELSE
        move_len := sel.sfp_rec_key_len + cgg_rec_key_offset - qual_st.epos + 1;
    (*ENDIF*) 
    g10mv ('VKB71 ',  12,    
          sizeof(sel.sfp_rec_addr^), sel.sfp_workbuf_size,
          @sel.sfp_rec_addr^, qual_st.epos,
          @sel.sfp_workbuf_addr^, sel.sfp_workbuf_len+2,
          move_len, e);
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, 1);
    WITH sel.sfp_work_st_top^ DO
        BEGIN
        etype         := st_result;
        eop           := op_none;
        epos          := sel.sfp_workbuf_len + 1;
        elen_var      := move_len + 1;
        ecol_tab [1]  := chr(0);
        ecol_tab [2]  := chr(0)
        END;
    (*ENDWITH*) 
&   ifdef TRACE
    t01sname (kb_qual, '=== result: ');
    WITH sel.sfp_work_st_top^ DO
        t01moveobj (kb_qual,
              sel.sfp_workbuf_addr^, epos, epos + elen_var - 1);
    (*ENDWITH*) 
&   endif
    END;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      kb71bool_arith (
            VAR t           : tgg00_TransContext;
            VAR sel         : tgg00_SelectFieldsParam;
            VAR st          : tgg00_StackEntry) : tgg00_BasisError;
 
VAR
      e             : tgg00_BasisError;
      bool_result1  : integer;
      bool_result2  : integer;
      cnt           : integer;
      top           : tgg00_StEntryAddr;
 
LABEL
      999;
 
BEGIN
&ifdef TRACE
(* The following code exists to make usecheck happy.     *)
(* The parameter t is necessary, because                 *)
(* the procedure is called by a pointer from             *)
(* an array of procedure pointers, i.e. all              *)
(* those procedures must have the same formal parameters *)
e := t.trError_gg00;
&endif
IF  sel.sfp_optimized
THEN
    cnt := st.epos + 1
ELSE
    cnt := 1;
(*ENDIF*) 
top := sel.sfp_work_st_top;
IF  top^.etype = st_bool
THEN
    e := e_ok
ELSE
    BEGIN
    e := e_stack_type_illegal;
    goto 999;
    END;
(*ENDIF*) 
REPEAT
    cnt          := cnt - 1;
    bool_result1 := top^.epos;
    top          := s35inc_st (top, - 1);
    bool_result2 := top^.epos;
    CASE st.eop OF
        op_and:
            BEGIN
            sel.sfp_work_st_top := top;
            IF  top^.etype <> st_bool
            THEN
                BEGIN
                e := e_stack_type_illegal;
                goto 999;
                END;
            (*ENDIF*) 
            IF  NOT ((bool_result1 = cgg04_is_true) AND
                (bool_result2 = cgg04_is_true))
            THEN
                IF  bool_result2 <> cgg04_is_false
                THEN
                    IF  bool_result1 = cgg04_is_false
                    THEN
                        top^.epos := cgg04_is_false
                    ELSE
                        top^.epos := cgg04_is_undef
                    (*ENDIF*) 
                (*ENDIF*) 
            (*ENDIF*) 
            END;
        op_not:
            CASE bool_result1 OF
                cgg04_is_true:
                    sel.sfp_work_st_top^.epos := cgg04_is_false;
                cgg04_is_false:
                    BEGIN
                    sel.sfp_work_st_top^.epos  := cgg04_is_true;
                    END;
                cgg04_is_undef:
                    sel.sfp_work_st_top^.epos := cgg04_is_undef
                END;
            (*ENDCASE*) 
        op_or:
            BEGIN
            sel.sfp_work_st_top := top;
            IF  top^.etype <> st_bool
            THEN
                BEGIN
                e := e_stack_type_illegal;
                goto 999;
                END;
            (*ENDIF*) 
            IF  (bool_result1 = cgg04_is_true) OR
                (bool_result2 = cgg04_is_true)
            THEN
                BEGIN
                top^.epos  := cgg04_is_true;
                END
            ELSE
                BEGIN
                IF  (bool_result1 = cgg04_is_false) AND
                    (bool_result2 = cgg04_is_false)
                THEN
                    top^.epos := cgg04_is_false
                ELSE
                    top^.epos := cgg04_is_undef;
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            END;
        op_upd_view_and:
            BEGIN
            IF  NOT sel.sfp_check_new_rec
            THEN
                BEGIN
                sel.sfp_work_st_top := top;
                IF  top^.etype <> st_bool
                THEN
                    BEGIN
                    e := e_stack_type_illegal;
                    goto 999;
                    END;
                (*ENDIF*) 
                IF  NOT ((bool_result1 = cgg04_is_true) AND
                    (bool_result2 = cgg04_is_true))
                THEN
                    IF  (bool_result1 = cgg04_is_false) OR
                        (bool_result2 = cgg04_is_false)
                    THEN
                        top^.epos := cgg04_is_false
                    ELSE
                        top^.epos := cgg04_is_undef
                    (*ENDIF*) 
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            END;
        op_undef_to_false:
            CASE bool_result1 OF
                cgg04_is_true, cgg04_is_false :
                    sel.sfp_work_st_top^.epos := bool_result1;
                cgg04_is_undef:
                    sel.sfp_work_st_top^.epos := cgg04_is_false;
                END;
            (*ENDCASE*) 
        OTHERWISE
            BEGIN
            e := e_stack_op_illegal;
            goto 999
            END;
        END;
    (*ENDCASE*) 
UNTIL
    cnt <= 0;
(*ENDREPEAT*) 
&ifdef TRACE
t01int4 (kb_qual, '=== result  ', sel.sfp_work_st_top^.epos);
&endif
999 : ;
kb71bool_arith := e
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb71catalog_output (
            VAR qual_st    : tgg00_StackEntry;
            VAR sel        : tgg00_SelectFieldsParam;
            result_size    : tsp00_Int4;
            result_addr    : tsp00_MoveObjPtr;
            VAR result_len : tsp00_Int2;
            VAR e          : tgg00_BasisError);
 
VAR
      add_len : integer;
      col_pos : integer;
      col_len : tsp_int_map_c2;
 
BEGIN
e := e_ok;
CASE sel.sfp_work_st_top^.etype OF
    st_varkey :
        BEGIN
        add_len         := 0;
        col_pos         := cgg_rec_key_offset + 1;
        col_len.map_int := sel.sfp_rec_key_len
        END;
    st_varlongchar : (* h.b. PTS 1105136 *)
        BEGIN
        add_len := 2;
        col_pos := cgg_rec_key_offset + 1 + sel.sfp_rec_key_len;
        col_len.map_int := sel.sfp_rec_len -
              sel.sfp_rec_key_len - cgg_rec_key_offset
        END;
    OTHERWISE
        e := e_stack_type_illegal;
    END;
(*ENDCASE*) 
IF  e = e_ok
THEN
    IF  result_len + add_len + qual_st.elen_var > result_size
    THEN
        e := e_buffer_limit
    ELSE
        BEGIN
        result_addr^ [qual_st.epos] := chr(0);
        IF  add_len > 0
        THEN
            BEGIN
            result_addr^ [qual_st.epos+1] := col_len.map_c2 [1];
            result_addr^ [qual_st.epos+2] := col_len.map_c2 [2]
            END;
        (*ENDIF*) 
        g10mv ('VKB71 ',  13,    
              sizeof(sel.sfp_rec_addr^), result_size,
              @sel.sfp_rec_addr^, col_pos,
              @result_addr^, qual_st.epos + add_len + 1, col_len.map_int, e);
        IF  qual_st.elen_var - (col_len.map_int + 1) > 0
        THEN
            SAPDB_PascalFill ('VKB71 ',  14,    
                  result_size, @result_addr^,
                  qual_st.epos + col_len.map_int + add_len + 1,
                  qual_st.elen_var - (col_len.map_int + 1), chr(0), e);
        (*ENDIF*) 
        result_len          := result_len + add_len + qual_st.elen_var;
        sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, -1)
        END;
    (*ENDIF*) 
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb71code_transform (
            op               : tgg00_StackOpType;
            VAR sel          : tgg00_SelectFieldsParam;
            operand_addr     : tsp00_MoveObjPtr;
            len              : integer;
            operand_st_addr  : tgg00_StEntryAddr;
            VAR e            : tgg00_BasisError);
 
VAR
      already_done : boolean;
      undef        : boolean;
      def_byte     : char;
      code_tab     : integer;
      trunc_len    : integer;
 
LABEL
      999;
 
BEGIN
e := e_ok;
&ifdef TRACE
t01op      (kb_qual, 'translate op', op);
t01moveobj (kb_qual, operand_addr^, 1, len);
&endif
def_byte := operand_addr^ [1];
undef    := (def_byte = csp_undef_byte);
IF  operand_st_addr^.etype in [st_value , st_result]
THEN
    trunc_len := len
ELSE
    IF  undef
    THEN
        trunc_len := 1
    ELSE
        trunc_len := 1 + a05lnr_space_defbyte (sel.sfp_acv_addr,
              operand_addr, def_byte, 2, len-1);
    (*ENDIF*) 
(*ENDIF*) 
sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, 1);
IF  operand_st_addr^.etype <> st_result
THEN
    BEGIN
    IF  sel.sfp_workbuf_len + trunc_len > sel.sfp_workbuf_size
    THEN
        BEGIN
        e := e_stack_overflow;
        goto 999;
        END;
    (*ENDIF*) 
    sel.sfp_workbuf_len := sel.sfp_workbuf_len + 1;
    WITH sel.sfp_work_st_top^ DO
        BEGIN
        etype        := st_result;
        eop          := op_none;
        epos         := sel.sfp_workbuf_len;
        elen_var     := trunc_len;
        ecol_tab [1] := chr(0);
        ecol_tab [2] := chr(0)
        END;
    (*ENDWITH*) 
    END
ELSE
    sel.sfp_work_st_top^ := operand_st_addr^;
(*ENDIF*) 
IF  undef
THEN
    sel.sfp_workbuf_addr^ [sel.sfp_work_st_top^.epos] := def_byte
ELSE
    BEGIN
    already_done := false;
    CASE op OF
        op_lowcase:
            IF  def_byte = csp_ascii_blank
            THEN
                code_tab := cgg04_low_ascii
            ELSE
                code_tab := cgg04_low_ebcdic;
            (*ENDIF*) 
        op_upcase:
            IF  def_byte = csp_ascii_blank
            THEN
                code_tab := cgg04_up_ascii
            ELSE
                code_tab := cgg04_up_ebcdic;
            (*ENDIF*) 
        op_ascii:
            IF  def_byte = csp_ascii_blank
            THEN
                already_done := true
            ELSE
                code_tab := cgg04_to_ascii;
            (*ENDIF*) 
        op_ebcdic:
            IF  def_byte = csp_ascii_blank
            THEN
                code_tab := cgg04_to_ebcdic
            ELSE
                already_done := true
            (*ENDIF*) 
        END;
    (*ENDCASE*) 
    IF  already_done
    THEN
        BEGIN
        g10mv ('VKB71 ',  15,    
              sizeof(operand_addr^), sel.sfp_workbuf_size,
              @operand_addr^, 1, @sel.sfp_workbuf_addr^,
              sel.sfp_work_st_top^.epos, trunc_len, e);
        IF  op = op_ascii
        THEN
            sel.sfp_workbuf_addr^[sel.sfp_work_st_top^.epos] := csp_ascii_blank
        (*ENDIF*) 
        END
    ELSE
        s30map (g02codetables.tables [code_tab], operand_addr^, 1,
              sel.sfp_workbuf_addr^, sel.sfp_work_st_top^.epos,
              trunc_len);
    (*ENDIF*) 
    sel.sfp_workbuf_len := sel.sfp_work_st_top^.epos + trunc_len - 1
    END;
(*ENDIF*) 
&ifdef TRACE
t01sname (kb_qual, '=== result: ');
WITH sel.sfp_work_st_top^ DO
    t01moveobj (kb_qual, sel.sfp_workbuf_addr^, epos, epos + elen_var - 1);
(*ENDWITH*) 
&endif
999 : ;
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb71comparison (
            VAR sel      : tgg00_SelectFieldsParam;
            op           : tgg00_StackOpType;
            VAR workbuf  : tkb07_buffer_description;
            VAR buf1     : tsp00_MoveObj;
            pos1         : tsp00_Int4;
            len1         : tsp00_Int4;
            VAR buf2     : tsp00_MoveObj;
            pos2         : tsp00_Int4;
            len2         : tsp00_Int4;
            VAR ok       : integer);
 
VAR
      compare_result : tsp00_LcompResult;
      trunc_len1     : integer;
      trunc_len2     : integer;
      start_pos1     : tsp00_Int4;
      start_pos2     : tsp00_Int4;
      operand1       : tsp00_MoveObjPtr;
      operand2       : tsp00_MoveObjPtr;
      i              : integer;
 
BEGIN
&ifdef TRACE
t01op      (kb_qual, 'compare op  ', op);
t01moveobj (kb_qual, buf1, pos1, pos1 + len1 - 1);
t01moveobj (kb_qual, buf2, pos2, pos2 + len2 - 1);
&endif
IF  op >= op_eq
THEN
    BEGIN
    IF  op = op_eq_all
    THEN
        s30cmp (buf1, pos1, len1, buf2, pos2, len2, compare_result)
    ELSE
        a05luc_space (sel.sfp_acv_addr,
              buf1, pos1, len1, buf2, pos2, len2, compare_result);
    (*ENDIF*) 
    ok := kb71cmp_table[op, compare_result]
    END
ELSE
    BEGIN
    ok := cgg04_is_true;
    CASE op OF
        op_like, op_not_like, op_sounds, op_not_sounds :
            BEGIN
            trunc_len1 := 0;
            trunc_len2 := 0;
            IF  (len1 < 1) OR (len2 < 1)
            THEN
                ok := cgg04_is_undef
            ELSE
                IF  (buf1 [pos1] = csp_undef_byte) OR
                    (buf2 [pos2] = csp_undef_byte)
                THEN
                    ok := cgg04_is_undef;
                (*ENDIF*) 
            (*ENDIF*) 
            IF  ok = cgg04_is_true
            THEN
                BEGIN
                start_pos1 := 1;
                operand1   := @(buf1 [pos1]);
                trunc_len1 :=
                      a05lnr_space_defbyte (sel.sfp_acv_addr,
                      operand1, operand1^[1], 2, len1-1);
                start_pos2 := 1;
                operand2   := @(buf2 [pos2]);
                trunc_len2 :=
                      a05lnr_space_defbyte (sel.sfp_acv_addr,
                      operand2, operand2^[1], 2, len2-1)
                END;
            (*ENDIF*) 
            IF  (ok = cgg04_is_true) AND
                ((trunc_len1 < 1) OR (trunc_len2 < 1))
            THEN
                BEGIN
                IF  trunc_len1 = trunc_len2
                THEN
                    BEGIN
                    IF  op in  [op_not_like, op_not_sounds]
                    THEN
                        ok := cgg04_is_false
                    (*ENDIF*) 
                    END
                ELSE
                    IF  (trunc_len1 > 0)
                        OR (op in  [op_sounds, op_not_sounds])
                    THEN
                        (* like value exists OR sound op *)
                        BEGIN
                        IF  op in  [op_like, op_sounds]
                        THEN
                            ok := cgg04_is_false
                        (*ENDIF*) 
                        END
                    ELSE
                        BEGIN
                        (* LIKE: val_len = 0 AND pat_len > 0 *)
                        (* test trailing blanks or pattern stars *)
                        i := 1;
                        IF  operand1^ [ start_pos1 ] = csp_unicode_def_byte
                        THEN
                            (* unicode-value *)
                            WHILE (i <= trunc_len2) AND
                                  (ok = cgg04_is_true) DO
                                IF  ( operand2^ [start_pos2+i  ] = csp_unicode_mark) AND
                                    ((operand2^ [start_pos2+i+1] = csp_star1) OR
                                    ( operand2^ [start_pos2+i+1] = csp_ascii_blank))
                                THEN
                                    i := i + 2
                                ELSE
                                    ok := cgg04_is_false
                                (*ENDIF*) 
                            (*ENDWHILE*) 
                        ELSE
                            WHILE (i <= trunc_len2) AND
                                  (ok = cgg04_is_true) DO
                                IF  (operand2^ [start_pos2 + i] = csp_star1) OR
                                    (operand2^ [start_pos2 + i] = operand2^ [start_pos2])
                                THEN
                                    i := i + 1
                                ELSE
                                    ok := cgg04_is_false;
                                (*ENDIF*) 
                            (*ENDWHILE*) 
                        (*ENDIF*) 
                        IF  op = op_not_like
                        THEN
                            BEGIN
                            IF  ok = cgg04_is_true
                            THEN
                                ok := cgg04_is_false
                            ELSE
                                ok := cgg04_is_true
                            (*ENDIF*) 
                            END
                        (*ENDIF*) 
                        END
                    (*ENDIF*) 
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            IF  (ok = cgg04_is_true) AND
                (trunc_len1 > 0) AND (trunc_len2 > 0)
            THEN
                CASE op OF
                    op_like:
                        IF  operand1^ [ start_pos1 ] = csp_unicode_def_byte
                        THEN
                            BEGIN
                            IF  NOT s49upatmatch (operand1^, start_pos1,
                                trunc_len1, operand2^, start_pos2, trunc_len2)
                            THEN
                                ok := cgg04_is_false;
                            (*ENDIF*) 
                            END
                        ELSE
                            IF  NOT s49patmatch (operand1^, start_pos1, trunc_len1,
                                operand2^, start_pos2, trunc_len2, operand2^ [ start_pos2 ])
                            THEN
                                ok := cgg04_is_false;
                            (*ENDIF*) 
                        (*ENDIF*) 
                    op_not_like:
                        IF  operand1^ [ start_pos1 ] = csp_unicode_def_byte
                        THEN
                            BEGIN
                            IF  s49upatmatch (operand1^, start_pos1, trunc_len1,
                                operand2^, start_pos2, trunc_len2)
                            THEN
                                ok := cgg04_is_false;
                            (*ENDIF*) 
                            END
                        ELSE
                            IF  s49patmatch (operand1^, start_pos1, trunc_len1,
                                operand2^, start_pos2, trunc_len2,  operand2^ [ start_pos2 ])
                            THEN
                                ok := cgg04_is_false;
                            (*ENDIF*) 
                        (*ENDIF*) 
                    op_sounds:
                        IF  NOT kb71phonmatch (workbuf,
                            operand1^, start_pos1, trunc_len1, operand2^, start_pos2, trunc_len2)
                        THEN
                            ok := cgg04_is_false;
                        (*ENDIF*) 
                    op_not_sounds:
                        IF  kb71phonmatch (workbuf,
                            operand1^, start_pos1, trunc_len1, operand2^, start_pos2, trunc_len2)
                        THEN
                            ok := cgg04_is_false
                        (*ENDIF*) 
                    END
                (*ENDCASE*) 
            (*ENDIF*) 
            END;
        OTHERWISE
            ok := cgg04_is_undef
        END;
    (*ENDCASE*) 
    END;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb71get_subquery_value (
            VAR t   : tgg00_TransContext;
            VAR sel : tgg00_SelectFieldsParam;
            VAR op  : tgg00_StackEntry);
 
VAR
      found_undef    : boolean;
      len            : integer;
      start          : integer;
      file_id        : tgg00_FileId;
      operand        : tsp00_MoveObjPtr;
      k              : tgg00_Lkey;
      rec            : tgg00_Rec;
 
BEGIN
t.trError_gg00       := e_ok;
s10mv (sizeof(sel.sfp_data_addr^), sizeof(file_id),
      @sel.sfp_data_addr^, op.epos, @file_id, 1, sizeof(tgg00_FileId));
found_undef := false;
k.len := 0;
b02next_record (t, file_id, k, c_inclusive, rec);
IF  t.trError_gg00 = e_no_next_record
THEN
    found_undef := true;
(*ENDIF*) 
IF  t.trError_gg00 = e_key_not_found
THEN
    t.trError_gg00 := e_ok;
(*ENDIF*) 
IF  ((t.trError_gg00 = e_ok) OR (t.trError_gg00 = e_no_next_record))
THEN
    BEGIN
    WITH sel.sfp_work_st_top^ DO
        BEGIN
        etype         := st_result;
        eop           := op_none;
        epos          := sel.sfp_workbuf_len + 1;
        ecol_tab [1] := chr(0);
        ecol_tab [2] := chr(0)
        END;
    (*ENDWITH*) 
    IF  found_undef
    THEN
        BEGIN
        sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len+1] := csp_undef_byte;
        len := 1;
        t.trError_gg00 := e_ok;
        END
    ELSE
        BEGIN
        (* PTS 1116323 E.Z. *)
        start := cgg_rec_key_offset+rec.keylen+op.elen_var;
        operand := @rec.buf[start];
        IF  rec.recLen_gg00 + 1 - start < op.ecol_pos
        THEN
            len := a05lnr_space_defbyte (t.trAcvPtr_gg00,
                  operand, operand^[1], 2, rec.recLen_gg00 - start) + 1
        ELSE
            len := op.ecol_pos;
        (*ENDIF*) 
        g10mv ('VKB71 ',  16,    
              sizeof(rec.buf), sel.sfp_workbuf_size,
              @operand^, 1,
              @sel.sfp_workbuf_addr^, sel.sfp_workbuf_len + 1,
              len, t.trError_gg00);
        END;
    (*ENDIF*) 
    sel.sfp_work_st_top^.elen_var := len;
    sel.sfp_workbuf_len           := sel.sfp_workbuf_len + len;
&   ifdef TRACE
    t01sname (kb_qual, '=== result: ');
    WITH sel.sfp_work_st_top^ DO
        t01moveobj (kb_qual, sel.sfp_workbuf_addr^,
              epos, epos + elen_var - 1);
    (*ENDWITH*) 
&   endif
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      k71sub_value_get (
            VAR t   : tgg00_TransContext;
            VAR op  : tgg00_StackEntry;
            dataptr : tsp00_MoveObjPtr;
            datasize: integer);
 
VAR
      _found_undef    : boolean;
      _len            : integer;
      _start          : integer;
      _file_id        : tgg00_FileId;
      _operand        : tsp00_MoveObjPtr;
      _k              : tgg00_Lkey;
      _rec            : tgg00_Rec;
 
BEGIN
t.trError_gg00       := e_ok;
s10mv (datasize, sizeof(_file_id),
      dataptr, op.epos, @_file_id, 1, sizeof(tgg00_FileId));
_found_undef := false;
_k.len := 0;
b02next_record (t, _file_id, _k, c_inclusive, _rec);
IF  t.trError_gg00 = e_no_next_record
THEN
    _found_undef := true;
(*ENDIF*) 
IF  t.trError_gg00 = e_key_not_found
THEN
    t.trError_gg00 := e_ok;
(*ENDIF*) 
IF  ((t.trError_gg00 = e_ok) OR (t.trError_gg00 = e_no_next_record))
THEN
    BEGIN
    IF  _found_undef
    THEN
        BEGIN
        dataptr^ [op.epos] := csp_undef_byte;
        _len := 1;
        t.trError_gg00 := e_ok;
        END
    ELSE
        BEGIN
        _start := cgg_rec_key_offset+_rec.keylen + 1;
        _operand := @_rec.buf[_start];
        IF  _rec.recLen_gg00 + 1 - _start < op.ecol_pos
        THEN
            _len := a05lnr_space_defbyte (t.trAcvPtr_gg00,
                  _operand, _operand^[1], 2, _rec.recLen_gg00 - _start) + 1
        ELSE
            _len := a05lnr_space_defbyte (t.trAcvPtr_gg00,
                  _operand, _operand^[1], 2, op.ecol_pos - 1) + 1;
        (*ENDIF*) 
        g10mv ('VKB71 ',  17,    
              sizeof(_rec.buf), datasize, @_operand^, 1,
              dataptr, op.epos, _len, t.trError_gg00);
        END;
    (*ENDIF*) 
    op.etype := st_value;
    op.eop   := op_none;
    op.epos  := op.epos; (* unchanged *)
    op.elen_var := _len;
    op.ecol_pos := 0;
&   ifdef TRACE
    t01stackentry (kb_qual, op, 1);
    t01moveobj (kb_qual, dataptr^, op.epos, op.epos + _len - 1);
&   endif
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb71mass_compare (
            VAR op  : tgg00_StackEntry;
            VAR sel : tgg00_SelectFieldsParam;
            VAR e   : tgg00_BasisError);
 
VAR
      all           : boolean;
      exit_loop     : boolean;
      undef         : boolean;
      done          : boolean;
      skip_this_list: boolean;
      ok            : integer;
      curr_op_len   : integer;
      operand_len   : integer;
      operand_ptr   : tgg00_StEntryAddr;
      curr_op_ptr   : tgg00_StEntryAddr;
      first_op_ptr  : tgg00_StEntryAddr;
      next_list_ptr : tgg00_StEntryAddr;
      aux_ptr       : tgg00_StEntryAddr;
      operand_addr  : tsp00_MoveObjPtr;
      curr_op_addr  : tsp00_MoveObjPtr;
      workbuf       : tkb07_buffer_description;
 
LABEL
      999;
 
BEGIN
e     := e_ok;
undef := false;
all   := (op.ecol_tab [1] = chr(1));
IF  (op.epos = 0)
THEN (* Already parsed views are out there with epos not set... *)
    op.epos := 1;
&ifdef TRACE
(*ENDIF*) 
t01op     (kb_qual, 'mas_comp op ', op.eop);
t01p2int4 (kb_qual, '# lists     ', op.elen_var
      ,             '# elem per l', op.epos);
&endif
operand_ptr  := s35inc_st (sel.sfp_work_st_top,
      - (op.elen_var+1) * op.epos + 1);
curr_op_ptr  := sel.sfp_work_st_top;
first_op_ptr := s35inc_st (curr_op_ptr, - op.elen_var * op.epos);
IF  s35le_bufaddr (operand_ptr, sel.sfp_work_st_bottom)
THEN (* Oops, there are not enough operands on the stack! *)
    BEGIN
    e := e_stack_type_illegal;
    goto 999;
    END;
(*ENDIF*) 
exit_loop           := false;
sel.sfp_work_st_top := first_op_ptr;
REPEAT
    (* In a first round we check, whether there is   *)
    (* a null value in the list left to the op.      *)
    k71get_operand (sel,
          c_check_spec_null, operand_addr, operand_len, e);
    IF  e <> e_ok
    THEN
        goto 999;
    (*ENDIF*) 
    IF  operand_addr^[1] = csp_undef_byte
    THEN
        BEGIN
        undef     := true;
        exit_loop := true
        END
    ELSE
        IF  sel.sfp_work_st_top = operand_ptr
        THEN
            exit_loop := true
        ELSE
            sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, -1);
        (*ENDIF*) 
    (*ENDIF*) 
UNTIL
    exit_loop;
(*ENDREPEAT*) 
IF  NOT undef
THEN (* None of the values on the left side are null. *)
    BEGIN
    next_list_ptr       := s35inc_st (curr_op_ptr, -op.epos);
    sel.sfp_work_st_top := first_op_ptr;
    workbuf.buffer_addr := sel.sfp_workbuf_addr;
    workbuf.buffer_size := sel.sfp_workbuf_size;
    workbuf.buffer_len  := sel.sfp_workbuf_len;
    REPEAT
        IF  operand_ptr <> sel.sfp_work_st_top
        THEN (* We have to load the left operand anew. *)
            BEGIN
            operand_ptr := sel.sfp_work_st_top;
            k71get_operand (sel, c_check_spec_null,
                  operand_addr, operand_len, e);
            IF  e <> e_ok (* this shouldn't happen here, since we *)
            THEN          (* already read the operand sucessfull. *)
                goto 999
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        aux_ptr             := sel.sfp_work_st_top;
        sel.sfp_work_st_top := curr_op_ptr;
        k71get_operand (sel, c_check_spec_null, curr_op_addr,
              curr_op_len, e);
        IF  e <> e_ok
        THEN
            goto 999;
        (*ENDIF*) 
        IF  curr_op_len > 0
        THEN
            BEGIN
            IF  (operand_addr^ [1] <> curr_op_addr^ [1]) AND
                (curr_op_addr^ [1] <> csp_defined_byte)
            THEN
                BEGIN
                k71code_operand (sel, operand_addr^ [1],
                      curr_op_addr, curr_op_len,
                      curr_op_ptr, e);
                IF  e <> e_ok
                THEN
                    goto 999
                (*ENDIF*) 
                END
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        sel.sfp_work_st_top := aux_ptr;
        kb71comparison (sel, op.eop, workbuf, operand_addr^,
              1, operand_len, curr_op_addr^,
              1, curr_op_len, ok);
        curr_op_ptr         := s35inc_st (curr_op_ptr, -1);
        sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, -1);
        (* We can skip to the next list, since we are   *)
        (* done with the current one, if                *)
        (*  a) we are at the last element, OR           *)
        (*  b) an <> op yields true        OR           *)
        (*  c) any other op yields false.               *)
        (* We can stop with the whole operation, if     *)
        (*  a) we are through with the current list AND *)
        (*  b) have no ALL or are at the last list.     *)
&       ifdef trace
        t01addr (kb_qual, 'curr_op     ', curr_op_ptr);
        t01addr (kb_qual, 'next_list   ', next_list_ptr);
&       endif
        skip_this_list := (curr_op_ptr = next_list_ptr)   OR
              ((op.eop =  op_ne) AND (ok =  cgg04_is_true)) OR
              ((op.eop <> op_ne) AND (ok <> cgg04_is_true));
        done := skip_this_list AND
              ((NOT all AND (ok =  cgg04_is_true)) OR
              (     all AND (ok <> cgg04_is_true)) OR
              (next_list_ptr = first_op_ptr));
&       ifdef TRACE
        t01int4 (kb_qual, 'ok          ', ord (ok));
        t01int4 (kb_qual, 'skip_it     ', ord (skip_this_list));
        t01int4 (kb_qual, '===> done:  ', ord (done));
&       endif
        IF  skip_this_list AND NOT done
        THEN (* here we have to check the next list. *)
            BEGIN
            curr_op_ptr         := next_list_ptr;
            sel.sfp_work_st_top := first_op_ptr;
            next_list_ptr       := s35inc_st (next_list_ptr, -op.epos)
            END;
        (*ENDIF*) 
    UNTIL
        done;
    (*ENDREPEAT*) 
    END;
(* Before we assign the result, we must adjust the stackpointer, *)
(* since it can point to any element of the left list.           *)
(*ENDIF*) 
sel.sfp_workbuf_len := sel.sfp_workbuf_top;
sel.sfp_work_st_top := s35inc_st (first_op_ptr, - op.epos + 1);
WITH sel.sfp_work_st_top^ DO
    BEGIN
    etype := st_bool;
    IF  undef
    THEN (* At least one of the values on the left side was null. *)
        epos := cgg04_is_undef
    ELSE
        epos := ok;
    (*ENDIF*) 
&   ifdef TRACE
    t01int4 (kb_qual, '=== result  ', epos);
&   endif
    END;
(*ENDWITH*) 
999 : ;
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb71matchvalue (
            VAR workbuf  : tkb07_buffer_description;
            VAR val      : tsp00_MoveObj;
            val_pos      : tsp00_Int4;
            val_len      : tsp00_Int4;
            offset       : tsp00_Int4;
            VAR compare  : tsp00_C4;
            VAR e        : tgg00_BasisError);
 
VAR
      c           : char;
      i           : integer;
      compare_pos : integer;
      code_tab    : integer;
      len         : integer;
      buf_pos     : integer;
 
BEGIN
IF  val [val_pos] = ' '
THEN
    SAPDB_PascalOverlappingMove ('VKB71 ',  18,    
          sizeof(val), workbuf.buffer_size, @val, val_pos+1,
          @workbuf.buffer_addr^, offset+1, val_len, e)
ELSE
    BEGIN
    IF  ' ' = csp_ascii_blank
    THEN
        code_tab := cgg04_to_ascii
    ELSE
        code_tab := cgg04_to_ebcdic;
    (*ENDIF*) 
    s30map (g02codetables.tables [code_tab],
          val, val_pos+1, workbuf.buffer_addr^, offset+1, val_len)
    END;
(*ENDIF*) 
len     := val_len;
compare := '    ';
buf_pos     := 1;
compare_pos := 1;
WHILE (buf_pos <= len) AND (compare_pos <= 4) DO
    BEGIN
    c := workbuf.buffer_addr^  [offset + buf_pos];
    CASE c OF
        'W', 'w', 'B', 'b', 'F', 'f', 'P', 'p', 'V', 'v' :
            c := '1';
        'C', 'c', 'G', 'g', 'J', 'j', 'K', 'k',
        'Q', 'q', 'S', 's', 'X', 'x', 'Z', 'z' :
            c := '2';
        'D', 'd', 'T', 't':
            c := '3';
        'L', 'l':
            c := '4';
        'M', 'm', 'N', 'n':
            c := '5';
        'R', 'r':
            c := '6';
        OTHERWISE
            c := ' ';
        END;
    (*ENDCASE*) 
    IF  compare_pos = 1
    THEN
        BEGIN
        compare [compare_pos] := c;
        compare_pos := compare_pos + 1
        END
    ELSE
        IF  (c <> ' ') AND (c <> compare [compare_pos-1])
        THEN
            BEGIN
            compare [compare_pos] := c;
            compare_pos := compare_pos + 1
            END;
        (*ENDIF*) 
    (*ENDIF*) 
    buf_pos := buf_pos + 1
    END;
(*ENDWHILE*) 
IF  val_len > 0
THEN
    BEGIN
    c       := workbuf.buffer_addr^  [offset+1];
    IF  c in  ['a'..'i', 'j'..'r', 's'..'z']
    THEN
        c := chr( ord(c) + ord('A') - ord('a') );
    (*ENDIF*) 
    CASE c OF
        'D':
            compare [1] := 'T';
        'B':
            compare [1] := 'P';
        'C', 'G':
            compare [1] := 'K';
        'V':
            compare [1] := 'F';
        'S', 'X':
            compare [1] := 'Z';
        OTHERWISE
            compare [1] := c;
        END;
    (*ENDCASE*) 
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      kb71number_to_value (
            VAR t   : tgg00_TransContext;
            VAR sel : tgg00_SelectFieldsParam;
            VAR st  : tgg00_StackEntry) : tgg00_BasisError;
 
VAR
      e            : tgg00_BasisError;
      num_err      : tsp00_NumError;
      def_byte     : char;
      len          : integer;
      datalen      : integer;
      datafrac     : integer;
      bytelen      : integer;
      operand_addr : tsp00_MoveObjPtr;
 
LABEL
      999;
 
BEGIN
&ifdef TRACE
(* The following code exists to make usecheck happy.     *)
(* The parameter t is necessary, because the             *)
(* the procedure is called by a pointer from             *)
(* an array of procedure pointers, i.e. all              *)
(* those procedures must have the same formal parameters *)
e := t.trError_gg00;
&endif
IF  sel.sfp_workbuf_top + 1 + mxsp_number > sel.sfp_workbuf_size
THEN
    BEGIN
    e := e_stack_overflow;
    goto 999;
    END
ELSE
    BEGIN
    k71get_operand (sel,
          NOT c_check_spec_null, operand_addr, len, e);
    IF  e <> e_ok
    THEN
        goto 999
    ELSE
        IF  len > 1 + mxsp_number
        THEN
            BEGIN
            e := e_stack_type_illegal;
            goto 999;
            END;
        (*ENDIF*) 
    (*ENDIF*) 
    END;
(*ENDIF*) 
def_byte := operand_addr^[1];
IF  def_byte <> csp_oflw_byte
THEN
    IF  (len = 1)                             OR
        (st.ecol_tab [1] = csp_undef_byte)    OR
        (st.ecol_tab [2] = csp_undef_byte)
    THEN
        def_byte := csp_undef_byte;
    (*ENDIF*) 
(*ENDIF*) 
WITH sel.sfp_work_st_top^ DO
    BEGIN
    etype        := st_result;
    eop          := op_none;
    epos         := sel.sfp_workbuf_top + 1;
    ecol_tab [2] := chr(0)
    END;
(*ENDWITH*) 
IF  (def_byte = csp_undef_byte) OR (def_byte = csp_oflw_byte)
THEN
    BEGIN
    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_top+1] := def_byte;
    len := 0
    END
ELSE
    BEGIN
    num_err := num_ok;
    IF  ((st.eop = op_fixed) OR (st.etype = st_result))
    THEN
        BEGIN
        s51kroun (operand_addr^, 2, len-1,
              sel.sfp_workbuf_addr^, sel.sfp_workbuf_top+2,
              st.epos, st.elen_var, len, num_err);
        END
    ELSE
        BEGIN
        (* st_noround *)
        IF  st.elen_var = csp_float_frac
        THEN
            BEGIN
            datafrac := csp_float_frac;
            datalen  := s51floatlen (operand_addr^, 2, len-1);
            bytelen := ((datalen + 1) DIV 2) + 1
            END
        ELSE
            s43lfrac (operand_addr^, 2, len-1,
                  datalen, datafrac, bytelen);
        (*ENDIF*) 
&       ifdef TRACE
        t01moveobj (kb_qual, operand_addr^, 1, len);
        t01p2int4  (kb_qual, 'st.epos     ', st.epos
              ,              'datalen     ', datalen);
        t01p2int4  (kb_qual, 'st.elen_var ', st.elen_var
              ,              'datafrac    ', datafrac);
&       endif
        IF  ((st.epos < datalen) OR
            ((st.elen_var >= 0) AND
            ((datafrac < 0) OR
            (st.elen_var < datafrac) OR
            (st.epos - st.elen_var < datalen - datafrac))))
        THEN
            num_err := num_invalid
        ELSE
            BEGIN
            num_err := num_ok;
            g10mv ('VKB71 ',  19,    
                  sizeof(operand_addr^), sel.sfp_workbuf_size,
                  @operand_addr^, 2,
                  @sel.sfp_workbuf_addr^, sel.sfp_workbuf_top+2,
                  bytelen, e);
            len := ((st.epos + 1) DIV 2) + 1;
            IF  len > bytelen
            THEN
                SAPDB_PascalFill ('VKB71 ',  20,    
                      sel.sfp_workbuf_size, @sel.sfp_workbuf_addr^,
                      sel.sfp_workbuf_top + 2 + bytelen,
                      len - bytelen, csp_defined_byte, e)
            (*ENDIF*) 
            END
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  num_err <> num_ok
    THEN
        k71num_err_to_b_err (num_err, e);
    (*ENDIF*) 
    IF  e = e_ok
    THEN
        BEGIN
        len := ((st.epos + 1) DIV 2) + 1;
        sel.sfp_workbuf_addr^ [sel.sfp_workbuf_top+1] :=
              csp_defined_byte;
        END
    ELSE
        IF  st.eop = op_fixed
        THEN
            BEGIN
            e   := e_ok;
            len := 0;
            sel.sfp_workbuf_addr^ [sel.sfp_workbuf_top+1] :=
                  csp_oflw_byte
            END
        ELSE
            goto 999;
        (*ENDIF*) 
    (*ENDIF*) 
    END;
(*ENDIF*) 
&ifdef TRACE
t01sname (kb_qual, '=== result: ');
t01moveobj   (kb_qual, sel.sfp_workbuf_addr^,
      sel.sfp_workbuf_top+1, sel.sfp_workbuf_top+1+len);
&endif
sel.sfp_work_st_top^.elen_var := 1 + len;
sel.sfp_workbuf_len := sel.sfp_workbuf_top + 1 + len;
999 : ;
kb71number_to_value := e
END;
 
(*------------------------------*) 
 
FUNCTION
      kb71op_mapchar (
            VAR t           : tgg00_TransContext;
            VAR sel         : tgg00_SelectFieldsParam;
            VAR st          : tgg00_StackEntry) : tgg00_BasisError;
 
VAR
      to_upper     : boolean;
      e            : tgg00_BasisError;
      found        : boolean;
      operand_addr : ARRAY  [1..2] OF tsp00_MoveObjPtr;
      len          : ARRAY  [1..2] OF integer;
      undef        : ARRAY  [1..2] OF boolean;
      c            : char;
      def_byte     : char;
      up_code_tab  : integer;
      alpha_len    : integer;
      trunc_len    : integer;
      i            : integer;
      source_index : integer;
      map_index    : integer;
      map_set_end  : integer;
 
LABEL
      999;
 
BEGIN
&ifdef TRACE
(* The following code exists to make usecheck happy.     *)
(* The parameters are necessary, because the             *)
(* the procedure is called by a pointer from             *)
(* an array of procedure pointers, i.e. all              *)
(* those procedures must have the same formal parameters *)
e := t.trError_gg00;
i := ord(st.etype);
&endif
to_upper       := sel.sfp_work_st_top^.ecol_tab[1] = chr (ord(true));
undef [1]      := true;
undef [2]      := true;
len [1]        := 0;
len [2]        := 0;
FOR i := 2 DOWNTO 1 DO
    BEGIN
    k71get_operand (sel,
          c_check_spec_null, operand_addr [i], len [i], e);
    IF  e <> e_ok
    THEN
        goto 999;
    (*ENDIF*) 
    undef [i] := (operand_addr [i]^ [1] = csp_undef_byte);
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, -1)
    END;
(*ENDFOR*) 
IF  (len [2] - 1) MOD 3 <> 0
THEN
    BEGIN
    e := e_invalid_parameter;
    goto 999;
    END
ELSE
    map_set_end := len [2];
(*ENDIF*) 
IF  sel.sfp_workbuf_len + len [1] > sel.sfp_workbuf_size
THEN
    BEGIN
    e := e_stack_overflow;
    goto 999;
    END;
(*ENDIF*) 
sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, 1);
sel.sfp_workbuf_len := sel.sfp_workbuf_len + 1;
WITH sel.sfp_work_st_top^ DO
    BEGIN
    etype    := st_result;
    eop      := op_none;
    epos     := sel.sfp_workbuf_len;
    ecol_tab := cgg_zero_c2
    END;
(*ENDWITH*) 
IF  undef [1]
THEN
    BEGIN
    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len]:= csp_undef_byte;
    sel.sfp_work_st_top^.elen_var := 1
    END
ELSE
    BEGIN
    def_byte  := operand_addr [1]^ [1];
    IF  to_upper
    THEN
        IF  g01code.ctype = csp_ascii
        THEN
            BEGIN
            IF  def_byte = csp_ascii_blank
            THEN
                up_code_tab  := cgg04_up_ascii
            ELSE
                up_code_tab  := cgg04_to_up_ascii
            (*ENDIF*) 
            END
        ELSE
            IF  def_byte = csp_ebcdic_blank
            THEN
                up_code_tab  := cgg04_up_ebcdic
            ELSE
                up_code_tab  := cgg04_to_up_ebcdic;
            (*ENDIF*) 
        (*ENDIF*) 
    (*ENDIF*) 
    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len] := def_byte;
    (* PTS 1121403 E.Z. *)
    trunc_len := a05lnr_space_defbyte (sel.sfp_acv_addr,
          operand_addr [1], def_byte, 2, len [1] - 1);
    alpha_len := 0;
    IF  trunc_len > 0
    THEN
        BEGIN
        source_index := 1;
        WHILE (source_index <= trunc_len) DO
            BEGIN
            c         := operand_addr [1]^ [1 + source_index];
            found     := false;
            map_index := 2;
            WHILE (map_index <= map_set_end) AND
                  NOT found DO
                BEGIN
                IF  operand_addr [2]^ [map_index] = c
                THEN
                    found := true
                ELSE
                    map_index := map_index + 3;
                (*ENDIF*) 
                END;
            (*ENDWHILE*) 
            alpha_len := succ (alpha_len);
            IF  NOT found
            THEN
                sel.sfp_workbuf_addr^
                      [sel.sfp_workbuf_len + alpha_len] := c
            ELSE
                BEGIN
                IF  operand_addr [2]^ [map_index + 2] = def_byte
                THEN (* One Character is to map *)
                    sel.sfp_workbuf_addr^
                          [sel.sfp_workbuf_len + alpha_len] :=
                          operand_addr [2]^ [map_index + 1]
                ELSE (* Two Character are to map *)
                    BEGIN
                    sel.sfp_workbuf_addr^
                          [sel.sfp_workbuf_len + alpha_len] :=
                          operand_addr [2]^ [map_index + 1];
                    alpha_len := succ(alpha_len);
                    sel.sfp_workbuf_addr^
                          [sel.sfp_workbuf_len + alpha_len] :=
                          operand_addr [2]^ [map_index + 2]
                    END;
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            source_index := succ(source_index);
            IF  (source_index < trunc_len) AND
                (sel.sfp_workbuf_len + alpha_len + 1 > sel.sfp_workbuf_size)
            THEN
                BEGIN
                e := e_stack_overflow;
                goto 999;
                END;
            (*ENDIF*) 
            END
        (*ENDWHILE*) 
        END;
    (*ENDIF*) 
    sel.sfp_work_st_top^.elen_var := 1 + alpha_len;
    sel.sfp_workbuf_len           := sel.sfp_workbuf_len + alpha_len;
    IF  to_upper
    THEN
        s30map (g02codetables.tables [up_code_tab],
              sel.sfp_workbuf_addr^, sel.sfp_work_st_top^.epos,
              sel.sfp_workbuf_addr^, sel.sfp_work_st_top^.epos,
              1 + alpha_len)
    (*ENDIF*) 
    END;
(*ENDIF*) 
&ifdef TRACE
t01sname (kb_qual, '=== result: ');
WITH sel.sfp_work_st_top^ DO
    t01moveobj (kb_qual, sel.sfp_workbuf_addr^, epos, epos + elen_var - 1);
(*ENDWITH*) 
&endif
999 : ;
kb71op_mapchar := e
END;
 
(* PTS 1120720 E.Z. *)
(*------------------------------*) 
 
FUNCTION
      kb71dbyte_mapchar (
            VAR t           : tgg00_TransContext;
            VAR sel         : tgg00_SelectFieldsParam;
            VAR st          : tgg00_StackEntry) : tgg00_BasisError;
 
VAR
      to_upper     : boolean;
      e            : tgg00_BasisError;
      found        : boolean;
      operand_addr : ARRAY  [1..2] OF tsp00_MoveObjPtr;
      len          : ARRAY  [1..2] OF integer;
      undef        : ARRAY  [1..2] OF boolean;
      c1           : char;
      c2           : char;
      def_byte     : char;
      alpha_len    : integer;
      trunc_len    : integer;
      i            : integer;
      source_index : integer;
      map_index    : integer;
      map_set_end  : integer;
 
LABEL
      999;
 
BEGIN
&ifdef TRACE
(* The following code exists to make usecheck happy.     *)
(* The parameters are necessary, because the             *)
(* the procedure is called by a pointer from             *)
(* an array of procedure pointers, i.e. all              *)
(* those procedures must have the same formal parameters *)
e := t.trError_gg00;
i := ord(st.etype);
&endif
undef [1]      := true;
undef [2]      := true;
len [1]        := 0;
len [2]        := 0;
FOR i := 2 DOWNTO 1 DO
    BEGIN
    k71get_operand (sel,
          c_check_spec_null, operand_addr [i], len [i], e);
    IF  e <> e_ok
    THEN
        goto 999;
    (*ENDIF*) 
    undef [i] := (operand_addr [i]^ [1] = csp_undef_byte);
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, -1)
    END;
(*ENDFOR*) 
IF  (len [2] - 1) MOD 6 <> 0
THEN
    BEGIN
    e := e_invalid_parameter;
    goto 999;
    END
ELSE
    map_set_end := len [2];
(*ENDIF*) 
IF  sel.sfp_workbuf_len + len [1] + 2 > sel.sfp_workbuf_size
THEN
    BEGIN
    e := e_stack_overflow;
    goto 999;
    END;
(*ENDIF*) 
sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, 1);
sel.sfp_workbuf_len := sel.sfp_workbuf_len + 1;
WITH sel.sfp_work_st_top^ DO
    BEGIN
    etype    := st_result;
    eop      := op_none;
    epos     := sel.sfp_workbuf_len;
    ecol_tab := cgg_zero_c2
    END;
(*ENDWITH*) 
IF  undef [1]
THEN
    BEGIN
    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len]:= csp_undef_byte;
    sel.sfp_work_st_top^.elen_var := 1
    END
ELSE
    BEGIN
    def_byte  := operand_addr [1]^ [1];
    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len] := def_byte;
    trunc_len := a05lnr_space_defbyte (sel.sfp_acv_addr,
          operand_addr [1], def_byte, 2, len [1] - 1);
    alpha_len := 0;
    IF  trunc_len > 0
    THEN
        BEGIN
        source_index := 1;
        WHILE (source_index <= trunc_len) DO
            BEGIN
            c1        := operand_addr [1]^ [1 + source_index    ];
            c2        := operand_addr [1]^ [1 + source_index + 1];
            found     := false;
            map_index := 2;
            WHILE (map_index <= map_set_end) AND
                  NOT found DO
                BEGIN
                IF  (operand_addr [2]^ [map_index    ] = c1) AND
                    (operand_addr [2]^ [map_index + 1] = c2)
                THEN
                    found := true
                ELSE
                    map_index := map_index + 6;
                (*ENDIF*) 
                END;
            (*ENDWHILE*) 
            IF  NOT found
            THEN
                BEGIN
                sel.sfp_workbuf_addr^[sel.sfp_workbuf_len + alpha_len+1] := c1;
                sel.sfp_workbuf_addr^[sel.sfp_workbuf_len + alpha_len+2] := c2;
                alpha_len := alpha_len + 2;
                END
            ELSE
                BEGIN
                IF  (operand_addr [2]^ [map_index + 4] = csp_unicode_mark) AND
                    (operand_addr [2]^ [map_index + 5] = csp_ascii_blank)
                THEN
                    BEGIN
                    (* One Character is to map *)
                    sel.sfp_workbuf_addr^[sel.sfp_workbuf_len + alpha_len+1] :=
                          operand_addr [2]^ [map_index + 2];
                    sel.sfp_workbuf_addr^[sel.sfp_workbuf_len + alpha_len+2] :=
                          operand_addr [2]^ [map_index + 3];
                    alpha_len := alpha_len + 2;
                    END
                ELSE (* Two Character are to map *)
                    BEGIN
                    g10mv ('VKB71 ',  21,    
                          len[2], sel.sfp_workbuf_size,
                          @operand_addr [2]^, map_index + 2,
                          @sel.sfp_workbuf_addr^, sel.sfp_workbuf_len + alpha_len+1, 4, e);
                    alpha_len := alpha_len+4;
                    END;
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            source_index := source_index+2;
            IF  (source_index < trunc_len) AND
                (sel.sfp_workbuf_len + alpha_len + 4 > sel.sfp_workbuf_size)
            THEN
                BEGIN
                e := e_stack_overflow;
                goto 999;
                END;
            (*ENDIF*) 
            END
        (*ENDWHILE*) 
        END;
    (*ENDIF*) 
    sel.sfp_work_st_top^.elen_var := 1 + alpha_len;
    sel.sfp_workbuf_len           := sel.sfp_workbuf_len + alpha_len;
    END;
(*ENDIF*) 
&ifdef TRACE
t01sname (kb_qual, '=== result: ');
WITH sel.sfp_work_st_top^ DO
    t01moveobj (kb_qual, sel.sfp_workbuf_addr^, epos, epos + elen_var - 1);
(*ENDWITH*) 
&endif
999 : ;
kb71dbyte_mapchar := e
END;
 
(*------------------------------*) 
 
FUNCTION
      kb71op_arith (
            VAR t    : tgg00_TransContext;
            VAR sel  : tgg00_SelectFieldsParam;
            VAR st   : tgg00_StackEntry) : tgg00_BasisError;
 
VAR
      undef         : boolean;
      spec_null     : boolean;
      is_int        : boolean;
      no_number     : boolean;
      e             : tgg00_BasisError;
      op            : tgg00_StackOpType;
      operand_count : integer;
      res_len       : integer;
      help1_len     : integer;
      help2_len     : integer;
      res_pos       : integer;
      i             : integer;
      num_err       : tsp00_NumError;
      len           : ARRAY [1..2] OF integer;
      buf_addr_list : ARRAY [1..2] OF tsp00_MoveObjPtr;
      help_buf      : ARRAY [1..2] OF tsp00_Number;
      help1         : tsp00_MoveObjPtr;
      help2         : tsp00_MoveObjPtr;
      res           : tsp00_MoveObjPtr;
 
LABEL
      999;
 
BEGIN
&ifdef TRACE
(* The following code exists to make usecheck happy.     *)
(* The parameter t is necessary, because the             *)
(* the procedure is called by a pointer from             *)
(* an array of procedure pointers, i.e. all              *)
(* those procedures must have the same formal parameters *)
e := t.trError_gg00;
&endif
num_err      := num_ok;
undef        := false;
spec_null    := false;
no_number    := false;
op           := st.eop;
&ifdef TRACE
t01op (kb_qual, 'arithm op   ', op);
&endif
IF  op = op_minus_monad
THEN
    operand_count := 1
ELSE
    operand_count := 2;
(*ENDIF*) 
FOR i := operand_count DOWNTO 1 DO
    BEGIN
    k71get_operand (sel, NOT c_check_spec_null, buf_addr_list [i],
          len [i], e);
    IF  e <> e_ok
    THEN
        goto 999;
    (*ENDIF*) 
    CASE buf_addr_list[i]^[1] OF
        csp_undef_byte :
            undef := true;
        csp_oflw_byte :
            spec_null := true;
        csp_defined_byte :
            BEGIN
            END;
        OTHERWISE
            no_number := true;
        END;
    (*ENDCASE*) 
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, -1)
    END;
(*ENDFOR*) 
IF  sel.sfp_workbuf_top + 1 + mxsp_number > sel.sfp_workbuf_size
THEN
    BEGIN
    e := e_stack_overflow;
    goto 999;
    END;
(*ENDIF*) 
res := sel.sfp_workbuf_addr;
IF  NOT undef AND NOT spec_null
THEN
    BEGIN
    IF  no_number
    THEN
        BEGIN
        e := e_num_invalid;
        goto 999;
        END;
    (*ENDIF*) 
    res^ [sel.sfp_workbuf_top+1] := csp_defined_byte;
    res_pos := sel.sfp_workbuf_top + 2;
    CASE op OF
        op_div:
            s51div (buf_addr_list [1]^, 2, len [1]-1,
                  buf_addr_list [2]^, 2, len [2]-1, res^,
                  res_pos, csp_fixed, csp_float_frac, res_len,
                  num_err);
        op_intdiv:
            BEGIN
            s51intdiv (buf_addr_list [1]^, 2, len [1] - 1,
                  buf_addr_list [2]^, 2, len [2] - 1, res^,
                  res_pos, csp_fixed, csp_float_frac,
                  res_len, num_err);
            IF  num_err = num_invalid
            THEN
                BEGIN
                e := e_num_invalid;
                goto 999
                END;
            (*ENDIF*) 
            END;
        op_minus:
            s51sub (buf_addr_list [1]^, 2, len [1] - 1,
                  buf_addr_list [2]^, 2, len [2] - 1, res^,
                  res_pos, csp_fixed, csp_float_frac, res_len,
                  num_err);
        op_minus_monad:
            s51neg (buf_addr_list [1]^, 2, len [1]-1, res^,
                  res_pos, csp_fixed, csp_float_frac, res_len,
                  num_err);
        op_mod, op_mod_func :
            BEGIN
            s51isint (buf_addr_list [1]^,
                  2, len [1] - 1, is_int, num_err);
            IF  num_err = num_ok
            THEN
                BEGIN
                IF  NOT is_int
                THEN
                    BEGIN
                    e := e_num_invalid;
                    goto 999;
                    END;
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            IF  num_err = num_ok
            THEN
                BEGIN
                s51isint (buf_addr_list [2]^,
                      2, len [2] - 1, is_int, num_err);
                IF  num_err = num_ok
                THEN
                    BEGIN
                    IF  NOT is_int
                    THEN
                        BEGIN
                        e := e_num_invalid;
                        goto 999;
                        END;
                    (*ENDIF*) 
                    END
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            IF  (num_err = num_ok) AND
                (buf_addr_list [2]^ [2] = cgg04_zero_exponent)
            THEN
                BEGIN (* result := a, if b = 0*)
                SAPDB_PascalOverlappingMove ('VKB71 ',  22,    
                      sizeof(buf_addr_list [1]^),
                      sizeof(res^), @buf_addr_list [1]^,
                      2, @res^, res_pos, len [1] - 1, e);
                res_len := len [1] - 1;
                END
            ELSE
                BEGIN
                (*  a MOD b  ==>  a - TRUNC(a / b) * b  *)
                IF  (e = e_ok) AND (num_err = num_ok)
                THEN
                    BEGIN
                    help1 := @help_buf[1];
                    help2 := @help_buf[2];
                    (*---  help2 := a div b  ---*)
                    s51intdiv (buf_addr_list [1]^, 2, len [1]-1,
                          buf_addr_list [2]^, 2, len [2] - 1,
                          help2^, 1, csp_fixed, csp_float_frac,
                          help2_len, num_err)
                    END;
                (*ENDIF*) 
                IF  num_err = num_ok
                THEN
                    (*---  help1 := help2 * b  ---*)
                    s51mul (help2^, 1, help2_len,
                          buf_addr_list [2]^, 2, len [2] - 1,
                          help1^, 1, csp_fixed, csp_float_frac,
                          help1_len, num_err);
                (*ENDIF*) 
                IF  (num_err in  [num_ok, num_trunc])
                THEN
                    (*---  help2 := a - help1  ---*)
                    s51sub (buf_addr_list [1]^, 2, len [1]-1,
                          help1^, 1, help1_len, help2^,
                          1, csp_fixed, csp_float_frac,
                          help2_len, num_err);
                (*ENDIF*) 
                IF  (num_err in  [num_ok, num_trunc])
                THEN
                    BEGIN (*--- result := help2 ---*)
                    g10mv ('VKB71 ',  23,    
                          sizeof (tsp00_Number),
                          sizeof(res^), @help2^, 1,
                          @res^, res_pos, help2_len, e);
                    res_len := help2_len
                    END
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            END;
        op_mult:
            s51mul (buf_addr_list [1]^, 2, len [1]-1,
                  buf_addr_list [2]^, 2, len [2]-1, res^,
                  res_pos, csp_fixed, csp_float_frac, res_len,
                  num_err);
        op_plus:
            s51add (buf_addr_list [1]^, 2, len [1]-1,
                  buf_addr_list [2]^, 2, len [2]-1, res^,
                  res_pos, csp_fixed, csp_float_frac,
                  res_len, num_err);
        OTHERWISE
            BEGIN
            e := e_stack_type_illegal;
            goto 999;
            END;
        END;
    (*ENDCASE*) 
    IF  (num_err <> num_ok)
    THEN
        BEGIN
        k71num_err_to_b_err (num_err, e);
        IF  e <> e_ok
        THEN
            IF  e = e_num_overflow
            THEN
                BEGIN
                spec_null := true;
                e         := e_ok
                END
            ELSE
                goto 999;
            (*ENDIF*) 
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDIF*) 
sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, 1);
WITH sel.sfp_work_st_top^ DO
    BEGIN
    etype        := st_result;
    eop          := op_none;
    epos         := sel.sfp_workbuf_top + 1;
    ecol_tab [1] := chr(0);
    ecol_tab [2] := chr(0)
    END;
(*ENDWITH*) 
IF  spec_null
THEN
    BEGIN
    res^ [sel.sfp_workbuf_top + 1] := csp_oflw_byte;
    res_len := 0
    END
ELSE
    IF  undef
    THEN
        BEGIN
        res^ [sel.sfp_workbuf_top+1] := csp_undef_byte;
        res_len := 0
        END;
&   ifdef TRACE
    (*ENDIF*) 
(*ENDIF*) 
t01sname (kb_qual, '=== result: ');
t01moveobj   (kb_qual, res^, sel.sfp_workbuf_top+1,
      sel.sfp_workbuf_top + 1 + res_len);
&endif
sel.sfp_work_st_top^.elen_var := 1 + res_len;
sel.sfp_workbuf_len           := sel.sfp_workbuf_top + 1 + res_len;
999 :
      kb71op_arith := e
END;
 
(*------------------------------*) 
 
FUNCTION
      kb71op_bool (
            VAR t        : tgg00_TransContext;
            VAR sel      : tgg00_SelectFieldsParam;
            VAR st       : tgg00_StackEntry) : tgg00_BasisError;
 
VAR
      patt_ok        : boolean;
      ascii_type     : boolean;
      op             : tgg00_StackOpType;
      c2             : tsp00_C2;
      e              : tgg00_BasisError;
      i              : integer;
      ok             : integer;
      operand_count  : integer;
      curr_op        : tgg00_StackOpType;
      sqlmode        : tsp00_SqlMode;
      len            : ARRAY  [1..3] OF integer;
      operand_addr   : ARRAY  [1..3] OF tsp00_MoveObjPtr;
      number         : tsp00_Number;
      like_2nd_op    : boolean;
      workbuf        : tkb07_buffer_description;
 
LABEL
      999;
 
BEGIN
&ifdef TRACE
(* The following code exists to make usecheck happy.     *)
(* The parameters are necessary, because the             *)
(* the procedure is called by a pointer from             *)
(* an array of procedure pointers, i.e. all              *)
(* those procedures must have the same formal parameters *)
e := t.trError_gg00;
i := ord(sel.sfp_optimized);
i := ord(st.etype);
&endif
op := st.eop;
&ifdef TRACE
IF  op in  [op_is_integer,
    op_between, op_not_between,
    op_null, op_not_null,
    op_true, op_false]
THEN
    t01op (kb_qual, 'bool op     ', op);
&endif
(*ENDIF*) 
IF  op = op_is_integer
THEN
    operand_count := 1
ELSE
    IF  op in [op_between, op_not_between]
    THEN
        operand_count := 3
    ELSE
        operand_count := 2;
    (*ENDIF*) 
(*ENDIF*) 
FOR i := operand_count DOWNTO 1 DO
    BEGIN
    like_2nd_op := (i = 2) AND (op in [ op_like, op_not_like ]) AND
          NOT (sel.sfp_work_st_top^.etype in [ st_result, st_value ]);
    k71get_operand (sel, c_check_spec_null,
          operand_addr [i], len [i], e);
    IF  e <> e_ok
    THEN
        goto 999;
    (*ENDIF*) 
    IF  like_2nd_op
    THEN      (* If the condition goes like e.g. x LIKE col, and col *)
        BEGIN (* is not a literal or a temporary result, we have to  *)
        (*       create a copy of the column, since below all the    *)
        (*       special chars (like '*' or '%') will be replaced.   *)
&       ifdef trace
        t01int4 (ak_sem, 'LIKE col... ', i);
&       endif
        g10mv ('VKB71 ',  24,    
              sizeof (operand_addr[ i ]^), sel.sfp_workbuf_size,
              @operand_addr[ i ]^, 1,
              @sel.sfp_workbuf_addr^, sel.sfp_workbuf_len+1, len[ i ], e);
        operand_addr[ i ]   := s35add_moveobj_ptr (sel.sfp_workbuf_addr,
              sel.sfp_workbuf_len);
        sel.sfp_workbuf_len := sel.sfp_workbuf_len + len[ i ]
        END;
    (*ENDIF*) 
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, - 1);
    END;
(*ENDFOR*) 
FOR i := 2 TO operand_count DO
    BEGIN
    IF  (operand_addr [1]^ [1] <>
        operand_addr  [i]^ [1])
        AND
        (operand_addr [i]^ [1] <> csp_defined_byte)
        AND
        (operand_addr [1]^ [1] <> csp_undef_byte)
        AND
        (* undef_byte may be in correlations *)
        (* and with 'is [not] null'          *)
        (operand_addr [i]^ [1] <> csp_undef_byte)
    THEN
        BEGIN
        k71code_operand (sel, operand_addr [1]^ [1],
              operand_addr [i], len [i],
              s35inc_st (sel.sfp_work_st_top, i), e);
        IF  e <> e_ok
        THEN
            goto 999
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDFOR*) 
IF  ((op = op_like) OR (op = op_not_like))
THEN
    IF  st.elen_var > 0
    THEN
        BEGIN
        patt_ok    := false;
        ascii_type :=
              (operand_addr [2]^ [1] = csp_ascii_blank);
        IF  st.epos = ord(sqlm_internal)
        THEN
            sqlmode := sqlm_internal
        ELSE
            IF  st.epos = ord(sqlm_ansi)
            THEN
                sqlmode := sqlm_ansi
            ELSE
                IF  st.epos = ord(sqlm_db2)
                THEN
                    sqlmode := sqlm_db2
                ELSE
                    sqlmode := sqlm_oracle;
                (*ENDIF*) 
            (*ENDIF*) 
        (*ENDIF*) 
        IF  st.ecol_tab [2] = chr(1) (* escape *)
        THEN
            BEGIN
            IF  operand_addr [2]^[1] = csp_unicode_def_byte
            THEN
                BEGIN
                c2 [1] := operand_addr[1]^[2];
                c2 [2] := operand_addr[1]^[3];
                s49uni_build_pattern (operand_addr [2]^,
                      2, len [2], c2, c_escape,
                      sqlm_ansi, patt_ok)
                END
            ELSE
                s49build_pattern (operand_addr [2]^,
                      ascii_type, 2, len [2],
                      operand_addr [1]^ [2], c_escape,
                      NOT c_string, sqlm_ansi, patt_ok);
            (*ENDIF*) 
            IF  NOT patt_ok
            THEN
                BEGIN
                IF  sqlmode = sqlm_ansi
                THEN
                    e := e_illegal_escape_sequence
                ELSE
                    e := e_invalid_pattern;
                (*ENDIF*) 
                goto 999
                END
            ELSE
                k71get_operand (sel, c_check_spec_null,
                      operand_addr [1], len [1], e);
            (*ENDIF*) 
            sel.sfp_work_st_top :=
                  s35inc_st (sel.sfp_work_st_top, - 1)
            END
        ELSE
            BEGIN
            IF  operand_addr [2]^[1] = csp_unicode_def_byte
            THEN
                BEGIN
                s49uni_build_pattern (operand_addr [2]^,
                      2, len [2], csp_unicode_blank,
                      NOT c_escape,
                      sqlm_ansi, patt_ok)
                END
            ELSE
                s49build_pattern (operand_addr [2]^,
                      ascii_type, 2, len [2],
                      bsp_c1, NOT c_escape, NOT c_string,
                      sqlm_ansi, patt_ok);
            (*ENDIF*) 
            IF  NOT patt_ok
            THEN
                BEGIN
                IF  sqlmode = sqlm_ansi
                THEN
                    e := e_illegal_escape_sequence
                ELSE
                    e := e_invalid_pattern;
                (*ENDIF*) 
                goto 999
                END
            (*ENDIF*) 
            END
        (*ENDIF*) 
        END
    ELSE
        IF  ((op = op_sounds) OR (op = op_not_sounds))
        THEN
            BEGIN
            IF  sel.sfp_workbuf_len + len [1] + len [2] >
                sel.sfp_workbuf_size
            THEN
                BEGIN
                e := e_stack_overflow;
                goto 999
                END;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
    (*ENDIF*) 
(*ENDIF*) 
CASE op OF
    op_is_integer :
        BEGIN
        ok := cgg04_is_true;
        IF  operand_addr [1]^ [1] <> csp_undef_byte
        THEN
            BEGIN
            number := csp_null_number;
&           ifdef TRACE
            t01moveobj (kb_qual, operand_addr[1]^, 1, len[1]);
&           endif
            s10mv (sizeof (operand_addr[1]^), sizeof(number),
                  @operand_addr[1]^, 2, @number, 1, len[1] - 1);
            IF  st.elen_var <= 5
            THEN
                BEGIN
                IF  (number < csp_minsint) OR
                    (number > csp_maxsint)
                THEN
                    ok := cgg04_is_false;
                (*ENDIF*) 
                END
            ELSE
                IF  (number < csp_minlint) OR
                    (number > csp_maxlint)
                THEN
                    ok := cgg04_is_false
                (*ENDIF*) 
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        END;
    op_between,
    op_like,
    op_ne,
    op_not_between,
    op_not_like,
    op_not_sounds,
    op_sounds:
        BEGIN
        workbuf.buffer_addr := sel.sfp_workbuf_addr;
        workbuf.buffer_size := sel.sfp_workbuf_size;
        workbuf.buffer_len  := sel.sfp_workbuf_len;
        ok := cgg04_is_true;
        i  := 2;
        WHILE (ok = cgg04_is_true) AND
              (i <= operand_count) DO
            BEGIN
            IF  op = op_between
            THEN
                BEGIN
                IF  i = 2
                THEN
                    curr_op := op_ge
                ELSE
                    curr_op := op_le
                (*ENDIF*) 
                END
            ELSE
                IF  op = op_not_between
                THEN
                    BEGIN
                    IF  i = 2
                    THEN
                        curr_op := op_lt
                    ELSE
                        curr_op := op_gt
                    (*ENDIF*) 
                    END
                ELSE
                    curr_op := op;
                (*ENDIF*) 
            (*ENDIF*) 
            kb71comparison (sel, curr_op, workbuf, operand_addr [1]^,
                  1, len [1], operand_addr [i]^,
                  1, len [i], ok);
            IF  (op = op_not_between) AND (i = 2)
            THEN
                BEGIN
                IF  ok = cgg04_is_true
                THEN
                    i := operand_count
                ELSE
                    IF  ok <> cgg04_is_undef
                    THEN
                        ok := cgg04_is_true
                    (*ENDIF*) 
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            i := i + 1
            END;
        (*ENDWHILE*) 
        END;
    op_not_null:
        BEGIN
        IF  operand_addr [1]^ [1] <> csp_undef_byte
        THEN
            ok := cgg04_is_true
        ELSE
            ok := cgg04_is_false
        (*ENDIF*) 
        END;
    op_null:
        BEGIN
        IF  operand_addr [1]^ [1] = csp_undef_byte
        THEN
            ok := cgg04_is_true
        ELSE
            ok := cgg04_is_false
        (*ENDIF*) 
        END;
    op_true:
        BEGIN
        IF  (operand_addr [1]^ [1] <> csp_undef_byte)
        THEN
            IF  (len [1] > 1)
                AND
                (operand_addr [1]^ [2] = cgg04_truechar)
            THEN
                ok := cgg04_is_true
            ELSE
                ok := cgg04_is_false
            (*ENDIF*) 
        ELSE
            ok := cgg04_is_undef;
        (*ENDIF*) 
        END;
    op_false :
        BEGIN
        IF  (operand_addr [1]^ [1] <> csp_undef_byte)
        THEN
            IF  (len [1] = 1) (* truncated for bool added with alter table add *)
                OR
                (operand_addr [1]^ [2] = cgg04_falsechar)
            THEN
                ok := cgg04_is_true
            ELSE
                ok := cgg04_is_false
            (*ENDIF*) 
        ELSE
            ok := cgg04_is_undef;
        (*ENDIF*) 
        END;
    OTHERWISE
        BEGIN
        e := e_stack_op_illegal;
        goto 999
        END;
    END;
(*ENDCASE*) 
sel.sfp_work_st_top        := s35inc_st (sel.sfp_work_st_top, + 1);
sel.sfp_work_st_top^.etype := st_bool;
sel.sfp_work_st_top^.epos  := ok;
sel.sfp_workbuf_len        := sel.sfp_workbuf_top;
&ifdef TRACE
t01int4 (kb_qual, '=== result  ', sel.sfp_work_st_top^.epos);
&endif
999 :
      kb71op_bool := e
END;
 
(*------------------------------*) 
 
FUNCTION
      kb71op_bytes (
            VAR t    : tgg00_TransContext;
            VAR sel  : tgg00_SelectFieldsParam;
            VAR st   : tgg00_StackEntry) : tgg00_BasisError;
 
VAR
      c            : char;
      e            : tgg00_BasisError;
      byte_pos     : integer;
      char_pos     : integer;
      char_len     : integer;
      exponent     : integer;
      fill_len     : integer;
      fill_frac    : integer;
      digit_cnt    : integer;
      i            : integer;
      len          : integer;
      res_len      : integer;
      is_digits    : boolean;
      odd          : boolean;
      undef        : boolean;
      num_err      : tsp00_NumError;
      operand_addr : tsp00_MoveObjPtr;
      hex_byte     : ARRAY  [1..2] OF integer;
 
LABEL
      999;
 
BEGIN
&ifdef TRACE
(* The following code exists to make usecheck happy.     *)
(* The following code will never be compiled.            *)
(* The parameter t is necessary, because the             *)
(* the procedure is called by a pointer from             *)
(* an array of procedure pointers, i.e. all              *)
(* those procedures must have the same formal parameters *)
e := t.trError_gg00;
&endif
&ifdef TRACE
t01op (kb_qual, 'hex op      ', st.eop);
&endif
is_digits    := st.eop = op_digits;
k71get_operand (sel,
      NOT c_check_spec_null, operand_addr, len, e);
IF  e <> e_ok
THEN
    goto 999;
(*ENDIF*) 
IF  sel.sfp_workbuf_len + 3 * len - 1 > sel.sfp_workbuf_size
THEN
    BEGIN
    e := e_stack_overflow;
    goto 999;
    END;
(*ENDIF*) 
undef := ( operand_addr^ [1] = csp_undef_byte );
IF  operand_addr^ [1] = csp_oflw_byte
THEN
    BEGIN
    e := e_special_null;
    goto 999;
    END;
(*ENDIF*) 
IF  undef
THEN
    BEGIN
    sel.sfp_workbuf_len := sel.sfp_workbuf_len + 1;
    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len] := csp_undef_byte;
    byte_pos := sel.sfp_workbuf_len + 1;
    END
ELSE
    BEGIN
    IF  ( is_digits ) AND
        ( operand_addr^ [1] = csp_defined_byte) AND
        ( operand_addr^ [2] < csp_zero_exponent )(* negativ value *)
    THEN
        BEGIN
        sel.sfp_workbuf_len  := sel.sfp_workbuf_len + 1;
        s51neg (operand_addr^, 2, len - 1,
              sel.sfp_workbuf_addr^, sel.sfp_workbuf_len + 1,
              (len - 2) * 2, csp_float_frac, res_len, num_err);
        operand_addr := s35add_moveobj_ptr( sel.sfp_workbuf_addr,
              sel.sfp_workbuf_len - 1);
        operand_addr^ [1]   := csp_defined_byte;
        sel.sfp_workbuf_len  := sel.sfp_workbuf_len + res_len;
&       ifdef TRACE
        t01moveobj (kb_qual, operand_addr^, 1, 1 + res_len);
&       endif
        END
    ELSE
        res_len := len - 1;
    (*ENDIF*) 
    odd := false;
    char_len := a05lnr_space_defbyte (sel.sfp_acv_addr,
          operand_addr, operand_addr^ [1],
          2, res_len);
    sel.sfp_workbuf_len := sel.sfp_workbuf_len + 1;
    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len] := bsp_c1;
    byte_pos := sel.sfp_workbuf_len + 1;
    IF  is_digits
    THEN
        BEGIN
        IF  (operand_addr^ [2] = cgg04_zero_exponent)
        THEN
            BEGIN
            exponent  := 0;
            digit_cnt := 0;
            END
        ELSE
            BEGIN
            exponent  := ord(operand_addr^ [2]) - 192;
            digit_cnt := (char_len - 1) * 2;
            IF  (ord(operand_addr^ [1 + char_len]) MOD 16 = 0)
            THEN
                BEGIN
                digit_cnt := pred(digit_cnt);
                odd       := true;
                END;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        (* PTS 1123692 E.Z. *)
        IF  ord(st.ecol_tab[ 1 ]) = 255 (* float*)
        THEN
            IF  (exponent > 0) AND
                (digit_cnt <= exponent) AND
                (exponent <= st.elen_var)
            THEN
                fill_len := st.elen_var - exponent
            ELSE
                fill_len := st.elen_var - digit_cnt
            (*ENDIF*) 
        ELSE
            fill_len  := st.elen_var - ord(st.ecol_tab[ 1 ]) - exponent;
        (*ENDIF*) 
        byte_pos  := byte_pos + fill_len;
        fill_frac := st.elen_var - fill_len - digit_cnt;
        IF  (fill_len < 0) OR (fill_frac < 0)
        THEN
            BEGIN
            e := e_num_overflow;
            goto 999;
            END;
        (*ENDIF*) 
        char_pos := 2;
        END
    ELSE
        char_pos := 1;
    (*ENDIF*) 
    WHILE char_pos < 1 + char_len DO
        BEGIN
        char_pos := succ(char_pos);
        c := operand_addr^ [char_pos];
        IF  ord(c) > 0
        THEN
            BEGIN
            hex_byte [1] := ord(c) DIV 16;
            IF  hex_byte [1] = 0
            THEN
                hex_byte [2] := ord(c)
            ELSE
                hex_byte [2] := ord(c) - (hex_byte [1] * 16);
            (*ENDIF*) 
            FOR i := 1 TO 2 DO
                IF  NOT ( ( char_pos = 1 + char_len )
                    AND (i=2)
                    AND odd )
                THEN
                    IF  hex_byte [i] > 9
                    THEN
                        sel.sfp_workbuf_addr^ [byte_pos+i-1] :=
                              chr( ord('A') - 10 + hex_byte [i] )
                    ELSE
                        sel.sfp_workbuf_addr^ [byte_pos+i-1] :=
                              chr( ord('0') + hex_byte [i] )
                    (*ENDIF*) 
                (*ENDIF*) 
            (*ENDFOR*) 
            END
        ELSE
            BEGIN
            sel.sfp_workbuf_addr^ [byte_pos  ] := '0';
            sel.sfp_workbuf_addr^ [byte_pos+1] := '0'
            END;
        (*ENDIF*) 
        IF  (char_pos = 1 + char_len) AND odd
        THEN
            byte_pos := byte_pos + 1
        ELSE
            byte_pos := byte_pos + 2
        (*ENDIF*) 
        END
    (*ENDWHILE*) 
    END;
(*ENDIF*) 
IF  NOT undef
THEN
    IF  char_len < st.elen_var
    THEN
        IF  is_digits
        THEN
            BEGIN
            IF  fill_len > 0
            THEN
                SAPDB_PascalFill ('VKB71 ',  25,    
                      sel.sfp_workbuf_size, @sel.sfp_workbuf_addr^,
                      sel.sfp_workbuf_len + 1, fill_len, '0', e);
            (*ENDIF*) 
            IF  fill_frac > 0
            THEN
                BEGIN
                SAPDB_PascalFill ('VKB71 ',  26,    
                      sel.sfp_workbuf_size, @sel.sfp_workbuf_addr^,
                      byte_pos, fill_frac, '0', e);
                byte_pos := byte_pos + fill_frac;
                END;
            (*
                  END
                  ELSE
                  BEGIN
                  SAPDB_PascalFill ('VKB71 ',  27,
                  sel.sfp_workbuf_size, sel.sfp_workbuf_addr^,
                  byte_pos, (len - 1 - char_len) * 2,
                  @sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len], e);
                  byte_pos := byte_pos + (len - 1 - char_len)*2
                  *)
            (*ENDIF*) 
            END;
        (*ENDIF*) 
    (*ENDIF*) 
(*ENDIF*) 
WITH sel.sfp_work_st_top^ DO
    BEGIN
    etype         := st_result;
    eop           := op_none;
    epos          := sel.sfp_workbuf_len;
    elen_var      := byte_pos - epos;
    ecol_tab [1] := chr(0);
    ecol_tab [2] := chr(0);
    END;
(*ENDWITH*) 
sel.sfp_workbuf_len := byte_pos;
&ifdef TRACE
t01sname (kb_qual, '=== result: ');
WITH sel.sfp_work_st_top^ DO
    t01moveobj (kb_qual, sel.sfp_workbuf_addr^, epos, epos + elen_var - 1 );
(*ENDWITH*) 
&endif
999 :
      kb71op_bytes := e
END;
 
(*------------------------------*) 
 
FUNCTION
      kb71op_compare (
            VAR t   : tgg00_TransContext;
            VAR sel : tgg00_SelectFieldsParam;
            VAR st  : tgg00_StackEntry) : tgg00_BasisError;
 
VAR
      not_op_eq_all  : boolean;
      res            : integer;
      e              : tgg00_BasisError;
      compare_result : tsp00_LcompResult;
      len1           : integer;
      len2           : integer;
      operand_addr1  : tsp00_MoveObjPtr;
      operand_addr2  : tsp00_MoveObjPtr;
 
LABEL
      999;
 
BEGIN
&ifdef TRACE
(* The following code exists to make usecheck happy.     *)
(* The parameter t is necessary, because the             *)
(* the procedure is called by a pointer from             *)
(* an array of procedure pointers, i.e. all              *)
(* those procedures must have the same formal parameters *)
e := t.trError_gg00;
&endif
not_op_eq_all  := st.eop <> op_eq_all;
k71get_operand (sel, not_op_eq_all, operand_addr2, len2, e);
IF  e = e_ok
THEN
    BEGIN
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, - 1);
    k71get_operand (sel, not_op_eq_all, operand_addr1, len1, e)
    END;
(*ENDIF*) 
IF  e = e_ok
THEN
    BEGIN
    IF  (operand_addr1^[1] <> operand_addr2^[1])
        AND
        (operand_addr2^[1] <> csp_defined_byte)
        AND
        (operand_addr1^[1] <> csp_undef_byte)
        AND
        (* undef_byte may be in correlations *)
        (* and with 'is [not] null'          *)
        (operand_addr2^[1] <> csp_undef_byte)
    THEN
        BEGIN
        k71code_operand (sel, operand_addr1^[1],
              operand_addr2, len2,
              s35inc_st (sel.sfp_work_st_top, 1), e);
        IF  e <> e_ok
        THEN
            goto 999
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  not_op_eq_all
    THEN
        a05luc_space (sel.sfp_acv_addr, operand_addr1^, 1, len1,
              operand_addr2^, 1, len2, compare_result)
    ELSE
        s30cmp (operand_addr1^, 1, len1,
              operand_addr2^, 1, len2, compare_result);
    (*ENDIF*) 
    res := kb71cmp_table[st.eop, compare_result];
    IF  res = cgg04_is_true
    THEN
        BEGIN
        sel.sfp_work_st_top^.epos := cgg04_is_true;
        END
    ELSE
        sel.sfp_work_st_top^.epos := res;
    (*ENDIF*) 
    sel.sfp_work_st_top^.etype := st_bool;
    sel.sfp_workbuf_len := sel.sfp_workbuf_top;
    END;
(*ENDIF*) 
999 :
      kb71op_compare := e
END;
 
(*------------------------------*) 
 
FUNCTION
      kb71op_desc (
            VAR t   : tgg00_TransContext;
            VAR sel : tgg00_SelectFieldsParam;
            VAR st  : tgg00_StackEntry) : tgg00_BasisError;
 
VAR
      e            : tgg00_BasisError;
      operand_addr : tsp00_MoveObjPtr;
      i            : integer;
      len          : integer;
 
LABEL
      999;
 
BEGIN
&ifdef TRACE
(* The following code exists to make usecheck happy.     *)
(* The parameters are necessary, because the             *)
(* the procedure is called by a pointer from             *)
(* an array of procedure pointers, i.e. all              *)
(* those procedures must have the same formal parameters *)
e := t.trError_gg00;
i := ord(st.etype);
&endif
k71get_operand (sel,
      NOT c_check_spec_null, operand_addr, len, e);
IF  e <> e_ok
THEN
    goto 999;
(*ENDIF*) 
IF  sel.sfp_workbuf_top + len > sel.sfp_workbuf_size
THEN
    BEGIN
    e := e_stack_overflow;
    goto 999;
    END;
(*ENDIF*) 
len := a05lnr_space_defbyte (sel.sfp_acv_addr, operand_addr, operand_addr^ [1],
      2, len - 1) + 1;
FOR i := 1 TO len DO
    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_top + i] :=
          chr (255 - ord (operand_addr^ [i]) );
(*ENDFOR*) 
WITH sel.sfp_work_st_top^ DO
    BEGIN
    etype        := st_result;
    eop          := op_none;
    epos         := sel.sfp_workbuf_top + 1;
    elen_var     := len;
    ecol_tab [1] := chr(0);
    ecol_tab [2] := chr(0)
    END;
(*ENDWITH*) 
sel.sfp_workbuf_len := sel.sfp_workbuf_top + len;
&ifdef TRACE
t01sname (kb_qual, '=== result: ');
WITH sel.sfp_work_st_top^ DO
    t01moveobj (kb_qual,
          sel.sfp_workbuf_addr^, epos, epos + elen_var - 1);
(*ENDWITH*) 
&endif
999 :
      kb71op_desc := e
END;
 
(*------------------------------*) 
 
FUNCTION
      kb71op_func_arith (
            VAR t   : tgg00_TransContext;
            VAR sel : tgg00_SelectFieldsParam;
            VAR st  : tgg00_StackEntry) : tgg00_BasisError;
 
CONST
      vtrunc_rfrac        =  0;
      cfirst_exponent     = '\C1';
      cnumber_one         = '\10';
      cneg_first_exponent = '\3F';
      cneg_number_one     = '\90';
      cnum_one_len        = 2;
      (*       cnum_one_pos = 1; *)
 
TYPE
 
      num_moveobj_ptr = RECORD
            CASE boolean OF
                true :
                    (num_ptr : ^tsp00_Number);
                false :
                    (obj_ptr : tsp00_MoveObjPtr)
                END;
            (*ENDCASE*) 
 
 
VAR
      undef         : boolean;
      spec_null     : boolean;
      is_int        : boolean;
      e             : tgg00_BasisError;
      op            : tgg00_StackOpType;
      operand_count : integer;
      res_len       : integer;
      res_pos       : integer;
      help1_pos     : integer;
      i             : integer;
      num_err       : tsp00_NumError;
      trunc_frac    : tsp00_Int2;
      comp_result   : tsp00_LcompResult;
      op_build_in   : tgg00_StackOpBuildIn;
      len           : ARRAY  [1..2] OF integer;
      buf           : ARRAY  [1..2] OF tsp00_MoveObjPtr;
      first_number  : tsp00_Longreal;
      second_number : tsp00_Longreal;
      result_number : tsp00_Longreal;
      res           : tsp00_MoveObjPtr;
      pi_num        : tsp00_Number;
      div_num       : tsp00_Number;
      mul_num       : tsp00_Number;
      pi_ptr        : num_moveobj_ptr;
      div_ptr       : num_moveobj_ptr;
      mul_ptr       : num_moveobj_ptr;
 
LABEL
      999;
 
BEGIN
&ifdef TRACE
(* The following code exists to make usecheck happy.     *)
(* The parameter t is necessary, because the             *)
(* the procedure is called by a pointer from             *)
(* an array of procedure pointers, i.e. all              *)
(* those procedures must have the same formal parameters *)
e := t.trError_gg00;
i := ord(sel.sfp_optimized);
i := ord(st.etype);
&endif
num_err   := num_ok;
undef     := false;
spec_null := false;
IF  (st.etype <> st_build_in_func)
THEN
    BEGIN
    op        := st.eop;
&   ifdef TRACE
    t01op (kb_qual, 'arithfunc op', op);
&   endif
    IF  op in  [op_fracround, op_fractrunc, op_power]
    THEN
        operand_count := 2
    ELSE
        operand_count := 1;
    (*ENDIF*) 
    END
ELSE
    (*   st.etype = st_build_in_func   *)
    BEGIN
&   ifdef TRACE
    t01p2int4 (kb_qual, 'etype       ', ord (st.etype)
          ,             'arithmetic  ', ord (st.eop_build_in));
&   endif
    op_build_in := st.eop_build_in;
    IF  (op_build_in in [op_b_log, op_b_atan2])
    THEN
        operand_count := 2
    ELSE
        operand_count := 1;
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  sel.sfp_workbuf_len + 1 + mxsp_number > sel.sfp_workbuf_size
THEN
    BEGIN
    e := e_stack_overflow;
    goto 999;
    END;
(*ENDIF*) 
FOR i := operand_count DOWNTO 1 DO
    BEGIN
    k71get_operand (sel,
          NOT c_check_spec_null, buf [i], len [i], e);
    IF  e <> e_ok
    THEN
        goto 999;
    (*ENDIF*) 
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, -1)
    END;
(*ENDFOR*) 
res := sel.sfp_workbuf_addr;
i   := 1;
WHILE NOT spec_null AND NOT undef AND (i <= operand_count) DO
    BEGIN
    undef     := (buf [i]^ [1] = csp_undef_byte);
    spec_null := (buf [i]^ [1] = csp_oflw_byte);
    i         := i + 1
    END;
(*ENDWHILE*) 
IF  NOT undef AND NOT spec_null
THEN
    BEGIN
    i := 1;
    REPEAT
        IF  buf [i]^ [1] <> csp_defined_byte
        THEN
            BEGIN
            e := e_num_invalid;
            goto 999;
            END;
        (*ENDIF*) 
        i :=  succ (i)
    UNTIL
        (i > operand_count)
    (*ENDREPEAT*) 
    END;
(*ENDIF*) 
IF  NOT undef AND NOT spec_null
THEN
    BEGIN
    res_pos := sel.sfp_workbuf_len + 2;
    IF  (st.etype <> st_build_in_func)
    THEN
        CASE op OF
            op_abs:
                s51abs (buf [1]^, 2, len [1] - 1, res^,
                      res_pos, csp_fixed, csp_float_frac, res_len,
                      num_err);
            op_ceil:
                BEGIN
                s51trunc (buf [1]^, 2, len [1] - 1,
                      vtrunc_rfrac, res^, res_pos, csp_fixed,
                      csp_float_frac, res_len, num_err);
                IF  (num_err in  [num_ok, num_trunc])
                THEN
                    (* PTS 1112956 E.Z. *)
                    IF  (res^ [res_pos] > cgg04_zero_exponent)
                        OR
                        ((res^ [res_pos] = cgg04_zero_exponent) AND
                        ( buf [1]^[2] > cgg04_zero_exponent))
                    THEN
                        BEGIN
                        s30cmp(buf [1]^, 2, len [1] - 1,
                              res^, res_pos, len [1] - 1,
                              comp_result);
                        IF  comp_result <> l_equal
                        THEN
                            IF  res_pos + res_len + cnum_one_len + 1 >
                                sel.sfp_workbuf_size
                            THEN
                                BEGIN
                                e := e_stack_overflow;
                                goto 999;
                                END
                            ELSE
                                BEGIN
                                help1_pos := res_pos + res_len + 1;
                                res^ [help1_pos  ] := csp_defined_byte;
                                res^ [help1_pos+1] := cfirst_exponent;
                                res^ [help1_pos+2] := cnumber_one;
                                s51add(res^, res_pos, res_len - 1,
                                      res^, help1_pos + 1, cnum_one_len,
                                      res^, res_pos, csp_fixed,
                                      csp_float_frac, res_len, num_err);
                                END;
                            (*ENDIF*) 
                        (*ENDIF*) 
                        END;
                    (*ENDIF*) 
                (*ENDIF*) 
                END;
            op_floor:
                BEGIN
                s51trunc (buf [1]^, 2, len [1]-1,
                      vtrunc_rfrac, res^, res_pos, csp_fixed,
                      csp_float_frac, res_len, num_err);
                IF  (num_err in  [num_ok, num_trunc])
                THEN
                    (* PTS 1112956 E.Z. *)
                    IF  (res^ [res_pos] < cgg04_zero_exponent)
                        OR
                        ((res^ [res_pos] = cgg04_zero_exponent) AND
                        ( buf [1]^[2] < cgg04_zero_exponent))
                    THEN
                        BEGIN
                        s30cmp(buf [1]^, 2, len [1] - 1,
                              res^, res_pos, len [1] - 1,
                              comp_result);
                        IF  comp_result <> l_equal
                        THEN
                            IF  res_pos + res_len + cnum_one_len + 1 >
                                sel.sfp_workbuf_size
                            THEN
                                BEGIN
                                e := e_stack_overflow;
                                goto 999;
                                END
                            ELSE
                                BEGIN
                                help1_pos := res_pos + res_len + 1;
                                res^ [help1_pos  ] := csp_defined_byte;
                                res^ [help1_pos+1] := cfirst_exponent;
                                res^ [help1_pos+2] := cnumber_one;
                                s51sub(res^, res_pos,res_len - 1,
                                      res^, help1_pos + 1, cnum_one_len,
                                      res^, res_pos, csp_fixed,
                                      csp_float_frac, res_len, num_err);
                                END;
                            (*ENDIF*) 
                        (*ENDIF*) 
                        END;
                    (*ENDIF*) 
                (*ENDIF*) 
                END;
            op_fracround:
                BEGIN
                s40gsint (buf [2]^, 2, (len [2]-1-csp_attr_byte)*2,
                      trunc_frac, num_err);
                IF  num_err IN  [num_ok, num_trunc]
                THEN
                    s51round (buf [1]^, 2, len [1]-1,
                          trunc_frac, res^, res_pos, csp_fixed,
                          csp_float_frac, res_len, num_err);
                (*ENDIF*) 
                END;
            op_fractrunc:
                BEGIN
                s40gsint (buf [2]^, 2, (len [2]-1-csp_attr_byte)*2,
                      trunc_frac, num_err);
                IF  num_err IN  [num_ok, num_trunc]
                THEN
                    s51trunc (buf [1]^, 2, len [1]-1,
                          trunc_frac, res^, res_pos, csp_fixed,
                          csp_float_frac, res_len, num_err);
                (*ENDIF*) 
                END;
            op_power:
                BEGIN
                s51isint (buf [2]^, 2, len [2] - 1, is_int, num_err);
                IF  num_err = num_ok
                THEN
                    IF  NOT is_int
                    THEN
                        BEGIN
                        e := e_num_invalid;
                        goto 999;
                        END
                    ELSE
                        BEGIN
                        s51power (buf [1]^, 2, len [1]-1,
                              csp_float_frac, buf [2]^, 2,
                              len [2]-1, csp_float_frac, res^,
                              res_pos, csp_fixed, csp_float_frac,
                              res_len, num_err);
                        END;
                    (*ENDIF*) 
                (*ENDIF*) 
                END;
            op_sign:
                IF  buf [1]^ [2] = cgg04_zero_exponent
                THEN
                    BEGIN
                    res^ [res_pos    ] := cgg04_zero_exponent;
                    res^ [res_pos + 1] := csp_defined_byte;
                    res_len             := cnum_one_len;
                    END
                ELSE
                    IF  buf [1]^ [2] > cgg04_zero_exponent
                    THEN
                        BEGIN
                        res^ [res_pos    ] := cfirst_exponent;
                        res^ [res_pos + 1] := cnumber_one;
                        res_len             := cnum_one_len;
                        END
                    ELSE
                        BEGIN
                        res^ [res_pos    ] := cneg_first_exponent;
                        res^ [res_pos + 1] := cneg_number_one;
                        res_len             := cnum_one_len;
                        END;
                    (*ENDIF*) 
                (*ENDIF*) 
            op_sqrt:
                IF  buf [1]^ [2] <= cgg04_zero_exponent
                THEN
                    IF  buf [1]^ [2] = cgg04_zero_exponent
                    THEN
                        BEGIN
                        res^ [res_pos    ] := cgg04_zero_exponent;
                        res^ [res_pos + 1] := csp_defined_byte;
                        res_len             := cnum_one_len;
                        END
                    ELSE
                        undef := true
                    (*ENDIF*) 
                ELSE
                    BEGIN
                    s51sqrt (buf [1]^, 2, len [1] - 1,
                          res^, res_pos, csp_fixed,
                          csp_float_frac, res_len, num_err);
                    END;
                (*ENDIF*) 
            op_trunc:
                s51trunc (buf [1]^, 2, len [1]-1,
                      vtrunc_rfrac, res^, res_pos, csp_fixed,
                      csp_float_frac, res_len, num_err);
            op_round:
                s51round (buf [1]^, 2, len [1]-1,
                      vtrunc_rfrac, res^, res_pos, csp_fixed,
                      csp_float_frac, res_len, num_err);
            OTHERWISE
                BEGIN
                e := e_stack_type_illegal;
                goto 999;
                END
            END
        (*ENDCASE*) 
    ELSE
        (*   st.etype = st_build_in_func   *)
        BEGIN
        s40glrel (buf [1]^, 2, (len [1]-1-csp_attr_byte)*2, first_number, num_err);
        (* PTS 1121197 E.Z. *)
        IF  num_err = num_trunc
        THEN
            BEGIN
            (* even in case of num_trunc the first 16 digits are ok *)
            CASE op_build_in OF
                op_b_cos,
                op_b_sin,
                op_b_cot,
                op_b_tan :
                    IF  first_number > 1000 (* too many significant digits lost *)
                    THEN
                        BEGIN
                        IF  (op_build_in = op_b_cos) OR
                            (op_build_in = op_b_sin)
                        THEN
                            pi_num := c_pi2
                        ELSE
                            pi_num := csp_value_pi;
                        (*ENDIF*) 
                        pi_ptr.num_ptr  := @pi_num;
                        div_num         := csp_null_number;
                        div_ptr.num_ptr := @div_num;
                        s51div (buf [1]^, 2, len [1]-1,
                              pi_ptr.obj_ptr^, 1, sizeof(pi_num),
                              div_ptr.obj_ptr^, 1, csp_fixed, csp_float_frac, res_len,
                              num_err);
&                       ifdef TRACE
                        t01int4 (kb_qual, 'num_err 1   ', ord(num_err));
                        t01moveobj (kb_qual, div_ptr.obj_ptr^, 1, res_len);
&                       endif
                        IF  (num_err = num_ok) OR (num_err = num_trunc)
                        THEN
                            BEGIN
                            s51trunc (div_ptr.obj_ptr^, 1, res_len,
                                  0, div_ptr.obj_ptr^, 1, csp_fixed,
                                  csp_float_frac, res_len, num_err);
&                           ifdef TRACE
                            t01int4 (kb_qual, 'num_err 1a  ', ord(num_err));
                            t01moveobj (kb_qual, div_ptr.obj_ptr^, 1, res_len);
&                           endif
                            mul_ptr.num_ptr := @mul_num;
                            s51mul (div_ptr.obj_ptr^, 1, res_len,
                                  pi_ptr.obj_ptr^, 1, sizeof(pi_num),
                                  mul_ptr.obj_ptr^, 1, csp_fixed, csp_float_frac, res_len,
                                  num_err);
&                           ifdef TRACE
                            t01int4 (kb_qual, 'num_err 2   ', ord(num_err));
                            t01moveobj (kb_qual, mul_ptr.obj_ptr^, 1, res_len);
&                           endif
                            IF  num_err = num_ok
                            THEN
                                BEGIN
                                s51sub (buf [1]^, 2, len [1]-1,
                                      mul_ptr.obj_ptr^, 1, res_len,
                                      div_ptr.obj_ptr^, 1, csp_fixed, csp_float_frac, res_len,
                                      num_err);
&                               ifdef TRACE
                                t01int4 (kb_qual, 'num_err 3   ', ord(num_err));
                                t01moveobj (kb_qual, div_ptr.obj_ptr^, 1, res_len);
&                               endif
                                IF  num_err = num_ok
                                THEN
                                    s40glrel (div_ptr.obj_ptr^, 1, 16, first_number, num_err);
                                (*ENDIF*) 
                                END
                            (*ENDIF*) 
                            END
                        (*ENDIF*) 
                        END
                    ELSE
                        num_err := num_ok;
                    (*ENDIF*) 
                OTHERWISE
                    (* PTS 1125795 E.Z. *)
                    BEGIN
                    div_ptr.num_ptr := @div_num;
                    s51kroun (buf [1]^, 2, len [1]-1,
                          div_ptr.obj_ptr^, 1, 15, csp_float_frac, res_len, num_err);
                    IF  num_err = num_ok
                    THEN
                        s40glrel (div_ptr.obj_ptr^, 1, 15, first_number, num_err);
                    (*ENDIF*) 
                    END;
                END
            (*ENDCASE*) 
            END;
        (*ENDIF*) 
        IF  num_err = num_ok
        THEN
            CASE op_build_in OF
                op_b_acos:
                    IF  (first_number >  1) OR
                        (first_number < -1)
                    THEN
                        num_err := num_invalid
                    ELSE
                        result_number := vacos (first_number,num_err);
                    (*ENDIF*) 
                op_b_asin:
                    IF  (first_number >  1) OR
                        (first_number < -1)
                    THEN
                        num_err := num_invalid
                    ELSE
                        result_number := vasin (first_number,num_err);
                    (*ENDIF*) 
                op_b_atan:
                    result_number := vatan (first_number,num_err);
                op_b_atan2:
                    BEGIN
                    s40glrel (buf [2]^, 2, (len [2]-1-csp_attr_byte)*2,
                          second_number, num_err);
                    result_number := vatan2 (first_number,
                          second_number,num_err);
                    END;
                op_b_cos:
                    result_number := vcos (first_number,num_err);
                op_b_cosh:
                    IF  (first_number >  145) OR
                        (first_number < -145)
                    THEN
                        num_err := num_invalid
                    ELSE
                        result_number := vcosh (first_number,num_err);
                    (*ENDIF*) 
                op_b_cot:
                    result_number := 1/vtan (first_number,num_err);
                op_b_degrees:
                    result_number := 180 * first_number / c_m_pi;
                op_b_exp:
                    IF  (first_number > 145.0)
                    THEN
                        num_err := num_invalid
                    ELSE
                        IF  (first_number > -148.0)
                        THEN
                            result_number := vexp (first_number,num_err)
                        ELSE
                            result_number := 0.0;
                        (*ENDIF*) 
                    (*ENDIF*) 
                op_b_ln:
                    IF  (first_number > 0.0)
                    THEN
                        result_number := vln (first_number,num_err)
                    ELSE
                        num_err := num_invalid;
                    (*ENDIF*) 
                op_b_log10:
                    IF  (first_number > 0.0)
                    THEN
                        result_number := vlog10 (first_number,num_err)
                    ELSE
                        num_err := num_invalid;
                    (*ENDIF*) 
                op_b_log:
                    BEGIN
                    s40glrel (buf [2]^, 2, (len [2]-1-csp_attr_byte)*2,
                          second_number, num_err);
                    IF  (first_number  <= 0.0) OR
                        (first_number   = 1.0) OR
                        (second_number <= 0.0)
                    THEN
                        num_err := num_invalid
                    ELSE
                        result_number := vln (second_number,num_err) /
                              vln (first_number,num_err);
                    (*ENDIF*) 
                    END;
                op_b_radians:
                    result_number := c_m_pi * first_number / 180;
                op_b_sin:
                    result_number := vsin (first_number,num_err);
                op_b_sinh:
                    IF  (first_number >  145) OR
                        (first_number < -145)
                    THEN
                        num_err := num_invalid
                    ELSE
                        result_number := vsinh (first_number,num_err);
                    (*ENDIF*) 
                op_b_tan:
                    result_number := vtan (first_number,num_err);
                op_b_tanh:
                    result_number := vtanh (first_number,num_err);
                OTHERWISE
                    BEGIN
                    e := e_stack_type_illegal;
                    goto 999;
                    END
                END;
            (*ENDCASE*) 
        (*ENDIF*) 
        IF  (num_err = num_ok)
        THEN
            BEGIN
&           ifdef TRACE
            t01real (kb_qual, 'result_num. ', result_number, 18);
&           endif
            res_len := mxsp_number;
            s41plrel (res^, res_pos, csp_fixed, csp_float_frac,
                  result_number, num_err);
            END;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  (num_err <> num_ok)
    THEN
        BEGIN
        k71num_err_to_b_err (num_err, e);
        IF  e = e_num_overflow
        THEN
            BEGIN
            e         := e_ok;
            spec_null := true
            END
        ELSE
            IF  e <> e_ok
            THEN
                goto 999;
            (*ENDIF*) 
        (*ENDIF*) 
        END
    (*ENDIF*) 
    END;
(*ENDIF*) 
sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, + 1);
WITH sel.sfp_work_st_top^ DO
    BEGIN
    etype         := st_result;
    eop           := op_none;
    epos          := sel.sfp_workbuf_len + 1;
    ecol_tab [1] := chr(0);
    ecol_tab [2] := chr(0)
    END;
(*ENDWITH*) 
IF  spec_null
THEN
    BEGIN
    res^ [sel.sfp_workbuf_len+1] := csp_oflw_byte;
    res_len := 0
    END
ELSE
    IF  undef
    THEN
        BEGIN
        res^ [sel.sfp_workbuf_len+1] := csp_undef_byte;
        res_len := 0
        END
    ELSE
        res^ [sel.sfp_workbuf_len+1] := csp_defined_byte;
    (*ENDIF*) 
(*ENDIF*) 
&ifdef TRACE
t01sname (kb_qual, '=== result: ');
t01moveobj   (kb_qual, res^, sel.sfp_workbuf_len+1,
      sel.sfp_workbuf_len + 1 + res_len);
&endif
sel.sfp_work_st_top^.elen_var := 1 + res_len;
sel.sfp_workbuf_len           := sel.sfp_workbuf_len + 1 + res_len;
999 :
      kb71op_func_arith := e
END;
 
(*------------------------------*) 
 
FUNCTION
      kb71op_hextoraw (
            VAR t            : tgg00_TransContext;
            VAR sel          : tgg00_SelectFieldsParam;
            VAR st           : tgg00_StackEntry) : tgg00_BasisError;
 
VAR
      c            : char;
      byte_pos     : tsp00_Int2;
      e            : tgg00_BasisError;
      char_pos     : integer;
      char_len     : integer;
      count        : integer;
      erg          : integer;
      len          : integer;
      up_code_tab  : integer;
      operand_addr : tsp00_MoveObjPtr;
 
LABEL
      999;
 
BEGIN
&ifdef TRACE
(* The following code exists to make usecheck happy.     *)
(* The parameter t is necessary, because the             *)
(* the procedure is called by a pointer from             *)
(* an array of procedure pointers, i.e. all              *)
(* those procedures must have the same formal parameters *)
e := t.trError_gg00;
&endif
&ifdef TRACE
t01op (kb_qual, 'hex st      ', st.eop);
&endif
k71get_operand (sel,
      NOT c_check_spec_null, operand_addr, len, e);
IF  e <> e_ok
THEN
    goto 999;
(*ENDIF*) 
IF  sel.sfp_workbuf_top + 1 * (len + 1) DIV 2 > sel.sfp_workbuf_size
THEN
    BEGIN
    e := e_stack_overflow;
    goto 999;
    END;
(*ENDIF*) 
IF  operand_addr^ [1] = csp_oflw_byte
THEN
    BEGIN
    e := e_special_null;
    goto 999;
    END;
(*ENDIF*) 
IF  operand_addr^ [1] = csp_undef_byte
THEN
    BEGIN
    sel.sfp_workbuf_len := sel.sfp_workbuf_top + 1;
    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len] := csp_undef_byte;
    byte_pos := sel.sfp_workbuf_len + 1;
    END
ELSE
    BEGIN
    IF  g01code.ctype = csp_ascii
    THEN
        BEGIN
        IF  operand_addr^ [1] = csp_ascii_blank
        THEN
            up_code_tab  := cgg04_up_ascii
        ELSE
            up_code_tab  := cgg04_to_up_ascii
        (*ENDIF*) 
        END
    ELSE
        IF  operand_addr^ [1] = csp_ebcdic_blank
        THEN
            up_code_tab  := cgg04_up_ebcdic
        ELSE
            up_code_tab  := cgg04_to_up_ebcdic;
        (*ENDIF*) 
    (*ENDIF*) 
    char_len := a05lnr_space_defbyte (sel.sfp_acv_addr,
          operand_addr, operand_addr^ [1], 2, len- 1);
    sel.sfp_workbuf_len := sel.sfp_workbuf_top + 1;
    sel.sfp_workbuf_addr^[sel.sfp_workbuf_len] := csp_defined_byte;
    byte_pos := sel.sfp_workbuf_len + 1;
    erg      := 0;
    char_pos := 2;
    IF  char_len MOD 2 <> 0
    THEN
        count := 0
    ELSE
        count := 1;
    (*ENDIF*) 
    WHILE (char_pos <= 1 + char_len) DO
        BEGIN
        erg   := 0;
        WHILE (count >= 0) DO
            BEGIN
            c := g02codetables.tables [up_code_tab]
                  [ord(operand_addr^ [char_pos]) + 1];
            IF  (c >= 'A') AND (c <= 'F')
            THEN
                erg := erg + (ord(c) - ord('A') + 10)
            ELSE
                IF  (c  >= '0') AND (c <= '9')
                THEN
                    erg := erg + (ord(c) - ord('0'))
                ELSE
                    BEGIN
                    e := e_num_invalid;
                    goto 999;
                    END;
                (*ENDIF*) 
            (*ENDIF*) 
            IF  count = 1
            THEN
                erg := erg * 16;
            (*ENDIF*) 
            count    := pred(count);
            char_pos := succ(char_pos);
            END;
        (*ENDWHILE*) 
        count := 1;
        sel.sfp_workbuf_addr^ [byte_pos] := chr(erg);
        byte_pos := succ(byte_pos);
        END
    (*ENDWHILE*) 
    END;
(*ENDIF*) 
WITH sel.sfp_work_st_top^ DO
    BEGIN
    etype         := st_result;
    eop           := op_none;
    epos          := sel.sfp_workbuf_len;
    elen_var      := byte_pos - epos;
    ecol_tab [1] := chr(0);
    ecol_tab [2] := chr(0);
    END;
(*ENDWITH*) 
sel.sfp_workbuf_len := byte_pos;
&ifdef TRACE
t01sname (kb_qual, '=== result: ');
WITH sel.sfp_work_st_top^ DO
    t01moveobj (kb_qual, sel.sfp_workbuf_addr^, epos, epos+elen_var+1);
(*ENDWITH*) 
&endif
999 :
      kb71op_hextoraw := e
END;
 
(*------------------------------*) 
 
FUNCTION
      kb71op_in (
            VAR t      : tgg00_TransContext;
            VAR sel    : tgg00_SelectFieldsParam;
            VAR st     : tgg00_StackEntry) : tgg00_BasisError;
 
CONST
      c_min_binary = 16;
 
VAR
      exit_loop      : boolean;
      is_sorted      : boolean;
      ok             : boolean;
      undef          : boolean;
      compare_result : tsp00_LcompResult;
      e              : tgg00_BasisError;
      curr_op_len    : integer;
      operand_len    : integer;
      operand_addr   : tsp00_MoveObjPtr;
      curr_op_addr   : tsp00_MoveObjPtr;
      (* the following are indexes into the stack. *)
      aux_ptr        : tgg00_StEntryAddr;
      (* temporary place for curr_op_ptr.     *)
      operand_ptr    : tgg00_StEntryAddr;
      (* left  operand.                       *)
      curr_op_ptr    : tgg00_StEntryAddr;
      (* right operand.                       *)
      next_list_ptr  : tgg00_StEntryAddr;
      (* begin of next list segment.          *)
      first_op_ptr   : tgg00_StEntryAddr;
      (* place of the first (left) operand;   *)
      (*                           also place behind last (right) list. *)
 
LABEL
      999;
 
BEGIN
undef        := false;
is_sorted    := (st.ecol_tab [1] = chr(1));
IF  (st.epos = 0)
THEN (* Already parsed views are out there with epos not set... *)
    st.epos := 1;
&ifdef TRACE
(*ENDIF*) 
t01op     (kb_qual, 'test_in op  ', st.eop);
t01p2int4 (kb_qual, '# lists     ', st.elen_var
      ,             '# elem per l', st.epos);
t01bool   (kb_qual, 'is_sorted   ', is_sorted);
&endif
IF  is_sorted     AND
    (st.epos = 1) AND
    (st.elen_var > c_min_binary)
THEN
    kb71op_in_sorted (st, sel, e)
ELSE
    BEGIN
    operand_ptr  := s35inc_st (sel.sfp_work_st_top,
          - (st.elen_var + 1) * st.epos + 1);
    curr_op_ptr  := sel.sfp_work_st_top;
    first_op_ptr := s35inc_st (curr_op_ptr, - st.elen_var * st.epos);
    IF  s35le_bufaddr (operand_ptr, sel.sfp_work_st_bottom)
    THEN (* Oops, there are not enough operands on the stack! *)
        BEGIN
        e := e_stack_type_illegal;
        goto 999
        END;
    (*ENDIF*) 
    sel.sfp_work_st_top := first_op_ptr;
    exit_loop           := false;
    REPEAT
        (* In a first round we check, whether there is *)
        (* a null value in the list left to the IN.    *)
        k71get_operand (sel,
              c_check_spec_null, operand_addr, operand_len, e);
        IF  e <> e_ok
        THEN
            goto 999;
        (*ENDIF*) 
        IF  operand_addr^[1] = csp_undef_byte
        THEN
            BEGIN
            exit_loop := true;
            undef     := true;
            END
        ELSE
            IF  sel.sfp_work_st_top = operand_ptr
            THEN
                exit_loop := true
            ELSE
                sel.sfp_work_st_top :=
                      s35inc_st (sel.sfp_work_st_top, -1);
            (*ENDIF*) 
        (*ENDIF*) 
    UNTIL
        exit_loop;
    (*ENDREPEAT*) 
    IF  NOT undef
    THEN (* None of the values on the left side are null. *)
        BEGIN
        next_list_ptr       := s35inc_st (curr_op_ptr, - st.epos);
        sel.sfp_work_st_top := first_op_ptr;
        ok                  := false;
        WHILE (NOT ok AND (s35gt_bufaddr (curr_op_ptr, first_op_ptr)))
              OR
              (    ok AND (s35gt_bufaddr (curr_op_ptr, next_list_ptr)))
              DO
            BEGIN
            IF  operand_ptr <> sel.sfp_work_st_top
            THEN (* We have to load the left operand anew. *)
                BEGIN
                operand_ptr := sel.sfp_work_st_top;
                k71get_operand (sel, c_check_spec_null,
                      operand_addr, operand_len, e);
                IF  e <> e_ok (* this shoudn't happen here, since we  *)
                THEN          (* already read the operand sucessfully.*)
                    goto 999;
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            aux_ptr             := sel.sfp_work_st_top;
            sel.sfp_work_st_top := curr_op_ptr;
            k71get_operand (sel,
                  c_check_spec_null, curr_op_addr, curr_op_len, e);
            IF  e <> e_ok
            THEN
                goto 999;
            (*ENDIF*) 
            IF  (curr_op_len > 0)
            THEN
                BEGIN
                IF  (operand_addr^ [1] <> curr_op_addr^ [1]) AND
                    (curr_op_addr^ [1] <> csp_defined_byte)  AND
                    (curr_op_addr^ [1] <> csp_undef_byte)
                THEN
                    BEGIN
                    k71code_operand (sel, operand_addr^ [1],
                          curr_op_addr, curr_op_len,
                          curr_op_ptr, e);
                    IF  e <> e_ok
                    THEN
                        goto 999;
                    (*ENDIF*) 
                    END
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            sel.sfp_work_st_top := aux_ptr;
            (* for in we use s30, not a05, because of sorting according to storing *)
            s30luc (operand_addr^, 1, operand_len, curr_op_addr^,
                  1, curr_op_len, compare_result);
            ok := (compare_result = l_equal);
            IF  ok (* We found two values, that are the same, but in  *)
            THEN   (* the case of a list to compare, we must continue.*)
                BEGIN
                curr_op_ptr         := s35inc_st (curr_op_ptr, -1);
                sel.sfp_work_st_top :=
                      s35inc_st (sel.sfp_work_st_top, -1)
                END
            ELSE (* The two compared values differed. *)
                IF  is_sorted AND (compare_result = l_greater)
                THEN (* the search is almost done. *)
                    curr_op_ptr := first_op_ptr
                ELSE
                    BEGIN (* Skip to the next list of elems. *)
                    curr_op_ptr         := next_list_ptr;
                    sel.sfp_work_st_top := first_op_ptr;
                    next_list_ptr       :=
                          s35inc_st (next_list_ptr, -st.epos)
                    END
                (*ENDIF*) 
            (*ENDIF*) 
            END;
        (*ENDWHILE*) 
        IF  st.eop = op_not_in
        THEN (* For NOT IN we have to invert the result. *)
            ok := NOT ok
        (*ENDIF*) 
        END;
    (* Before we assign the result, we must adjust the stackpointer, *)
    (* since it can point to any element of the left list.           *)
    (*ENDIF*) 
    sel.sfp_work_st_top := s35inc_st (first_op_ptr, -st.epos + 1);
    sel.sfp_workbuf_len := sel.sfp_workbuf_top;
    WITH sel.sfp_work_st_top^ DO
        BEGIN
        etype := st_bool;
        IF  undef
        THEN (* At least one of the values on the left side was null. *)
            epos := cgg04_is_undef
        ELSE
            IF  ok
            THEN
                epos := cgg04_is_true
            ELSE
                epos := cgg04_is_false;
            (*ENDIF*) 
        (*ENDIF*) 
&       ifdef TRACE
        t01int4 (kb_qual, 'in result:  ', epos);
&       endif
        END;
    (*ENDWITH*) 
    END;
(*ENDIF*) 
999 :
      kb71op_in := e
END;
 
(*------------------------------*) 
 
FUNCTION
      kb71case (
            VAR t    : tgg00_TransContext;
            VAR sel  : tgg00_SelectFieldsParam;
            VAR st   : tgg00_StackEntry;
            qualPtr  : integer;
            VAR e    : tgg00_BasisError) : integer;
 
VAR
      compare_result : tsp00_LcompResult;
      operand_ptr    : tgg00_StEntryAddr;
      aux_ptr        : tgg00_StEntryAddr;
      operand_len    : integer;
      operand_addr   : tsp00_MoveObjPtr;
      curr_len       : integer;
      curr_addr      : tsp00_MoveObjPtr;
 
LABEL
      999;
 
BEGIN
kb71case  := qualPtr;
operand_ptr := s35inc_st (sel.sfp_work_st_top,
      - (st.elen_var + 1) * st.epos + 1);
&ifdef trace
t01stackentry (kb_qual, operand_ptr^, qualPtr);
&endif
aux_ptr             := sel.sfp_work_st_top;
sel.sfp_work_st_top := operand_ptr;
k71get_operand (sel,
      c_check_spec_null, operand_addr, operand_len, e);
sel.sfp_work_st_top := aux_ptr;
WHILE true DO
    BEGIN
    IF  sel.sfp_work_st_top = operand_ptr
    THEN
        goto 999;
    (*ENDIF*) 
    k71get_operand (sel,
          c_check_spec_null, curr_addr, curr_len, e);
    IF  e <> e_ok
    THEN
        goto 999;
    (*ENDIF*) 
    a05luc_space (sel.sfp_acv_addr, operand_addr^, 1, operand_len, curr_addr^,
          1, curr_len, compare_result);
    IF  compare_result = l_equal
    THEN
        BEGIN
        kb71case := sel.sfp_work_st_top^.ecol_pos - 1;
        goto 999;
        END;
    (*ENDIF*) 
    sel.sfp_work_st_top :=
          s35inc_st (sel.sfp_work_st_top, -1);
    END;
(*ENDWHILE*) 
999 :
      sel.sfp_work_st_top := s35inc_st (operand_ptr, -1);
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb71op_in_sorted (
            VAR op      : tgg00_StackEntry;
            VAR sel     : tgg00_SelectFieldsParam;
            VAR e       : tgg00_BasisError);
 
VAR
      binary_search : boolean;
      found         : boolean;
      cmp_result    : tsp00_LcompResult;
      li            : integer;
      ri            : integer;
      middle        : integer;
      left_op_len   : integer;
      in_op_len     : integer;
      left_op_addr  : tsp00_MoveObjPtr;
      in_op_addr    : tsp00_MoveObjPtr;
      first         : tgg00_StEntryAddr;
      res_st_addr   : tgg00_StEntryAddr;
 
LABEL
      999;
 
BEGIN
(* get left operand first *)
found := false;
sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, - op.elen_var);
IF  s35le_bufaddr (sel.sfp_work_st_top, sel.sfp_work_st_bottom)
THEN (* Oops, there are not enough operands on the stack! *)
    BEGIN
    e := e_stack_type_illegal;
    goto 999
    END;
(*ENDIF*) 
k71get_operand (sel,
      c_check_spec_null, left_op_addr, left_op_len, e);
IF  e = e_ok
THEN
    IF  left_op_addr^[1] = csp_undef_byte
    THEN
        sel.sfp_work_st_top^.epos := cgg04_is_undef
    ELSE
        BEGIN
        res_st_addr   := sel.sfp_work_st_top;
        binary_search := false;
        (* get first value of in list *)
        sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, 1);
        k71get_operand (sel,
              c_check_spec_null, in_op_addr, in_op_len, e);
        IF  e <> e_ok
        THEN
            goto 999;
        (*ENDIF*) 
        IF  in_op_len > 0
        THEN
            BEGIN
            IF  (left_op_addr^[1] <> in_op_addr^[1]) AND
                (in_op_addr^  [1] <> csp_defined_byte)
            THEN
                BEGIN
                k71code_operand (sel, in_op_addr^[ 1 ],
                      in_op_addr, in_op_len,
                      sel.sfp_work_st_top, e);
                IF  e <> e_ok
                THEN
                    goto 999;
                (*ENDIF*) 
                END
            (*ENDIF*) 
            END;
        (* compare left operand with first element of list *)
        (*ENDIF*) 
        first := sel.sfp_work_st_top;
        (* sorting should be according to storing --> ' ' before x'09' *)
        (* --> s30luc, not a05, see vgg04                              *)
        s30luc (left_op_addr^, 1, left_op_len,
              in_op_addr^, 1, in_op_len, cmp_result);
        IF  cmp_result = l_greater
        THEN
            BEGIN
            (* compare left operand with last element of list *)
            sel.sfp_work_st_top :=
                  s35inc_st (sel.sfp_work_st_top, (op.elen_var - 1));
            k71get_operand (sel,
                  c_check_spec_null, in_op_addr, in_op_len, e);
            IF  e <> e_ok
            THEN
                goto 999;
            (*ENDIF*) 
            IF  in_op_len > 0
            THEN
                BEGIN
                IF  (left_op_addr^[1] <> in_op_addr^[1]) AND
                    (in_op_addr^  [1] <> csp_defined_byte)
                THEN
                    BEGIN
                    k71code_operand (sel, in_op_addr^[ 1 ],
                          in_op_addr, in_op_len,
                          sel.sfp_work_st_top, e);
                    IF  e <> e_ok
                    THEN
                        goto 999;
                    (*ENDIF*) 
                    END
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            s30luc (left_op_addr^, 1, left_op_len,
                  in_op_addr^, 1, in_op_len, cmp_result);
            IF  cmp_result = l_less
            THEN
                BEGIN
                IF  op.elen_var > 2
                THEN
                    BEGIN
                    binary_search := true;
                    first := s35inc_st (first, 1)
                    END;
                (*ENDIF*) 
                END
            ELSE
                IF  cmp_result = l_equal
                THEN
                    found := true;
                (*ENDIF*) 
            (*ENDIF*) 
            END
        ELSE
            IF  cmp_result = l_equal
            THEN
                found := true;
            (*ENDIF*) 
        (*ENDIF*) 
        IF  binary_search
        THEN
            BEGIN
            (* binary search for in value *)
            li    := 0;
            ri    := op.elen_var - 3;
            REPEAT
                middle := (li + ri) DIV 2;
                sel.sfp_work_st_top := s35inc_st (first, middle);
                k71get_operand (sel,
                      c_check_spec_null, in_op_addr, in_op_len, e);
                IF  e <> e_ok
                THEN
                    goto 999;
                (*ENDIF*) 
                IF  in_op_len > 0
                THEN
                    BEGIN
                    IF  (left_op_addr^[1] <> in_op_addr^[1]) AND
                        (in_op_addr^  [1] <> csp_defined_byte)
                    THEN
                        BEGIN
                        k71code_operand (sel, in_op_addr^[ 1 ],
                              in_op_addr, in_op_len,
                              sel.sfp_work_st_top, e);
                        IF  e <> e_ok
                        THEN
                            goto 999;
                        (*ENDIF*) 
                        END
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
                s30luc (left_op_addr^, 1, left_op_len,
                      in_op_addr^, 1, in_op_len, cmp_result);
                IF  cmp_result = l_equal
                THEN
                    BEGIN
                    found := true;
                    li    := ri + 1
                    END
                ELSE
                    IF  cmp_result = l_less
                    THEN
                        ri := middle - 1
                    ELSE
                        li := middle + 1;
                    (*ENDIF*) 
                (*ENDIF*) 
            UNTIL
                li > ri;
            (*ENDREPEAT*) 
            END;
        (*ENDIF*) 
        IF  op.eop = op_not_in
        THEN
            found := NOT (found);
        (*ENDIF*) 
        IF  found
        THEN
            res_st_addr^.epos := cgg04_is_true
        ELSE
            res_st_addr^.epos := cgg04_is_false;
        (*ENDIF*) 
        sel.sfp_work_st_top := res_st_addr
        END;
    (*ENDIF*) 
(*ENDIF*) 
sel.sfp_workbuf_len        := sel.sfp_workbuf_top;
sel.sfp_work_st_top^.etype := st_bool;
999 : ;
END;
 
(*------------------------------*) 
 
FUNCTION
      kb71dbyte_initcap (
            VAR t   : tgg00_TransContext;
            VAR sel : tgg00_SelectFieldsParam;
            VAR st  : tgg00_StackEntry) : tgg00_BasisError;
 
VAR
      e              : tgg00_BasisError;
      operand_addr   : tsp00_MoveObjPtr;
      len            : integer;
      index          : integer;
      trunc_len      : integer;
      start_convert  : integer;
      first          : boolean;
 
LABEL
      999;
 
BEGIN
&ifdef TRACE
(* The following code exists to make usecheck happy.     *)
(* The parameters are necessary, because the             *)
(* the procedure is called by a pointer from             *)
(* an array of procedure pointers, i.e. all              *)
(* those procedures must have the same formal parameters *)
e := t.trError_gg00;
index := ord(st.etype);
&endif
k71get_operand (sel, c_check_spec_null, operand_addr, len, e);
IF  e <> e_ok
THEN
    goto 999;
(*ENDIF*) 
IF  sel.sfp_work_st_top^.etype in [st_value , st_result]
THEN
    trunc_len := len
ELSE
    trunc_len := 1 + a05lnr_space_defbyte (sel.sfp_acv_addr,
          operand_addr, operand_addr^ [1], 2, len-1);
(*ENDIF*) 
IF  sel.sfp_workbuf_top + trunc_len > sel.sfp_workbuf_size
THEN
    BEGIN
    e := e_stack_overflow;
    goto 999;
    END;
(*ENDIF*) 
sel.sfp_workbuf_len := sel.sfp_workbuf_top + 1;
WITH sel.sfp_work_st_top^ DO
    BEGIN
    etype         := st_result;
    eop           := op_none;
    epos          := sel.sfp_workbuf_len;
    elen_var      := trunc_len;
    ecol_tab [1]  := chr(0);
    ecol_tab [2]  := chr(0)
    END;
(*ENDWITH*) 
IF  operand_addr^[1] = csp_undef_byte
THEN
    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len]:= csp_undef_byte
ELSE
    BEGIN
    SAPDB_PascalOverlappingMove ('VKB71 ',  27,    
          sizeof(operand_addr^), sel.sfp_workbuf_size,
          @operand_addr^, 1, @sel.sfp_workbuf_addr^, sel.sfp_workbuf_len,
          trunc_len, e);
    IF  e <> e_ok
    THEN
        goto 999;
    (*ENDIF*) 
    index := sel.sfp_workbuf_len + 1;
    sel.sfp_workbuf_len := sel.sfp_workbuf_len + trunc_len - 1;
    first     := true;
    (* PTS 1121500 E.Z. *)
    start_convert := index+2;
    WHILE index <= sel.sfp_workbuf_len DO
        BEGIN
        IF  (sel.sfp_workbuf_addr^ [ index ] = csp_unicode_mark) AND
            (ord(sel.sfp_workbuf_addr^ [ index+1 ]) < 128)       AND
            NOT (sel.sfp_workbuf_addr^ [ index+1 ] in ['0'..'9', 'a'..'z', 'A'..'Z'])
        THEN
            BEGIN
            IF  start_convert < index
            THEN
                sp81UCS2StringTolower (@(sel.sfp_workbuf_addr^ [start_convert]),
                      index - start_convert);
            (*ENDIF*) 
            first := true;
            start_convert := index + 4
            END
        ELSE
            IF  first
            THEN
                BEGIN
                sp81UCS2StringToupper (@(sel.sfp_workbuf_addr^ [index]), 2);
                first := false
                END;
            (*ENDIF*) 
        (*ENDIF*) 
        index := index + 2
        END;
    (*ENDWHILE*) 
    IF  NOT first AND
        (start_convert < index)
    THEN
        sp81UCS2StringTolower (@(sel.sfp_workbuf_addr^ [start_convert]),
              index - start_convert);
    (*ENDIF*) 
    END;
(*ENDIF*) 
&ifdef TRACE
t01sname (kb_qual, '=== result: ');
WITH sel.sfp_work_st_top^ DO
    t01moveobj (kb_qual, sel.sfp_workbuf_addr^, epos, epos + elen_var - 1);
(*ENDWITH*) 
&endif
999 :
      kb71dbyte_initcap := e
END;
 
(*------------------------------*) 
 
FUNCTION
      kb71op_initcap (
            VAR t           : tgg00_TransContext;
            VAR sel         : tgg00_SelectFieldsParam;
            VAR st          : tgg00_StackEntry) : tgg00_BasisError;
 
VAR
      e            : tgg00_BasisError;
      operand_addr : tsp00_MoveObjPtr;
      len          : integer;
      index        : integer;
      end_pos      : integer;
      up_code_tab  : integer;
      low_code_tab : integer;
      ch_code_tab  : integer;
      trunc_len    : integer;
      def_byte     : char;
      letter       : char;
      undef        : boolean;
      first        : boolean;
      transform    : boolean;
 
LABEL
      999;
 
BEGIN
&ifdef TRACE
(* The following code exists to make usecheck happy.     *)
(* The parameters are necessary, because the             *)
(* the procedure is called by a pointer from             *)
(* an array of procedure pointers, i.e. all              *)
(* those procedures must have the same formal parameters *)
e := t.trError_gg00;
index := ord(st.etype);
&endif
k71get_operand (sel, c_check_spec_null, operand_addr, len, e);
IF  e <> e_ok
THEN
    goto 999;
(*ENDIF*) 
def_byte  := operand_addr^ [1];
undef     := (def_byte = csp_undef_byte);
IF  sel.sfp_work_st_top^.etype in [st_value , st_result]
THEN
    trunc_len := len
ELSE
    trunc_len := 1 + a05lnr_space_defbyte (sel.sfp_acv_addr,
          operand_addr, def_byte, 2, len-1);
(*ENDIF*) 
IF  sel.sfp_workbuf_top + trunc_len > sel.sfp_workbuf_size
THEN
    BEGIN
    e := e_stack_overflow;
    goto 999;
    END;
(*ENDIF*) 
sel.sfp_workbuf_len := sel.sfp_workbuf_top + 1;
WITH sel.sfp_work_st_top^ DO
    BEGIN
    etype         := st_result;
    eop           := op_none;
    epos          := sel.sfp_workbuf_len;
    elen_var      := trunc_len;
    ecol_tab [1] := chr(0);
    ecol_tab [2] := chr(0)
    END;
(*ENDWITH*) 
IF  undef
THEN
    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len]:= csp_undef_byte
ELSE
    BEGIN
    first       := true;
    IF  def_byte = csp_ascii_blank
    THEN
        BEGIN
        low_code_tab := cgg04_low_ascii;
        up_code_tab  := cgg04_up_ascii;
        transform    := (g01code.ctype = csp_ebcdic);
        IF  transform
        THEN
            ch_code_tab := cgg04_to_ebcdic;
        (*ENDIF*) 
        END
    ELSE
        BEGIN
        low_code_tab := cgg04_low_ebcdic;
        up_code_tab  := cgg04_up_ebcdic;
        transform    := (g01code.ctype = csp_ascii);
        IF  transform
        THEN
            ch_code_tab := cgg04_to_ascii;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len] := def_byte;
    s30map (g02codetables.tables [low_code_tab], operand_addr^,
          1 , sel.sfp_workbuf_addr^,
          sel.sfp_workbuf_len, trunc_len);
    index   := succ(sel.sfp_workbuf_len);
    end_pos := index + trunc_len - 1;
    WHILE index < end_pos DO
        BEGIN
        IF  transform
        THEN
            letter := g02codetables.tables [ch_code_tab]
                  [ord(sel.sfp_workbuf_addr^ [index]) +1]
        ELSE
            letter := sel.sfp_workbuf_addr^ [index];
        (*ENDIF*) 
        IF  NOT (letter in kb71initcap_set)
        THEN
            first := true
        ELSE
            IF  first
            THEN
                BEGIN
                sel.sfp_workbuf_addr^ [index] :=
                      g02codetables.tables [up_code_tab]
                      [ord(sel.sfp_workbuf_addr^ [index]) + 1];
                first := false;
                END;
            (*ENDIF*) 
        (*ENDIF*) 
        index := succ(index);
        END;
    (*ENDWHILE*) 
    sel.sfp_workbuf_len := sel.sfp_workbuf_len + trunc_len;
    END;
(*ENDIF*) 
&ifdef TRACE
t01sname (kb_qual, '=== result: ');
WITH sel.sfp_work_st_top^ DO
    t01moveobj (kb_qual, sel.sfp_workbuf_addr^, epos, epos + elen_var - 1);
(*ENDWITH*) 
&endif
999 :
      kb71op_initcap := e
END;
 
(*------------------------------*) 
 
FUNCTION
      kb71op_length (
            VAR t    : tgg00_TransContext;
            VAR sel  : tgg00_SelectFieldsParam;
            VAR st   : tgg00_StackEntry) : tgg00_BasisError;
 
VAR
      e            : tgg00_BasisError;
      num_err      : tsp00_NumError;
      operand_addr : tsp00_MoveObjPtr;
      len          : integer;
      trunc_len    : integer;
      result_len   : integer;
 
LABEL
      999;
 
BEGIN
&ifdef TRACE
(* The following code exists to make usecheck happy.     *)
(* The parameter t is necessary, because the             *)
(* the procedure is called by a pointer from             *)
(* an array of procedure pointers, i.e. all              *)
(* those procedures must have the same formal parameters *)
e := t.trError_gg00;
&endif
result_len    := 3;
IF  sel.sfp_workbuf_top + 1 + result_len > sel.sfp_workbuf_size
THEN
    e := e_stack_overflow
ELSE
    k71get_operand (sel,
          NOT c_check_spec_null, operand_addr, len, e);
(*ENDIF*) 
IF  e <> e_ok
THEN
    goto 999;
(*ENDIF*) 
sel.sfp_workbuf_len := sel.sfp_workbuf_top + 1;
WITH sel.sfp_work_st_top^ DO
    BEGIN
    epos     := sel.sfp_workbuf_len;
    CASE operand_addr^ [1] OF
        csp_undef_byte, csp_oflw_byte :
            BEGIN
            sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len] := operand_addr^[1];
            elen_var := 1;
            END;
        OTHERWISE
            BEGIN
            IF  NOT (sel.sfp_work_st_top^.etype in [st_result])
            THEN
                trunc_len := a05lnr_space_defbyte (sel.sfp_acv_addr,
                      operand_addr, operand_addr^ [1], 2, len - 1)
            ELSE
                trunc_len := len - 1;
            (*ENDIF*) 
            IF  st.eop = op_dbyte_length
            THEN
                trunc_len:= trunc_len DIV 2;
            (*ENDIF*) 
            sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len] :=
                  csp_defined_byte;
            s41psint (sel.sfp_workbuf_addr^, sel.sfp_workbuf_len + 1,
                  4, 0, trunc_len, num_err);
            IF  num_err <> num_ok
            THEN
                BEGIN
                k71num_err_to_b_err (num_err, e);
                IF  e <> e_ok
                THEN
                    goto 999;
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            elen_var := 1 + result_len;
            END;
        END;
    (*ENDCASE*) 
    etype    := st_result;
    eop      := op_none;
    ecol_tab [1] := chr(0);
    ecol_tab [2] := chr(0);
    sel.sfp_workbuf_len := sel.sfp_workbuf_len + result_len
    END;
(*ENDWITH*) 
&ifdef TRACE
t01sname (kb_qual, '=== result: ');
WITH sel.sfp_work_st_top^ DO
    t01moveobj (kb_qual, sel.sfp_workbuf_addr^, epos, epos + elen_var - 1);
(*ENDWITH*) 
&endif
999 :
      kb71op_length := e
END;
 
(*------------------------------*) 
 
FUNCTION
      kb71op_longcol_update (
            VAR t   : tgg00_TransContext;
            VAR sel : tgg00_SelectFieldsParam;
            VAR st  : tgg00_StackEntry) : tgg00_BasisError;
 
VAR
      e            : tgg00_BasisError;
      operand_addr : ARRAY  [1..2] OF tsp00_MoveObjPtr;
      len          : ARRAY  [1..2] OF integer;
      undef        : ARRAY  [1..2] OF boolean;
      k            : tgg00_Lkey;
      i            : integer;
 
LABEL
      999;
 
BEGIN
&ifdef TRACE
(* The following code exists to make usecheck happy.     *)
(* The parameters are necessary, because the             *)
(* the procedure is called by a pointer from             *)
(* an array of procedure pointers, i.e. all              *)
(* those procedures must have the same formal parameters *)
e := ord(st.etype);
&endif
undef [1] := true;
undef [2] := true;
len [1]   := 0;
len [2]   := 0;
FOR i := 2 DOWNTO 1 DO
    BEGIN
    k71get_operand (sel, NOT c_check_spec_null, operand_addr [i],
          len [i], e);
    IF  e <> e_ok
    THEN
        goto 999;
    (*ENDIF*) 
    undef [i] := (operand_addr [i]^ [1] = csp_undef_byte);
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, -1)
    END;
(*ENDFOR*) 
IF  sel.sfp_workbuf_len + len [1] > sel.sfp_workbuf_size
THEN
    BEGIN
    e := e_stack_overflow;
    goto 999;
    END;
(*ENDIF*) 
sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, 1);
sel.sfp_workbuf_len := sel.sfp_workbuf_len + 1;
WITH sel.sfp_work_st_top^ DO
    BEGIN
    etype := st_result;
    eop   := op_none;
    epos  := sel.sfp_workbuf_len;
    ecol_tab [1] := chr(0);
    ecol_tab [2] := chr(0)
    END;
(*ENDWITH*) 
IF  undef [2]
THEN
    BEGIN
    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len]:= csp_undef_byte;
    sel.sfp_work_st_top^.elen_var := 1
    END
ELSE
    IF  undef [1]
    THEN
        BEGIN
        sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len]:= csp_defined_byte;
        k57table_key_get (t.trTaskId_gg00, t.trState_gg00, k);
&       ifdef TRACE
        t01lkey (kb_qual, k);
&       endif
        g10mv ('VKB71 ',  28,    
              sizeof(k.k), sel.sfp_workbuf_size, @k.k, 1,
              @sel.sfp_workbuf_addr^, sel.sfp_workbuf_len+1,
              sizeof(tgg00_Surrogate), e);
        sel.sfp_work_st_top^.elen_var := 1 + SURROGATE_MXGG00
        END
    ELSE
        BEGIN
        g10mv ('VKB71 ',  29,    
              sizeof(operand_addr [1]^), sel.sfp_workbuf_size,
              @operand_addr [1]^, 1,
              @sel.sfp_workbuf_addr^, sel.sfp_workbuf_len,
              len [1], e);
        END;
    (*ENDIF*) 
(*ENDIF*) 
999 :
      kb71op_longcol_update := e
END;
 
(*------------------------------*) 
 
FUNCTION
      kb71op_nextval (
            VAR t   : tgg00_TransContext;
            VAR sel : tgg00_SelectFieldsParam;
            VAR st  : tgg00_StackEntry) : tgg00_BasisError;
 
VAR
      i_int4 : tsp00_Int4;
 
BEGIN
t.trError_gg00 := e_ok;
IF  sel.sfp_workbuf_len + 1 + sizeof (tsp00_Number) > sel.sfp_workbuf_size
THEN
    t.trError_gg00 := e_stack_overflow
ELSE
    BEGIN
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, 1);
    WITH sel.sfp_work_st_top^ DO
        BEGIN
        etype        := st_result;
        eop          := op_none;
        epos         := sel.sfp_workbuf_len + 1;
        ecol_tab [1] := chr(0);
        ecol_tab [2] := chr(0)
        END;
    (*ENDWITH*) 
    (* PTS 1112079 E.Z. *)
    IF  sel.sfp_check_for_result
    THEN
        k57overall_currval (t, sel.sfp_data_addr, sel.sfp_data_size, st.epos,
              sel.sfp_workbuf_addr, sel.sfp_workbuf_size, sel.sfp_workbuf_len+2,
              i_int4)
    ELSE
        k57nextval (t, sel.sfp_data_addr, sel.sfp_data_size, st.epos,
              sel.sfp_workbuf_addr, sel.sfp_workbuf_size, sel.sfp_workbuf_len+2,
              i_int4);
    (*ENDIF*) 
    IF  t.trError_gg00 = e_ok
    THEN
        BEGIN
        sel.sfp_work_st_top^.elen_var := 1 + i_int4;
        sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len+1] := csp_defined_byte;
&       ifdef TRACE
        t01sname (kb_qual, '=== result: ');
        t01moveobj (kb_qual, sel.sfp_workbuf_addr^,
              sel.sfp_workbuf_len+1, sel.sfp_workbuf_len + 1 + i_int4);
&       endif
        sel.sfp_workbuf_len := sel.sfp_workbuf_len + 1 + i_int4
        END
    (*ENDIF*) 
    END;
(*ENDIF*) 
kb71op_nextval := t.trError_gg00
END;
 
(*------------------------------*) 
 
FUNCTION
      kb71op_num (
            VAR t       : tgg00_TransContext;
            VAR sel     : tgg00_SelectFieldsParam;
            VAR st      : tgg00_StackEntry) : tgg00_BasisError;
 
VAR
      e            : tgg00_BasisError;
      num_err      : tsp00_NumError;
      operand_addr : tsp00_MoveObjPtr;
      len          : integer;
      bool_val     : boolean;
 
LABEL
      999;
 
BEGIN
&ifdef TRACE
(* The following code exists to make usecheck happy.     *)
(* The parameters are necessary, because the             *)
(* the procedure is called by a pointer from             *)
(* an array of procedure pointers, i.e. all              *)
(* those procedures must have the same formal parameters *)
e := t.trError_gg00;
len := ord(st.etype);
&endif
IF  sel.sfp_workbuf_top + 1 + mxsp_number > sel.sfp_workbuf_size
THEN
    e := e_stack_overflow
ELSE
    k71get_operand (sel,
          c_check_spec_null, operand_addr, len, e);
(*ENDIF*) 
IF  e <> e_ok
THEN
    goto 999;
(*ENDIF*) 
bool_val := (len = 2) AND
      (operand_addr^ [2] in [cgg04_truechar, cgg04_falsechar]);
len := a05lnr_space_defbyte (sel.sfp_acv_addr,
      operand_addr, operand_addr^ [1], 2, len-1) + 1;
sel.sfp_workbuf_len := sel.sfp_workbuf_top + 1;
IF  operand_addr^[1] = csp_undef_byte
THEN
    BEGIN
    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len] := csp_undef_byte;
    len := 0
    END
ELSE
    BEGIN
    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len] := csp_defined_byte;
    IF  bool_val
    THEN
        s41psint (sel.sfp_workbuf_addr^, sel.sfp_workbuf_len + 1,
              csp_fixed, csp_float_frac,
              ord(operand_addr^ [2]), num_err)
    ELSE
        s43pstr (sel.sfp_workbuf_addr^, sel.sfp_workbuf_len+1,
              csp_fixed, csp_float_frac,
              operand_addr^, 2, len - 1, num_err);
    (*ENDIF*) 
    len := mxsp_number;
    IF  num_err <> num_ok
    THEN
        BEGIN
        k71num_err_to_b_err (num_err, e);
        IF  e = e_num_overflow
        THEN
            BEGIN
            e   := e_ok;
            len := 0;
            sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len] := csp_oflw_byte
            END
        ELSE
            IF  e <> e_ok
            THEN
                goto 999;
            (*ENDIF*) 
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDIF*) 
WITH sel.sfp_work_st_top^ DO
    BEGIN
    etype        := st_result;
    eop          := op_none;
    epos         := sel.sfp_workbuf_len;
    elen_var     := 1 + len;
    ecol_tab [1] := chr(0);
    ecol_tab [2] := chr(0)
    END;
(*ENDWITH*) 
sel.sfp_workbuf_len := sel.sfp_workbuf_len + len;
&ifdef TRACE
t01sname (kb_qual, '=== result: ');
WITH sel.sfp_work_st_top^ DO
    t01moveobj (kb_qual, sel.sfp_workbuf_addr^, epos, epos + elen_var - 1);
(*ENDWITH*) 
&endif
999 :
      kb71op_num := e
END;
 
(*------------------------------*) 
 
FUNCTION
      kb71op_rem_repl (
            VAR t   : tgg00_TransContext;
            VAR sel : tgg00_SelectFieldsParam;
            VAR st  : tgg00_StackEntry) : tgg00_BasisError;
 
VAR
      e              : tgg00_BasisError;
      index          : integer;
      start_pos      : integer;
      end_pos        : integer;
      akt_pos        : integer;
      result_len     : integer;
      param_cnt      : integer;
      del_len        : integer;
      mv_len         : integer;
      found          : boolean;
      compare_result : tsp00_LcompResult;
      undef          : ARRAY  [1..3] OF boolean;
      operand_addr   : ARRAY  [1..3] OF tsp00_MoveObjPtr;
      len            : ARRAY  [1..3] OF integer;
 
LABEL
      999;
 
BEGIN
&ifdef TRACE
(* The following code exists to make usecheck happy.     *)
(* The parameter t is necessary, because the             *)
(* the procedure is called by a pointer from             *)
(* an array of procedure pointers, i.e. all              *)
(* those procedures must have the same formal parameters *)
e := t.trError_gg00;
&endif
len [1]   := 0;
len [2]   := 0;
undef [3] := true;
IF  (st.eop = op_remove) OR (st.eop = op_dbyte_remove)
THEN
    param_cnt := 2
ELSE
    param_cnt := 3;
(*ENDIF*) 
FOR index := param_cnt DOWNTO 1 DO
    BEGIN
    k71get_operand (sel, c_check_spec_null, operand_addr [index],
          len [index], e);
    IF  e <> e_ok
    THEN
        goto 999;
    (*ENDIF*) 
    undef [index] := (operand_addr [index]^ [1] = csp_undef_byte);
    IF  (NOT (sel.sfp_work_st_top^.etype in [st_value, st_result])) OR
        (a05space_option(sel.sfp_acv_addr) AND (len[index] = 1))
    THEN
        len [index] := 1 + a05lnr_space_defbyte (sel.sfp_acv_addr,
              operand_addr [index], operand_addr [index]^ [1], 2, len [index]-1);
    (*ENDIF*) 
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, -1);
&   ifdef TRACE
    t01moveobj (kb_qual, operand_addr [index]^, 1, len [index]);
&   endif
    END;
(*ENDFOR*) 
IF  undef [3]
THEN
    len [3] := 0;
(*ENDIF*) 
IF  NOT undef [1] AND NOT undef  [2] AND NOT undef [3]
THEN
    BEGIN
    IF  (operand_addr [1]^ [1] <>
        operand_addr  [2]^ [1])
        AND
        (operand_addr [2]^ [1] <> csp_defined_byte)
    THEN
        k71code_operand (sel, operand_addr [1]^ [1],
              operand_addr [2], len [2],
              s35inc_st (sel.sfp_work_st_top, 2), e)
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  sel.sfp_workbuf_len + len  [1] > sel.sfp_workbuf_size
THEN
    BEGIN
    e := e_stack_overflow;
    goto 999;
    END;
(*ENDIF*) 
sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, 1);
sel.sfp_workbuf_len := sel.sfp_workbuf_len + 1;
WITH sel.sfp_work_st_top^ DO
    BEGIN
    etype         := st_result;
    eop           := op_none;
    epos          := sel.sfp_workbuf_len;
    ecol_tab [1] := chr(0);
    ecol_tab [2] := chr(0)
    END;
(*ENDWITH*) 
IF  undef [1] OR undef [2]
THEN
    IF  undef [1]
    THEN
        BEGIN
        sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len] := csp_undef_byte;
        sel.sfp_work_st_top^.elen_var := 1;
        END
    ELSE
        BEGIN
        g10mv ('VKB71 ',  30,    
              sizeof(operand_addr [1]^), sel.sfp_workbuf_size,
              @operand_addr [1]^, 1,
              @sel.sfp_workbuf_addr^, sel.sfp_workbuf_len, len [1], e);
        sel.sfp_workbuf_len := sel.sfp_workbuf_len + len [1];
        sel.sfp_work_st_top^.elen_var := len [1]
        END
    (*ENDIF*) 
ELSE
    BEGIN
    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len] :=
          operand_addr [1]^ [1];
    result_len := len [1];
    found      := false;
    start_pos  := 2;
    akt_pos    := 2;
    end_pos    := len [1];
    del_len    := pred (len [2]);
    mv_len     := pred (len [3]);
    IF  len [2] <= 1
    THEN
        BEGIN
        found := true;
        akt_pos := end_pos + 1
        END
    ELSE
        WHILE  (akt_pos <= end_pos) DO
            BEGIN
            IF  ((st.eop = op_dbyte_replace) OR (st.eop = op_dbyte_remove))
            THEN
                REPEAT
                    IF  (operand_addr [1]^ [akt_pos  ] =
                        operand_addr [2]^ [2])           AND
                        (operand_addr [1]^ [akt_pos+1] =
                        operand_addr [2]^ [3])
                    THEN
                        found   := true
                    ELSE
                        akt_pos := akt_pos+2;
                    (*ENDIF*) 
                UNTIL
                    (akt_pos > end_pos) OR found
                (*ENDREPEAT*) 
            ELSE
                REPEAT
                    IF  operand_addr [1]^ [akt_pos] =
                        operand_addr [2]^ [2]
                    THEN
                        found   := true
                    ELSE
                        akt_pos := succ(akt_pos);
                    (*ENDIF*) 
                UNTIL
                    (akt_pos > end_pos) OR found;
                (*ENDREPEAT*) 
            (*ENDIF*) 
            IF  found AND (len [2] > 2)
            THEN
                BEGIN
                s30cmp (operand_addr [1]^, akt_pos + 1,
                      del_len - 1, operand_addr [2]^,
                      3, del_len - 1, compare_result);
                found := (compare_result = l_equal);
                END;
            (*ENDIF*) 
            IF  found
            THEN
                BEGIN
                IF  akt_pos > start_pos
                THEN
                    BEGIN
                    g10mv ('VKB71 ',  31,    
                          sizeof(operand_addr [1]^),
                          sel.sfp_workbuf_size,
                          @operand_addr [1]^, start_pos,
                          @sel.sfp_workbuf_addr^, sel.sfp_workbuf_len + 1,
                          akt_pos - start_pos, e);
                    sel.sfp_workbuf_len := sel.sfp_workbuf_len +
                          akt_pos - start_pos;
                    END;
                (*ENDIF*) 
                IF  len [3] > 1
                THEN
                    BEGIN
                    g10mv ('VKB71 ',  32,    
                          sizeof(operand_addr [3]^),
                          sel.sfp_workbuf_size,
                          @operand_addr [3]^, 2,
                          @sel.sfp_workbuf_addr^, sel.sfp_workbuf_len + 1,
                          mv_len, e);
                    IF  e <> e_ok
                    THEN
                        goto 999;
                    (*ENDIF*) 
                    sel.sfp_workbuf_len := sel.sfp_workbuf_len + mv_len;
                    result_len         := result_len + mv_len;
                    END;
                (*ENDIF*) 
                result_len := result_len - del_len;
                akt_pos    := akt_pos + del_len - 1;
                start_pos  := akt_pos + 1;
                found      := false;
                END;
            (*ENDIF*) 
            akt_pos := succ(akt_pos)
            END;
        (*ENDWHILE*) 
    (*ENDIF*) 
    g10mv ('VKB71 ',  33,    
          sizeof(operand_addr [1]^), sel.sfp_workbuf_size,
          @operand_addr [1]^, start_pos,
          @sel.sfp_workbuf_addr^,  sel.sfp_workbuf_len + 1,
          akt_pos - start_pos, e);
    sel.sfp_work_st_top^.elen_var := result_len;
    sel.sfp_workbuf_len := sel.sfp_workbuf_len + akt_pos - start_pos
    END;
(*ENDIF*) 
&ifdef trace
t01sname (kb_qual, '=== result: ');
WITH sel.sfp_work_st_top^ DO
    t01moveobj (kb_qual, sel.sfp_workbuf_addr^, epos, epos + elen_var - 1);
(*ENDWITH*) 
&endif
999 :
      kb71op_rem_repl := e
END;
 
(*------------------------------*) 
 
FUNCTION
      kb71op_serial (
            VAR t   : tgg00_TransContext;
            VAR sel : tgg00_SelectFieldsParam;
            VAR st  : tgg00_StackEntry) : tgg00_BasisError;
 
VAR
      operand_addr : tsp00_MoveObjPtr;
      len          : integer;
 
      seq_info     : RECORD
            s_id   : tgg00_Surrogate;
            s_info : tgg00_SeqInfo;
      END;
 
 
BEGIN
s10mv (sizeof(sel.sfp_data_addr^), sizeof(seq_info.s_id),
      @sel.sfp_data_addr^, st.epos, @seq_info.s_id, 1,
      sizeof (seq_info.s_id));
k71get_operand (sel,
      NOT c_check_spec_null, operand_addr, len, t.trError_gg00);
IF  t.trError_gg00 = e_ok
THEN
    IF  operand_addr^[2] = csp_zero_exponent
    THEN
        BEGIN
        sel.sfp_workbuf_len := sel.sfp_workbuf_top + 1;
        IF  sel.sfp_workbuf_len + 1 + sizeof (tsp00_Number) >
            sel.sfp_workbuf_size
        THEN
            t.trError_gg00 := e_stack_overflow
        ELSE
            BEGIN
            seq_info.s_info                 := k71serial_seq_info;
            seq_info.s_info.seq_maxvalue[1] := chr (192+ord (st.ecol_tab[1]));
            seq_info.s_info.seq_site        := cgg_zero_c2;
            IF  st.elen_var > SURROGATE_MXGG00
            THEN
                BEGIN
                sel.sfp_workbuf_addr^[sel.sfp_workbuf_len+2] :=
                      csp_zero_exponent;
                a05temp_nextval (sel.sfp_data_addr^, sel.sfp_data_size,
                      st, seq_info.s_info,
                      sel.sfp_workbuf_addr^, sel.sfp_workbuf_size,
                      sel.sfp_workbuf_len + 1, len);
                len := len - 1
                END
            ELSE
                k57nextval (t, @seq_info, sizeof (seq_info), 1,
                      sel.sfp_workbuf_addr, sel.sfp_workbuf_size,
                      sel.sfp_workbuf_len + 2, len);
            (*ENDIF*) 
            sel.sfp_workbuf_addr^[sel.sfp_workbuf_len+1] := csp_defined_byte;
            WITH sel.sfp_work_st_top^ DO
                BEGIN
                etype        := st_result;
                eop          := op_none;
                epos         := sel.sfp_workbuf_len + 1;
                elen_var     := 1 + len;
                ecol_tab [1] := chr(0);
                ecol_tab [2] := chr(0)
                END;
            (*ENDWITH*) 
            (* PTS 1118423 E.Z. *)
            sel.sfp_last_serial := csp_null_number;
            s10mv (sel.sfp_workbuf_size, sizeof (sel.sfp_last_serial),
                  @sel.sfp_workbuf_addr^, sel.sfp_workbuf_len + 2,
                  @sel.sfp_last_serial, 1, len);
            IF  sel.sfp_first_serial = csp_null_number
            THEN
                sel.sfp_first_serial := sel.sfp_last_serial;
            (*ENDIF*) 
            END
        (*ENDIF*) 
        END
    ELSE
        IF  operand_addr^[2] > csp_zero_exponent
        THEN
            BEGIN
            IF  st.elen_var > SURROGATE_MXGG00
            THEN
                a05temp_nextval (sel.sfp_data_addr^, sel.sfp_data_size,
                      st, seq_info.s_info,
                      operand_addr^, len, 1, len)
            ELSE
                k57put_sequence_value (t, seq_info.s_id,
                      operand_addr^, sizeof (tsp00_Number),  2, len - 1);
            (*ENDIF*) 
            (* PTS 1118423 E.Z. *)
            sel.sfp_last_serial := csp_null_number;
            s10mv (sel.sfp_data_size, sizeof (sel.sfp_last_serial),
                  @operand_addr^, 2, @sel.sfp_last_serial, 1, len-1);
            IF  sel.sfp_first_serial = csp_null_number
            THEN
                sel.sfp_first_serial := sel.sfp_last_serial;
            (*ENDIF*) 
            END
        ELSE
            t.trError_gg00 := e_range_violation;
        (*ENDIF*) 
    (*ENDIF*) 
(*ENDIF*) 
kb71op_serial := t.trError_gg00
END;
 
(* PTS 1126557 *)
(*------------------------------*) 
 
FUNCTION
      kb71op_updated (
            VAR t   : tgg00_TransContext;
            VAR sel : tgg00_SelectFieldsParam;
            VAR st  : tgg00_StackEntry) : tgg00_BasisError;
 
VAR
      ix          : integer;
 
      pUpdatedSet : RECORD
            CASE boolean OF
                true :
                    (pSet : ^tgg00_ColumnSet);
                false :
                    (pMoveObj : tsp00_MoveObjPtr);
                END;
            (*ENDCASE*) 
 
 
BEGIN
&ifdef trace
t01stackentry (kb_qual, st, 1);
&endif
pUpdatedSet.pMoveObj := s35add_moveobj_ptr (@sel.sfp_rec_addr^,
      cgg_rec_key_offset + sel.sfp_rec_key_len + st.epos - 1);
&ifdef trace
FOR ix := 1 TO st.elen_var DO
    IF  ix in pUpdatedSet.pSet^
    THEN
        t01int4 (kb_qual, 'updated     ', ord (ix in pUpdatedSet.pSet^));
&   endif
    (*ENDIF*) 
(*ENDFOR*) 
IF  sel.sfp_workbuf_top + 2 > sel.sfp_workbuf_size
THEN
    kb71op_updated := e_stack_overflow
ELSE
    BEGIN
    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_top + 1] := csp_defined_byte;
    IF  st.ecol_pos in pUpdatedSet.pSet^
    THEN
        sel.sfp_workbuf_addr^ [sel.sfp_workbuf_top + 2] := chr(1)
    ELSE
        sel.sfp_workbuf_addr^ [sel.sfp_workbuf_top + 2] := chr(0);
    (*ENDIF*) 
    kb71op_updated                := e_ok;
    sel.sfp_work_st_top^.etype    := st_result;
    sel.sfp_work_st_top^.eop      := op_none;
    sel.sfp_work_st_top^.epos     := sel.sfp_workbuf_top + 1;
    sel.sfp_work_st_top^.elen_var := 2;
    sel.sfp_workbuf_len           := sel.sfp_workbuf_top + 2;
&   ifdef trace
    t01sname (kb_qual, '=== result: ');
    WITH sel.sfp_work_st_top^ DO
        t01moveobj (kb_qual, sel.sfp_workbuf_addr^, epos, epos + elen_var - 1);
    (*ENDWITH*) 
&   endif
    END;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      kb71op_soundex (
            VAR t   : tgg00_TransContext;
            VAR sel : tgg00_SelectFieldsParam;
            VAR st  : tgg00_StackEntry) : tgg00_BasisError;
 
CONST
      soundex_len = 4;
 
VAR
      undef        : boolean;
      e            : tgg00_BasisError;
      operand_addr : tsp00_MoveObjPtr;
      def_byte     : char;
      matchval     : tsp00_C4;
      len          : integer;
      code_tab     : integer;
      workbuf      : tkb07_buffer_description;
 
LABEL
      999;
 
BEGIN
&ifdef TRACE
(* The following code exists to make usecheck happy.     *)
(* The parameters are necessary, because the             *)
(* the procedure is called by a pointer from             *)
(* an array of procedure pointers, i.e. all              *)
(* those procedures must have the same formal parameters *)
e := t.trError_gg00;
len := ord(st.etype);
&endif
k71get_operand (sel,
      NOT c_check_spec_null, operand_addr, len, e);
IF  e <> e_ok
THEN
    goto 999;
(*ENDIF*) 
def_byte := operand_addr^ [1];
undef    := (def_byte = csp_undef_byte);
IF  operand_addr = @sel.sfp_rec_addr^ [1]
THEN
    len := a05lnr_space_defbyte (sel.sfp_acv_addr,
          operand_addr, def_byte, 2, len-1)
ELSE
    len := len - 1;
(*ENDIF*) 
IF  sel.sfp_workbuf_top + 1 + len > sel.sfp_workbuf_size
THEN
    BEGIN
    e := e_stack_overflow;
    goto 999;
    END;
(*ENDIF*) 
sel.sfp_workbuf_len := sel.sfp_workbuf_top + 1;
WITH sel.sfp_work_st_top^ DO
    BEGIN
    etype    := st_result;
    eop      := op_none;
    epos     := sel.sfp_workbuf_len;
    elen_var := 1 + soundex_len;
    ecol_tab [1] := chr(0);
    ecol_tab [2] := chr(0)
    END;
(*ENDWITH*) 
IF  undef
THEN
    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len] := csp_undef_byte
ELSE
    BEGIN
    workbuf.buffer_addr := sel.sfp_workbuf_addr;
    workbuf.buffer_size := sel.sfp_workbuf_size;
    workbuf.buffer_len  := sel.sfp_workbuf_len;
    kb71matchvalue (workbuf,
          operand_addr^, 1, len, sel.sfp_workbuf_len, matchval, e);
    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len] := bsp_c1;
    g10mv ('VKB71 ',  34,    
          sizeof (matchval), sel.sfp_workbuf_size,
          @matchval, 1, @sel.sfp_workbuf_addr^, sel.sfp_workbuf_len+1,
          soundex_len, e);
    IF  e <> e_ok
    THEN
        goto 999;
    (*ENDIF*) 
    IF  operand_addr^ [1] <> bsp_c1
    THEN
        BEGIN
        IF  operand_addr^ [1] = csp_ascii_blank
        THEN
            code_tab := cgg04_to_ascii
        ELSE
            code_tab := cgg04_to_ebcdic;
        (*ENDIF*) 
        s30map (g02codetables.tables [code_tab],
              sel.sfp_workbuf_addr^, sel.sfp_workbuf_len,
              sel.sfp_workbuf_addr^, sel.sfp_workbuf_len,
              soundex_len+1)
        END;
    (*ENDIF*) 
    sel.sfp_workbuf_len := sel.sfp_workbuf_len + 1 + soundex_len
    END;
(*ENDIF*) 
&ifdef TRACE
t01sname (kb_qual, '=== result: ');
WITH sel.sfp_work_st_top^ DO
    t01moveobj (kb_qual, sel.sfp_workbuf_addr^, epos, epos + elen_var - 1);
(*ENDWITH*) 
&endif
999 :
      kb71op_soundex := e
END;
 
(*------------------------------*) 
 
FUNCTION
      kb71op_stamp (
            VAR t   : tgg00_TransContext;
            VAR sel : tgg00_SelectFieldsParam;
            VAR st  : tgg00_StackEntry) : tgg00_BasisError;
 
VAR
      k : tgg00_Lkey;
 
BEGIN
t.trError_gg00 := e_ok;
IF  sel.sfp_workbuf_len + 1 + SURROGATE_MXGG00 > sel.sfp_workbuf_size
THEN
    t.trError_gg00 := e_stack_overflow
ELSE
    BEGIN
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, 1);
    WITH sel.sfp_work_st_top^ DO
        BEGIN
        etype        := st_result;
        eop          := op_none;
        epos         := sel.sfp_workbuf_len + 1;
        elen_var     := 1 + SURROGATE_MXGG00;
        ecol_tab [1] := chr(0);
        ecol_tab [2] := chr(0)
        END;
    (*ENDWITH*) 
    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len+1] := csp_defined_byte;
    IF  st.ecol_tab [1] = chr(0)
    THEN
        BEGIN
        k57table_key_get (t.trTaskId_gg00, t.trState_gg00, k);
        g10mv ('VKB71 ',  35,    
              sizeof(k.k), sel.sfp_workbuf_size, @k.k, 1,
              @sel.sfp_workbuf_addr^, sel.sfp_workbuf_len+2,
              sizeof(tgg00_Surrogate), t.trError_gg00);
        END
    ELSE
        SAPDB_PascalFill ('VKB71 ',  36,    
              sel.sfp_workbuf_size, @sel.sfp_workbuf_addr^,
              sel.sfp_workbuf_len+2, sizeof(tgg00_Surrogate),
              csp_defined_byte, t.trError_gg00);
    (*ENDIF*) 
&   ifdef TRACE
    t01sname (kb_qual, '=== result: ');
    t01moveobj (kb_qual, sel.sfp_workbuf_addr^,
          sel.sfp_workbuf_len + 1,
          sel.sfp_workbuf_len + 1 + SURROGATE_MXGG00);
&   endif
    sel.sfp_workbuf_len := sel.sfp_workbuf_len + 1 + SURROGATE_MXGG00
    END;
(*ENDIF*) 
kb71op_stamp := t.trError_gg00
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb71op_subquery (
            VAR t     : tgg00_TransContext;
            VAR op    : tgg00_StackEntry;
            VAR sel : tgg00_SelectFieldsParam;
            VAR e   : tgg00_BasisError);
 
VAR
      get_prev       : boolean;
      is_all         : boolean;
      found_undef    : boolean;
      compare_op     : tgg00_StackOpType;
      compare_result : integer;
      len            : integer;
      collength      : integer;
      operand_addr   : tsp00_MoveObjPtr;
      aux_ptr        : tsp00_MoveObjPtr;
      file_id        : tgg00_FileId;
      k              : tgg00_Lkey;
      rec            : tgg00_Rec;
      workbuf        : tkb07_buffer_description;
 
LABEL
      999;
 
BEGIN
t.trError_gg00       := e_ok;
compare_result := cgg04_is_false;
IF  s35le_bufaddr (sel.sfp_work_st_top, sel.sfp_work_st_bottom)
THEN
    BEGIN
    t.trError_gg00 := e_stack_op_illegal;
    goto 999;
    END
ELSE
    IF  s35ge_bufaddr (sel.sfp_work_st_top, sel.sfp_work_st_last)
    THEN
        BEGIN
        t.trError_gg00 := e_stack_overflow;
        goto 999;
        END;
    (*ENDIF*) 
(*ENDIF*) 
s10mv (sizeof(sel.sfp_data_addr^), sizeof(file_id),
      @sel.sfp_data_addr^, op.epos,
      @file_id, 1, sizeof (tgg00_FileId));
k71get_operand (sel, c_check_spec_null, operand_addr, len, t.trError_gg00);
IF  t.trError_gg00 <> e_ok
THEN
    goto 999;
(*ENDIF*) 
IF  len > 0
THEN
    BEGIN
&   ifdef TRACE
    t01moveobj (kb_qual, operand_addr^, 1, len);
&   endif
    IF  operand_addr^ [1] = csp_undef_byte
    THEN
        compare_result := cgg04_is_undef;
    (*ENDIF*) 
    END
ELSE
    compare_result := cgg04_is_undef;
(*ENDIF*) 
IF  (compare_result <> cgg04_is_undef)
THEN
    BEGIN
    is_all     := (op.ecol_tab [1] = chr(1));
    compare_op := op.eop;
    IF  ((op.eop in  [op_ge, op_gt]) AND is_all)
        OR
        ((op.eop in  [op_le, op_lt]) AND NOT is_all)
    THEN (* >= ALL, > ALL, <= ANY, < ANY *)
        get_prev := true
    ELSE
        BEGIN
        get_prev := false;
        IF  op.eop = op_in
        THEN
            BEGIN
            compare_op := op_eq;
            is_all     := false
            END
        ELSE
            IF  op.eop = op_not_in
            THEN
                BEGIN
                compare_op := op_ne;
                is_all     := true
                END
            (*ENDIF*) 
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  op.elen_var > 0
    THEN
        BEGIN
        found_undef := false;
        collength   := op.elen_var
        END
    ELSE
        BEGIN
        found_undef := true;
        collength   := -op.elen_var
        END;
    (*ENDIF*) 
    workbuf.buffer_addr := sel.sfp_workbuf_addr;
    workbuf.buffer_size := sel.sfp_workbuf_size;
    workbuf.buffer_len  := sel.sfp_workbuf_len;
    REPEAT
        IF  get_prev
        THEN
            BEGIN
            k.len := MAX_KEYLEN_GG00;
            k.k   := b01fullkey;
            (* < undef key *)
            k.k [1] := chr(254);
            b02prev_record (t, file_id, k, c_inclusive, rec);
            IF  t.trError_gg00 = e_no_prev_record
            THEN
                compare_result := cgg04_is_undef
            (*ENDIF*) 
            END
        ELSE
            BEGIN
            IF  ((op.eop in  [op_le, op_lt, op_eq]) AND is_all)
                OR
                ((op.eop in  [op_ge, op_gt, op_ne]) AND NOT is_all)
            THEN (* <= ALL, < ALL, = ALL, >= ANY, > ANY, <> ANY *)
                k.len := 0
            ELSE (* IN / = ANY, NOT IN / <> ALL *)
                BEGIN
                IF  len > collength
                THEN
                    k.len := a05lnr_space_defbyte (sel.sfp_acv_addr,
                          operand_addr, operand_addr^ [1], 1, len)
                ELSE
                    k.len := len;
                (*ENDIF*) 
                g10mv ('VKB71 ',  37,    
                      sizeof (operand_addr^), sizeof(k.k),
                      @operand_addr^, 1, @k.k, 1, k.len, t.trError_gg00);
                IF  t.trError_gg00 <> e_ok
                THEN
                    goto 999;
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            b02next_record (t, file_id, k, c_inclusive, rec);
            IF  t.trError_gg00 = e_no_next_record
            THEN
                BEGIN
                IF  is_all
                THEN (* NOT IN / <> ALL *)
                    compare_result := cgg04_is_true
                ELSE (* IN / = ANY *)
                    compare_result := cgg04_is_false
                (*ENDIF*) 
                END
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        IF  t.trError_gg00 = e_key_not_found
        THEN
            t.trError_gg00 := e_ok;
        (*ENDIF*) 
        IF  t.trError_gg00 = e_ok
        THEN
            BEGIN
            IF  collength > 0
            THEN
                BEGIN
                IF  rec.buf [cgg_rec_key_offset+1] = csp_oflw_byte
                THEN
                    BEGIN
                    t.trError_gg00 := e_special_null;
                    goto 999;
                    END;
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            aux_ptr := @rec.buf;
            kb71comparison (sel, compare_op, workbuf, operand_addr^,
                  1, len, aux_ptr^, cgg_rec_key_offset+1, collength,
                  compare_result)
            END
        ELSE
            IF  (t.trError_gg00 = e_no_next_record) OR
                (t.trError_gg00 = e_no_prev_record)
            THEN
                t.trError_gg00 := e_ok
            ELSE
                goto 999;
            (*ENDIF*) 
        (*ENDIF*) 
        IF  NOT get_prev
        THEN
            BEGIN
            IF  (op.eop = op_eq) AND is_all
                AND (compare_result = cgg04_is_true)
            THEN
                get_prev := true
            ELSE
                IF  (op.eop = op_ne) AND NOT is_all
                    AND (compare_result = cgg04_is_false)
                THEN
                    get_prev := true;
                (*ENDIF*) 
            (*ENDIF*) 
            END
        ELSE
            get_prev := false
        (*ENDIF*) 
    UNTIL
        NOT get_prev;
    (*ENDREPEAT*) 
    IF  found_undef
    THEN (* UNDEF in subquery *)
        BEGIN
        IF  is_all AND (compare_result = cgg04_is_true)
        THEN (* ALL: true *)
            compare_result := cgg04_is_undef
        ELSE
            IF  NOT is_all AND (compare_result = cgg04_is_false)
            THEN (* ANY: false *)
                compare_result := cgg04_is_undef;
            (*ENDIF*) 
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDIF*) 
sel.sfp_work_st_top^.etype      := st_bool;
sel.sfp_work_st_top^.epos  := compare_result;
sel.sfp_workbuf_len             := sel.sfp_workbuf_top;
999 :
      e := t.trError_gg00
END;
 
(*------------------------------*) 
 
FUNCTION
      kb71dbyte_translate (
            VAR t   : tgg00_TransContext;
            VAR sel : tgg00_SelectFieldsParam;
            VAR st  : tgg00_StackEntry) : tgg00_BasisError;
 
VAR
      operand_addr     : ARRAY  [1..3] OF tsp00_MoveObjPtr;
      len              : ARRAY  [1..3] OF integer;
      found            : boolean;
      e                : tgg00_BasisError;
      i                : integer;
      source_len       : integer;
      dest_len         : integer;
      value_len        : integer;
      result_len       : integer;
      pos1             : integer;
      pos2             : integer;
      undef            : ARRAY  [1..3] OF boolean;
      first_byte_found : ARRAY  [0..255] OF boolean;
 
LABEL
      999;
 
BEGIN
&ifdef TRACE
(* The following code exists to make usecheck happy.     *)
(* The parameters are necessary, because the             *)
(* the procedure is called by a pointer from             *)
(* an array of procedure pointers, i.e. all              *)
(* those procedures must have the same formal parameters *)
e := t.trError_gg00;
i := ord(st.etype);
&endif
len [1]   := 0;
len [2]   := 0;
len [3]   := 0;
FOR i := 0 TO 255 DO
    first_byte_found [i] := false;
(*ENDFOR*) 
FOR i := 3 DOWNTO 1 DO
    BEGIN
    k71get_operand (sel,
          c_check_spec_null, operand_addr [i], len [i], e);
    IF  e <> e_ok
    THEN
        goto 999;
    (*ENDIF*) 
    undef [i] := (operand_addr [i]^ [1] = csp_undef_byte);
    IF  (NOT undef[i]) AND
        (NOT (sel.sfp_work_st_top^.etype in [st_value, st_result])) OR
        (a05space_option(sel.sfp_acv_addr) AND (len[i] = 1))
    THEN
        len [i] := a05lnr_space_defbyte (sel.sfp_acv_addr, operand_addr [i],
              operand_addr [i]^ [1], 2, len [i] - 1) + 1;
    (*ENDIF*) 
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, -1);
    END;
(*ENDFOR*) 
IF  sel.sfp_workbuf_len + len [1] > sel.sfp_workbuf_size
THEN
    BEGIN
    e := e_stack_overflow;
    goto 999;
    END;
(*ENDIF*) 
sel.sfp_work_st_top        := s35inc_st (sel.sfp_work_st_top, 1);
sel.sfp_workbuf_len := succ(sel.sfp_workbuf_len);
WITH sel.sfp_work_st_top^ DO
    BEGIN
    etype         := st_result;
    eop           := op_none;
    epos          := sel.sfp_workbuf_len;
    elen_var      := len [1];
    ecol_tab [1] := chr(0);
    ecol_tab [2] := chr(0);
    END;
(*ENDWITH*) 
IF  undef [1] OR undef [2] OR undef [3]
THEN
    BEGIN
    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len]    := csp_undef_byte;
    sel.sfp_work_st_top^.elen_var := 1
    END
ELSE
    BEGIN
    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len] := operand_addr [1]^ [1];
    value_len     := len [1];
    result_len    := 0;
    source_len    := len [2];
    dest_len      := len [3];
    pos1 := 2;
    WHILE pos1 <= source_len DO
        BEGIN
        first_byte_found [ord(operand_addr[2]^ [pos1])] := true;
        pos1 := pos1 + 2
        END;
    (*ENDWHILE*) 
    pos1 := 2;
    WHILE pos1 <= value_len DO
        BEGIN
        IF  NOT first_byte_found [ord(operand_addr[1]^ [pos1])]
        THEN
            BEGIN
            result_len := result_len+2;
            sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len + result_len - 1] :=
                  operand_addr[1]^ [pos1];
            sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len + result_len   ] :=
                  operand_addr[1]^ [pos1+1];
            END
        ELSE
            BEGIN
            pos2   := 2;
            found  := false;
            WHILE (pos2 <= source_len) AND NOT found DO
                IF  (operand_addr[2]^ [pos2  ] <> operand_addr[1]^ [pos1  ]) OR
                    (operand_addr[2]^ [pos2+1] <> operand_addr[1]^ [pos1+1])
                THEN
                    pos2  := pos2+2
                ELSE
                    found := true;
                (*ENDIF*) 
            (*ENDWHILE*) 
            IF  NOT found
            THEN
                BEGIN
                result_len := result_len+2;
                sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len + result_len - 1] :=
                      operand_addr[1]^ [pos1];
                sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len + result_len   ] :=
                      operand_addr[1]^ [pos1+1];
                END
            ELSE
                IF  pos2 <= dest_len
                THEN
                    BEGIN
                    result_len := result_len+2;
                    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len + result_len - 1] :=
                          operand_addr[3]^ [pos2];
                    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len + result_len   ] :=
                          operand_addr[3]^ [pos2+1];
                    END
                (*ENDIF*) 
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        pos1 := pos1 + 2
        END;
    (*ENDWHILE*) 
    IF  result_len < value_len
    THEN
        SAPDB_PascalUnicodeFill ('VKB71 ',  38,    
              sizeof (sel.sfp_workbuf_addr^),
              @sel.sfp_workbuf_addr^,
              sel.sfp_workbuf_len+result_len+1, value_len-1-result_len,
              csp_unicode_blank, e);
    (*ENDIF*) 
    sel.sfp_workbuf_len := sel.sfp_workbuf_len + value_len
    END;
(*ENDIF*) 
&ifdef TRACE
t01sname (kb_qual, '=== result: ');
WITH sel.sfp_work_st_top^ DO
    t01moveobj (kb_qual, sel.sfp_workbuf_addr^, epos, epos + elen_var - 1);
(*ENDWITH*) 
&endif
999 :
      kb71dbyte_translate := e
END;
 
(*------------------------------*) 
 
FUNCTION
      kb71test_zero (
            VAR t    : tgg00_TransContext;
            VAR sel  : tgg00_SelectFieldsParam;
            VAR st   : tgg00_StackEntry) : tgg00_BasisError;
 
VAR
      e            : tgg00_BasisError;
      operand_addr : tsp00_MoveObjPtr;
      len          : integer;
      i            : integer;
 
BEGIN
&ifdef TRACE
(* The following code exists to make usecheck happy.     *)
(* The parameters are necessary, because the             *)
(* the procedure is called by a pointer from             *)
(* an array of procedure pointers, i.e. all              *)
(* those procedures must have the same formal parameters *)
e := t.trError_gg00;
i := ord(st.etype);
&endif
k71get_operand (sel, c_check_spec_null, operand_addr, len, e);
IF  e = e_ok
THEN
    BEGIN
    IF  (operand_addr^[1] <> csp_undef_byte   ) AND
        (operand_addr^[2] =  csp_zero_exponent)
    THEN
        sel.sfp_work_st_top^.epos := cgg04_is_true
    ELSE
        sel.sfp_work_st_top^.epos := cgg04_is_false;
    (*ENDIF*) 
    sel.sfp_work_st_top^.etype := st_bool;
    END;
(*ENDIF*) 
kb71test_zero := e
END;
 
(*------------------------------*) 
 
FUNCTION
      kb71translate (
            VAR t   : tgg00_TransContext;
            VAR sel : tgg00_SelectFieldsParam;
            VAR st  : tgg00_StackEntry) : tgg00_BasisError;
 
VAR
      undef        : boolean;
      e            : tgg00_BasisError;
      operand_addr : ARRAY  [1..3] OF tsp00_MoveObjPtr;
      len          : ARRAY  [1..3] OF integer;
      i            : integer;
      map_table    : tsp00_Ctable;
      define_chars : tsp00_C2;
 
LABEL
      999;
 
BEGIN
&ifdef TRACE
(* The following code exists to make usecheck happy.     *)
(* The parameters are necessary, because the             *)
(* the procedure is called by a pointer from             *)
(* an array of procedure pointers, i.e. all              *)
(* those procedures must have the same formal parameters *)
e := t.trError_gg00;
i := ord(st.etype);
&endif
len [1]   := 0;
len [2]   := 0;
len [3]   := 0;
SAPDB_PascalForcedFill (sizeof(map_table), @map_table, 1, sizeof(map_table),
      csp_undef_byte);
undef := false;
FOR i := 3 DOWNTO 1 DO
    BEGIN
    k71get_operand (sel,
          c_check_spec_null, operand_addr [i], len [i], e);
    IF  e <> e_ok
    THEN
        goto 999;
    (*ENDIF*) 
    IF  operand_addr [i]^ [1] = csp_undef_byte
    THEN
        undef := true
    ELSE
        IF  (NOT (sel.sfp_work_st_top^.etype in [st_value, st_result])) OR
            (a05space_option(sel.sfp_acv_addr) AND (len[i] = 1))
        THEN
            len [i] := a05lnr_space_defbyte (sel.sfp_acv_addr, operand_addr [i],
                  operand_addr [i]^ [1], 2, len [i] - 1) + 1;
        (*ENDIF*) 
    (*ENDIF*) 
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, -1);
    END;
(*ENDFOR*) 
IF  sel.sfp_workbuf_top + len [1] > sel.sfp_workbuf_size
THEN
    BEGIN
    e := e_stack_overflow;
    goto 999;
    END;
(*ENDIF*) 
sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, 1);
sel.sfp_workbuf_len := sel.sfp_workbuf_top + 1;
WITH sel.sfp_work_st_top^ DO
    BEGIN
    etype         := st_result;
    eop           := op_none;
    epos          := sel.sfp_workbuf_len;
    elen_var      := len [1];
    ecol_tab [1] := chr(0);
    ecol_tab [2] := chr(0);
    END;
(*ENDWITH*) 
IF  undef
THEN
    BEGIN
    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len] := csp_undef_byte;
    sel.sfp_work_st_top^.elen_var := 1
    END
ELSE
    BEGIN
    FOR i := len [2] DOWNTO 2 DO
        BEGIN
        IF  i > len [3]
        THEN
            map_table [ord(operand_addr [2]^ [i] )] :=
                  csp_defined_byte
        ELSE
            map_table [ord(operand_addr [2]^ [i] )] :=
                  operand_addr [3]^ [i];
        (*ENDIF*) 
        END;
    (*ENDFOR*) 
    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len] := operand_addr [1]^ [1];
    sel.sfp_workbuf_len := succ(sel.sfp_workbuf_len);
    FOR i := 2 TO len [1] DO
        BEGIN
        IF  map_table [ ord(operand_addr [1]^ [i])] =
            csp_undef_byte
        THEN
            BEGIN
            sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len] :=
                  operand_addr [1]^ [i];
            sel.sfp_workbuf_len := succ(sel.sfp_workbuf_len);
            END
        ELSE
            IF  map_table [ ord(operand_addr [1]^ [i])] <>
                csp_defined_byte
            THEN
                BEGIN
                sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len] :=
                      map_table [ ord(operand_addr [1]^ [i])];
                sel.sfp_workbuf_len := succ(sel.sfp_workbuf_len);
                END;
            (*ENDIF*) 
        (*ENDIF*) 
        END;
    (*ENDFOR*) 
    WITH sel.sfp_work_st_top^ DO
        IF  sel.sfp_workbuf_len - epos < len [1]
        THEN
            BEGIN
            SAPDB_PascalFill ('VKB71 ',  39,    
                  sel.sfp_workbuf_size, @sel.sfp_workbuf_addr^,
                  sel.sfp_workbuf_len,
                  len [1] + epos - sel.sfp_workbuf_len,
                  operand_addr [1]^ [1], e);
            sel.sfp_workbuf_len :=  epos + elen_var;
            END;
        (*ENDIF*) 
    (*ENDWITH*) 
    END;
(*ENDIF*) 
&ifdef TRACE
t01sname (kb_qual, '=== result: ');
WITH sel.sfp_work_st_top^ DO
    t01moveobj (kb_qual, sel.sfp_workbuf_addr^, epos, epos + elen_var - 1);
(*ENDWITH*) 
&endif
999 :
      kb71translate := e
END;
 
(*------------------------------*) 
 
FUNCTION
      kb71dbyte_upp_low (
            VAR t   : tgg00_TransContext;
            VAR sel : tgg00_SelectFieldsParam;
            VAR st  : tgg00_StackEntry) : tgg00_BasisError;
 
VAR
      operand_addr   : tsp00_MoveObjPtr;
      e              : tgg00_BasisError;
      len            : integer;
      index          : integer;
      undef          : boolean;
      def_byte       : char;
      code_tab       : integer;
      trunc_len      : integer;
 
LABEL
      999;
 
BEGIN
&ifdef TRACE
(* The following code exists to make usecheck happy.     *)
(* The parameter t is necessary, because the             *)
(* the procedure is called by a pointer from             *)
(* an array of procedure pointers, i.e. all              *)
(* those procedures must have the same formal parameters *)
e := t.trError_gg00;
&endif
k71get_operand (sel, c_check_spec_null, operand_addr, len, e);
IF  e = e_ok
THEN
    BEGIN
&   ifdef TRACE
    t01op  (kb_qual, 'dbyte upplow', st.eop);
&   endif
    def_byte := operand_addr^ [1];
    undef    := (def_byte = csp_undef_byte);
    IF  sel.sfp_work_st_top^.etype in [st_value , st_result]
    THEN
        trunc_len := len
    ELSE
        IF  undef
        THEN
            trunc_len := 1
        ELSE
            trunc_len := 1 + a05lnr_space_defbyte (sel.sfp_acv_addr, operand_addr,
                  def_byte, 2, len-1);
        (*ENDIF*) 
    (*ENDIF*) 
    IF  sel.sfp_workbuf_len + trunc_len > sel.sfp_workbuf_size
    THEN
        BEGIN
        e := e_stack_overflow;
        goto 999;
        END;
    (*ENDIF*) 
    sel.sfp_workbuf_len := sel.sfp_workbuf_len + 1;
    WITH sel.sfp_work_st_top^ DO
        BEGIN
        etype    := st_result;
        eop      := op_none;
        epos     := sel.sfp_workbuf_len;
        elen_var := trunc_len;
        ecol_tab [1] := chr(0);
        ecol_tab [2] := chr(0)
        END;
    (*ENDWITH*) 
    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len] := def_byte;
    IF  NOT undef
    THEN
        BEGIN
        (* PTS 1118244 E.Z. *)
        g10mv ('VKB71 ',  40,    
              sizeof(operand_addr^), sel.sfp_workbuf_size,
              @operand_addr^, 1, @sel.sfp_workbuf_addr^, sel.sfp_workbuf_len,
              trunc_len, e);
        IF  e <> e_ok
        THEN
            goto 999;
        (*ENDIF*) 
        CASE st.eop OF
            op_dbyte_lower:
                sp81UCS2StringTolower (@(sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len+1]),
                      trunc_len - 1);
            op_dbyte_upper:
                sp81UCS2StringToupper (@(sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len+1]),
                      trunc_len - 1);
            END;
        (*ENDCASE*) 
        sel.sfp_workbuf_len := sel.sfp_workbuf_len + trunc_len - 1;
        END;
&   ifdef TRACE
    (*ENDIF*) 
    t01sname (kb_qual, '=== result: ');
    WITH sel.sfp_work_st_top^ DO
        t01moveobj (kb_qual, sel.sfp_workbuf_addr^, epos, epos + elen_var - 1);
    (*ENDWITH*) 
&   endif
    END;
(*ENDIF*) 
999 :
      kb71dbyte_upp_low := e
END;
 
(*------------------------------*) 
 
FUNCTION
      kb71op_trans_string (
            VAR t   : tgg00_TransContext;
            VAR sel : tgg00_SelectFieldsParam;
            VAR st  : tgg00_StackEntry) : tgg00_BasisError;
 
VAR
      e               : tgg00_BasisError;
      operand_addr    : tsp00_MoveObjPtr;
      len             : integer;
      operand_st_addr : tgg00_StEntryAddr;
 
BEGIN
&ifdef TRACE
(* The following code exists to make usecheck happy.     *)
(* The parameters are necessary, because the             *)
(* the procedure is called by a pointer from             *)
(* an array of procedure pointers, i.e. all              *)
(* those procedures must have the same formal parameters *)
e := t.trError_gg00;
&endif
k71get_operand (sel, c_check_spec_null, operand_addr, len, e);
IF  e = e_ok
THEN
    BEGIN
    operand_st_addr     := sel.sfp_work_st_top;
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, -1);
    kb71code_transform (st.eop, sel, operand_addr, len,
          operand_st_addr, e)
    END;
(*ENDIF*) 
kb71op_trans_string := e
END;
 
(*------------------------------*) 
 
FUNCTION
      kb71ok (
            VAR t   : tgg00_TransContext;
            VAR sel : tgg00_SelectFieldsParam;
            VAR st  : tgg00_StackEntry) : tgg00_BasisError;
&     ifdef TRACE
 
VAR
      e : tgg00_BasisError;
      i : integer;
&     endif
 
BEGIN
&ifdef TRACE
(* The following code exists to make usecheck happy.     *)
(* The parameters are necessary, because the             *)
(* the procedure is called by a pointer from             *)
(* an array of procedure pointers, i.e. all              *)
(* those procedures must have the same formal parameters *)
e := t.trError_gg00;
i := ord(sel.sfp_optimized);
i := ord(st.etype);
&endif
kb71ok := e_ok
END;
 
(*------------------------------*) 
 
FUNCTION
      kb71optimized_compare (
            VAR t        : tgg00_TransContext;
            VAR sel      : tgg00_SelectFieldsParam;
            op           : tgg00_StackOpType;
            curr_st      : tgg00_StEntryAddr;
            VAR qualptr  : integer) : tgg00_BasisError;
 
VAR
      e              : tgg00_BasisError;
      st_top         : tgg00_StEntryAddr;
      compare_result : tsp00_LcompResult;
      len1           : integer;
      len2           : integer;
      operand_addr1  : tsp00_MoveObjPtr;
      operand_addr2  : tsp00_MoveObjPtr;
 
LABEL
      999;
 
BEGIN
&ifdef TRACE
(* The following code exists to make usecheck happy.     *)
(* The parameter t is necessary, because the             *)
(* the procedure is called by a pointer from             *)
(* an array of procedure pointers, i.e. all              *)
(* those procedures must have the same formal parameters *)
e := t.trError_gg00;
&endif
(* optimized comparison without pushing the operands *)
(* on the stack                                      *)
st_top              := s35inc_st (sel.sfp_work_st_top, 1);
sel.sfp_work_st_top := curr_st;
k71get_operand (sel, c_check_spec_null, operand_addr1, len1, e);
IF  e = e_ok
THEN
    BEGIN
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, 1);
    k71get_operand (sel, c_check_spec_null, operand_addr2, len2, e);
    END;
(*ENDIF*) 
IF  e = e_ok
THEN
    BEGIN
    IF  sel.sfp_work_st_top^.eop = op
    THEN
        qualptr := qualptr + 1
    ELSE
        qualptr := qualptr + 2;
    (*ENDIF*) 
    IF  (operand_addr1^[1] <> operand_addr2^[1])
        AND
        (operand_addr2^[1] <> csp_defined_byte)
        AND
        (operand_addr1^[1] <> csp_undef_byte)
        AND
        (* undef_byte may be in correlations *)
        (* and with 'is [not] null'          *)
        (operand_addr2^[1] <> csp_undef_byte)
    THEN
        BEGIN
        k71code_operand (sel, operand_addr1^[1],
              operand_addr2, len2, curr_st, e);
        IF  e <> e_ok
        THEN
            goto 999
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    a05luc_space (sel.sfp_acv_addr, operand_addr1^, 1, len1,
          operand_addr2^, 1, len2, compare_result);
    st_top^.etype       := st_bool;
    st_top^.epos        := kb71cmp_table[op, compare_result];
    sel.sfp_work_st_top := st_top
    END;
(*ENDIF*) 
999 :
      kb71optimized_compare := e
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb71output (
            qual_st         : tgg00_StEntryAddr;
            VAR sel         : tgg00_SelectFieldsParam;
            output_col_cnt  : integer;
            result_size     : tsp00_Int4;
            result_addr     : tsp00_MoveObjPtr;
            VAR result_len  : tsp00_Int2;
            VAR build_rec   : boolean;
            VAR pos_var_cnt : integer;
            VAR var_cnt     : integer;
            VAR e           : tgg00_BasisError);
 
VAR
      undef        : boolean;
      def_byte     : char;
      op_out       : tgg00_StackOpOutput;
      out_pos      : integer;
      col_len      : integer;
      required_len : integer;
      i            : integer;
      i2           : tsp_int_map_c2;
      operand_addr : tsp00_MoveObjPtr;
      fill_char    : char;
 
LABEL
      999;
 
BEGIN
REPEAT
    undef := true;
    IF  qual_st^.eop_out = op_o_output_outer_join
    THEN
        op_out := op_o_none
    ELSE
        op_out := qual_st^.eop_out;
    (*ENDIF*) 
    required_len := qual_st^.elen_var;
    k71get_operand (sel, op_out = op_o_output_no_oflw,
          operand_addr, col_len, e);
    IF  e <> e_ok
    THEN
        goto 999;
    (*ENDIF*) 
    def_byte := operand_addr^[1];
    IF  qual_st^.etype = st_output_build_rec
    THEN
        build_rec := true;
    (*ENDIF*) 
    IF  (op_out = op_o_output_key    ) OR
        (op_out = op_o_output_var    ) OR
        (op_out = op_o_output_longvar)
    THEN
        BEGIN
        IF  col_len > 0
        THEN
            BEGIN
            IF  def_byte = csp_undef_byte
            THEN
                col_len := 0
            ELSE
                IF  def_byte = csp_oflw_byte
                THEN
                    BEGIN
                    e := e_special_null;
                    goto 999;
                    END
                ELSE
                    BEGIN
                    undef   := false;
                    col_len := a05lnr_space_defbyte (sel.sfp_acv_addr, operand_addr,
                          def_byte, 2, col_len-1) + 1
                    END;
                (*ENDIF*) 
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        IF  undef AND (op_out = op_o_output_key)
        THEN
            BEGIN
            e := e_null_value_illegal;
            goto 999;
            END
        ELSE
            IF  col_len > required_len
            THEN
                BEGIN
                e := e_column_trunc;
                goto 999;
                END;
            (*ENDIF*) 
        (*ENDIF*) 
        IF  build_rec AND (pos_var_cnt = 0) AND
            ((op_out = op_o_output_var) OR
            (op_out = op_o_output_longvar))
        THEN
            BEGIN
            IF  qual_st^.epos > 0
            THEN
                result_len := qual_st^.epos - 1;
            (*ENDIF*) 
            pos_var_cnt := result_len + 1;
            IF  result_len > result_size
            THEN
                BEGIN
                e := e_buffer_limit;
                goto 999;
                END
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        IF  (pos_var_cnt > 0) AND (op_out = op_o_output_var)
        THEN
            var_cnt := succ(var_cnt);
        (*ENDIF*) 
        IF  NOT undef
        THEN
            BEGIN
            IF  op_out = op_o_output_var
            THEN
                BEGIN
                result_len := result_len + 1;
                IF  result_len > result_size
                THEN
                    BEGIN
                    e := e_buffer_limit;
                    goto 999;
                    END
                ELSE
                    result_addr^ [result_len] := chr(col_len);
                (*ENDIF*) 
                END
            ELSE
                IF  op_out = op_o_output_longvar
                THEN
                    BEGIN
                    result_len := result_len + 2;
                    IF  result_len > result_size
                    THEN
                        BEGIN
                        e := e_buffer_limit;
                        goto 999;
                        END
                    ELSE
                        BEGIN
                        i2.map_int := col_len;
                        result_addr^ [result_len-1] := i2.map_c2 [1];
                        result_addr^ [result_len]   := i2.map_c2 [2];
                        END;
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
            (*ENDIF*) 
            IF  col_len > 0
            THEN
                IF  result_len + col_len > result_size
                THEN
                    BEGIN
                    e := e_buffer_limit;
                    goto 999;
                    END
                ELSE
                    BEGIN
                    g10mv ('VKB71 ',  41,    
                          col_len, result_size,
                          @operand_addr^, 1,
                          @result_addr^, result_len+1, col_len, e);
                    result_len := result_len + col_len
                    END;
                (*ENDIF*) 
            (*ENDIF*) 
            IF  op_out = op_o_output_key
            THEN
                BEGIN
                i2.map_int := result_len - cgg_rec_key_offset;
                result_addr^ [3] := i2.map_c2  [1];
                result_addr^ [4] := i2.map_c2  [2]
                END
            (*ENDIF*) 
            END
        ELSE
            IF  op_out = op_o_output_longvar
            THEN
                BEGIN
                IF  result_len + 3 > result_size
                THEN
                    BEGIN
                    e := e_buffer_limit;
                    goto 999;
                    END
                ELSE
                    BEGIN
                    i2.map_int := 1;
                    result_addr^ [result_len+1] := i2.map_c2 [1];
                    result_addr^ [result_len+2] := i2.map_c2 [2];
                    result_addr^ [result_len+3] := csp_undef_byte;
                    result_len := result_len + 3
                    END
                (*ENDIF*) 
                END
            ELSE
                BEGIN
                IF  result_len + 2 > result_size
                THEN
                    BEGIN
                    e := e_buffer_limit;
                    goto 999;
                    END
                ELSE
                    BEGIN
                    result_addr^ [result_len+1] := chr(1);
                    result_addr^ [result_len+2] := csp_undef_byte;
                    result_len := result_len + 2
                    END
                (*ENDIF*) 
                END
            (*ENDIF*) 
        (*ENDIF*) 
        END
    ELSE
        IF  op_out <> op_o_output_later
        THEN
            BEGIN
            IF  qual_st^.epos = 0
            THEN
                out_pos := result_len + 1
            ELSE
                out_pos := qual_st^.epos - sel.sfp_output_offset;
            (*ENDIF*) 
            IF  op_out = op_o_output_not_fill
            THEN
                BEGIN
                (* a single output value is guaranteed by VAK505, VAK651 *)
                (* constant values expressions                           *)
                IF  def_byte = csp_undef_byte
                THEN
                    col_len := 0;
                (*ENDIF*) 
                IF  col_len > required_len
                THEN
                    BEGIN
                    col_len := a05lnr_space_defbyte (sel.sfp_acv_addr, operand_addr,
                          def_byte, 2, col_len-1) + 1;
                    IF  col_len > required_len
                    THEN
                        BEGIN
                        e := e_column_trunc;
                        goto 999;
                        END
                    (*ENDIF*) 
                    END
                ELSE
                    IF  (def_byte = csp_defined_byte)   AND
                        (qual_st^.ecol_tab [1] = chr(0))
                    THEN
                        col_len := a05lnr_space_defbyte (sel.sfp_acv_addr,
                              operand_addr, csp_defined_byte,
                              2, col_len-1) + 1;
                    (*ENDIF*) 
                (*ENDIF*) 
                IF  col_len > 0
                THEN
                    BEGIN
                    IF  col_len > result_size
                    THEN
                        BEGIN
                        e := e_buffer_limit;
                        goto 999;
                        END;
                    (*ENDIF*) 
                    SAPDB_PascalOverlappingMove ('VKB71 ',  42,    
                          col_len, result_size,
                          @operand_addr^, 1,
                          @result_addr^, out_pos, col_len, e)
                    END
                ELSE
                    BEGIN
                    result_addr^ [out_pos] := csp_undef_byte;
                    col_len := 1
                    END;
                (*ENDIF*) 
                result_len := col_len;
                END
            ELSE
                BEGIN
                IF  out_pos + required_len - 1 > result_len
                THEN
                    BEGIN
                    result_len := out_pos + required_len - 1;
                    IF  result_len > result_size
                    THEN
                        BEGIN
                        e := e_buffer_limit;
                        goto 999;
                        END;
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
                IF  def_byte = csp_oflw_byte
                THEN
                    BEGIN
                    IF  NOT (op_out in
                        [op_o_output_hold, op_o_output_oflw,
                        op_o_output, op_o_output_order])
                    THEN
                        BEGIN
                        e := e_special_null;
                        goto 999;
                        END;
                    (*ENDIF*) 
                    END
                ELSE
                    IF  (def_byte = csp_undef_byte) AND
                        (op_out = op_o_output_fixkey)
                    THEN
                        col_len := 0;
                    (*ENDIF*) 
                (*ENDIF*) 
                IF  (col_len > 1) AND
                    ((op_out = op_o_output_fixkey) OR
                    (col_len > required_len))
                THEN
                    col_len := a05lnr_space_defbyte (sel.sfp_acv_addr, operand_addr,
                          def_byte, 2, col_len-1) + 1;
                (*ENDIF*) 
                IF  (def_byte = csp_undef_byte)
                    AND (col_len > required_len)
                    AND (col_len > 1)
                    AND ((op_out = op_o_none) OR
                    (     op_out = op_o_output_fixcol))
                THEN
                    (* do NOT use col_len := 0; then *)
                    (* concatenated columns with the *)
                    (* first one with NULL will be   *)
                    (* filled all with x'00'         *)
                    col_len := a05lnr_space_defbyte (sel.sfp_acv_addr, operand_addr,
                          csp_defined_byte,
                          2, col_len-1) + 1;
                (*ENDIF*) 
                IF  col_len > required_len
                THEN
                    BEGIN
                    e := e_column_trunc;
                    goto 999;
                    END;
                (*ENDIF*) 
                IF  col_len > 0
                THEN
                    SAPDB_PascalOverlappingMove ('VKB71 ',  43,    
                          col_len, result_size,
                          @operand_addr^, 1,
                          @result_addr^, out_pos, col_len, e)
                ELSE
                    IF  op_out = op_o_output_fixkey
                    THEN
                        BEGIN
                        e := e_null_value_illegal;
                        goto 999;
                        END
                    ELSE
                        BEGIN
                        result_addr^ [out_pos] := csp_undef_byte;
                        col_len := 1
                        END;
                    (*ENDIF*) 
                (*ENDIF*) 
                IF  required_len > col_len
                THEN
                    IF  def_byte = csp_unicode_def_byte
                    THEN
                        BEGIN
                        SAPDB_PascalUnicodeFill ('VKB71 ',  44,    
                              result_size, @result_addr^,
                              out_pos + col_len, required_len - col_len,
                              csp_unicode_blank, e)
                        END
                    ELSE
                        BEGIN
                        IF  (result_addr^ [out_pos] = csp_undef_byte)
                        THEN
                            fill_char := csp_defined_byte
                        ELSE
                            fill_char := result_addr^ [out_pos];
                        (*ENDIF*) 
                        SAPDB_PascalFill ('VKB71 ',  45,    
                              result_size, @result_addr^,
                              out_pos + col_len,
                              required_len - col_len, fill_char, e);
                        (* ++++ elen_var - col_len, ecol_tab [1]) ++++*)
                        END;
                    (*ENDIF*) 
                (*ENDIF*) 
                IF  op_out = op_o_output_order
                THEN (* i:=0 => incl. defined_byte *)
                    FOR i:= 0 TO required_len-1 DO
                        result_addr^ [out_pos+i]:= chr(255
                              - ord(result_addr^ [out_pos+i]));
                    (*ENDFOR*) 
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
    (*ENDIF*) 
    output_col_cnt := output_col_cnt - 1;
    IF  output_col_cnt > 0
    THEN
        BEGIN
        sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, 2);
        qual_st             := s35inc_st (qual_st, 2)
        END;
    (*ENDIF*) 
UNTIL
    output_col_cnt <= 0;
(*ENDREPEAT*) 
IF  op_out <> op_o_output_hold
THEN
    sel.sfp_workbuf_len := 0;
(*ENDIF*) 
999 : ;
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb71output_dbproc_param (
            VAR sel     : tgg00_SelectFieldsParam;
            VAR qual_st : tgg00_StackEntry;
            VAR e       : tgg00_BasisError);
 
VAR
 
      dataType      : RECORD
            CASE boolean OF
                true :
                    (c : tsp00_C1);
                false :
                    (dt : tsp00_DataType);
                END;
            (*ENDCASE*) 
 
      operand_addr  : tsp00_MoveObjPtr;
      operand_len   : integer;
 
LABEL
      999;
 
BEGIN
e := e_ok;
IF  qual_st.epos > 0
THEN
    BEGIN
    k71get_operand (sel,
          NOT c_check_spec_null, operand_addr, operand_len, e);
    IF  e = e_ok
    THEN
        BEGIN
        sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, -1);
        END
    ELSE
        goto 999;
    (*ENDIF*) 
    END
ELSE
    BEGIN
    qual_st.ecol_tab[1] := chr(0); (* has been uninitialized till 7.3.0.22 *)
    operand_addr        := NIL;
    END;
(*ENDIF*) 
IF  qual_st.ecol_tab[1] = chr(true)
THEN
    a262ReturnCursor (sel.sfp_acv_addr, operand_addr, operand_len, e)
ELSE
    BEGIN
    dataType.c[1] := qual_st.ecol_tab[2];
    a262ReturnParam (sel.sfp_acv_addr, dataType.dt, operand_addr, operand_len, e);
    END;
(*ENDIF*) 
999 : ;
END;
 
(*------------------------------*) 
 
FUNCTION
      kb71phonmatch (
            VAR workbuf  : tkb07_buffer_description;
            VAR val      : tsp00_MoveObj;
            val_pos      : tsp00_Int4;
            val_len      : tsp00_Int4;
            VAR pat      : tsp00_MoveObj;
            pat_pos      : tsp00_Int4;
            pat_len      : tsp00_Int4): boolean;
 
VAR
      match   : boolean;
      compare : ARRAY  [1..2] OF tsp00_C4;
      e       : tgg00_BasisError;
 
BEGIN
match := false;
IF  (val_len > 0) AND (pat_len > 0)
THEN
    BEGIN
    e := e_ok;
    kb71matchvalue (workbuf,
          val, val_pos, val_len, workbuf.buffer_len, compare [1], e);
    kb71matchvalue (workbuf,
          pat, pat_pos, pat_len, workbuf.buffer_len+val_len, compare [2], e);
    match := (e = e_ok) AND (compare [1] = compare [2])
    END;
(*ENDIF*) 
kb71phonmatch := match
END;
 
(* PTS 1112385 *)
(*------------------------------*) 
 
PROCEDURE
      kb71InternalFunction(
            VAR sel    : tgg00_SelectFieldsParam;
            StackEntry : tgg00_StackEntry;
            VAR e      : tgg00_BasisError);
 
BEGIN
IF  s35ge_bufaddr (sel.sfp_work_st_top,sel.sfp_work_st_last)
THEN
    e := e_stack_overflow
ELSE
    BEGIN
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, 1);
    a262InternalFunction(
          StackEntry,
          sel.sfp_workbuf_addr^, sel.sfp_workbuf_size,
          sel.sfp_workbuf_len + 1, e);
    sel.sfp_work_st_top^.etype        := st_result;
    sel.sfp_work_st_top^.eop          := op_none;
    sel.sfp_work_st_top^.epos         := sel.sfp_workbuf_len + 1;
    sel.sfp_work_st_top^.elen_var     := StackEntry.elen_var;
    sel.sfp_work_st_top^.ecol_tab [1] := chr(0);
    sel.sfp_work_st_top^.ecol_tab [2] := chr(0);
    sel.sfp_workbuf_len               := sel.sfp_workbuf_len + StackEntry.elen_var;
    END;
(*ENDIF*) 
&ifdef TRACE
t01sname (kb_qual, '=== result: ');
WITH sel.sfp_work_st_top^ DO
    t01moveobj (kb_qual, sel.sfp_workbuf_addr^, epos, epos + elen_var - 1);
(*ENDWITH*) 
&endif
END;
 
(*------------------------------*) 
 
FUNCTION
      kb71invalid (
            VAR t   : tgg00_TransContext;
            VAR sel : tgg00_SelectFieldsParam;
            VAR st  : tgg00_StackEntry) : tgg00_BasisError;
&     ifdef TRACE
 
VAR
      e : tgg00_BasisError;
      i : integer;
&     endif
 
BEGIN
&ifdef TRACE
(* The following code exists to make usecheck happy.     *)
(* The parameters are necessary, because the             *)
(* the procedure is called by a pointer from             *)
(* an array of procedure pointers, i.e. all              *)
(* those procedures must have the same formal parameters *)
e := t.trError_gg00;
i := ord(sel.sfp_optimized);
i := ord(st.etype);
&endif
kb71invalid := e_stack_type_illegal
END;
 
(*------------------------------*) 
 
PROCEDURE
      k71qual_handling (
            VAR t              : tgg00_TransContext;
            VAR sel            : tgg00_SelectFieldsParam;
            with_view          : boolean;
            check_new_rec      : boolean;
            VAR stack_desc     : tgg00_StackDesc;
            VAR err_st_ptr     : tgg00_StEntryAddr;
            VAR unqualified    : boolean);
 
VAR
      _is_first_col          : boolean;
      _is_view_qual          : boolean;
      _constraint_check      : boolean;
      _build_rec             : boolean;
      _isDBProcCall          : boolean;
      _isDBFuncCall          : boolean;
      _isDebug               : boolean;
      _e_type                : tgg00_StackEntryType;
      _e_op                  : tgg00_StackOpType;
      _e                     : tgg00_BasisError;
      _qual_offset           : integer;
      _last_qual             : integer;
      _continue_index        : integer;
      _codePos               : integer;
      _codeLength            : integer;
      _qualptr               : tsp00_Int4;
      _err_qualptr           : integer;
      _pos_var_count         : integer;
      _var_count             : integer;
      _cnt                   : integer;
      _initWorkBufLength     : integer;
      _optimize_ptr          : tsp00_MoveObjPtr;
      _curr_st               : tgg00_StEntryAddr;
      _aux_st                : tgg00_StEntryAddr;
      _work_st_last          : tgg00_StEntryAddr;
      _work_st_bottom        : tgg00_StEntryAddr;
      _constraint_err_st     : tgg00_StEntryAddr;
      _rec_ptr               : tgg00_RecPtr;
      _output_state          : (skip_output, create_output, output_created);
      _keylen                : tsp00_Int2;
 
      _op : RECORD
            CASE boolean OF
                true :
                    (c : tsp00_C1);
                false :
                    (o : tgg00_StackOpType);
                END;
            (*ENDCASE*) 
 
      _continueStack : ARRAY[0..MAX_CATCH_LEVEL_GG04] OF tsp00_Int2;
 
LABEL
      999;
 
BEGIN
_e            := e_ok;
(*unqualified := false; is done already when necessary *)
_isDBProcCall := ( sel.sfp_bd_mess_type = m_procedure );
IF  _isDBProcCall
THEN
    BEGIN
    _isDebug      := a101_DebuggerActive(t);
    _isDBFuncCall := sel.sfp_bd_mess2_type = mm_ignore;
    END
ELSE
    BEGIN
    _isDebug      := false;
    _isDBFuncCall := false;
    END;
(*ENDIF*) 
IF  ( stack_desc.mst_optimize_pos > 0 )
THEN
    _optimize_ptr := @sel.sfp_data_addr^[ stack_desc.mst_optimize_pos ]
ELSE
    _optimize_ptr := NIL;
(*ENDIF*) 
&ifdef trace
IF  _optimize_ptr <> NIL
THEN
    BEGIN
    t01sname( kb_qual, 'optim info  ' );
    t01moveobj( kb_qual, _optimize_ptr^, 1, stack_desc.mqual_cnt );
    END;
&endif
(*ENDIF*) 
_build_rec     := false;
_pos_var_count := 0;
_var_count     := 0;
BEGIN
&ifdef TRACE
IF  t01trace (kb_qual)
THEN
    BEGIN
    t01bool (kb_qual, 'check_new_re', check_new_rec);
    CASE sel.sfp_bd_inv_only OF
        primary_only    :
            t01name (kb_qual, 'primary_only      ');
        inv_only        :
            t01name (kb_qual, 'inv_only          ');
        inv_and_primary :
            t01name (kb_qual, 'inv_and_primary   ');
        OTHERWISE
        END;
    (*ENDCASE*) 
    t01buf (kb_qual, sel.sfp_rec_addr^, 1, sel.sfp_rec_len);
    IF  sel.sfp_primkey_addr <> NIL
    THEN
        t01buf1 (kb_qual, sel.sfp_primkey_addr^, 1, sel.sfp_rec_key_len)
    ELSE
        IF  sel.sfp_oldrec_addr <> NIL
        THEN
            t01moveobj (kb_qual, sel.sfp_oldrec_addr^,
                  sel.sfp_oldrec_pos,
                  sel.sfp_oldrec_pos + sel.sfp_oldrec_len - 1)
        (*ENDIF*) 
    (*ENDIF*) 
    END;
&endif
(*ENDIF*) 
err_st_ptr    := NIL;
_is_view_qual := false;
IF  ( sel.sfp_bd_inv_only <> inv_and_primary )
THEN
    sel.sfp_rows_read := succ( sel.sfp_rows_read );
(*ENDIF*) 
sel.sfp_varcol_pos.vpl_last := -1;
IF  _isDBFuncCall
THEN
    _work_st_bottom := sel.sfp_work_st_top
ELSE
    _work_st_bottom := @sel.sfp_work_st_addr^[1];
(*ENDIF*) 
_work_st_last               := @sel.sfp_work_st_addr^[ sel.sfp_work_st_max ];
sel.sfp_work_st_bottom      := _work_st_bottom;
sel.sfp_work_st_last        := _work_st_last;
sel.sfp_check_new_rec       := check_new_rec;
_constraint_check           := false;
IF  ( sel.sfp_first_qual )
THEN
    BEGIN
    IF  ( sel.sfp_bd_inv_only = inv_and_primary )
    THEN
        BEGIN
        _optimize_ptr := NIL;
        _qual_offset  := stack_desc.minvqual_pos - 1;
        _last_qual    := _qual_offset + stack_desc.minvqual_cnt;
        _qualptr      := _qual_offset + 1;
        _output_state := output_created;
        END
    ELSE
        BEGIN
        _qual_offset  := stack_desc.mqual_pos - 1;
        _last_qual    := _qual_offset + stack_desc.mqual_cnt;
        _output_state := skip_output;
        _qualptr      := _qual_offset + 1;
        IF  ( _qualptr > 0 )
        THEN
            IF  stack_desc.mst_addr^[ _qualptr ].etype = st_jump_output
            THEN
                _qualptr := _qual_offset +
                      stack_desc.mst_addr^[ _qualptr ].epos;
            (*ENDIF*) 
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END
ELSE
    BEGIN
    IF  ( sel.sfp_bd_inv_only = inv_and_primary )
    THEN
        _output_state := output_created
    ELSE
        _output_state := create_output;
    (*ENDIF*) 
    IF  ( with_view )
    THEN
        BEGIN
        _is_view_qual := true;
        _qual_offset  := stack_desc.mview_pos - 1;
        _last_qual    := _qual_offset + stack_desc.mview_cnt
        END
    ELSE
        BEGIN
        _constraint_check := true;
        _optimize_ptr     := NIL;
        _qual_offset      := stack_desc.mupd_pos - 1;
        _last_qual        := _qual_offset + stack_desc.mupd_cnt
        END;
    (*ENDIF*) 
    _qualptr := _qual_offset + 1
    END;
(*ENDIF*) 
_constraint_err_st         := NIL;
sel.sfp_optimized          := ( _optimize_ptr <> NIL );
sel.sfp_work_st_top        := _work_st_bottom;
IF  NOT _isDBFuncCall
THEN
    BEGIN
    sel.sfp_work_st_top^.etype := st_dummy;
    sel.sfp_workbuf_len        := 0;
    END;
(*ENDIF*) 
_initWorkBufLength         := sel.sfp_workbuf_len;
_err_qualptr               := _qualptr;
REPEAT
    WHILE _qualptr <= _last_qual DO
        BEGIN
        IF  _isDebug AND
            a262StatementBeginStackEntry(sel.sfp_acv_addr, sel, _qualptr, _codePos, _codeLength)
        THEN
            a101_DebuggerCheckDebugBreak(t, sel, _qualptr, sel.sfp_oldrec_addr, _codePos, _codeLength);
        (*ENDIF*) 
        _curr_st := s35inc_st( @stack_desc.mst_addr^[ 1 ], _qualptr - 1 );
&       ifdef trace
        t01name       (kb_qual, 'stack-entry       ');
        t01stackentry (kb_qual, _curr_st^, _qualptr);
&       endif
        _err_qualptr := _qualptr;
        IF  ( sel.sfp_work_st_top = _work_st_bottom )
        THEN
            _is_first_col := true;
        (*ENDIF*) 
        sel.sfp_workbuf_top := sel.sfp_workbuf_len;
        _e_type             := _curr_st^.etype;
        ;
        IF  ( _e_type <= st_value )
        THEN
            BEGIN
            IF  ( _optimize_ptr <> NIL ) AND
                ( s35add_moveobj_ptr( _optimize_ptr,
                _qualptr - 1 - _qual_offset )^[ 1 ] > chr( 0 ))
            THEN
                BEGIN
                (* push more than one operand *)
                _cnt       := ord( s35add_moveobj_ptr( _optimize_ptr,
                      _qualptr - 1 - _qual_offset )^[ 1 ]);
                _op.c[ 1 ] := s35add_moveobj_ptr( _optimize_ptr,
                      _qualptr - _qual_offset )^[ 1 ];
                IF  s35ge_bufaddr( s35inc_st( sel.sfp_work_st_top, _cnt ),
                    _work_st_last )
                THEN
                    BEGIN
                    _e := e_stack_overflow;
                    goto 999
                    END
                ELSE
                    BEGIN
                    IF  ( _is_first_col AND
                        ( _e_type <= st_varlongchar ))
                    THEN
                        BEGIN
                        _is_first_col := false;
                        err_st_ptr   := _curr_st
                        END;
                    (*ENDIF*) 
                    IF  ( _cnt = 1 )
                    THEN
                        IF  ( _output_state = create_output )
                        THEN
                            BEGIN
                            IF  ( sel.sfp_result_wanted )
                            THEN
                                BEGIN
                                _aux_st := sel.sfp_work_st_top;
                                sel.sfp_work_st_top := _curr_st;
                                _curr_st := s35inc_st( _curr_st, 1 );
                                _cnt     := ord( _op.c[ 1 ] );
                                kb71output( _curr_st, sel, _cnt,
                                      sel.sfp_m_result_size,
                                      sel.sfp_m_result_addr,
                                      sel.sfp_result_length,
                                      _build_rec, _pos_var_count,
                                      _var_count, _e );
                                sel.sfp_work_st_top := _aux_st;
                                _qualptr := _qualptr + 2 * _cnt - 1;
                                END
                            (*ENDIF*) 
                            END
                        ELSE
                            BEGIN
                            (* comparison without pushing of *)
                            (* operands                      *)
                            _is_first_col := true;
                            _e := kb71optimized_compare( t,
                                  sel, _op.o, _curr_st, _qualptr );
                            END
                        (*ENDIF*) 
                    ELSE
                        BEGIN (* push cnt operands *)
                        g10mv ('VKB71 ',  46,    
                              ( _last_qual - _qualptr + 1 ) *
                              sizeof( tgg00_StackEntry ),
                              sel.sfp_work_st_size,
                              @_curr_st^, 1, @sel.sfp_work_st_top^,
                              sizeof( tgg00_StackEntry ) + 1,
                              _cnt * sizeof( tgg00_StackEntry ), _e);
                        IF  ( _e <> e_ok )
                        THEN
                            goto 999;
                        (*ENDIF*) 
                        _qualptr := _qualptr + _cnt - 1;
                        _curr_st := s35inc_st( _curr_st, _cnt - 1 );
                        sel.sfp_work_st_top :=
                              s35inc_st( sel.sfp_work_st_top, _cnt );
                        IF  ( _op.o <> op_none )
                        THEN
                            BEGIN
                            IF  ( _op.o >= op_is_integer )
                            THEN
                                _is_first_col := true;
                            (*ENDIF*) 
                            IF  ( _curr_st^.eop <> _op.o )
                            THEN
                                BEGIN
                                (* operator not included in last *)
                                (* operand stack entry           *)
                                _qualptr := _qualptr + 1;
                                _curr_st := s35inc_st( _curr_st, 1 );
                                END;
                            (* The following statement calls the *)
                            (* function where                    *)
                            (* kb71op_call[op.o] is pointing to  *)
                            (* with parameters t, sel, curr_st^. *)
                            (* This is no real PASCAL code !     *)
                            (*ENDIF*) 
                            _e := s35op_case( kb71op_call[_op.o],
                                  t, sel, _curr_st^ );
                            END;
                        (*ENDIF*) 
                        END;
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
                END
            ELSE
                BEGIN (* push one operand *)
                _e_op := _curr_st^.eop;
                IF  ( s35ge_bufaddr( sel.sfp_work_st_top, _work_st_last ))
                THEN
                    BEGIN
                    _e := e_stack_overflow;
                    goto 999
                    END
                ELSE
                    BEGIN
                    sel.sfp_work_st_top :=
                          s35inc_st( sel.sfp_work_st_top, 1 );
                    IF  ( _is_first_col AND ( _e_type <= st_varlongchar ))
                    THEN
                        BEGIN
                        _is_first_col := false;
                        err_st_ptr   := _curr_st
                        END;
                    (*ENDIF*) 
                    IF  ( _e_type = st_get_subquery )
                    THEN
                        BEGIN
                        kb71get_subquery_value( t, sel, _curr_st^ );
                        IF  ( _e <> e_ok )
                        THEN
                            goto 999
                        (*ENDIF*) 
                        END
                    ELSE
                        sel.sfp_work_st_top^ := _curr_st^;
                    (*ENDIF*) 
                    IF  ( _e_op <> op_none )
                    THEN
                        IF  (_e_op >= op_order_asc) AND
                            (_e_op <= op_filler8)
                        THEN
                            IF  (_e_op = op_order_asc )
                                OR
                                (_e_op = op_unique    )
                                OR
                                (((_e_op = op_order_desc ) OR
                                (  _e_op = op_unique_desc))
                                AND (_e_type <> st_fixinv)
                                AND (_e_type <> st_varinv))
                            THEN
                                _e_op := op_none;
                            (*ENDIF*) 
                        (*ENDIF*) 
                    (*ENDIF*) 
                    IF  ( _e_op <> op_none )
                    THEN
                        BEGIN
                        IF  ( _e_op >= op_is_integer )
                        THEN
                            _is_first_col := true;
                        (* The following statement calls the function *)
                        (* kb71op_call[e_op] is pointing to with      *)
                        (* parameters t, sel, curr_st^.               *)
                        (* This is no real PASCAL code !              *)
                        (*ENDIF*) 
                        _e := s35op_case( kb71op_call[_e_op],
                              t, sel, _curr_st^ );
                        END;
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            END
        ELSE
            (* _e_type > st_value *)
            CASE _e_type OF
                st_op :
                    BEGIN
                    _e_op := _curr_st^.eop;
                    IF  _e_op >= op_is_integer
                    THEN
                        BEGIN
                        _is_first_col := true;
                        IF  ( _optimize_ptr <> NIL ) AND
                            ( _e_op in [op_and, op_or] )
                        THEN
                            _qualptr := _qualptr + _curr_st^.epos;
                        (*ENDIF*) 
                        END;
                    (* The following statement calls the function *)
                    (* kb71op_call[e_op] is pointing to with      *)
                    (* parameters t, sel, curr_st^.               *)
                    (* This is no real PASCAL code !              *)
                    (*ENDIF*) 
                    _e := s35op_case( kb71op_call[_e_op],
                          t, sel, _curr_st^ );
                    END;
                st_build_in_func:
                    CASE _curr_st^.eop_build_in OF
                        op_b_check_format, op_b_datetime,
                        op_b_format_change, op_b_next_day,
                        op_b_ts_trunc, op_b_ts_round,
                        op_b_new_time, op_b_dayofmonth :
                            _e := k79date_time (t, sel, _curr_st^);
                        op_b_currval :
                            BEGIN
                            k78currval (t, _curr_st^, sel);
                            _e := t.trError_gg00
                            END;
                        op_b_exp, op_b_ln, op_b_log,
                        op_b_sin, op_b_sinh,
                        op_b_cos, op_b_cosh,
                        op_b_tan, op_b_tanh,
                        op_b_acos, op_b_asin,
                        op_b_atan, op_b_log10,
                        op_b_degrees, op_b_radians,
                        op_b_cot, op_b_atan2 :
                            _e := kb71op_func_arith (t, sel, _curr_st^);
                        OTHERWISE
                            k78build_in_func (_curr_st^, sel, _e)
                        END;
                    (*ENDCASE*) 
                st_datetime_arith:
                    _e := k79date_time (t, sel, _curr_st^);
                st_dummy :
                    BEGIN
                    IF  _constraint_check AND
                        (_qualptr = stack_desc.mupd_pos) AND
                        (_curr_st^.ecol_pos <> 0)
                    THEN
                        _constraint_err_st := _curr_st;
                    (*ENDIF*) 
                    _e := e_ok
                    END;
                st_func:
                    IF  _curr_st^.eop_func = op_f_count_kb
                    THEN
                        BEGIN
                        _qualptr := _qualptr + 1;
                        IF  s35inc_st (_curr_st, 1)^.eop_out =
                            op_o_output_hold
                        THEN
                            _qualptr := _qualptr + 1;
                        (*ENDIF*) 
                        unqualified       := true;
                        _e                 := e_qual_violation;
                        sel.sfp_rows_qual := sel.sfp_rows_qual + 1;
                        sel.sfp_act_cntresult :=
                              succ (sel.sfp_act_cntresult)
                        END
                    ELSE
                        BEGIN
                        _e := e_ok;
                        IF  _curr_st^.eop_func  in
                            [op_f_all_count, op_f_check_null]
                        THEN
                            BEGIN
                            (* skip st_output *)
                            _qualptr := _qualptr + 1;
                            IF  s35inc_st (_curr_st, 1)^.eop_out =
                                op_o_output_hold
                            THEN
                                _qualptr := _qualptr + 1
                            (*ENDIF*) 
                            END
                        (*ENDIF*) 
                        END;
                    (*ENDIF*) 
                st_jump_absolute :
                    _qualptr := _qualptr + _curr_st^.epos;
                st_jump_false:
                    BEGIN
                    IF  (sel.sfp_work_st_top^.epos = cgg04_is_false)
                    THEN
                        _qualptr :=
                              _qualptr + _curr_st^.epos - 1
                    ELSE
                        BEGIN
                        IF  _constraint_check AND
                            (_curr_st^.ecol_pos <> 0)
                        THEN
                            _constraint_err_st := _curr_st;
                        (*ENDIF*) 
                        IF  check_new_rec AND
                            (_curr_st^.eop = op_jmp_ins_upd)
                        THEN
                            _qualptr := _qualptr +
                                  _curr_st^.elen_var - 1
                        (*ENDIF*) 
                        END;
                    (*ENDIF*) 
                    IF  _isDBProcCall AND (_curr_st^.ecol_tab[1] = chr(1))
                    THEN
                        sel.sfp_work_st_top :=
                              s35inc_st (sel.sfp_work_st_top, - 1)
                    (*ENDIF*) 
                    END;
                st_jump_output:
                    IF  (_output_state = skip_output)
                    THEN
                        _qualptr := _qual_offset +
                              _curr_st^.epos - 1;
                    (*ENDIF*) 
                st_jump_true:
                    IF  sel.sfp_work_st_top^.epos = cgg04_is_true
                    THEN
                        _qualptr :=
                              _qualptr + _curr_st^.epos - 1;
                    (*ENDIF*) 
                st_mass_compare :
                    kb71mass_compare (_curr_st^, sel, _e);
                st_noround:
                    _e := kb71number_to_value (t, sel, _curr_st^);
                st_output, st_output_build_rec:
                    BEGIN
                    IF  sel.sfp_result_wanted
                    THEN
                        kb71output (_curr_st, sel, 0,
                              sel.sfp_m_result_size,
                              sel.sfp_m_result_addr,
                              sel.sfp_result_length,
                              _build_rec, _pos_var_count,
                              _var_count, _e);
                    (*ENDIF*) 
                    IF  _curr_st^.eop_out <> op_o_output_hold
                    THEN
                        sel.sfp_work_st_top :=
                              s35inc_st (sel.sfp_work_st_top, - 1)
                    (*ENDIF*) 
                    END;
                st_output_catalog :
                    kb71catalog_output (_curr_st^, sel,
                          sel.sfp_m_result_size,
                          sel.sfp_m_result_addr,
                          sel.sfp_result_length, _e);
                st_rec_output:
                    BEGIN
                    g10mv ('VKB71 ',  47,    
                          sizeof(sel.sfp_rec_addr^),
                          sel.sfp_m_result_size,
                          @sel.sfp_rec_addr^, 1,
                          @sel.sfp_m_result_addr^, 1, sel.sfp_rec_len, _e);
                    sel.sfp_result_length := sel.sfp_rec_len
                    END;
                st_result:
                    CASE _curr_st^.eop OF
                        op_ascii, op_ebcdic, op_date,
                        op_hex, op_time, op_timestamp, op_not, op_not_in :
                            kb71result_value (_curr_st^, sel, _e);
                        op_eq_all :
                            kb71catalog_column (_curr_st^, sel, _e);
                        op_copy :
                            IF  sel.sfp_work_st_top^.etype <> st_result
                            THEN
                                kb71result_copy (_curr_st^, sel, _e);
                            (*ENDIF*) 
                        OTHERWISE
                            _e := kb71number_to_value (t,
                                  sel, _curr_st^);
                        END;
                    (*ENDCASE*) 
                st_rowno:
                    kb71rowno (_curr_st^,
                          sel.sfp_act_cntresult, sel, _e);
                st_strat:
                    _e := e_ok;
                st_subquery:
                    IF  _curr_st^.eop = op_get_sub_value
                    THEN
                        BEGIN
                        k71sub_value_get (t, _curr_st^, sel.sfp_data_addr, sel.sfp_data_size);
                        (* next time you will find a st_value here *)
                        _e := t.trError_gg00;
                        IF  ( _e <> e_ok )
                        THEN
                            goto 999;
                        (*ENDIF*) 
                        _qualptr := _qualptr - 1;
                        END
                    ELSE
                        kb71op_subquery (t, _curr_st^, sel, _e);
                    (*ENDIF*) 
                st_sum_length :
                    _e := e_ok;
                st_truth :
                    kb71truth (_curr_st^, sel, _e);
                st_parseid :
                    BEGIN
                    a101_ExecuteSqlStatement (sel.sfp_acv_addr,
                          sel, sel.sfp_oldrec_addr, stack_desc.mst_addr^, _qualptr, _e);
                    _continueStack[ord(_curr_st^.ecol_tab[1])] := _qualptr + 2;
&                   ifdef trace
                    t01p2int4 (kb_qual, 'continueIdx ', ord(_curr_st^.ecol_tab[1]), 'continueStpt',
                          _continueStack[ord(_curr_st^.ecol_tab[1])]);
&                   endif
                    END;
                st_dyn_sql :
                    kb71DynamicSQL (sel, _e);
                st_stop :
                    IF  _isDBFuncCall
                    THEN
                        BEGIN
                        IF  _curr_st^.eop = op_null
                        THEN
                            kb71PushNull (sel, _e);
                        (*ENDIF*) 
                        goto 999
                        END
                    ELSE
                        BEGIN
                        kb71stop (sel, _curr_st^.epos, _curr_st^.elen_var, _e);
                        IF  _curr_st^.epos > 0
                        THEN
                            _output_state := output_created;
                        (*ENDIF*) 
                        _qualptr := _last_qual + 1
                        END;
                    (*ENDIF*) 
                st_format,
                st_language,
                st_date,
                st_time,
                st_timestamp,
                st_utcdiff,
                st_user,
                st_usergroup,
                st_uid,
                st_sysdba,
                st_localsysdba,
                st_transaction : (* PTS 1112385 *)
                    BEGIN
                    _e_op := _curr_st^.eop;
                    kb71InternalFunction(sel, _curr_st^, _e);
                    IF  ( _e_op <> op_none ) AND ( _e = e_ok )
                    THEN
                        BEGIN
                        IF  _e_op >= op_is_integer
                        THEN
                            _is_first_col := true;
                        (* The following statement calls the function *)
                        (* kb71op_call[e_op] is pointing to with      *)
                        (* parameters t, sel, curr_st^.               *)
                        (* This is no real PASCAL code !              *)
                        (*ENDIF*) 
                        _e := s35op_case( kb71op_call[_e_op],
                              t, sel, _curr_st^ )
                        END
                    (*ENDIF*) 
                    END;
                st_assign :
                    kb71assign (sel, _curr_st^, _initWorkBufLength, _e);
                st_output_param :
                    kb71output_dbproc_param (sel, _curr_st^, _e);
                st_continue_execute :
                    BEGIN
                    _continue_index := _continueStack[_curr_st^.epos];
&                   ifdef trace
                    t01int4 (kb_qual, 'condinue idx', _continue_index);
&                   endif
                    IF  _continue_index + 1 = _qualptr
                    THEN
                        BEGIN
                        _e := e_invalid;
                        goto 999;
                        END
                    ELSE
                        _qualptr := _continue_index;
                    (*ENDIF*) 
                    END;
                st_case :
                    BEGIN
                    _qualptr := kb71case (t, sel, _curr_st^, _qualptr, _e);
&                   ifdef trace
                    t01int4 (kb_qual, 'qualptr     ', _qualptr);
&                   endif
                    END;
                st_surrogate :
                    BEGIN (* user defined function call *)
                    _qualptr := _qualptr + 1;
                    a101_UserDefinedFunctionCall  (t, sel,
                          stack_desc.mst_addr^[_qualptr], _curr_st^, _e);
                    END;
                OTHERWISE
                    _e := e_stack_type_illegal
                END;
            (*ENDCASE*) 
        (*ENDIF*) 
        _qualptr := _qualptr + 1;
        IF  ( _e <> e_ok )
        THEN
            goto 999;
        (*ENDIF*) 
        IF  _is_view_qual AND ( _qualptr > _last_qual )
        THEN
            BEGIN
            _is_view_qual := false;
            IF  ( sel.sfp_work_st_top^.etype <> st_bool )
            THEN
                BEGIN
                _e := e_stack_type_illegal;
                goto 999
                END
            ELSE
                IF  ( sel.sfp_work_st_top^.epos <> cgg04_is_true )
                THEN
                    BEGIN
                    _e := e_view_violation;
                    goto 999
                    END;
                (*ENDIF*) 
            (*ENDIF*) 
            _qualptr          := stack_desc.mupd_pos;
            _constraint_check := true;
            _qual_offset  := stack_desc.mupd_pos - 1;
            _last_qual    := _qual_offset + stack_desc.mupd_cnt
            END
        (*ENDIF*) 
        END;
    (*ENDWHILE*) 
    ;
    (* go on in REPEAT loop *)
    IF  s35gt_bufaddr( sel.sfp_work_st_top, _work_st_bottom )
    THEN
        BEGIN
        IF  sel.sfp_work_st_top^.etype <> st_bool
        THEN
            BEGIN
            _e := e_stack_type_illegal;
            goto 999
            END
        ELSE
            IF  sel.sfp_work_st_top^.epos <> cgg04_is_true
            THEN
                BEGIN
                unqualified := true;
                IF  (_err_qualptr <
                    stack_desc.mview_pos + stack_desc.mview_cnt)
                    AND (_err_qualptr >= stack_desc.mview_pos)
                THEN
                    BEGIN
                    _e := e_view_violation;
                    goto 999
                    END
                ELSE
                    IF  (_err_qualptr <
                        stack_desc.mupd_pos + stack_desc.mupd_cnt)
                        AND
                        (_err_qualptr >= stack_desc.mupd_pos)
                    THEN
                        BEGIN
                        IF  _constraint_err_st <> NIL
                        THEN
                            IF  _constraint_err_st^.ecol_pos <> 0
                            THEN
                                err_st_ptr := _constraint_err_st;
                            (*ENDIF*) 
                        (*ENDIF*) 
                        _e := e_range_violation;
                        goto 999
                        END
                    ELSE
                        BEGIN
                        _e := e_qual_violation;
                        goto 999
                        END
                    (*ENDIF*) 
                (*ENDIF*) 
                END
            (*ENDIF*) 
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  _output_state = skip_output
    THEN
        BEGIN
        _isDebug := false;
        IF  stack_desc.mqual_cnt > 0
        THEN
            BEGIN
            _qual_offset := stack_desc.mqual_pos - 1;
            _last_qual   := _qual_offset + stack_desc.mqual_cnt;
            _qualptr     := _qual_offset + 1;
            IF  stack_desc.mst_addr^ [_qualptr].etype = st_jump_output
            THEN
                BEGIN
                IF  _last_qual >
                    (_qual_offset + stack_desc.mst_addr^[_qualptr].epos-1)
                THEN
                    _last_qual := _qual_offset +
                          stack_desc.mst_addr^ [_qualptr].epos-1;
                (*ENDIF*) 
                _qualptr      := _qualptr + 1;
                _output_state := create_output
                END
            ELSE
                _output_state := output_created
            (*ENDIF*) 
            END
        ELSE
            _output_state := output_created
        (*ENDIF*) 
        END
    ELSE
        IF  _output_state = create_output
        THEN
            _output_state := output_created
        (*ENDIF*) 
    (*ENDIF*) 
UNTIL
    ( _output_state = output_created );
(*ENDREPEAT*) 
IF  sel.sfp_bd_inv_only <> inv_and_primary
THEN
    sel.sfp_rows_qual := sel.sfp_rows_qual + 1;
(*ENDIF*) 
IF  _build_rec
THEN
    BEGIN
    _rec_ptr := @sel.sfp_m_result_addr^;
    _keylen  := _rec_ptr^.recKeyLen_gg00;
    IF  _keylen = 0
    THEN (* insert_nokey *)
        _keylen := SURROGATE_MXGG00 + 1;
    (*ENDIF*) 
    IF  _pos_var_count = 0
    THEN
        _pos_var_count := sel.sfp_result_length - cgg_rec_key_offset - _keylen
    ELSE
        _pos_var_count := _pos_var_count - 1     - cgg_rec_key_offset - _keylen;
    (*ENDIF*) 
    _rec_ptr^.recVarcolOffset_gg00 := _pos_var_count;
    _rec_ptr^.recVarcolCnt_gg00    := _var_count
    END;
(*ENDIF*) 
IF  sel.sfp_result_length > sel.sfp_resrec_maxlen
THEN
    sel.sfp_result_length := sel.sfp_resrec_maxlen
(*ENDIF*) 
END;
999 :
      t.trError_gg00 := _e
&     ifdef trace
      ;
t01basis_error( kb_qual, 'kb71qual err', _e );
IF  ( err_st_ptr <> NIL )
THEN
    t01stackentry ( kb_qual, err_st_ptr^, 1 );
&endif
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb71PushNull (
            VAR sel : tgg00_SelectFieldsParam;
            VAR e : tgg00_BasisError);
 
BEGIN
IF  sel.sfp_workbuf_top + 1 > sel.sfp_workbuf_size
THEN
    e := e_stack_overflow
ELSE
    IF  s35ge_bufaddr (sel.sfp_work_st_top,sel.sfp_work_st_last)
    THEN
        e := e_stack_overflow
    ELSE
        BEGIN
        sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, 1);
        sel.sfp_workbuf_top := sel.sfp_workbuf_top + 1;
        sel.sfp_workbuf_addr^[sel.sfp_workbuf_top] := csp_undef_byte;
        sel.sfp_workbuf_len := sel.sfp_workbuf_top;
        WITH sel.sfp_work_st_top^ DO
            BEGIN
            etype        := st_result;
            eop          := op_none;
            epos         := sel.sfp_workbuf_len;
            elen_var     := 1;
            ecol_tab [1] := chr(0);
            ecol_tab [2] := chr(0)
            END;
        (*ENDWITH*) 
        END;
    (*ENDIF*) 
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb71result_copy (
            VAR qual_st : tgg00_StackEntry;
            VAR sel   : tgg00_SelectFieldsParam;
            VAR e     : tgg00_BasisError);
 
VAR
      def_byte     : char;
      len          : integer;
      operand_addr : tsp00_MoveObjPtr;
 
LABEL
      999;
 
BEGIN
k71get_operand (sel, NOT c_check_spec_null, operand_addr, len, e);
IF  e <> e_ok
THEN
    goto 999;
(*ENDIF*) 
IF  sel.sfp_workbuf_top + len > sel.sfp_workbuf_size
THEN
    BEGIN
    e := e_stack_overflow;
    goto 999;
    END;
(*ENDIF*) 
WITH sel.sfp_work_st_top^ DO
    BEGIN
    etype    := st_result;
    eop      := qual_st.eop;
    epos     := sel.sfp_workbuf_top + 1;
    elen_var := len;
    ecol_pos := qual_st.ecol_pos
    END;
(*ENDWITH*) 
g10mv ('VKB71 ',  48,    
      sizeof(operand_addr^), sel.sfp_workbuf_size,
      @operand_addr^, 1, @sel.sfp_workbuf_addr^,
      sel.sfp_workbuf_top + 1, len, e);
&ifdef TRACE
t01sname (kb_qual, '=== result: ');
t01moveobj   (kb_qual, sel.sfp_workbuf_addr^,
      sel.sfp_workbuf_top+1, sel.sfp_workbuf_top + len);
&endif
sel.sfp_workbuf_len := sel.sfp_workbuf_top + len;
999 : ;
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb71result_value (
            VAR qual_st : tgg00_StackEntry;
            VAR sel   : tgg00_SelectFieldsParam;
            VAR e     : tgg00_BasisError);
 
VAR
      def_byte     : char;
      len          : integer;
      operand_addr : tsp00_MoveObjPtr;
 
LABEL
      999;
 
BEGIN
k71get_operand (sel, NOT c_check_spec_null, operand_addr, len, e);
IF  e <> e_ok
THEN
    goto 999;
(*ENDIF*) 
IF  sel.sfp_workbuf_top + 1 + qual_st.elen_var > sel.sfp_workbuf_size
THEN
    BEGIN
    e := e_stack_overflow;
    goto 999;
    END;
(*ENDIF*) 
WITH sel.sfp_work_st_top^ DO
    IF  qual_st.eop in [op_not, op_not_in]
    THEN
        BEGIN
        eop      := qual_st.eop;
        ecol_pos := qual_st.ecol_pos;
        goto 999
        END
    ELSE
        BEGIN
        etype    := st_result;
        eop      := qual_st.eop;
        epos     := sel.sfp_workbuf_top + 1;
        elen_var := qual_st.epos + 1;
        ecol_pos := qual_st.ecol_pos
        END;
    (*ENDIF*) 
(*ENDWITH*) 
IF  (operand_addr^ [1] = csp_undef_byte) OR (len = 1)
THEN
    BEGIN
    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_top+1] := csp_undef_byte;
    def_byte := csp_defined_byte;
    len      := 1
    END
ELSE
    BEGIN
    def_byte := operand_addr^[1];
    IF  len > qual_st.epos + 1
    THEN
        len := 1 + a05lnr_space_defbyte (sel.sfp_acv_addr, operand_addr,
              operand_addr^[1], 2, len - 1);
    (*ENDIF*) 
    IF  len > qual_st.epos + 1
    THEN
        BEGIN
        e := e_column_trunc;
        goto 999
        END;
    (*ENDIF*) 
    g10mv ('VKB71 ',  49,    
          sizeof(operand_addr^), sel.sfp_workbuf_size,
          @operand_addr^, 1, @sel.sfp_workbuf_addr^,
          sel.sfp_workbuf_top + 1, len, e)
    END;
(*ENDIF*) 
IF  len < qual_st.epos + 1
THEN
    IF  def_byte <> csp_unicode_def_byte
    THEN
        SAPDB_PascalFill ('VKB71 ',  50,    
              sel.sfp_workbuf_size, @sel.sfp_workbuf_addr^,
              sel.sfp_workbuf_top + len + 1,
              qual_st.epos + 1 - len, def_byte, e)
    ELSE
        SAPDB_PascalUnicodeFill ('VKB71 ',  51,    
              sel.sfp_workbuf_size,
              @sel.sfp_workbuf_addr^,
              sel.sfp_workbuf_top + len + 1, qual_st.epos + 1 - len,
              csp_unicode_blank, e);
    (*ENDIF*) 
&ifdef TRACE
(*ENDIF*) 
t01sname (kb_qual, '=== result: ');
t01moveobj   (kb_qual, sel.sfp_workbuf_addr^,
      sel.sfp_workbuf_top+1, sel.sfp_workbuf_top + qual_st.epos + 1);
&endif
sel.sfp_workbuf_len := sel.sfp_workbuf_top + qual_st.epos + 1;
999 : ;
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb71rowno (
            VAR qual_st : tgg00_StackEntry;
            rowno     : tsp00_Int4;
            VAR sel   : tgg00_SelectFieldsParam;
            VAR e     : tgg00_BasisError);
 
VAR
      num_err : tsp00_NumError;
 
LABEL
      999;
 
BEGIN
e := e_ok;
IF  sel.sfp_workbuf_top + 1 + ord (qual_st.ecol_tab [1]) >
    sel.sfp_workbuf_size
THEN
    BEGIN
    e := e_stack_overflow;
    goto 999;
    END
ELSE
    BEGIN
    sel.sfp_workbuf_len := sel.sfp_workbuf_top + 1;
    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len] := csp_defined_byte;
    s41plint (sel.sfp_workbuf_addr^, sel.sfp_workbuf_len + 1,
          qual_st.epos, qual_st.elen_var, rowno, num_err);
    IF  num_err <> num_ok
    THEN
        BEGIN
        k71num_err_to_b_err (num_err, e);
        IF  e <> e_ok
        THEN
            goto 999;
        (*ENDIF*) 
        END
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  s35ge_bufaddr (sel.sfp_work_st_top,sel.sfp_work_st_last)
THEN
    BEGIN
    e := e_stack_overflow;
    goto 999
    END;
(*ENDIF*) 
sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, 1);
WITH sel.sfp_work_st_top^ DO
    BEGIN
    etype        := st_result;
    eop          := op_none;
    epos         := sel.sfp_workbuf_len;
    elen_var     := ord (qual_st.ecol_tab [1]);
    ecol_tab [1] := chr(0);
    ecol_tab [2] := chr(0)
    END;
(*ENDWITH*) 
sel.sfp_workbuf_len := sel.sfp_workbuf_len +
      ord (qual_st.ecol_tab [1]);
&ifdef TRACE
t01sname (kb_qual, '=== result: ');
WITH sel.sfp_work_st_top^ DO
    t01moveobj (kb_qual, sel.sfp_workbuf_addr^, epos, epos + elen_var - 1);
(*ENDWITH*) 
&endif
999 : ;
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb71stop (
            VAR sel     : tgg00_SelectFieldsParam;
            param_cnt   : integer;
            basisError  : integer;
            VAR e       : tgg00_BasisError);
 
VAR
      res          : tsp00_NumError;
      rc           : tsp00_Int2;
      len          : integer;
      msgtext_len  : integer;
      dummyMsg     : tsp00_C2;
      operand_addr : tsp00_MoveObjPtr;
      msgtext_addr : tsp00_MoveObjPtr;
 
BEGIN
IF  basisError <> e_ok
THEN
    e := basisError
ELSE
    BEGIN
    e := e_ok;
    IF  param_cnt > 0
    THEN
        BEGIN
        IF  param_cnt > 1
        THEN
            BEGIN
            k71get_operand (sel, NOT c_check_spec_null, msgtext_addr, msgtext_len, e);
            sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, -1)
            END
        ELSE
            BEGIN
            msgtext_addr := @dummyMsg;
            msgtext_len  := 0
            END;
        (*ENDIF*) 
        IF  e = e_ok
        THEN
            k71get_operand (sel, NOT c_check_spec_null, operand_addr, len, e);
        (*ENDIF*) 
        IF  e = e_ok
        THEN
            BEGIN
            sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, -1);
            IF  (operand_addr^ [1] <> csp_undef_byte)
            THEN
                BEGIN
                s40gsint (operand_addr^, 2, (len - 1 - csp_attr_byte) * 2, rc, res);
                IF  res <> num_ok
                THEN
                    k71num_err_to_b_err (res, e);
                (*ENDIF*) 
                IF  e = e_ok
                THEN
                    BEGIN
                    IF  msgtext_addr^[1] = csp_undef_byte
                    THEN
                        msgtext_len := 0;
                    (*ENDIF*) 
                    IF  rc = 0
                    THEN
                        rc := e_stop_0;
                    (*ENDIF*) 
                    a262stop (sel.sfp_acv_addr, rc, msgtext_len, @msgtext_addr^[1]);
                    END;
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        END
    ELSE
        a262stop (sel.sfp_acv_addr, 0, 0, @dummyMsg);
    (*ENDIF*) 
    END;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb71DynamicSQL (
            VAR sel : tgg00_SelectFieldsParam;
            VAR e : tgg00_BasisError);
 
VAR
      len          : integer;
      msgtext_len  : integer;
      operand_addr : tsp00_MoveObjPtr;
 
BEGIN
e := e_ok;
k71get_operand (sel, NOT c_check_spec_null, operand_addr, len, e);
IF  e = e_ok
THEN
    BEGIN
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, -1);
    a262DynamicSQL (sel.sfp_acv_addr, sel, operand_addr, len, sel.sfp_oldrec_addr, e);
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb71truth (
            VAR st      : tgg00_StackEntry;
            VAR sel     : tgg00_SelectFieldsParam;
            VAR e       : tgg00_BasisError);
 
VAR
      ok            : integer;
      operand       : integer;
      bool_result   : integer;
 
BEGIN
e  := e_ok;
WITH sel DO
    BEGIN
    bool_result := sfp_work_st_top^.epos;
    operand     := st.epos;
    CASE operand OF
        cgg04_is_true :
            IF  bool_result = cgg04_is_true
            THEN
                ok := cgg04_is_true
            ELSE
                ok := cgg04_is_false;
            (*ENDIF*) 
        cgg04_is_not_true :
            IF  bool_result = cgg04_is_true
            THEN
                ok := cgg04_is_false
            ELSE
                ok := cgg04_is_true;
            (*ENDIF*) 
        cgg04_is_false :
            IF  bool_result = cgg04_is_false
            THEN
                ok := cgg04_is_true
            ELSE
                ok := cgg04_is_false;
            (*ENDIF*) 
        cgg04_is_not_false :
            IF  bool_result = cgg04_is_false
            THEN
                ok := cgg04_is_false
            ELSE
                ok := cgg04_is_true;
            (*ENDIF*) 
        cgg04_is_undef :
            IF  bool_result = cgg04_is_undef
            THEN
                ok := cgg04_is_true
            ELSE
                ok := cgg04_is_false;
            (*ENDIF*) 
        cgg04_is_not_undef :
            IF  bool_result = cgg04_is_undef
            THEN
                ok := cgg04_is_false
            ELSE
                ok := cgg04_is_true;
            (*ENDIF*) 
        OTHERWISE
            e := e_stack_op_illegal
        END;
    (*ENDCASE*) 
    IF  e = e_ok
    THEN
        BEGIN
        sfp_work_st_top^.etype     := st_bool;
        sfp_work_st_top^.epos := ok;
&       ifdef TRACE
        t01int4 (kb_qual, '=== result  ',
              sfp_work_st_top^.epos);
&       endif
        END
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
.PA 
