.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$VKB78$
.tt 2 $$$
.tt 3 $JuergenA$KB_build_in_func$2000-08-25$
***********************************************************
.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_build_in_func
=========
.sp
Purpose :  SELECT ROW and GET processing and qualification handling
.CM *-END-* purpose -------------------------------------
.sp
.cp 3
Define  :
 
        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);
 
.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :
 
        FROM
              Scanner : VAK01;
 
        FUNCTION
              a01is_identifier (
                    VAR identifier : tsp00_MoveObj;
                    len     : integer;
                    sqlmode : tsp00_SqlMode) : boolean;
 
      ------------------------------ 
 
        FROM
              AK_semantic_scanner_tools : VAK05;
 
        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
              KB_restart_record : VKB57;
 
        PROCEDURE
              k57currval (
                    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);
 
      ------------------------------ 
 
        FROM
              KB_get : VKB71;
 
        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
              k71get_operand (
                    VAR sel             : tgg00_SelectFieldsParam;
                    check_spec_null     : boolean;
                    VAR operand_addr    : tsp00_MoveObjPtr;
                    VAR len             : integer;
                    VAR e               : tgg00_BasisError);
 
        PROCEDURE
              k71num_err_to_b_err (
                    num_err : tsp00_NumError;
                    VAR e : tgg00_BasisError);
 
      ------------------------------ 
 
        FROM
              KB_date_time : VKB79;
 
        PROCEDURE
              k79new_pos_ora_number_format (
                    last_fmt : tkb07_ora_number_fmt_elem;
                    VAR pos  : tsp00_Int4);
 
        FUNCTION
              k79ora_number_format (
                    VAR format : tsp00_MoveObj;
                    len : tsp00_Int4;
                    pos : tsp00_Int4) : tkb07_ora_number_fmt_elem;
 
      ------------------------------ 
 
        FROM
              Configuration_Parameter : VGG01;
 
        VAR
              g01code          : tgg04_CodeGlobals;
              g01glob          : tgg00_KernelGlobals;
              g01unicode       : boolean;
 
      ------------------------------ 
 
        FROM
              Codetransformation_and_Coding : VGG02;
 
        VAR
              g02codetables : tgg04_CodeTables;
 
        PROCEDURE
              g02tascii_to_ebcdic (
                    VAR source : tsp00_MoveObj;
                    VAR dest : tsp00_C132;
                    length   : tsp00_Int4);
 
        PROCEDURE
              g02tebcdic_to_ascii (
                    VAR source : tsp00_MoveObj;
                    VAR dest : tsp00_C132;
                    length   : tsp00_Int4);
 
      ------------------------------ 
 
        FROM
              Check-Date-Time : VGG03;
 
        VAR
              g03dictionary : tsp6_dictionaries;
 
        FUNCTION
              g03date_error_to_b_err (date_e : tsp6_date_error)
                    : tgg00_BasisError;
 
      ------------------------------ 
 
        FROM
              Unicode-Utilities : VGG20;
 
        PROCEDURE
              g20get_uni_key (
                    VAR setname   : tsp00_KnlIdentifier;
                    VAR messcode  : tsp00_CodeType;
                    VAR codewidth : tsp00_Uint1;
                    VAR rc        : tsp8_uni_error);
 
      ------------------------------ 
 
        FROM
              Kernel_move_and_fill : VGG101;
 
        PROCEDURE
              SAPDB_PascalForcedFill (
                    size     : tsp00_Int4;
                    m        : tsp00_MoveObjPtr;
                    pos      : tsp00_Int4;
                    len      : tsp00_Int4;
                    fillchar : char);
 
        PROCEDURE
              SAPDB_PascalFill  (
                    mod_id         : tsp00_C6;
                    mod_intern_num : tsp00_Int4;
                    source_upb     : tsp00_Int4;
                    source         : tsp00_MoveObjPtr;
                    source_pos     : tsp00_Int4;
                    length         : tsp00_Int4;
                    fill_char      : 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_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
              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);
 
      ------------------------------ 
 
        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
              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;
 
      ------------------------------ 
 
        FROM
              GET-Conversions : VSP40;
 
        PROCEDURE
              s40glint (
                    VAR buf     : tsp00_MoveObj;
                    pos         : tsp00_Int4;
                    len         : integer;
                    VAR dest    : tsp00_Int4;
                    VAR res     : tsp00_NumError);
 
        PROCEDURE
              s40gsint (
                    VAR buf     : tsp00_MoveObj;
                    pos         : tsp00_Int4;
                    len         : integer;
                    VAR dest    : tsp00_Int2;
                    VAR res     : tsp00_NumError);
 
      ------------------------------ 
 
        FROM
              PUT-Conversions : VSP41;
 
        PROCEDURE
              s41psint (
                    VAR buf     : tsp00_MoveObj;
                    pos         : tsp00_Int4;
                    len         : integer;
                    frac        : integer;
                    source      : tsp00_Int2;
                    VAR res     : tsp00_NumError);
 
      ------------------------------ 
 
        FROM
              GETSTRING-Conversions : VSP42;
 
        PROCEDURE
              s42gchr (
                    VAR buf    : tsp00_Number;
                    pos        : tsp00_Int4;
                    len        : integer;
                    frac       : integer;
                    origlen    : integer;
                    VAR dest   : tsp00_MoveObj;
                    dpos       : tsp00_Int4;
                    VAR dlen   : integer;
                    VAR res    : tsp00_NumError);
 
        PROCEDURE
              s42gochr (
                    VAR buf     : tsp00_Number;
                    pos         : tsp00_Int4;
                    VAR dest    : tsp00_MoveObj;
                    dpos        : tsp00_Int4;
                    VAR dlen    : integer;
                    VAR res     : tsp00_NumError);
 
        PROCEDURE
              s42gstr (
                    VAR buf    : tsp00_Number;
                    pos        : tsp00_Int4;
                    len        : integer;
                    frac       : integer;
                    origlen    : integer;
                    VAR dest   : tsp00_MoveObj;
                    dpos       : tsp00_Int4;
                    VAR dlen   : integer;
                    VAR res    : tsp00_NumError);
 
      ------------------------------ 
 
        FROM
              Number-Arithmetic : VSP51;
 
        PROCEDURE
              s51abs (
                    VAR source     : tsp00_MoveObj;
                    spos           : tsp00_Int4;
                    slen           : integer;
                    VAR result     : tsp00_Number;
                    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
              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
              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);
 
      ------------------------------ 
 
        FROM
              date_time_formatting : VSP78;
 
        PROCEDURE
              s78df_analyze (
                    format_addr    : tsp00_MoveObjPtr;
                    format_len     : tsp00_Int2;
                    dest_addr      : tsp00_MoveObjPtr;
                    VAR dest_len   : tsp00_Int2;
                    to_date_format : boolean;
                    VAR e          : tsp6_date_error);
 
        PROCEDURE
              s78df_default (
                    dest_addr      : tsp00_MoveObjPtr;
                    VAR dest_len   : tsp00_Int2;
                    VAR e          : tsp6_date_error);
 
        PROCEDURE
              s78d2c_to_char (
                    VAR dictionary : tsp6_dictionary;
                    ts_addr      : tsp00_MoveObjPtr;
                    format_addr  : tsp00_MoveObjPtr;
                    format_len   : integer;
                    dest_size    : integer;
                    dest_addr    : tsp00_MoveObjPtr;
                    VAR dest_pos : integer;
                    dest_len     : integer;
                    VAR e        : tsp6_date_error);
 
        PROCEDURE
              s78year_month_day (
                    VAR datbuf : tsp00_MoveObj;
                    datpos    : tsp00_Int4;
                    VAR year  : integer;
                    VAR month : integer;
                    VAR day   : integer;
                    VAR e     : tsp6_date_error);
 
        PROCEDURE
              s78language (
                    VAR dictionary    : tsp6_dictionaries;
                    VAR language_name : tsp00_C3;
                    VAR language_no   : tsp6_language;
                    for_init          : boolean;
                    VAR is_ok         : boolean);
 
        PROCEDURE
              s78c2d_to_date (
                    VAR dictionary : tsp6_dictionary;
                    curr_date    : tsp00_MoveObjPtr;
                    fmt_addr     : tsp00_MoveObjPtr;
                    fmt_len      : tsp00_Int4;
                    src_addr     : tsp00_MoveObjPtr;
                    src_len      : tsp00_Int4;
                    dest_addr    : tsp00_MoveObjPtr;
                    VAR dest_pos : tsp00_Int4;
                    VAR e        : tsp6_date_error);
 
        PROCEDURE
              s78week_and_day (
                    VAR datbuf      : tsp00_MoveObj;
                    datpos          : tsp00_Int4;
                    VAR week        : integer;
                    VAR day_of_week : integer;
                    VAR e           : tsp6_date_error);
 
      ------------------------------ 
 
        FROM
              RTE-Extension-80: VSP80;
 
        PROCEDURE
              s80uni_trans
                    (src_ptr        : tsp00_MoveObjPtr;
                    src_len         : tsp00_Int4;
                    src_codeset     : tsp00_Int2;
                    dest_ptr        : tsp00_MoveObjPtr;
                    VAR dest_len    : tsp00_Int4;
                    dest_codeset    : tsp00_Int2;
                    trans_options   : tsp8_uni_opt_set;
                    VAR rc          : tsp8_uni_error;
                    VAR err_char_no : tsp00_Int4);
&       ifdef TRACE
 
      ------------------------------ 
 
        FROM
              Test_Procedures : VTA01;
 
        PROCEDURE
              t01int4 (
                    debug    : tgg00_Debug;
                    nam      : tsp00_Sname;
                    int      : tsp00_Int4);
 
        PROCEDURE
              t01moveobj (
                    debug    : tgg00_Debug;
                    VAR buf  : tsp00_MoveObj;
                    startpos : tsp00_Int4;
                    endpos   : tsp00_Int4);
 
        PROCEDURE
              t01sname (debug : tgg00_Debug; nam : tsp00_Sname);
 
        PROCEDURE
              t01stackentry (
                    debug          : tgg00_Debug;
                    VAR st         : tgg00_StackEntry;
                    entry_index    : integer);
&       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
              g02tascii_to_ebcdic;
 
              tsp00_MoveObj tsp00_C132
 
        PROCEDURE
              g02tebcdic_to_ascii;
 
              tsp00_MoveObj tsp00_C132
 
        FUNCTION
              s35add_moveobj_ptr;
 
              tsp00_Int4  tsp00_MoveObjPtr
 
        FUNCTION
              s35le_bufaddr;
 
              tsp00_Addr tgg00_StEntryAddr
 
        FUNCTION
              s35gt_bufaddr;
 
              tsp00_Addr tgg00_StEntryAddr
 
        PROCEDURE
              s42gstr;
 
              tsp00_MoveObj tsp00_Number
 
        PROCEDURE
              s42gchr;
 
              tsp00_MoveObj tsp00_Number
 
        PROCEDURE
              s42gochr;
 
              tsp00_MoveObj tsp00_Number
 
        PROCEDURE
              s51abs;
 
              tsp00_MoveObj tsp00_Number
 
.CM *-END-* synonym -------------------------------------
.sp;.cp 3
Author  :  JuergenA
.sp
.cp 3
Created :  1.06.79
.sp
.cp 3
.sp
.cp 3
Release :      Date : 2000-08-25
.sp
***********************************************************
.sp
.cp 11
.fo
.oc _/1
Specification:
.fo
.sp 2;.cp 3
Procedure K78BUILD_IN_FUNC
.sp
Distributor for the build-in functions except date/time functions.
.sp 2;.cp 5
Procedure KB78CHECKLEN
.sp
The procedure checks the length of a value. OP.ELEN_VAR specifies
the maximum column length without the defined byte.
.in +5
.br;OP_B_CHECKLEN
.in -5
.sp 2;.cp 8
Procedure KB78CHR
.sp
Supplies the character representation of a number in the character
code (ACSII or EBCDIC) of the kernel computer represented by
OP.EPOS places and OP.ELEN_VAR decimal places. If the
number is UNDEF, UNDEF is supplied.
.in +5;.br;.nf
OP_B_CHR   CHR(123)  ==> '123'
.in -5;.fo
.sp 2;.cp 8
Procedure KB78CHR_ORA
.sp
Supplies the character from the codetable with index number in the
character code (ACSII or EBCDIC) of the kernel computer represented by
OP.EPOS places and OP.ELEN_VAR = 2.
.in +5;.br;.nf
OP_B_CHR_ORA   CHR(97)  ==> '/'  for EBCDIC
OP_B_CHR_ORA   CHR(97)  ==> 'a'  for ASCII
.in -5;.fo
.sp 2;.cp 5
Procedure KB78CONCAT
.sp
The procedure concatenates two strings.
If one of the two strings is UNDEF, the result is UNDEF.
A string from a record is UNDEF either if it has
an UNDEF byte or if it consists of blanks only.
Strings from PART1/2 or from the result buffer
are UNDEF if they have an UNDEF byte or if they consist of the
DEFINED byte only, i.e. the trailing blanks are truncated for
concatenation only in the case of columns from the database.
.in +5;.br;.nf
OP_B_CONCAT   'abc' || 'xyz'  ==> 'abcxyz'
.in -5;.fo
.sp 2;.cp 5
Procedure KB78DECODE
.sp
The procedure compares the first value with second, fourth, sixth, ...
values and supplies the next of this values if the first value equal
with this value. If no values equal with the first value then supplies
the last value when the number of value is odd else the UNDEF byte.
.in +5;.br;.nf
OP_B_DECODE   decode(4 , 4 , 5, 1) |==> 5
OP_B_DECODE   decode(4 , 3 , 5, 1) |==> 1
OP_B_DECODE   decode(4 , 3 , 5)    |==> NULL
.in -5;.fo
.sp 2;.cp 9
Procedure KB78EXPAND
.sp
The procedure processes the operator EXPAND. OP.ELEN_VAR
specifies the length of the result string (incl. defined byte).
The operand string is assigned to the result string and the result string
is filled with the defined byte of the operand string.
.in +5;.br;.nf
OP_B_EXPAND    EXPAND ('abc', 5) ~==> 'abc~~'
.in -5;.fo
.sp 2;.cp 5
Procedure KB78FILL_PAD
.sp
Procedure for processing the operators LFILL, LPAD, RFILL and RPAD.
OP.ECOL_TAB [1] specifies the fill character and OP.ELEN_VAR
specifies the length of the result string (incl. defined byte).
The first operand in the stack identifies the string to be filled.
The leading and trailing blanks of this string are removed. In the case
of fill, the result string is filled with the fill character
whereas, in the case of PAD, it is filled only with the number of
characters specified in the second operand.
.br
The error message E_COLUMN_TRUNC is set if the first string exceeds
the result length or if, when it is filled with the specified
number of fill characters (LPAD or RPAD), it exceeds the result
length.
.in +5;.br;.nf
OP_B_LFILL    LFILL ('   abc   ',    'x', 9) ==> 'xxxxxxabc'
OP_B_RFILL    RFILL ('   abc   ',    'x', 9) ==> 'abcxxxxxx'
OP_B_LPAD     LPAD  ('   abc   ', 2, 'x', 9) ==> 'xxabc    '
OP_B_RPAD     RPAD  ('   abc   ', 2, 'x', 9) ==> 'abcxx    '
.in -5;.fo
.sp 2;.cp 9
Procedure KB78GREATEST
.sp
The procedure processes the GREATEST operator and substitutes a
value for a null value. OP.ELEN_VAR indicates the number of
value elements that are located at the end of the stack.
The result consits of the greastest element.
.in +5;.br;.nf
OP_B_GREATEST   GREATEST (1, 2 , 3)  ==> 3
OP_B_GREATEST   GREATEST (1, -2 , -3)  ==> 1
.in -5;.fo
.sp 2;.cp 11
Procedure KB78INDEX
.sp
Supplies the position of the second string in the first string.
If the operand quantity '3' was specified by OP.ECOL_TAB [1], the
third operand marks the start position (without defined byte) in the
first string where the search should begin. If one of the operands
.cp 3
is UNDEF, the result is also UNDEF.
.in +5;.br;.nf
OP_B_INDEX   INDEX ('abcde', 'cd')     ==> 3
             INDEX ('ababab', 'ab', 4) ==> 5
.in -5;.fo
.sp 2;.cp 9
Procedure KB78LEAST
.sp
The procedure processes the LEAST operator and substitutes a value for
a null value. OP.ELEN_VAR indicates the number of
value elements that are located at the end of the stack.
The result consits of the least element.
.in +5;.br;.nf
OP_B_LEAST    LEAST (1, 2 , 3)  ==> 1
OP_B_LEAST    LEAST (1, 2 , -3)  ==> -3
.in -5;.fo
.sp 2;.cp 5
Procedure KB78SUBSTR
.sp
Supplies a substring from the string of the first operand.  The
maximum total length of this string is in OP.EPOS.  The start
position of the substring is specified by the second operand. If the
operand count '3' is specified by OP.ECOL_TAB [1], the
third operand indicates the length of the substring; otherwise, the
remaining length of the string is taken.  If the substring exceeds
the maximum length of the string, the error E_COLUMN_TRUNC
.cp 4
is set. If one of the operands is UNDEF, the substring is also UNDEF.
.in +5;.br;.nf
OP_B_DBYTE_SUBSTR
OP_B_SUBSTR       SUBSTR ('abcdefg', 3)     ==> 'cdefg'
                  SUBSTR ('abcdefg', 3, 2)  ==> 'cd'
.in -5;.fo
.sp 2;.cp 7
Procedure KB78TRIM
.sp
The procedure processes the string operator TRIM. A result string
is created without leading or trailing blanks.
.in +5;.br;.nf
OP_B_TRIM      TRIM  ('  abc  ')  ==> 'abc'
OP_B_LTRIM     LTRIM ('  abc  ')  ==> 'abc  '
OP_B_RTRIM     RTRIM ('  abc  ')  ==> '  abc'
.in -5;.fo
.sp 2;.cp 9
Procedure KB78VALUE
.sp
The procedure processes the VALUE operator and substitutes a value for
a null value. OP.ELEN_VAR indicates the number of
value elements that are located at the end of the stack.
The result consits of the first element that is not UNDEF.
The elements are evaluated in the stack order.
.in +5;.br;.nf
OP_B_VALUE    VALUE (NULL, '   ', 'abc')  ==> 'abc'
.in -5;.fo
.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_spec_null    = true;
      c_for_init           = true;    (* g03language  *)
      c_before             = true;    (* kb78put_sign *)
      c_to_date_format     = true;    (* s78df_analyze *)
 
 
(*------------------------------*) 
 
PROCEDURE
      k78build_in_func (
            VAR op    : tgg00_StackEntry;
            VAR sel   : tgg00_SelectFieldsParam;
            VAR e     : tgg00_BasisError);
 
BEGIN
CASE op.eop_build_in OF
    op_b_checklen :
        kb78checklen (op, sel, e);
    op_b_chr:
        kb78chr (op, sel, e);
    op_b_chr_ora:
        kb78chr_ora (op, sel, e);
    op_b_concat, op_b_dbyte_concat:
        kb78concat (op, sel, e);
    op_b_decode :
        kb78decode (op, sel, e);
    op_b_expand :
        kb78expand (op, sel, e);
    op_b_greatest :
        kb78greatest_least (op, sel, l_greater, e);
    op_b_index:
        kb78index (op, sel, e);
    op_b_least:
        kb78greatest_least (op, sel, l_less, e);
    op_b_lfill, op_b_rfill, op_b_lpad, op_b_rpad:
        kb78fill_pad (op, sel, e);
    op_b_substr:
        kb78substr (op, sel, e);
    op_b_dbyte_substr:
        kb78dbyte_substr (op, sel, e);
    op_b_left, op_b_right:
        kb78leftright (op, sel, e);
    op_b_to_char:
        kb78to_char (op, sel, e);
    op_b_to_date:
        kb78to_date (op, sel, e);
    op_b_to_24_char:
        kb78to_24_char (sel, e);
    op_b_trim, op_b_ltrim, op_b_rtrim:
        kb78trim (op, sel, e);
    op_b_value:
        kb78value (op, sel, e);
    op_b_length_ora:
        kb78length_ora (op, sel, e);
    op_b_ascii_ora:
        kb78ascii_ora (op, sel, e);
    op_b_namefromdate:
        kb78name_from_date (op, sel, e);
    op_b_toidentifier:
        kb78toidentifier (op, sel, e);
    op_b_dbyte_lfill,
    op_b_dbyte_rfill,
    op_b_dbyte_lpad,
    op_b_dbyte_rpad :
        kb78dbyte_fill_pad (op, sel, e);
    op_b_dbyte_trim,
    op_b_dbyte_rtrim,
    op_b_dbyte_ltrim :
        kb78dbyte_trim (op, sel, e);
    op_b_uni_trans :
        kb78uni_trans (op, sel, e);
    op_b_float :
        kb78float (op, sel, e);
    (* PTS 1117523 E.Z. *)
    op_b_case_start :
        BEGIN
        END;
    op_b_case_stop :
        kb78case_stop (op, sel, e);
    OTHERWISE
        e := e_stack_op_illegal
    END;
(*ENDCASE*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb78ascii_ora (
            VAR op      : tgg00_StackEntry;
            VAR sel     : tgg00_SelectFieldsParam;
            VAR e       : tgg00_BasisError);
 
VAR
      num_err      : tsp00_NumError;
      operand_addr : tsp00_MoveObjPtr;
      len          : integer;
      result_len   : integer;
      result_value : integer;
      to_code      : integer;
      defined_byte : char;
      byte_two     : integer;
 
LABEL
      999;
 
BEGIN
result_len := 3;
IF  (sel.sfp_workbuf_top + 1 + result_len > 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*) 
defined_byte        := operand_addr^ [1];
sel.sfp_workbuf_len := sel.sfp_workbuf_top + 1;
IF  (defined_byte = csp_undef_byte)
THEN
    BEGIN
    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len] := csp_undef_byte;
    result_len := 0
    END
ELSE
    BEGIN
    IF  NOT (defined_byte IN  [bsp_c1, csp_defined_byte,
        csp_unicode_def_byte])
    THEN
        (*   it's an EBCDIC-computer and an ASCII-value   *)
        (*   or an ASCII-computer and an EBCDIC-value     *)
        BEGIN
&       ifdef TRACE
        t01moveobj (kb_qual, operand_addr^, 1, len);
&       endif
        IF  (g01code.ctype = csp_ascii)
        THEN
            to_code := cgg04_to_ascii
        ELSE
            to_code := cgg04_to_ebcdic;
        (*ENDIF*) 
        s30map (g02codetables.tables [to_code], operand_addr^, 1,
              sel.sfp_workbuf_addr^, sel.sfp_workbuf_len, 2);
        operand_addr  := s35add_moveobj_ptr (sel.sfp_workbuf_addr,
              sel.sfp_workbuf_len - 1);
        defined_byte  := operand_addr^ [1];
&       ifdef TRACE
        t01moveobj (kb_qual, operand_addr^, 1, len);
&       endif
        END;
    (*ENDIF*) 
    IF  (len > 1)
    THEN
        byte_two := ord (operand_addr^ [2]);
    (*ENDIF*) 
    IF  (defined_byte in  [bsp_c1, csp_unicode_def_byte])
    THEN
        (*   it's a string or date   *)
        IF  (len = 1)
        THEN
            (*  it's a varchar-value with empty string  *)
            IF  defined_byte = bsp_c1
            THEN
                result_value :=  ord (' ')
            ELSE
                result_value := ord (csp_unicode_mark)
            (*ENDIF*) 
        ELSE
            IF  defined_byte = bsp_c1
            THEN
                result_value := byte_two
            ELSE
                result_value := byte_two * 256 + ord (operand_addr^ [3])
            (*ENDIF*) 
        (*ENDIF*) 
    ELSE
        (*   it's a number or a byte-value   *)
        IF  (op.edatatype <> dchb)
        THEN
            (*   it' a number   *)
            IF  (byte_two > 192)
            THEN
                (*  number > 1  *)
                result_value := ord (operand_addr^ [3]) DIV 16 +
                      ord ('0')
            ELSE
                IF  (byte_two < ord (cgg04_zero_exponent))
                THEN
                    (*  number < 0  *)
                    result_value := ord ('-')
                ELSE
                    IF  (byte_two > ord (cgg04_zero_exponent)) AND
                        (byte_two < 193)
                    THEN
                        (*  0 < number < 1  *)
                        result_value := ord ('.')
                    ELSE
                        (*  number = 0  *)
                        result_value := ord ('0')
                    (*ENDIF*) 
                (*ENDIF*) 
            (*ENDIF*) 
        ELSE
            (*   it's a raw-column   *)
            BEGIN
            result_value := ord (byte_two) DIV 16 + ord ('0');
            IF  (result_value > ord ('9'))
            THEN
                (*  the left part of the byte is between A and F  *)
                result_value := result_value + ord('A') - ord('9') - 1
            (*ENDIF*) 
            END;
        (*ENDIF*) 
    (*ENDIF*) 
    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len] := csp_defined_byte;
    s41psint (sel.sfp_workbuf_addr^, sel.sfp_workbuf_len + 1,
          result_len, 0, result_value, 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*) 
WITH sel.sfp_work_st_top^ DO
    BEGIN
    etype    := st_result;
    eop      := op_none;
    epos     := sel.sfp_workbuf_len;
    elen_var := 1 + result_len;
    ecol_tab [1] := chr(0);
    ecol_tab [2] := chr(0)
    END;
(*ENDWITH*) 
sel.sfp_workbuf_len := sel.sfp_workbuf_len + result_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 : ;
END;   (*   end of procedure kb78ascii_ora   *)
 
(*------------------------------*) 
 
PROCEDURE
      kb78case_stop (
            VAR op      : tgg00_StackEntry;
            VAR sel     : tgg00_SelectFieldsParam;
            VAR e       : tgg00_BasisError);
 
VAR
      old_stack_top : tgg00_StEntryAddr;
 
BEGIN
IF  e = e_qual_violation
THEN
    e := e_ok;
(*ENDIF*) 
old_stack_top := sel.sfp_work_st_top;
sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, -1);
sel.sfp_work_st_top^ := old_stack_top^;
END; (*   end of procedure kb78case_stop   *)
 
(*------------------------------*) 
 
PROCEDURE
      kb78checklen (
            VAR op         : tgg00_StackEntry;
            VAR sel        : tgg00_SelectFieldsParam;
            VAR e          : tgg00_BasisError);
 
VAR
      len          : integer;
      operand_addr : tsp00_MoveObjPtr;
 
BEGIN
k71get_operand (sel, c_check_spec_null, operand_addr, len, e);
IF  e = e_ok
THEN
    BEGIN
    (* PTS 1122766 E.Z. *)
    IF  operand_addr^[1] = csp_undef_byte
    THEN
        len := 1
    ELSE
        len := a05lnr_space_defbyte (sel.sfp_acv_addr,
              operand_addr, operand_addr^[1], 2, len-1) + 1;
    (*ENDIF*) 
&   ifdef TRACE
    IF  len > 1
    THEN
        t01moveobj (kb_qual, operand_addr^, 1, len);
&   endif
    (*ENDIF*) 
    IF  len - 1 > op.elen_var
    THEN
        e := e_column_trunc;
    (*ENDIF*) 
    END;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb78chr (
            VAR op    : tgg00_StackEntry;
            VAR sel   : tgg00_SelectFieldsParam;
            VAR e     : tgg00_BasisError);
 
VAR
      num_err      : tsp00_NumError;
      operand_addr : tsp00_MoveObjPtr;
      len          : integer;
      number       : tsp00_Number;
 
LABEL
      999;
 
BEGIN
k71get_operand (sel, c_check_spec_null, operand_addr, len, e);
IF  e = e_ok
THEN
    BEGIN
    IF  sel.sfp_workbuf_top + 1 + ord(op.ecol_tab [2]) >
        sel.sfp_workbuf_size
    THEN
        BEGIN
        e := e_stack_overflow;
        goto 999;
        END
    (*ENDIF*) 
    END
ELSE
    goto 999;
(*ENDIF*) 
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
    IF  (ord(op.ecol_tab [1]) = 3) (* datatype is boolean *)
    THEN
        BEGIN
        sel.sfp_workbuf_addr^[sel.sfp_workbuf_len] := csp_ascii_blank;
        IF  operand_addr^  [2] = cgg04_truechar
        THEN
            sel.sfp_workbuf_addr^  [sel.sfp_workbuf_len + 1] := 'T'
        ELSE
            sel.sfp_workbuf_addr^  [sel.sfp_workbuf_len + 1] := 'F';
        (*ENDIF*) 
        (* PTS 1121403 E.Z. *)
        len := 1;
        END
    ELSE
        BEGIN
        number := csp_null_number;
        g10mv ('VKB78 ',   1,
              len, sizeof (number), @operand_addr^, 2,
              @number, 1, len - 1, e);
        IF  e <> e_ok
        THEN
            goto 999;
        (*ENDIF*) 
        sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len] := ' ';
        IF  op.epos <= csp_fixed
        THEN
            (* ORACLE number -> char is             *)
            (* indicated by op.epos = 2 * csp_fixed *)
            s42gchr (number, 1, op.epos, op.elen_var,
                  op.epos, sel.sfp_workbuf_addr^,
                  sel.sfp_workbuf_len+1, len, num_err)
        ELSE
            s42gochr (number, 1, sel.sfp_workbuf_addr^,
                  sel.sfp_workbuf_len+1, len, num_err);
        (*ENDIF*) 
        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*) 
        IF  len > ord(op.ecol_tab [2])
        THEN
            BEGIN
            e := e_column_trunc;
            goto 999;
            END
        (* PTS 1121403 E.Z. *)
        (*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 : ;
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb78chr_ora (
            VAR op        : tgg00_StackEntry;
            VAR sel       : tgg00_SelectFieldsParam;
            VAR e         : tgg00_BasisError);
 
CONST
      trunc_frac   = 0;
 
VAR
      undef        : boolean;
      number256    : tsp00_Number;
      chr_num      : tsp00_Int2;
      truncnum_pos : integer;
      truncnum_len : integer;
      num256pos    : integer;
      erg1_pos     : integer;
      erg1_len     : integer;
      erg2_pos     : integer;
      erg2_len     : integer;
      len          : integer;
      letter       : char;
      def_byte     : char;
      result_code  : integer;
      num_err      : tsp00_NumError;
      operand_addr : tsp00_MoveObjPtr;
 
LABEL
      999;
 
BEGIN
e     := e_ok;
IF  sel.sfp_workbuf_size < sel.sfp_workbuf_len + 4 * mxsp_number + 4
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;
&ifdef TRACE
(*ENDIF*) 
t01moveobj (kb_qual, operand_addr^, 1, len);
&endif
undef :=  operand_addr^ [1] = csp_undef_byte;
IF  NOT undef
THEN
    BEGIN
    number256    := csp_number256;
    num256pos    := sel.sfp_workbuf_size - mxsp_number + 1;
    truncnum_pos := num256pos - mxsp_number;
    erg1_pos     := truncnum_pos - mxsp_number;
    erg2_pos     := erg1_pos - mxsp_number;
    g10mv ('VKB78 ',   2,
          sizeof(number256), sizeof(sel.sfp_workbuf_addr^),
          @number256, 1, @sel.sfp_workbuf_addr^, num256pos, mxsp_number, e);
    IF  e <> e_ok
    THEN
        goto 999;
    (*ENDIF*) 
    s51trunc (operand_addr^, 2, len - 1, trunc_frac,
          sel.sfp_workbuf_addr^, truncnum_pos, csp_fixed, csp_float_frac,
          truncnum_len, num_err);
    (* chr_number MOD 256  ===> chr_number - TRUNC(chr_number/256) * 256*)
    IF  num_err in  [num_ok, num_trunc]
    THEN
        (* erg1 = truncnum/256 *)
        s51div ( sel.sfp_workbuf_addr^, truncnum_pos, truncnum_len,
              sel.sfp_workbuf_addr^, num256pos, mxsp_number,
              sel.sfp_workbuf_addr^, erg1_pos,
              csp_fixed, csp_float_frac,
              erg1_len, num_err);
    (*ENDIF*) 
    IF  num_err in  [num_ok, num_trunc]
    THEN
        (* erg2 = TRUNC(erg1) *)
        s51trunc (sel.sfp_workbuf_addr^, erg1_pos, erg1_len, trunc_frac,
              sel.sfp_workbuf_addr^, erg2_pos, csp_fixed,
              csp_float_frac, erg2_len, num_err);
    (*ENDIF*) 
    IF  num_err in  [num_ok, num_trunc]
    THEN
        (* erg1 = erg2 * 256 *)
        s51mul( sel.sfp_workbuf_addr^, erg2_pos, erg2_len,
              sel.sfp_workbuf_addr^, num256pos, mxsp_number,
              sel.sfp_workbuf_addr^, erg1_pos, csp_fixed, csp_float_frac,
              erg1_len, num_err);
    (*ENDIF*) 
    IF  num_err in  [num_ok, num_trunc]
    THEN
        (* erg2 = truncnum - erg1 *)
        s51sub ( sel.sfp_workbuf_addr^, truncnum_pos, truncnum_len,
              sel.sfp_workbuf_addr^, erg1_pos, erg1_len,
              sel.sfp_workbuf_addr^, erg2_pos, csp_fixed, csp_float_frac,
              erg2_len, num_err);
    (*ENDIF*) 
    IF  num_err in  [num_ok, num_trunc]
    THEN
        IF  sel.sfp_workbuf_addr^ [erg2_pos] < cgg04_zero_exponent
        THEN
            (* erg1 = 256 + erg2 *)
            s51add ( sel.sfp_workbuf_addr^, erg2_pos, erg2_len,
                  sel.sfp_workbuf_addr^, num256pos, mxsp_number,
                  sel.sfp_workbuf_addr^, erg1_pos, csp_fixed,
                  csp_float_frac, erg1_len, num_err)
        ELSE
            BEGIN
            (* erg1 = erg2 *)
            g10mv ('VKB78 ',   3,
                  sel.sfp_workbuf_size, sel.sfp_workbuf_size,
                  @sel.sfp_workbuf_addr^, erg2_pos,
                  @sel.sfp_workbuf_addr^, erg1_pos, erg2_len, e);
            IF  e <> e_ok
            THEN
                goto 999;
            (*ENDIF*) 
            erg1_len := erg2_len;
            END;
        (*ENDIF*) 
    (*ENDIF*) 
    IF  NOT (num_err in  [num_ok, num_trunc])
    THEN
        BEGIN
        e := e_num_invalid;
        goto 999;
        END;
    (*ENDIF*) 
    s40gsint ( sel.sfp_workbuf_addr^, erg1_pos, csp_fixed,
          chr_num, num_err);
    result_code := ord(op.ecol_tab [1]);
&   ifdef TRACE
    t01int4 (kb_qual, 'chr_number  ', chr_num);
&   endif
    IF  (num_err <> num_ok)
    THEN
        BEGIN
        e := e_num_invalid;
        goto 999;
        END;
&   ifdef TRACE
    (*ENDIF*) 
    t01int4 (kb_qual, 'g01code.styp', g01code.ctype);
    t01int4 (kb_qual, 'result code ', result_code);
&   endif
    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;
    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
    IF  g01code.ctype = result_code
    THEN
        BEGIN
        letter   := chr(chr_num);
        def_byte := bsp_c1;
        END
    ELSE
        IF  result_code = csp_ascii
        THEN
            BEGIN
            def_byte := csp_ascii_blank;
            letter   := g02codetables.tables [cgg04_to_ascii,
                  chr_num + 1];
            END
        ELSE
            BEGIN
            def_byte := csp_ebcdic_blank;
            letter   := g02codetables.tables [cgg04_to_ebcdic,
                  chr_num + 1];
            END;
        (*ENDIF*) 
    (*ENDIF*) 
    WITH sel DO
        BEGIN
        sfp_workbuf_addr^ [sfp_workbuf_len]    := def_byte;
        sfp_workbuf_len                         := succ(sfp_workbuf_len);
        sfp_workbuf_addr^ [sfp_workbuf_len]    := letter;
        sfp_work_st_top^.elen_var := 2;
        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)
&             endif
    (*ENDWITH*) 
    END;
(*ENDIF*) 
999 : ;
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb78concat (
            VAR op       : tgg00_StackEntry;
            VAR sel      : tgg00_SelectFieldsParam;
            VAR e        : tgg00_BasisError);
 
CONST
      c_is_undefined = csp_maxint4 - 2;
 
VAR
      is_list_compare : boolean;
      is_long_concat  : boolean;
      def_byte        : char;
      undef           : boolean;
      i               : integer;
      op2_pos         : tsp00_Int4;
      workbuf_top     : tsp00_Int4;
      op2_dest_pos    : tsp00_Int4;
      workbuf_pos     : ARRAY  [1..2] OF tsp00_Int4;
      len             : ARRAY  [1..2] OF integer;
      operand_addr    : ARRAY  [1..2] OF tsp00_MoveObjPtr;
 
LABEL
      999;
 
BEGIN
undef           := false;
len [1]         := 0;
len [2]         := 0;
is_list_compare := op.ecol_tab[1] = chr (1);
is_long_concat  := op.ecol_tab[1] = chr (3);
op2_pos         := 1;
(* left side of list/subquery compare *)
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*) 
    IF  sel.sfp_work_st_top^.etype = st_result
    THEN
        workbuf_pos[i] := sel.sfp_work_st_top^.epos
    ELSE
        workbuf_pos[i] := c_is_undefined;
    (*ENDIF*) 
    def_byte := operand_addr [i]^ [1];
    IF  NOT is_list_compare                                               AND
        (* PTS 1123552 E.Z. *)
        NOT is_long_concat                                                AND
        (sel.sfp_work_st_top^.etype <> st_result)                         AND
        (
        ((sel.sfp_work_st_top^.etype        = st_value) AND
        ( len[i] = 1))
        OR
        NOT
        ((sel.sfp_work_st_top^.etype        = st_value) AND
        ( sel.sfp_work_st_top^.ecol_tab[1] <> cgg04_value_to_be_truncated))
        )
    THEN
        len [i] := 1 + a05lnr_space_defbyte (sel.sfp_acv_addr, operand_addr [i],
              def_byte, 2, len [i]-1);
    (*ENDIF*) 
    IF  def_byte = csp_undef_byte
    THEN
        BEGIN
        IF  (sel.sfp_sqlmode = sqlm_oracle) AND NOT is_list_compare
        THEN
            len [i] := 0;
        (*ENDIF*) 
        undef := true;
        END;
    (*ENDIF*) 
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, -1)
    END;
(*ENDFOR*) 
workbuf_top := sel.sfp_workbuf_top;
IF  NOT undef AND (len [1] > 0) AND (len [2] > 0)
THEN
    BEGIN
    IF  (operand_addr [1]^ [1] <> operand_addr  [2]^ [1])
        AND
        (operand_addr [2]^ [1] <> csp_defined_byte)
        AND
        NOT is_list_compare
    THEN
        BEGIN
        IF  operand_addr [2]^ [1] = csp_unicode_def_byte
        THEN
            BEGIN
            sel.sfp_workbuf_top := sel.sfp_workbuf_len;
            workbuf_pos[1]      := sel.sfp_workbuf_len + 1;
            k71code_operand (sel, csp_unicode_def_byte,
                  operand_addr [1], len [1],
                  s35inc_st (sel.sfp_work_st_top, 1), e);
            END
        ELSE
            BEGIN
            k71code_operand (sel, operand_addr [1]^[1],
                  operand_addr [2], len [2],
                  s35inc_st (sel.sfp_work_st_top, 2), e);
            END;
        (*ENDIF*) 
        IF  e <> e_ok
        THEN
            goto 999;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  NOT undef
THEN
    BEGIN
    IF  is_list_compare
    THEN
        op2_pos := 1
    ELSE
        BEGIN
        (* don't copy def byte of 2. Operand *)
        workbuf_pos[2] := workbuf_pos[2] + 1;
        op2_pos        := 2;
        len[2]         := len[2] - 1
        END;
    (*ENDIF*) 
    IF  len [1] + len [2] > op.elen_var
    THEN
        BEGIN
        e := e_column_trunc;
        goto 999;
        END
    (*ENDIF*) 
    END
ELSE
    IF  sel.sfp_sqlmode = sqlm_oracle
    THEN
        BEGIN
        IF  len [1] + len [2] > op.elen_var
        THEN
            BEGIN
            e := e_column_trunc;
            goto 999;
            END
        ELSE
            IF  ((operand_addr [1]^ [1] <> csp_undef_byte) OR
                ( operand_addr [2]^ [1] <> csp_undef_byte))    AND
                NOT is_long_concat
            THEN
                undef := false
            (*ENDIF*) 
        (*ENDIF*) 
        END;
    (*ENDIF*) 
(*ENDIF*) 
IF  sel.sfp_workbuf_top + len[1] + len[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 := workbuf_top + 1;
WITH sel.sfp_work_st_top^ DO
    BEGIN
    etype    := st_result;
    eop      := op_none;
    epos     := sel.sfp_workbuf_len;
    IF  undef
    THEN
        elen_var := 1
    ELSE
        elen_var := len [1] + len [2];
    (*ENDIF*) 
    ecol_tab [1] := chr(ord(is_list_compare));
    ecol_tab [2] := chr(0)
    END;
(*ENDWITH*) 
IF  undef
THEN
    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len] := csp_undef_byte
ELSE
    BEGIN
&   ifdef trace
    t01int4 (kb_qual, 'wb 2 pos    ', workbuf_pos[2]);
    t01int4 (kb_qual, 'workbuf_len ', sel.sfp_workbuf_len);
    t01int4 (kb_qual, 'len1        ', len[1]);
    t01int4 (kb_qual, 'len2        ', len[2]);
&   endif
    op2_dest_pos := sel.sfp_workbuf_len + len[1];
&   ifdef trace
    t01int4 (kb_qual, 'op2_dest_pos', op2_dest_pos);
&   endif
    IF  (workbuf_pos[2] <> op2_dest_pos) AND (len[2] > 0)
    THEN
        IF  workbuf_pos[2] < op2_dest_pos
        THEN
            SAPDB_PascalOverlappingMove ('VKB78 ',   4,
                  sel.sfp_workbuf_size, sel.sfp_workbuf_size,
                  @sel.sfp_workbuf_addr^, workbuf_pos[2],
                  @sel.sfp_workbuf_addr^, op2_dest_pos, len[2], e)
        ELSE
            SAPDB_PascalOverlappingMove ('VKB78 ',   5,
                  sizeof (operand_addr[2]^), sel.sfp_workbuf_size,
                  @operand_addr[2]^, op2_pos, @sel.sfp_workbuf_addr^,
                  op2_dest_pos, len[2], e);
        (*ENDIF*) 
&   ifdef trace
    (*ENDIF*) 
    t01moveobj (kb_qual, sel.sfp_workbuf_addr^, 1,
          sel.sfp_workbuf_len + len[1] + len[2] - 1);
    t01int4 (kb_qual, 'workpos 1   ', workbuf_pos[1]);
&   endif
    IF  (workbuf_pos[1] <> workbuf_top + 1) AND (len[1] > 0)
    THEN
        SAPDB_PascalOverlappingMove ('VKB78 ',   6,
              sizeof (operand_addr[1]^), sel.sfp_workbuf_size,
              @operand_addr[1]^, 1, @sel.sfp_workbuf_addr^,
              workbuf_top + 1, len[1], e);
    (*ENDIF*) 
    sel.sfp_workbuf_len := workbuf_top + len [1] + len[2]
    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
      k78currval (
            VAR t   : tgg00_TransContext;
            VAR op  : tgg00_StackEntry;
            VAR sel : tgg00_SelectFieldsParam);
 
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*) 
    k57currval (t, sel.sfp_data_addr, sel.sfp_data_size, op.epos,
          sel.sfp_workbuf_addr, sel.sfp_workbuf_size, sel.sfp_workbuf_len+2,
          i_int4);
    IF  t.trError_gg00 = e_ok
    THEN
        BEGIN
        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_work_st_top^.elen_var := 1 + i_int4;
        sel.sfp_workbuf_len := sel.sfp_workbuf_len + 1 + i_int4
        END
    (*ENDIF*) 
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb78dbyte_fill_pad (
            VAR op         : tgg00_StackEntry;
            VAR sel        : tgg00_SelectFieldsParam;
            VAR e          : tgg00_BasisError);
 
VAR
      len            : ARRAY  [1..3] OF integer;
      undef          : ARRAY  [1..4] OF boolean;
      operand_addr   : ARRAY  [1..3] OF tsp00_MoveObjPtr;
      pad_len        : tsp00_Int2;
      operand_count  : tsp00_Int2;
      trunc_len      : integer;
      fill_len       : integer;
      filled_len     : integer;
      i              : integer;
      num_err        : tsp00_NumError;
 
LABEL
      999;
 
BEGIN
e := e_ok;
&ifdef TRACE
t01stackentry (kb_qual, op, 0);
&endif
IF  op.eop_build_in in  [op_b_dbyte_lfill, op_b_dbyte_rfill]
THEN
    operand_count := 1
ELSE
    operand_count := 2;
(*ENDIF*) 
IF  op.epos = 1
THEN
    operand_count := succ (operand_count);
(*ENDIF*) 
IF  sel.sfp_workbuf_len + op.elen_var > sel.sfp_workbuf_size
THEN
    BEGIN
    e := e_stack_overflow;
    goto 999;
    END;
(*ENDIF*) 
undef [1] := false;
undef [2] := false;
undef [3] := false;
undef [4] := (op.ecol_tab [1] = csp_undef_byte);
FOR i := operand_count 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*) 
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;
    ecol_tab [1] := chr(0);
    ecol_tab [2] := chr(0)
    END;
(*ENDWITH*) 
IF  undef [1] OR undef [2] OR undef [3] OR undef [4]
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_work_st_top^.elen_var               := op.elen_var;
    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len] := operand_addr [1]^ [1];
    trunc_len := a05lnr_space_defbyte (sel.sfp_acv_addr, operand_addr [1],
          operand_addr [1]^ [1], 2, len [1]-1);
    IF  trunc_len > op.elen_var - 1
    THEN
        BEGIN
        e := e_column_trunc;
        goto 999;
        END;
    (*ENDIF*) 
    IF  op.eop_build_in in  [op_b_dbyte_lpad, op_b_dbyte_rpad]
    THEN
        BEGIN
        s40gsint (operand_addr [2]^, 2, (len [2]-1-csp_attr_byte) * 2,
              pad_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*) 
        IF  pad_len < 0
        THEN
            BEGIN
            e := e_num_invalid;
            goto 999;
            END
        ELSE
            BEGIN
            IF  op.epos = 1
            THEN
                pad_len := pad_len * (len[ operand_count ] - 1) DIV 2;
            (*ENDIF*) 
            IF  trunc_len + 2 * pad_len > op.elen_var - 1
            THEN
                BEGIN
                e := e_column_trunc;
                goto 999;
                END;
            (*ENDIF*) 
            END
        (*ENDIF*) 
        END
    ELSE
        pad_len := (op.elen_var - 1 - trunc_len) DIV 2;
    (*ENDIF*) 
    IF  (op.eop_build_in IN  [op_b_dbyte_lfill, op_b_dbyte_lpad])
    THEN
        BEGIN
        IF  pad_len > 0
        THEN
            IF  op.epos = 0
            THEN
                FOR i := 1 TO pad_len DO
                    BEGIN
                    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len + 2*i - 1] :=
                          op.ecol_tab [1];
                    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len + 2*i    ] :=
                          op.ecol_tab [2];
                    END
                (*ENDFOR*) 
            ELSE
                kb78pad_string (sel.sfp_workbuf_size,
                      sel.sfp_workbuf_addr^,
                      sel.sfp_workbuf_len + 1,
                      2*pad_len, operand_addr[ operand_count ]^,
                      len[ operand_count ], e);
            (*ENDIF*) 
        (*ENDIF*) 
        IF  trunc_len > 0
        THEN
            g10mv ('VKB78 ',   7,
                  sizeof(operand_addr [1]^), sel.sfp_workbuf_size,
                  @operand_addr [1]^, 2,
                  @sel.sfp_workbuf_addr^,
                  sel.sfp_workbuf_len+2*pad_len+1, trunc_len, e);
        (*ENDIF*) 
        IF  e <> e_ok
        THEN
            goto 999;
        (*ENDIF*) 
        filled_len := 2*pad_len + trunc_len;
        fill_len   := op.elen_var - 1;
        WHILE filled_len < fill_len DO
            BEGIN
            sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len + filled_len + 1] :=
                  csp_unicode_mark;
            sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len + filled_len + 2] :=
                  bsp_c1;
            filled_len := filled_len + 2
            END;
        (*ENDWHILE*) 
        END;
    (*ENDIF*) 
    IF  (op.eop_build_in IN  [op_b_dbyte_rfill, op_b_dbyte_rpad])
    THEN
        BEGIN
        IF  trunc_len > 0
        THEN
            g10mv ('VKB78 ',   8,
                  sizeof(operand_addr [1]^), sel.sfp_workbuf_size,
                  @operand_addr [1]^, 2,
                  @sel.sfp_workbuf_addr^, sel.sfp_workbuf_len + 1,
                  trunc_len, e);
        (*ENDIF*) 
        IF  e <> e_ok
        THEN
            goto 999;
        (*ENDIF*) 
        filled_len := trunc_len;
        IF  pad_len > 0
        THEN
            IF  op.epos = 0
            THEN
                FOR i := 1 TO pad_len DO
                    BEGIN
                    sel.sfp_workbuf_addr^
                          [sel.sfp_workbuf_len + filled_len + 2*i - 1] :=
                          op.ecol_tab [1];
                    sel.sfp_workbuf_addr^
                          [sel.sfp_workbuf_len + filled_len + 2*i    ] :=
                          op.ecol_tab [2];
                    END
                (*ENDFOR*) 
            ELSE
                kb78pad_string (sel.sfp_workbuf_size,
                      sel.sfp_workbuf_addr^,
                      sel.sfp_workbuf_len + 1 + trunc_len,
                      2*pad_len, operand_addr[ operand_count ]^,
                      len[ operand_count ], e);
            (*ENDIF*) 
        (*ENDIF*) 
        filled_len := filled_len + 2*pad_len;
        fill_len   := op.elen_var - 1;
        WHILE filled_len < fill_len DO
            BEGIN
            sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len + filled_len + 1] :=
                  csp_unicode_mark;
            sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len + filled_len + 2] :=
                  bsp_c1;
            filled_len := filled_len + 2
            END;
        (*ENDWHILE*) 
        END;
    (*ENDIF*) 
    sel.sfp_workbuf_len := sel.sfp_workbuf_len + op.elen_var - 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
      kb78decode (
            VAR op       : tgg00_StackEntry;
            VAR sel      : tgg00_SelectFieldsParam;
            VAR e        : tgg00_BasisError);
 
VAR
      check_is_null : boolean;
      found         : boolean;
      len           : integer;
      first_len     : integer;
      first_addr    : tsp00_MoveObjPtr;
      result_len    : integer;
      last_ptr      : tgg00_StEntryAddr;
      result_addr   : tsp00_MoveObjPtr;
      operand_addr  : tsp00_MoveObjPtr;
      l_result      : tsp00_LcompResult;
 
LABEL
      999;
 
BEGIN
IF  op.elen_var < 1
THEN
    BEGIN
    e := e_stack_type_illegal;
    goto 999;
    END;
(*ENDIF*) 
result_addr := @g01glob.undef_addr^;
result_len  := 1;
IF  op.elen_var MOD 2 = 0
THEN
    BEGIN
&   ifdef trace
    t01sname (kb_qual, 'default val ');
&   endif
    k71get_operand (sel, NOT c_check_spec_null, result_addr,
          result_len, e);
    IF  e <> e_ok
    THEN
        goto 999;
    (*ENDIF*) 
    last_ptr     := s35inc_st (sel.sfp_work_st_top, -1);
    END
ELSE
    last_ptr := sel.sfp_work_st_top;
(*ENDIF*) 
sel.sfp_work_st_top :=
      s35inc_st (sel.sfp_work_st_top, - op.elen_var + 1);
k71get_operand (sel, NOT c_check_spec_null, first_addr, first_len, e);
IF  e <> e_ok
THEN
    goto 999;
(*ENDIF*) 
check_is_null       := first_addr^ [1] = csp_undef_byte;
sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, 1);
found               := false;
WHILE s35gt_bufaddr (last_ptr, sel.sfp_work_st_top) DO
    BEGIN
    IF  found
    THEN
        BEGIN
        (* try to release sfp_workbuf *)
        IF  sel.sfp_work_st_top^.etype = st_result
        THEN
            IF  sel.sfp_work_st_top^.epos < sel.sfp_workbuf_top
            THEN
                sel.sfp_workbuf_top := sel.sfp_work_st_top^.epos - 1
            (*ENDIF*) 
        (*ENDIF*) 
        END
    ELSE
        BEGIN
        k71get_operand (sel,
              NOT c_check_spec_null, operand_addr, len, e);
        IF  e <> e_ok
        THEN
            goto 999;
        (*ENDIF*) 
        a05luc_space (sel.sfp_acv_addr, operand_addr^, 1 , len,
              first_addr^, 1, first_len, l_result);
        IF  (l_result = l_equal) OR
            ( check_is_null AND
            ( operand_addr^ [1] = csp_undef_byte ))
        THEN
            BEGIN
            found               := true;
            sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, 1);
            k71get_operand (sel, NOT c_check_spec_null,
                  result_addr, result_len, e);
            sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, -1);
            IF  e <> e_ok
            THEN
                goto 999;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, 2)
    END;
(*ENDWHILE*) 
IF  op.elen_var MOD 2 = 0
THEN
    sel.sfp_work_st_top := s35inc_st (last_ptr, - op.elen_var + 2)
ELSE
    sel.sfp_work_st_top := s35inc_st (last_ptr, - op.elen_var + 1);
(*ENDIF*) 
IF  sel.sfp_workbuf_top + result_len > sel.sfp_workbuf_size
THEN
    BEGIN
    e := e_stack_overflow;
    goto 999;
    END;
(*ENDIF*) 
sel.sfp_workbuf_len := sel.sfp_workbuf_top + 1;
SAPDB_PascalOverlappingMove ('VKB78 ',   9,
      sizeof(result_addr^), sel.sfp_workbuf_size,
      @result_addr^, 1, @sel.sfp_workbuf_addr^, sel.sfp_workbuf_len,
      result_len, e);
IF  e <> e_ok
THEN
    goto 999;
(*ENDIF*) 
WITH sel.sfp_work_st_top^ DO
    BEGIN
    etype         := st_result;
    eop           := op_none;
    epos          := sel.sfp_workbuf_len;
    elen_var      := result_len;
    ecol_tab [1]  := chr(0);
    ecol_tab [2]  := chr(0)
    END;
(*ENDWITH*) 
sel.sfp_workbuf_len := sel.sfp_workbuf_len + result_len - 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
      kb78expand (
            VAR op       : tgg00_StackEntry;
            VAR sel      : tgg00_SelectFieldsParam;
            VAR e        : tgg00_BasisError);
 
VAR
      len          : integer;
      undef        : boolean;
      operand_addr : tsp00_MoveObjPtr;
      pad_len      : tsp00_Int2;
      trunc_len    : integer;
      def_byte     : char;
 
LABEL
      999;
 
BEGIN
undef := false;
&ifdef TRACE
t01stackentry (kb_qual, op, 0);
&endif
IF  sel.sfp_workbuf_top + op.elen_var > 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*) 
undef := (operand_addr^ [1] = csp_undef_byte)  OR
      (op.ecol_tab  [1]     = csp_undef_byte)  OR
      (op.ecol_tab  [2]     = csp_undef_byte);
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      := op.elen_var;
    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;
    SAPDB_PascalFill ('VKB78 ',  10,
          sel.sfp_workbuf_size, @sel.sfp_workbuf_addr^,
          sel.sfp_workbuf_len + 1, op.elen_var - 1 , chr (0), e);
    IF  e <> e_ok
    THEN
        goto 999;
    (*ENDIF*) 
    END
ELSE
    BEGIN
    def_byte  := operand_addr^ [1];
    trunc_len := a05lnr_space_defbyte (sel.sfp_acv_addr,
          operand_addr, def_byte, 2, len-1);
    IF  trunc_len > op.elen_var - 1
    THEN
        IF  op.ecol_tab[1] = chr (1)
        THEN      (* Here we have to expand an expression inside of   *)
            BEGIN (* an expression list to the left to a subquery.    *)
            trunc_len := op.elen_var - 1;
            (* Since it's merely to test equality, and a value, which *)
            (* is too long, can't match any other value, we generate  *)
            (* an impossibly value by resetting the defined byte.     *)
            IF  def_byte = csp_defined_byte
            THEN
                def_byte := csp_ascii_blank
            ELSE
                def_byte := csp_defined_byte
            (*ENDIF*) 
            END
        ELSE
            BEGIN
            e := e_column_trunc;
            goto 999
            END;
        (*ENDIF*) 
    (*ENDIF*) 
    pad_len := op.elen_var - 1 - trunc_len;
    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len] := def_byte;
    IF  trunc_len > 0
    THEN
        SAPDB_PascalOverlappingMove ('VKB78 ',  11,
              sizeof(operand_addr^), sel.sfp_workbuf_size,
              @operand_addr^, 2,
              @sel.sfp_workbuf_addr^, sel.sfp_workbuf_len + 1,
              trunc_len, e);
    (*ENDIF*) 
    IF  e <> e_ok
    THEN
        goto 999;
    (*ENDIF*) 
    IF  pad_len > 0
    THEN
        IF  def_byte = csp_unicode_def_byte
        THEN
            SAPDB_PascalUnicodeFill ('VKB78 ',  12,
                  sizeof(sel.sfp_workbuf_addr^),
                  @sel.sfp_workbuf_addr^,
                  sel.sfp_workbuf_len + 1 + trunc_len, pad_len,
                  csp_unicode_blank, e)
        ELSE
            SAPDB_PascalFill ('VKB78 ',  13,
                  sel.sfp_workbuf_size, @sel.sfp_workbuf_addr^,
                  sel.sfp_workbuf_len + 1 + trunc_len,
                  pad_len, def_byte, e);
        (*ENDIF*) 
    (*ENDIF*) 
    IF  e <> e_ok
    THEN
        goto 999;
    (*ENDIF*) 
    sel.sfp_workbuf_len := sel.sfp_workbuf_len + op.elen_var - 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
      kb78fill_pad (
            VAR op         : tgg00_StackEntry;
            VAR sel        : tgg00_SelectFieldsParam;
            VAR e          : tgg00_BasisError);
 
VAR
      len            : ARRAY [1..3] OF integer;
      undef          : boolean;
      operand_addr   : ARRAY [1..3] OF tsp00_MoveObjPtr;
      pad_len        : tsp00_Int2;
      operand_count  : tsp00_Int2;
      trunc_len      : integer;
      i              : integer;
      def_byte       : char;
      num_err        : tsp00_NumError;
 
LABEL
      999;
 
BEGIN
&ifdef TRACE
t01stackentry (kb_qual, op, 0);
&endif
IF  op.eop_build_in in  [op_b_lfill, op_b_rfill]
THEN
    operand_count := 1
ELSE
    operand_count := 2;
(*ENDIF*) 
IF  op.epos = 1
THEN
    operand_count := succ (operand_count);
(*ENDIF*) 
IF  sel.sfp_workbuf_len + op.elen_var > sel.sfp_workbuf_size
THEN
    BEGIN
    e := e_stack_overflow;
    goto 999;
    END;
(*ENDIF*) 
undef := op.ecol_tab [1] = csp_undef_byte;
FOR i := operand_count 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;
    (*ENDIF*) 
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, -1)
    END;
(*ENDFOR*) 
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
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_work_st_top^.elen_var := op.elen_var;
    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);
    IF  trunc_len > op.elen_var - 1
    THEN
        BEGIN
        e := e_column_trunc;
        goto 999;
        END;
    (*ENDIF*) 
    IF  op.eop_build_in in  [op_b_lpad, op_b_rpad]
    THEN
        BEGIN
        s40gsint (operand_addr [2]^, 2, (len [2]-1-csp_attr_byte) * 2,
              pad_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*) 
        IF  pad_len < 0
        THEN
            BEGIN
            e := e_num_invalid;
            goto 999;
            END
        ELSE
            BEGIN
            IF  op.epos = 1
            THEN
                pad_len := pad_len * (len[ operand_count ] - 1);
            (*ENDIF*) 
            IF  trunc_len + pad_len > op.elen_var - 1
            THEN
                BEGIN
                e := e_column_trunc;
                goto 999;
                END
            (*ENDIF*) 
            END
        (*ENDIF*) 
        END
    ELSE
        pad_len := op.elen_var - 1 - trunc_len;
    (*ENDIF*) 
    IF  (op.eop_build_in IN  [op_b_lfill, op_b_lpad])
    THEN
        BEGIN
        IF  pad_len > 0
        THEN
            IF  op.epos = 0
            THEN
                SAPDB_PascalFill ('VKB78 ',  14,
                      sel.sfp_workbuf_size, @sel.sfp_workbuf_addr^,
                      sel.sfp_workbuf_len + 1, pad_len, op.ecol_tab [1], e)
            ELSE
                kb78pad_string (sel.sfp_workbuf_size,
                      sel.sfp_workbuf_addr^,
                      sel.sfp_workbuf_len + 1, pad_len,
                      operand_addr[ operand_count ]^,
                      len[ operand_count ], e);
            (*ENDIF*) 
        (*ENDIF*) 
        IF  e <> e_ok
        THEN
            goto 999;
        (*ENDIF*) 
        IF  trunc_len > 0
        THEN
            g10mv ('VKB78 ',  15,
                  sizeof(operand_addr [1]^), sel.sfp_workbuf_size,
                  @operand_addr [1]^, 2,
                  @sel.sfp_workbuf_addr^, sel.sfp_workbuf_len+1+pad_len,
                  trunc_len, e);
        (*ENDIF*) 
        IF  op.elen_var - 1 - pad_len - trunc_len > 0
        THEN
            SAPDB_PascalFill ('VKB78 ',  16,
                  sel.sfp_workbuf_size, @sel.sfp_workbuf_addr^,
                  sel.sfp_workbuf_len + 1 + pad_len + trunc_len,
                  op.elen_var - 1 - trunc_len - pad_len, def_byte, e);
        (*ENDIF*) 
        IF  e <> e_ok
        THEN
            goto 999;
        (*ENDIF*) 
        END
    ELSE
        IF  (op.eop_build_in IN  [op_b_rfill, op_b_rpad])
        THEN
            BEGIN
            IF  trunc_len > 0
            THEN
                g10mv ('VKB78 ',  17,
                      sizeof(operand_addr [1]^), sel.sfp_workbuf_size,
                      @operand_addr [1]^, 2,
                      @sel.sfp_workbuf_addr^, sel.sfp_workbuf_len + 1,
                      trunc_len, e);
            (*ENDIF*) 
            IF  e <> e_ok
            THEN
                goto 999;
            (*ENDIF*) 
            IF  pad_len > 0
            THEN
                IF  op.epos = 0
                THEN
                    SAPDB_PascalFill ('VKB78 ',  18,
                          sel.sfp_workbuf_size, @sel.sfp_workbuf_addr^,
                          sel.sfp_workbuf_len + 1 + trunc_len,
                          pad_len, op.ecol_tab [1], e)
                ELSE
                    kb78pad_string (sel.sfp_workbuf_size,
                          sel.sfp_workbuf_addr^,
                          sel.sfp_workbuf_len + 1 + trunc_len, pad_len,
                          operand_addr[ operand_count ]^,
                          len[ operand_count ], e);
                (*ENDIF*) 
            (*ENDIF*) 
            IF  op.elen_var - 1 - pad_len - trunc_len > 0
            THEN
                SAPDB_PascalFill ('VKB78 ',  19,
                      sel.sfp_workbuf_size, @sel.sfp_workbuf_addr^,
                      sel.sfp_workbuf_len+1+trunc_len+pad_len,
                      op.elen_var - 1 - trunc_len - pad_len, def_byte, e);
            (*ENDIF*) 
            IF  e <> e_ok
            THEN
                goto 999;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
    (*ENDIF*) 
    sel.sfp_workbuf_len := sel.sfp_workbuf_len + op.elen_var - 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
      kb78pad_string (
            buf_size   : tsp00_Int4;
            VAR buf    : tsp00_MoveObj;
            buf_pos    : tsp00_Int4;
            buf_len    : tsp00_Int4;
            VAR string : tsp00_MoveObj;
            string_len : tsp00_Int4;
            VAR e      : tgg00_BasisError);
 
VAR
      src_pos  : tsp00_Int4;
      dest_pos : tsp00_Int4;
      dest_end : tsp00_Int4;
 
BEGIN
src_pos  := 2; (* Skip the defined byte. *)
dest_pos := buf_pos;
dest_end := buf_pos + buf_len - 1;
IF  (buf_pos < 1) OR (dest_end > buf_size) OR
    (buf_len < 1) OR (string_len < 2)
THEN
    e := e_stack_type_illegal
ELSE
    WHILE dest_pos <= dest_end DO
        BEGIN
        buf[dest_pos] := string[src_pos];
        dest_pos      := succ (dest_pos);
        IF  src_pos < string_len
        THEN
            src_pos := succ (src_pos)
        ELSE
            src_pos := 2; (* Don't forget to skip the defined byte. *)
        (*ENDIF*) 
        END
    (*ENDWHILE*) 
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb78greatest_least (
            VAR op     : tgg00_StackEntry;
            VAR sel    : tgg00_SelectFieldsParam;
            compare_op : tsp00_LcompResult;
            VAR e      : tgg00_BasisError);
 
VAR
      undef        : boolean;
      len          : integer;
      found_len    : integer;
      found_ptr    : tgg00_StEntryAddr;
      last_ptr     : tgg00_StEntryAddr;
      found_addr   : tsp00_MoveObjPtr;
      operand_addr : tsp00_MoveObjPtr;
      l_result     : tsp00_LcompResult;
 
LABEL
      999;
 
BEGIN
last_ptr            := sel.sfp_work_st_top;
sel.sfp_work_st_top := s35inc_st (last_ptr, - op.elen_var + 1);
IF  s35gt_bufaddr (sel.sfp_work_st_bottom, sel.sfp_work_st_top)
THEN
    BEGIN
    e := e_stack_type_illegal;
    goto 999;
    END;
(*ENDIF*) 
found_ptr := NIL;
undef     := false;
WHILE s35le_bufaddr (sel.sfp_work_st_top, last_ptr) DO
    BEGIN
    IF  undef
    THEN
        BEGIN
        IF  sel.sfp_work_st_top^.etype = st_result
        THEN
            IF  sel.sfp_work_st_top^.epos < sel.sfp_workbuf_top
            THEN
                sel.sfp_workbuf_top := sel.sfp_work_st_top^.epos - 1
            (*ENDIF*) 
        (*ENDIF*) 
        END
    ELSE
        BEGIN
        k71get_operand (sel,
              NOT c_check_spec_null, operand_addr, len, e);
        IF  e <> e_ok
        THEN
            goto 999;
        (*ENDIF*) 
        IF  (operand_addr^ [1] = csp_oflw_byte ) OR
            (operand_addr^ [1] = csp_undef_byte)
        THEN
            undef := true
        ELSE
            BEGIN
            IF  found_ptr = NIL
            THEN
                l_result := compare_op
            ELSE
                a05luc_space (sel.sfp_acv_addr, operand_addr^, 1 , len,
                      found_addr^, 1, found_len, l_result);
            (*ENDIF*) 
            IF  l_result = compare_op
            THEN
                BEGIN
                found_addr := operand_addr;
                found_len  := len;
                found_ptr  := sel.sfp_work_st_top;
                END;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, 1)
    END;
(*ENDWHILE*) 
sel.sfp_work_st_top := s35inc_st (last_ptr, - op.elen_var + 1);
IF  NOT undef
THEN
    BEGIN
    IF  found_ptr^.etype = st_result
    THEN
        BEGIN
        IF  found_ptr <> sel.sfp_work_st_top
        THEN
            BEGIN
            SAPDB_PascalOverlappingMove ('VKB78 ',  20,
                  sel.sfp_workbuf_size, sel.sfp_workbuf_size,
                  @sel.sfp_workbuf_addr^, found_ptr^.epos,
                  @sel.sfp_workbuf_addr^,
                  sel.sfp_workbuf_top + 1, found_len, e);
            IF  e <> e_ok
            THEN
                goto 999;
            (*ENDIF*) 
            found_ptr^.epos := sel.sfp_workbuf_top + 1
            END;
        (*ENDIF*) 
        sel.sfp_work_st_top^ := found_ptr^;
        sel.sfp_workbuf_len  := found_ptr^.epos + found_len - 1
        END
    ELSE
        BEGIN
        sel.sfp_work_st_top^ := found_ptr^;
        sel.sfp_workbuf_len  := sel.sfp_workbuf_top
        END;
    (*ENDIF*) 
&   ifdef TRACE
    t01sname (kb_qual, '=== result: ');
    t01moveobj (kb_qual, found_addr^, 1, found_len);
&   endif
    END
ELSE
    BEGIN
    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       := 2;
        ecol_tab  [1] := chr(0);
        ecol_tab  [2] := chr(0);
        END;
    (*ENDWITH*) 
    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len] := csp_undef_byte;
&   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*) 
999 : ;
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb78index (
            VAR op      : tgg00_StackEntry;
            VAR sel     : tgg00_SelectFieldsParam;
            VAR e       : tgg00_BasisError);
 
CONST
      result_len = 3;
 
VAR
      len            : ARRAY  [1..4] OF integer;
      undef          : ARRAY  [1..4] OF boolean;
      operand_addr   : ARRAY  [1..4] OF tsp00_MoveObjPtr;
      operand_count  : integer;
      i              : integer;
      jump_len       : integer;
      skip_count     : tsp00_Int2;
      start_pos      : tsp00_Int2;
      found          : boolean;
      compare_result : tsp00_LcompResult;
      num_err        : tsp00_NumError;
 
LABEL
      999;
 
BEGIN
undef [1]     := false;
undef [2]     := false;
undef [3]     := false;
undef [4]     := false;
jump_len      := 1;
operand_count := ord(op.ecol_tab [1]);
IF  sel.sfp_workbuf_len + 1 + result_len > 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, 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 (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]  := 1 + a05lnr_space_defbyte (sel.sfp_acv_addr, operand_addr [i],
              operand_addr [i]^ [1], 2, len [i] - 1);
    (*ENDIF*) 
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, -1);
    END;
(*ENDFOR*) 
IF  NOT undef [1] AND NOT undef  [2]
THEN
    BEGIN
    IF  operand_addr [2]^ [1] = csp_unicode_def_byte
    THEN
        jump_len := 2
    ELSE
        IF  (operand_addr [1]^ [1] <> operand_addr  [2]^ [1])
            AND
            (operand_addr [2]^ [1] <> csp_defined_byte)
        THEN
            BEGIN
            IF  operand_addr [2]^ [1] = csp_unicode_def_byte
            THEN
                k71code_operand (sel, operand_addr [2]^ [1],
                      operand_addr [1], len [1],
                      s35inc_st (sel.sfp_work_st_top, 1), e)
            ELSE
                k71code_operand (sel, operand_addr [1]^ [1],
                      operand_addr [2], len [2],
                      s35inc_st (sel.sfp_work_st_top, 2), e);
            (*ENDIF*) 
            IF  e <> e_ok
            THEN
                goto 999;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  (operand_count >= 3) AND NOT undef [3]
THEN
    BEGIN
    s40gsint (operand_addr [3]^, 2, (len [3]-1-csp_attr_byte) * 2,
          start_pos, 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
    ELSE
        IF  operand_addr [2]^ [1] = csp_unicode_def_byte
        THEN
            start_pos := start_pos*2 - 1
        (*ENDIF*) 
    (*ENDIF*) 
    END
ELSE
    start_pos := 1;
(*ENDIF*) 
IF  (operand_count = 4) AND NOT undef [4]
THEN
    BEGIN
    s40gsint (operand_addr [4]^, 2, (len [4]-1-csp_attr_byte) * 2,
          skip_count, 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
ELSE
    skip_count := 1;
(*ENDIF*) 
IF  (start_pos < 1) OR (skip_count < 1)
THEN
    BEGIN
    e := e_num_invalid;
    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;
    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] := csp_defined_byte;
    sel.sfp_work_st_top^.elen_var := 1 + result_len;
    found := false;
    i     := start_pos + 1;
    IF  len [2] <= 1
    THEN
        found := true
    ELSE
        WHILE NOT found AND (i <= len [1] - len [2] + 2) DO
            BEGIN
            REPEAT
&               ifdef TRACE
                t01int4 (kb_qual, 'links       ', ord(operand_addr [1]^ [i]));
                t01int4 (kb_qual, 'rechts      ', ord(operand_addr [2]^ [2]));
&               endif
                IF  operand_addr [1]^ [i] = operand_addr [2]^ [2]
                THEN
                    found := true
                ELSE
                    i := i + jump_len
                (*ENDIF*) 
            UNTIL
                (i > len [1] - len [2] + 1) OR found;
            (*ENDREPEAT*) 
            IF  found
            THEN
                BEGIN
                IF  len [2] > 2
                THEN
                    s30cmp (operand_addr [1]^,  i + 1,
                          len [2] - 2, operand_addr [2]^,
                          3, len [2] - 2, compare_result)
                ELSE
                    compare_result := l_equal;
                (*ENDIF*) 
&               ifdef TRACE
                t01int4 (kb_qual, 'found bei i ', ord(found)*i);
                t01int4 (kb_qual, 'compare res ', ord(compare_result));
&               endif
                IF  (compare_result = l_equal)
                THEN
                    skip_count := pred(skip_count);
                (*ENDIF*) 
                found := ((compare_result = l_equal) AND
                      (skip_count <= 0));
                i := i + jump_len
                END;
            (*ENDIF*) 
            END;
        (*ENDWHILE*) 
    (*ENDIF*) 
    (* Defined Byte and last i+jump_len not necessary *)
&   ifdef TRACE
    t01int4 (kb_qual, 'i nun       ', i);
&   endif
    i := i - 1 - jump_len;
    IF  NOT found
    THEN
        i := 0
    ELSE
        IF  jump_len > 1
        THEN
            i := (i-1) DIV jump_len + 1;
        (*ENDIF*) 
    (*ENDIF*) 
    s41psint (sel.sfp_workbuf_addr^, sel.sfp_workbuf_len + 1,
          result_len, 0, i, 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*) 
    sel.sfp_workbuf_len := sel.sfp_workbuf_len + result_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 : ;
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb78length_ora (
            VAR op      : tgg00_StackEntry;
            VAR sel     : tgg00_SelectFieldsParam;
            VAR e       : tgg00_BasisError);
 
VAR
      undef        : boolean;
      spec_null    : boolean;
      num_err      : tsp00_NumError;
      operand_addr : tsp00_MoveObjPtr;
      len          : integer;
      result_len   : integer;
      w_buf_len    : integer;
      number       : tsp00_Number;
 
LABEL
      999;
 
BEGIN
(* The result of this procedure is the length of a number *)
(* in ORACLE-mode.                                        *)
result_len := 3;
undef      := false;
spec_null  := false;
e          := e_ok;
IF  sel.sfp_workbuf_len + 1 + mxsp_number + 1 + ord(op.ecol_tab [2])
    > 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;
&ifdef TRACE
(*ENDIF*) 
t01moveobj (kb_qual, operand_addr^, 1, len);
&endif
sel.sfp_workbuf_len := sel.sfp_workbuf_len + 1;
w_buf_len  := sel.sfp_workbuf_len;
undef      := (operand_addr^ [1] = csp_undef_byte);
spec_null  := (operand_addr^ [1] = csp_oflw_byte);
IF  undef
THEN
    BEGIN
    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len] := csp_undef_byte;
    result_len := 0
    END
ELSE
    IF  spec_null
    THEN
        BEGIN
        sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len]:= csp_oflw_byte;
        result_len := 0
        END
    ELSE
        BEGIN
        number := csp_null_number;
        g10mv ('VKB78 ',  21,
              len, sizeof (number), @operand_addr^, 2,
              @number, 1, len - 1, e);
        IF  e <> e_ok
        THEN
            goto 999;
        (*ENDIF*) 
        s42gochr (number, 1, sel.sfp_workbuf_addr^,
              w_buf_len + 1, len, num_err);
&       ifdef TRACE
        t01int4 (kb_qual,'len of str= ', len);
        t01moveobj (kb_qual, sel.sfp_workbuf_addr^, w_buf_len + 1, len);
&       endif
        (* len contains the string-length of the number-operand *)
        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*) 
        sel.sfp_workbuf_addr^[sel.sfp_workbuf_len] := csp_defined_byte;
        s41psint (sel.sfp_workbuf_addr^, sel.sfp_workbuf_len + 1,
              4, 0, 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*) 
        END;
    (*ENDIF*) 
(*ENDIF*) 
WITH sel.sfp_work_st_top^ DO
    BEGIN
    etype    := st_result;
    eop      := op_none;
    epos     := sel.sfp_workbuf_len;
    elen_var := 1 + result_len;
    ecol_tab [1] := chr(0);
    ecol_tab [2] := chr(0)
    END;
(*ENDWITH*) 
sel.sfp_workbuf_len := sel.sfp_workbuf_len + result_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 : ;
END;   (*   end of procedure kb78length_ora   *)
 
(*------------------------------*) 
 
PROCEDURE
      kb78dbyte_substr (
            VAR op       : tgg00_StackEntry;
            VAR sel      : tgg00_SelectFieldsParam;
            VAR e        : tgg00_BasisError);
 
VAR
      undef          : boolean;
      num_err        : tsp00_NumError;
      def_byte       : char;
      substr_pos     : tsp00_Int2;
      substr_len     : tsp00_Int2;
      operand_count  : integer;
      i              : integer;
      trunclen       : integer;
      move_len       : integer;
      len            : ARRAY  [1..3] OF integer;
      operand_addr   : ARRAY  [1..3] OF tsp00_MoveObjPtr;
 
LABEL
      999;
 
BEGIN
undef         := false;
operand_count := ord(op.ecol_tab [1]);
FOR i := operand_count 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  len [1] MOD 2 = 0
    THEN
        len [1] := succ (len [1]);
    (*ENDIF*) 
    IF  operand_addr [i]^ [1] = csp_undef_byte
    THEN
        undef := true;
    (*ENDIF*) 
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, -1)
    END;
(*ENDFOR*) 
substr_len := 0;
IF  NOT undef
THEN
    BEGIN
    s40gsint (operand_addr [2]^, 2, (len [2]-1-csp_attr_byte) * 2,
          substr_pos, 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*) 
    substr_pos := 2 * substr_pos - 1;
    IF  substr_pos < 1
    THEN
        BEGIN
        e := e_num_invalid;
        goto 999;
        END
    ELSE
        IF  substr_pos > op.epos
        THEN
            BEGIN
            e := e_column_trunc;
            goto 999;
            END;
        (*ENDIF*) 
    (*ENDIF*) 
    IF  operand_count <> 3
    THEN
        BEGIN
        trunclen := 1 + a05lnr_space_defbyte (sel.sfp_acv_addr, operand_addr [1],
              operand_addr [1]^ [1], 2, len [1] - 1);
        substr_len := trunclen - substr_pos;
        IF  substr_len < 0
        THEN
            substr_len := 0;
        (*ENDIF*) 
        END
    ELSE
        BEGIN
        s40gsint (operand_addr [3]^, 2, (len [3]-1-csp_attr_byte) * 2,
              substr_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*) 
        substr_len:= 2 * substr_len;
        IF  substr_len < 0
        THEN
            BEGIN
            e := e_num_invalid;
            goto 999;
            END
        ELSE
            IF  substr_len > op.elen_var
            THEN
                BEGIN
                e := e_column_trunc;
                goto 999;
                END;
            (*ENDIF*) 
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  (sel.sfp_workbuf_top + 1 + substr_len > sel.sfp_workbuf_size)
THEN
    BEGIN
    e := e_stack_overflow;
    goto 999;
    END;
(*ENDIF*) 
IF  NOT undef
THEN
    BEGIN
    def_byte := operand_addr [1]^ [1];
    IF  def_byte <> csp_unicode_def_byte
    THEN
        BEGIN
        k71code_operand (sel, csp_unicode_def_byte,
              operand_addr [1], len [1],
              s35inc_st (sel.sfp_work_st_top, 1), e);
        def_byte := csp_unicode_def_byte;
        END;
    (*ENDIF*) 
    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      := 1 + substr_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
    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len] := def_byte;
    IF  substr_pos < len  [1]
    THEN
        BEGIN
        move_len := len [1] - substr_pos;
        IF  move_len > substr_len
        THEN
            move_len := substr_len;
        (*ENDIF*) 
        IF  move_len > 0
        THEN
            SAPDB_PascalOverlappingMove ('VKB78 ',  22,
                  sizeof(operand_addr [1]^), sel.sfp_workbuf_size,
                  @operand_addr [1]^, 1 + substr_pos,
                  @sel.sfp_workbuf_addr^, sel.sfp_workbuf_len + 1,
                  move_len, e);
        (*ENDIF*) 
        IF  e <> e_ok
        THEN
            goto 999;
        (*ENDIF*) 
        END
    ELSE
        move_len := 0;
    (*ENDIF*) 
    IF  move_len < substr_len
    THEN
        BEGIN
        i := move_len + 1;
        WHILE i <= substr_len DO
            BEGIN
            sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len + i    ] :=
                  csp_unicode_mark;
            sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len + i + 1] :=
                  bsp_c1;
            i := i + 2
            END;
        (*ENDWHILE*) 
        END;
    (*ENDIF*) 
    sel.sfp_workbuf_len := sel.sfp_workbuf_len + substr_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 : ;
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb78substr (
            VAR op       : tgg00_StackEntry;
            VAR sel      : tgg00_SelectFieldsParam;
            VAR e        : tgg00_BasisError);
 
VAR
      undef         : boolean;
      num_err       : tsp00_NumError;
      def_byte      : char;
      substr_pos    : tsp00_Int2;
      substr_len    : tsp00_Int2;
      operand_count : integer;
      i             : integer;
      trunclen      : integer;
      move_len      : integer;
      len           : ARRAY  [1..3] OF integer;
      operand_addr  : ARRAY  [1..3] OF tsp00_MoveObjPtr;
 
LABEL
      999;
 
BEGIN
undef         := false;
operand_count := ord(op.ecol_tab [1]);
FOR i := operand_count 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;
    (*ENDIF*) 
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, -1)
    END;
(*ENDFOR*) 
substr_len := 0;
IF  NOT undef
THEN
    BEGIN
    s40gsint (operand_addr [2]^, 2, (len [2]-1-csp_attr_byte) * 2,
          substr_pos, 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*) 
    IF  substr_pos < 1
    THEN
        BEGIN
        e := e_num_invalid;
        goto 999;
        END
    ELSE
        IF  substr_pos > op.epos
        THEN
            BEGIN
            e := e_column_trunc;
            goto 999;
            END;
        (*ENDIF*) 
    (*ENDIF*) 
    IF  operand_count <> 3
    THEN
        BEGIN
        trunclen := 1 + a05lnr_space_defbyte (sel.sfp_acv_addr, operand_addr [1],
              operand_addr [1]^ [1], 2, len [1] - 1);
        substr_len := trunclen - substr_pos;
        IF  substr_len < 0
        THEN
            substr_len := 0;
        (*ENDIF*) 
        END
    ELSE
        BEGIN
        s40gsint (operand_addr [3]^, 2, (len [3]-1-csp_attr_byte) * 2,
              substr_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*) 
        IF  substr_len < 0
        THEN
            BEGIN
            e := e_num_invalid;
            goto 999;
            END
        ELSE
            IF  substr_len > op.elen_var
            THEN
                BEGIN
                e := e_column_trunc;
                goto 999;
                END;
            (*ENDIF*) 
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  sel.sfp_workbuf_top + 1 + substr_len > 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      := 1 + substr_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
    def_byte := operand_addr [1]^ [1];
    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len] := def_byte;
    IF  substr_pos < len  [1]
    THEN
        BEGIN
        move_len := len [1] - substr_pos;
        IF  move_len > substr_len
        THEN
            move_len := substr_len;
        (*ENDIF*) 
        IF  move_len > 0
        THEN
            SAPDB_PascalOverlappingMove ('VKB78 ',  23,
                  sizeof(operand_addr [1]^), sel.sfp_workbuf_size,
                  @operand_addr [1]^, 1 + substr_pos,
                  @sel.sfp_workbuf_addr^, sel.sfp_workbuf_len + 1,
                  move_len, e);
        (*ENDIF*) 
        END
    ELSE
        move_len := 0;
    (*ENDIF*) 
    IF  move_len < substr_len
    THEN
        SAPDB_PascalFill ('VKB78 ',  24,
              sel.sfp_workbuf_size, @sel.sfp_workbuf_addr^,
              sel.sfp_workbuf_len + move_len + 1,
              substr_len - move_len, def_byte, e);
    (*ENDIF*) 
    IF  e <> e_ok
    THEN
        goto 999;
    (*ENDIF*) 
    sel.sfp_workbuf_len := sel.sfp_workbuf_len + substr_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 : ;
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb78leftright (
            VAR op       : tgg00_StackEntry;
            VAR sel      : tgg00_SelectFieldsParam;
            VAR e        : tgg00_BasisError);
 
VAR
      undef         : boolean;
      num_err       : tsp00_NumError;
      def_byte      : char;
      strlen        : tsp00_Int2;
      operand_count : integer;
      i             : integer;
      move_len      : integer;
      len           : ARRAY  [1..2] OF integer;
      operand_addr  : ARRAY  [1..2] OF tsp00_MoveObjPtr;
      is_byte       : boolean;
 
LABEL
      999;
 
BEGIN
undef         := false;
operand_count := 2;
is_byte := ord(op.ecol_tab [1]) = 2;
FOR i := operand_count 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  is_byte
    THEN
        BEGIN
        IF  len [1] MOD 2 = 0
        THEN
            len [1] := succ (len [1])
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  operand_addr [i]^ [1] = csp_undef_byte
    THEN
        undef := true;
    (*ENDIF*) 
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, -1)
    END;
(*ENDFOR*) 
strlen := 0;
IF  NOT undef
THEN
    BEGIN
    s40gsint (operand_addr [2]^, 2, (len [2]-1-csp_attr_byte) * 2,
          strlen, num_err);
&   ifdef TRACE
    t01int4 (kb_qual, 'leftrightlen', strlen);
    t01int4 (kb_qual, 'len_1       ', len [1]);
    t01int4 (kb_qual, 'len_2       ', len [2]);
&   endif
    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*) 
    IF  is_byte
    THEN
        strlen := 2 * strlen;
    (*ENDIF*) 
    IF  strlen < 0
    THEN
        BEGIN
        e := e_num_invalid;
        goto 999;
        END
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  (sel.sfp_workbuf_len+1+strlen > 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      := 1 + strlen;
    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;
    move_len := 0;
    END
ELSE
    BEGIN
    def_byte := operand_addr [1]^ [1];
    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len] := def_byte;
    move_len := strlen;
    (* SQL Server distinguishes CHAR and VARCHAR, we use as if VARCHAR *)
    len [1] := 1 + a05lnr_space_defbyte (sel.sfp_acv_addr, operand_addr [1],
          operand_addr [1]^ [1],
          2, len [1] - 1);
    IF  len [1] < strlen
    THEN
        move_len := len [1] - 1;
    (*ENDIF*) 
    IF  op.eop_build_in = op_b_left
    THEN
        g10mv ('VKB78 ',  25,
              sizeof(operand_addr [1]^), sel.sfp_workbuf_size,
              @operand_addr [1]^, 2,
              @sel.sfp_workbuf_addr^, sel.sfp_workbuf_len + 1,
              move_len, e)
    ELSE
        g10mv ('VKB78 ',  26,
              sizeof(operand_addr [1]^), sel.sfp_workbuf_size,
              @operand_addr [1]^, len  [1] - move_len + 1,
              @sel.sfp_workbuf_addr^, sel.sfp_workbuf_len + 1,
              move_len, e);
    (*ENDIF*) 
    IF  e <> e_ok
    THEN
        goto 999;
    (*ENDIF*) 
    sel.sfp_workbuf_len := sel.sfp_workbuf_len + move_len;
    END;
(*ENDIF*) 
sel.sfp_work_st_top^.elen_var := 1 + move_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 : ;
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb78to_char (
            VAR op        : tgg00_StackEntry;
            VAR sel       : tgg00_SelectFieldsParam;
            VAR e         : tgg00_BasisError);
 
VAR
      op_pos         : integer;
      dest_pos       : integer;
      language_op    : integer;
      language_name  : tsp00_C3;
      language       : tsp6_language;
      language_found : boolean;
      len            : ARRAY  [1 .. 3] OF integer;
      undef          : ARRAY  [1 .. 3] OF boolean;
      operand_addr   : ARRAY  [1 .. 3] OF tsp00_MoveObjPtr;
      date_e         : tsp6_date_error;
      comp_buf       : tsp00_C120;
      comp_mptr      : tsp00_MoveObjPtr;
      comp_len       : tsp00_Int2;
 
LABEL
      999;
 
BEGIN
e := e_ok;
(* PTS 1001130 E.Z. *)
CASE op.epos OF
    0 :
        BEGIN
        op_pos := 3;
        language_op := 3
        END;
    1 :
        BEGIN
        op_pos := 2;
        language_op := 2
        END;
    2 :
        BEGIN
        op_pos := 2;
        language_op := 0
        END;
    3 :
        BEGIN
        op_pos := 1;
        language_op := 0;
        undef [ 2 ] := false
        END;
    OTHERWISE
        BEGIN
        e := e_stack_type_illegal;
        goto 999
        END;
    END;
(*ENDCASE*) 
WHILE op_pos >= 1 DO
    BEGIN
    k71get_operand (sel, c_check_spec_null,
          operand_addr [op_pos], len [op_pos], e);
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, - 1);
    IF  (e <> e_ok)
    THEN
        goto 999;
    (*ENDIF*) 
    undef [op_pos] := (operand_addr [op_pos]^ [1] = csp_undef_byte);
&   ifdef TRACE
    t01moveobj   (kb_qual, operand_addr [op_pos]^, 1, len [op_pos]);
&   endif
    op_pos := pred (op_pos)
    END;
(*ENDWHILE*) 
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;
    elen_var      := op.elen_var;
    ecol_tab [1] := chr(0);
    ecol_tab [2] := chr(0)
    END;
(*ENDWITH*) 
IF  undef [1] OR 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
    BEGIN
    (* PTS 1001130 E.Z. *)
    IF  language_op > 0
    THEN
        BEGIN
        IF  undef [language_op] OR (len [language_op] <> mxsp_c3+1)
        THEN
            BEGIN
            e := e_stack_type_illegal;
            goto 999
            END;
        (*ENDIF*) 
        FOR op_pos := 1 TO mxsp_c3 DO
            language_name [op_pos] := operand_addr [language_op]^ [op_pos+1];
        (*ENDFOR*) 
        s78language (g03dictionary,
              language_name, language, NOT c_for_init, language_found);
        END;
    (*ENDIF*) 
    IF  sel.sfp_workbuf_len + op.elen_var > sel.sfp_workbuf_size
    THEN (* Is there enough place on the stack? *)
        BEGIN
        e := e_stack_overflow;
        goto 999;
        END;
    (*ENDIF*) 
    IF  g01code.ctype = csp_ascii
    THEN
        sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len] := csp_ascii_blank
    ELSE
        sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len] := csp_defined_byte;
    (*ENDIF*) 
    dest_pos            := sel.sfp_workbuf_len + 1;
    sel.sfp_workbuf_len := dest_pos + op.elen_var;
    CASE op.epos OF
        0: (* TO_CHAR (<timestamp>, <format>) *)
            BEGIN
            IF  (operand_addr[ 2 ]^[ 1 ] = csp_ascii_blank) OR
                (operand_addr[ 2 ]^[ 1 ] = csp_ebcdic_blank)
            THEN
                BEGIN
                comp_len := sizeof (comp_buf);
                s78df_analyze (operand_addr[ 2 ], len[ 2 ],
                      @comp_buf, comp_len, NOT c_to_date_format, date_e);
                IF  date_e <> sp6de_ok
                THEN
                    BEGIN
                    e := g03date_error_to_b_err (date_e);
                    goto 999
                    END;
                (*ENDIF*) 
                operand_addr[ 2 ] := @comp_buf;
                len[ 2 ]          := comp_len
                END;
&           ifdef trace
            (*ENDIF*) 
            comp_mptr := @comp_buf;
            t01moveobj (kb_qual, comp_mptr^, 1, sizeof (comp_buf));
&           endif
            s78d2c_to_char (g03dictionary.dict[ language ],
                  operand_addr [1], operand_addr[ 2 ], len[ 2 ],
                  sel.sfp_workbuf_size, sel.sfp_workbuf_addr,
                  dest_pos, sel.sfp_workbuf_len, date_e);
            e := g03date_error_to_b_err (date_e)
            END;
        1: (* TO_CHAR (<timestamp>>) *)
            BEGIN
            comp_len := sizeof (comp_buf);
            s78df_default (@comp_buf, comp_len, date_e);
            IF  date_e = sp6de_ok
            THEN
                s78d2c_to_char (g03dictionary.dict[ language ],
                      operand_addr[ 1 ], @comp_buf, comp_len,
                      sel.sfp_workbuf_size, sel.sfp_workbuf_addr,
                      dest_pos, sel.sfp_workbuf_len, date_e);
            (*ENDIF*) 
            e := g03date_error_to_b_err (date_e)
            END;
        2: (* TO_CHAR (<number>, <format>) *)
            kb78nu_to_char_number (operand_addr [1], len [1] - 1,
                  operand_addr [2], len [2],
                  dest_pos, op.elen_var, sel, e);
        3: (* TO_CHAR (<number>>) *)
            kb78nud_to_char_number_default (operand_addr [1], len [1] - 1,
                  ord (op.ecol_tab [2]), ord (op.ecol_tab [1]),
                  dest_pos, op.elen_var, sel, e);
        OTHERWISE
            e := e_stack_type_illegal
        END;
    (*ENDCASE*) 
    IF  e <> e_ok
    THEN
        goto 999;
    (*ENDIF*) 
    IF  dest_pos < sel.sfp_workbuf_len
    THEN (* Fill it up with blanks. *)
        SAPDB_PascalFill ('VKB78 ',  27,
              sel.sfp_workbuf_size, @sel.sfp_workbuf_addr^,
              dest_pos, sel.sfp_workbuf_len - dest_pos, ' ', e)
    (*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 : ;
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb78nu_to_char_number (
            num_addr     : tsp00_MoveObjPtr;
            num_len      : integer; (* without defined byte! *)
            format_addr  : tsp00_MoveObjPtr;
            format_len   : integer;
            VAR dest_pos : integer;
            dest_len     : integer;
            VAR sel      : tgg00_SelectFieldsParam;
            VAR e        : tgg00_BasisError);
 
LABEL
      999;
 
CONST
      c_max_comma = 13;
 
VAR
      curr_fmt    : tkb07_ora_number_fmt_elem;
      dollar      : tkb07_ora_number_fmt_elem;
      dot_kind    : tkb07_ora_number_fmt_elem;
      fmt_pos     : tsp00_Int4;
      start_pos   : integer;
      curr_pos    : integer;
      first_digpos: integer;
      sign_spec   : boolean;
      skip_zero   : boolean;
      loop_end    : boolean;
      found       : boolean;
      is_negativ  : boolean;
      dot_pos     : integer;
      roman_pos   : tsp00_Int4;
      abs_number  : tsp00_Number;
      zero_pos    : integer; (* pos of first 0 in format (or 0). *)
      comma_count : integer;
      erg_len     : integer;
      fraction    : integer;
      comma_pos   : ARRAY  [1..c_max_comma] OF integer;
      comma_com   : ARRAY  [1..c_max_comma] OF boolean;
      width       : integer; (* count of 0 and 9 in the format.  *)
      num_err     : tsp00_NumError;
      pos_char    : ARRAY  [1..2] OF char;
      neg_char    : ARRAY  [1..2] OF char;
      comma       : char;
 
BEGIN
sign_spec   := false;
skip_zero   := false;
dollar      := onf_no_correct_format;
(* PTS 1001476 E.Z. *)
dot_kind    := onf_no_correct_format;
dot_pos     := 0;
zero_pos    := 0;
roman_pos   := 0;
width       := 0;
comma_count := 0;
fmt_pos     := 2;
first_digpos:= dest_pos;
pos_char [1] := chr (0);
pos_char [2] := chr (0);
neg_char [1] := chr (0);
neg_char [2] := chr (0);
curr_fmt := k79ora_number_format (format_addr^, format_len, fmt_pos);
IF  curr_fmt = onf_sign_at_this_position
THEN (* Oracle7: A plus- or minus-sign at the left of the number. *)
    BEGIN
    k79new_pos_ora_number_format (curr_fmt, fmt_pos);
    pos_char [1] := '+';
    neg_char [1] := '-';
    sign_spec     := true
    END;
(*ENDIF*) 
loop_end := false;
WHILE (fmt_pos <= format_len) AND NOT loop_end DO
    BEGIN
    curr_fmt := k79ora_number_format (format_addr^,
          format_len, fmt_pos);
    CASE curr_fmt OF
        onf_currency_dollar, onf_currency_iso, onf_currency_local:
            IF  dollar <> onf_no_correct_format
            THEN (* Don't do this twice. *)
                BEGIN
                e := e_number_format_not_recogniz;
                goto 999
                END
            ELSE
                dollar := curr_fmt;
            (*ENDIF*) 
        onf_blank: (* Display zero value as blank, not "0". *)
            IF  skip_zero
            THEN (* Don't do this twice. *)
                BEGIN
                e := e_number_format_not_recogniz;
                goto 999
                END
            ELSE
                skip_zero := true;
            (*ENDIF*) 
        onf_decimal_dot, onf_decimal_point, onf_decimal_implicit:
            BEGIN (* Display a dot at this position. *)
            IF  dot_pos <> 0
            THEN (* Only one im- or explicit decimal point. *)
                BEGIN
                e := e_number_format_not_recogniz;
                goto 999
                END;
            (*ENDIF*) 
            dot_pos  := width;
            dot_kind := curr_fmt;
            IF  (zero_pos = 0)
            THEN
                zero_pos := dot_pos+1
            (*ENDIF*) 
            END;
        onf_seperator, onf_seperator_comma:
            IF  comma_count < c_max_comma
            THEN
                BEGIN (* Display a comma at this position. *)
                comma_count := succ (comma_count);
                comma_pos [comma_count] := width;
                comma_com [comma_count] := curr_fmt = onf_seperator_comma
                END;
            (*ENDIF*) 
        onf_nine, onf_zero:
            BEGIN (* Determines display width and leading zeroes. *)
            width := succ (width);
            IF  (curr_fmt = onf_zero) AND (zero_pos = 0)
            THEN (* Only the position of the first zero is interesting. *)
                zero_pos := width+1;
            (*ENDIF*) 
            END;
        onf_no_correct_format:
            BEGIN
            e := e_number_format_not_recogniz;
            goto 999
            END;
        onf_roman_numeral_lower, onf_roman_numeral_upper:
            BEGIN
            roman_pos := fmt_pos;
            k79new_pos_ora_number_format (curr_fmt, roman_pos);
            IF  (fmt_pos <> 2) OR (roman_pos <= format_len)
            THEN (* This format spec must be the one and only. *)
                BEGIN
                e := e_number_format_not_recogniz;
                goto 999
                END;
            (*ENDIF*) 
            loop_end := true
            END
        OTHERWISE
            loop_end := true
        END;
    (*ENDCASE*) 
    k79new_pos_ora_number_format (curr_fmt, fmt_pos);
    END;
(*ENDWHILE*) 
IF  roman_pos <> 0
THEN
    kb78roman_number (curr_fmt, num_addr^, num_len,
          sel, dest_pos, num_err)
ELSE
    BEGIN
    IF  dot_pos = 0
    THEN (* A little correction, if no fraction is wanted. *)
        dot_pos := width;
    (*ENDIF*) 
    IF  curr_fmt = onf_exponent
    THEN (* The scientific notation with exponent is wanted. *)
        BEGIN
        k79new_pos_ora_number_format (curr_fmt, fmt_pos);
        fraction := csp_float_frac
        END
    ELSE
        fraction := width-dot_pos;
    (*ENDIF*) 
    IF  NOT sign_spec (* If the sign isn't already specified... *)
    THEN
        (* At the end of the format (and only there) can stand one *)
        (* of the following suffixes, which determines the output  *)
        (* of negative numbers.   *)
        CASE curr_fmt OF
            onf_sign_at_end:
                BEGIN (* A minus-sign at the right end of the number. *)
                k79new_pos_ora_number_format (curr_fmt, fmt_pos);
                pos_char [2] := ' ';
                neg_char [2] := '-';
                END;
            onf_sign_brackets:
                BEGIN (* Angles should be printed (like <312>). *)
                k79new_pos_ora_number_format (curr_fmt, fmt_pos);
                pos_char [1] := ' ';
                neg_char [1] := '<';
                pos_char [2] := ' ';
                neg_char [2] := '>';
                END;
            onf_sign_at_this_position:
                BEGIN (* Oracle7: A plus- or minus-sign right here. *)
                k79new_pos_ora_number_format (curr_fmt, fmt_pos);
                pos_char [2] := '+';
                neg_char [2] := '-';
                END
            OTHERWISE
                BEGIN (* A minus-sign at the left end of the number. *)
                pos_char [1] := ' ';
                neg_char [1] := '-';
                END;
            END;
        (*ENDCASE*) 
    (*ENDIF*) 
    IF  fmt_pos <= format_len
    THEN
        BEGIN
        e := e_number_format_not_recogniz;
        goto 999
        END;
    (*ENDIF*) 
    IF  NOT skip_zero OR (ord (num_addr^ [2]) <> ord (cgg04_zero_exponent))
    THEN (* we have to print the number. *)
        BEGIN
        is_negativ := ord (num_addr^ [2]) < ord (cgg04_zero_exponent);
        SAPDB_PascalForcedFill (sizeof (abs_number), @abs_number,
              1, sizeof (abs_number), chr (0));
        IF  is_negativ
        THEN (* changing the exponent for resetting the sign. *)
            s51abs (num_addr^, 2, num_len, abs_number, 1, csp_fixed,
                  csp_float_frac, erg_len, num_err)
        ELSE
            BEGIN
            g10mv ('VKB78 ',  28,
                  sizeof (num_addr^), sizeof (abs_number),
                  @num_addr^, 2, @abs_number, 1, num_len, e);
            IF  e <> e_ok
            THEN
                goto 999;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        (* Note that s42gstr writes an define byte at the given dest_pos. *)
        s42gstr (abs_number, 1, width, fraction, num_len,
              sel.sfp_workbuf_addr^, dest_pos-1, dest_len, num_err);
        start_pos := dest_pos;              (* for later use.          *)
        dest_pos  := dest_pos + dest_len-1; (* -1 for the define byte. *)
        IF  zero_pos <> 0
        THEN
            BEGIN
            WHILE (zero_pos < dest_len) DO
                IF  sel.sfp_workbuf_addr^ [zero_pos] = ' '
                THEN
                    BEGIN
                    sel.sfp_workbuf_addr^ [zero_pos] := '0';
                    zero_pos := succ (zero_pos)
                    END
                ELSE
                    zero_pos := dest_len
                (*ENDIF*) 
            (*ENDWHILE*) 
            END;
        (*ENDIF*) 
        curr_pos := dest_pos-1;
        dest_pos := dest_pos+comma_count;
        comma    := ',';
        WHILE (comma_count > 0) AND (curr_pos > start_pos) DO
            BEGIN
            sel.sfp_workbuf_addr^ [curr_pos+comma_count] :=
                  sel.sfp_workbuf_addr^ [curr_pos];
            IF  sel.sfp_workbuf_addr^ [curr_pos-1] = ' '
            THEN (* We only insert commas into filled numbers. *)
                comma := ' ';
            (*ENDIF*) 
            IF  curr_pos = start_pos + comma_pos [comma_count]
            THEN
                BEGIN
                comma_count := pred (comma_count);
                sel.sfp_workbuf_addr^ [curr_pos+comma_count] := comma;
                END;
            (*ENDIF*) 
            curr_pos := pred (curr_pos)
            END;
        (*ENDWHILE*) 
        IF  dot_kind = onf_decimal_implicit
        THEN
            BEGIN
            found := false;
&           ifdef TRACE
            t01int4 (kb_qual, 'dest_pos    ', dest_pos);
            t01int4 (kb_qual, 'start_pos   ', start_pos);
&           endif
            FOR curr_pos := start_pos TO dest_pos DO
                IF  found
                THEN
                    sel.sfp_workbuf_addr^ [curr_pos-1] :=
                          sel.sfp_workbuf_addr^ [curr_pos]
                ELSE
                    found := sel.sfp_workbuf_addr^ [curr_pos] = '.';
                (*ENDIF*) 
            (*ENDFOR*) 
            dest_pos := pred (dest_pos)
            END;
        (*ENDIF*) 
        IF  dollar <> onf_no_correct_format
        THEN
            kb78insert_before_number (sel, first_digpos, dest_pos, '$');
        (*ENDIF*) 
        kb78put_sign (sel, first_digpos, dest_pos, is_negativ, c_before,
              pos_char [1], neg_char [1]);
        kb78put_sign (sel, first_digpos, dest_pos, is_negativ, NOT c_before,
              pos_char [2], neg_char [2]);
        END
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  (num_err <> num_ok) AND (num_err <> num_trunc)
THEN
    WITH sel, sfp_work_st_top^ DO
        SAPDB_PascalFill ('VKB78 ',  29,
              sfp_workbuf_size, @sfp_workbuf_addr^,
              epos+1, elen_var-1, '#', e);
    (*ENDWITH*) 
(*ENDIF*) 
999 : ;
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb78nud_to_char_number_default (
            num_addr     : tsp00_MoveObjPtr;
            length       : integer; (* length of num in bytes. *)
            num_len      : integer; (* number of digits, not bytes! *)
            num_frac     : integer; (* number of digits after dot   *)
            VAR dest_pos : integer;
            dest_len     : integer;
            VAR sel      : tgg00_SelectFieldsParam;
            VAR e        : tgg00_BasisError);
 
LABEL
      999;
 
VAR
      erg_len   : integer;
      num_err   : tsp00_NumError;
      number    : tsp00_Number;
      digits    : integer;
 
BEGIN
WITH sel DO
    BEGIN
    number := csp_null_number;
    g10mv ('VKB78 ',  30,
          sizeof (num_addr^), sizeof (number),
          @num_addr^, 2, @number, 1, length, e);
    IF  e <> e_ok
    THEN
        goto 999;
    (*ENDIF*) 
    digits := 2*(length-1);
    IF  digits = 0
    THEN
        digits := num_len;
    (*ENDIF*) 
    IF  chr (num_frac) = chr (csp_float_frac)
    THEN
        num_frac := csp_float_frac;
    (*ENDIF*) 
    s42gstr (number, 1, digits, num_frac, digits,
          sfp_workbuf_addr^, dest_pos, erg_len, num_err);
    IF  (num_err <> num_ok) AND (num_err <> num_trunc)
    THEN
        WITH sfp_work_st_top^ DO
            SAPDB_PascalFill ('VKB78 ',  31,
                  sfp_workbuf_size, @sfp_workbuf_addr^,
                  epos+1, elen_var-1, '#', e)
        (*ENDWITH*) 
    ELSE
        BEGIN
        dest_pos  := dest_pos + erg_len;
        IF  erg_len < dest_len
        THEN (* fill it up with blanks. *)
            SAPDB_PascalFill ('VKB78 ',  32,
                  sel.sfp_workbuf_size, @sel.sfp_workbuf_addr^,
                  dest_pos, dest_len-erg_len, chr(0), e);
        (*ENDIF*) 
        END
    (*ENDIF*) 
    END;
(*ENDWITH*) 
999 : ;
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb78put_sign (
            VAR sel      : tgg00_SelectFieldsParam;
            first_digpos : integer;
            VAR dest_pos : integer;
            is_negativ   : boolean;
            before       : boolean;
            pos_char     : char;
            neg_char     : char);
 
VAR
      insert_char : char;
 
BEGIN
IF  (pos_char > chr (0)) AND (neg_char > chr (0))
THEN
    BEGIN
    IF  is_negativ
    THEN
        insert_char := neg_char
    ELSE
        insert_char := pos_char;
    (*ENDIF*) 
    IF  before
    THEN
        kb78insert_before_number (sel, first_digpos, dest_pos, insert_char)
    ELSE
        BEGIN
        sel.sfp_workbuf_addr^ [dest_pos] := insert_char;
        dest_pos := succ (dest_pos)
        END
    (*ENDIF*) 
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb78insert_before_number (
            VAR sel      : tgg00_SelectFieldsParam;
            first_digpos : integer;
            VAR dest_pos : integer;
            insert_char  : char);
 
VAR
      start_pos : integer;
      curr_pos  : integer;
 
BEGIN
WITH sel DO
    BEGIN
    start_pos := first_digpos;
    WHILE (start_pos < dest_pos) AND
          (sfp_workbuf_addr^ [start_pos] = ' ') DO
        start_pos := succ (start_pos);
    (*ENDWHILE*) 
    FOR curr_pos := dest_pos DOWNTO start_pos DO
        sfp_workbuf_addr^ [curr_pos+1] := sfp_workbuf_addr^ [curr_pos];
    (*ENDFOR*) 
    sfp_workbuf_addr^ [start_pos] := insert_char;
    dest_pos := succ (dest_pos)
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb78roman_number (
            curr_fmt     : tkb07_ora_number_fmt_elem;
            VAR num      : tsp00_MoveObj;
            num_len      : integer;
            VAR sel      : tgg00_SelectFieldsParam;
            VAR dest_pos : integer;
            VAR num_err  : tsp00_NumError);
 
LABEL
      999;
 
VAR
      rom_dig   : ARRAY  [1..7] OF char;
      rom_div   : ARRAY  [0..1] OF integer;
      j         : integer;
      k         : integer;
      u         : integer;
      v         : integer;
      val       : tsp00_Int4;
      start_pos : integer;
      to_code   : integer;
 
BEGIN
s40glint (num, 2, (num_len-1) * 2, val, num_err);
IF  num_err <> num_ok
THEN
    goto 999;
(*ENDIF*) 
IF  (val < 1) OR (val > 3999)
THEN (* Number is out of range. *)
    BEGIN
    num_err := num_overflow;
    goto 999
    END;
(*ENDIF*) 
start_pos    := dest_pos;
num_err      := num_ok;
rom_dig      := 'mdclxvi';
rom_div [0] := 2;
rom_div [1] := 5;
j            := 1;
v            := 1000;
WHILE 42 = 42 DO
    BEGIN
    WHILE val >= v DO
        BEGIN
        sel.sfp_workbuf_addr^ [dest_pos] := rom_dig [j];
        dest_pos := succ (dest_pos);
        val := val - v
        END;
    (*ENDWHILE*) 
    IF  val <= 0
    THEN      (* Number is completely converted.   *)
        BEGIN (* If wanted, convert to upper case. *)
        IF  curr_fmt = onf_roman_numeral_upper
        THEN
            BEGIN
            IF  (g01code.ctype = csp_ascii)
            THEN
                to_code := cgg04_up_ascii
            ELSE
                to_code := cgg04_up_ebcdic;
            (*ENDIF*) 
            s30map (g02codetables.tables [to_code],
                  sel.sfp_workbuf_addr^, start_pos,
                  sel.sfp_workbuf_addr^, start_pos, dest_pos-start_pos+1)
            END;
        (*ENDIF*) 
        goto 999; (* ... und tschuess. *)
        END;
    (*ENDIF*) 
    k := j+1;
    u := v DIV rom_div [k MOD 2];
    IF  k MOD 2 = 0
    THEN
        BEGIN
        k := succ (k);
        u := u DIV rom_div [k MOD 2];
        END;
    (*ENDIF*) 
    IF  val + u >= v
    THEN
        BEGIN
        sel.sfp_workbuf_addr^ [dest_pos] := rom_dig [k];
        dest_pos := succ (dest_pos);
        val := val + u
        END
    ELSE
        BEGIN
        j := succ (j);
        v := v DIV rom_div [j MOD 2]
        END
    (*ENDIF*) 
    END;
(*ENDWHILE*) 
999: ;
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb78to_date (
            VAR op        : tgg00_StackEntry;
            VAR sel       : tgg00_SelectFieldsParam;
            VAR e         : tgg00_BasisError);
 
VAR
      src_pos        : integer;
      language_op    : integer;
      language_name  : tsp00_C3;
      language       : tsp6_language;
      language_found : boolean;
      len            : ARRAY [ 1 .. 4 ] OF integer;
      undef          : ARRAY [ 1 .. 4 ] OF boolean;
      operand_addr   : ARRAY [ 1 .. 4 ] OF tsp00_MoveObjPtr;
      date_e         : tsp6_date_error;
      comp_buf       : tsp00_C120;
      comp_mptr      : tsp00_MoveObjPtr;
      comp_len       : tsp00_Int2;
 
LABEL
      999;
 
BEGIN
e := e_ok;
IF  op.epos = 1
THEN
    src_pos := 3
ELSE
    src_pos := 4;
(*ENDIF*) 
language_op := src_pos;
WHILE src_pos >= 1 DO
    BEGIN
    k71get_operand (sel, c_check_spec_null,
          operand_addr[ src_pos ], len[ src_pos ], e);
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, - 1);
    IF  e <> e_ok
    THEN
        goto 999;
    (*ENDIF*) 
    undef[ src_pos ] := operand_addr[ src_pos ]^[ 1 ] = csp_undef_byte;
&   ifdef TRACE
    t01moveobj (kb_qual, operand_addr[ src_pos ]^, 1, len[ src_pos ]);
&   endif
    src_pos := pred (src_pos)
    END;
(*ENDWHILE*) 
IF  undef[ language_op-1 ] OR (len[ language_op-1 ] <> mxsp_date+1) OR
    undef[ language_op ]   OR (len[ language_op ]   <> mxsp_c3+1)
THEN
    BEGIN
    e := e_stack_type_illegal;
    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;
    elen_var      := op.elen_var;
    ecol_tab[ 1 ] := chr(0);
    ecol_tab[ 2 ] := chr(0)
    END;
(*ENDWITH*) 
IF  undef[ 1 ] OR ((op.epos = 0) AND 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
    BEGIN
    FOR src_pos := 1 TO mxsp_c3 DO
        language_name[ src_pos ] := operand_addr[ language_op ]^[ src_pos+1 ];
    (*ENDFOR*) 
    IF  g01code.ctype = csp_ascii
    THEN
        sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len ] := csp_ascii_blank
    ELSE
        sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len ] := csp_defined_byte;
    (*ENDIF*) 
    s78language (g03dictionary,
          language_name, language, NOT c_for_init, language_found);
    IF  e <> e_ok
    THEN
        goto 999;
    (*ENDIF*) 
    IF  sel.sfp_workbuf_len + op.elen_var > sel.sfp_workbuf_size
    THEN (* Is there enough place on the stack? *)
        BEGIN
        e := e_stack_overflow;
        goto 999;
        END;
    (*ENDIF*) 
    sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len ] := operand_addr[ 1 ]^[ 1 ];
    sel.sfp_workbuf_len := succ (sel.sfp_workbuf_len);
    IF  op.epos = 1
    THEN (* default in the form 'DD-MON-YY' *)
        BEGIN
        comp_len := sizeof (comp_buf);
        s78df_default (@comp_buf, comp_len, date_e);
        IF  date_e <> sp6de_ok
        THEN
            BEGIN
            e := g03date_error_to_b_err (date_e);
            goto 999
            END;
        (*ENDIF*) 
        operand_addr[ 3 ] := operand_addr[ 2 ];
        len[ 3 ]          := len[ 2 ];
        operand_addr[ 2 ] := @comp_buf;
        len[ 2 ]          := comp_len
        END
    ELSE
        BEGIN
        IF  (operand_addr[ 2 ]^[ 1 ] = csp_ascii_blank) OR
            (operand_addr[ 2 ]^[ 1 ] = csp_ebcdic_blank)
        THEN
            BEGIN
            comp_len := sizeof (comp_buf);
            (* PTS 1109357 E.Z. *)
            len[ 2 ] := 1 +
                  a05lnr_space_defbyte (sel.sfp_acv_addr,
                  operand_addr [2], operand_addr[2]^[1], 2, len[ 2 ] - 1);
            s78df_analyze (operand_addr[ 2 ], len[ 2 ],
                  @comp_buf, comp_len, NOT c_to_date_format, date_e);
            IF  date_e <> sp6de_ok
            THEN
                BEGIN
                e := g03date_error_to_b_err (date_e);
                goto 999
                END;
            (*ENDIF*) 
            operand_addr[ 2 ] := @comp_buf;
            len[ 2 ]          := comp_len
            END
        (*ENDIF*) 
        END;
    (*ENDIF*) 
&   ifdef trace
    comp_mptr := @comp_buf;
    t01moveobj (kb_qual, comp_mptr^, 1, comp_len);
&   endif
    s78c2d_to_date (g03dictionary.dict[ language ],
          operand_addr[ 3 ],           (* current_date *)
          operand_addr[ 2 ], len[ 2 ], (* format       *)
          operand_addr[ 1 ], len[ 1 ], (* src          *)
          sel.sfp_workbuf_addr, sel.sfp_workbuf_len, date_e);
    e := g03date_error_to_b_err (date_e)
    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
      kb78name_from_date (
            VAR op        : tgg00_StackEntry;
            VAR sel       : tgg00_SelectFieldsParam;
            VAR e         : tgg00_BasisError);
 
CONST
      operand_count    = 2;
 
VAR
      i              : integer;
      undef          : ARRAY  [1..2] OF boolean;
      len            : ARRAY  [1..2] OF integer;
      operand_addr   : ARRAY  [1..2] OF tsp00_MoveObjPtr;
      language_name  : tsp00_C3;
      language       : tsp6_language;
      language_found : boolean;
      year           : integer;
      month          : integer;
      week           : integer;
      day            : integer;
      dest_pos       : integer;
      month_name     : boolean;
      date_e         : tsp6_date_error;
 
LABEL
      999;
 
BEGIN
e       := e_ok;
i := operand_count;
month_name := (op.ecol_tab [1] = chr(0));
WHILE (i >= 1) DO
    BEGIN
    k71get_operand (sel, c_check_spec_null, operand_addr [i], len [i], e);
    IF  e <> e_ok
    THEN
        goto 999;
&   ifdef TRACE
    (*ENDIF*) 
    t01moveobj (kb_qual, operand_addr [i]^, 1, len [i]);
&   endif
    undef [i] := (operand_addr [i]^ [1] = csp_undef_byte);
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, - 1);
    i := i - 1
    END;
(*ENDWHILE*) 
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;
    elen_var      := op.elen_var;
    ecol_tab [1] := chr(0);
    ecol_tab [2] := chr(0)
    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
    FOR i := 1 TO mxsp_c3 DO
        language_name [i] := operand_addr [2]^ [i+1];
    (*ENDFOR*) 
    s78language (g03dictionary,
          language_name, language, NOT c_for_init, language_found);
    IF  month_name
    THEN
        s78year_month_day (operand_addr [1]^, 1,
              year, month, day, date_e)
    ELSE
        s78week_and_day (operand_addr [1]^, 1,
              week, day, date_e);
    (*ENDIF*) 
    e := g03date_error_to_b_err (date_e);
    IF  e <> e_ok
    THEN
        goto 999;
    (*ENDIF*) 
    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len] := csp_ascii_blank;
    dest_pos := sel.sfp_workbuf_len + 1;
    IF  language_found
    THEN
        IF  month_name
        THEN
            IF  (month >= 1) AND (month <= 12)
            THEN
                WITH g03dictionary.dict[ language ].dict_lang_month [ month ] DO
                    BEGIN
                    IF  (dest_pos + length - 1 > sel.sfp_workbuf_size)
                    THEN
                        BEGIN
&                       ifdef trace
                        t01int4 (kb_qual, 'dest_pos    ', dest_pos);
                        t01int4 (kb_qual, 'copy_len    ', length);
                        t01int4 (kb_qual, 'dest_size   ', sel.sfp_workbuf_size);
&                       endif
                        e := e_stack_overflow;
                        goto 999
                        END;
                    (*ENDIF*) 
                    g10mv ('VKB78 ',  33,
                          sizeof (string), sel.sfp_workbuf_size,
                          @string, 1, @sel.sfp_workbuf_addr^, dest_pos,
                          length, e);
                    sel.sfp_workbuf_len := dest_pos + length - 1;
                    sel.sfp_work_st_top^.elen_var := succ(length)
                    END
                (*ENDWITH*) 
            ELSE
                BEGIN
                e := e_invalid_date;
                goto 999
                END
            (*ENDIF*) 
        ELSE
            IF  (day >= 1) AND (day <= 7)
            THEN
                WITH g03dictionary.dict[ language ].dict_lang_day [ day ] DO
                    BEGIN
                    IF  (dest_pos + length - 1 > sel.sfp_workbuf_size)
                    THEN
                        BEGIN
&                       ifdef trace
                        t01int4 (kb_qual, 'dest_pos    ', dest_pos);
                        t01int4 (kb_qual, 'copy_len    ', length);
                        t01int4 (kb_qual, 'dest_size   ', sel.sfp_workbuf_size);
&                       endif
                        e := e_stack_overflow;
                        goto 999
                        END;
                    (*ENDIF*) 
                    g10mv ('VKB78 ',  34,
                          sizeof (string), sel.sfp_workbuf_size,
                          @string, 1, @sel.sfp_workbuf_addr^, dest_pos,
                          length, e);
                    sel.sfp_workbuf_len := dest_pos + length - 1;
                    sel.sfp_work_st_top^.elen_var := succ(length)
                    END
                (*ENDWITH*) 
            ELSE
                BEGIN
                e := e_invalid_date;
                goto 999
                END
            (*ENDIF*) 
        (*ENDIF*) 
    ELSE
        BEGIN
        sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len] := csp_undef_byte;
        sel.sfp_work_st_top^.elen_var := 1
        END
    (*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 : ;
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb78to_24_char (
            VAR sel : tgg00_SelectFieldsParam;
            VAR e : tgg00_BasisError);
 
VAR
      def_byte     : char;
      move_len     : integer;
      len          : integer;
      undef        : boolean;
      operand_addr : tsp00_MoveObjPtr;
 
LABEL
      999;
 
BEGIN
e     := e_ok;
undef := false;
k71get_operand (sel, c_check_spec_null, operand_addr, len, e);
IF  e <> e_ok
THEN
    goto 999;
&ifdef TRACE
(*ENDIF*) 
t01moveobj (kb_qual, operand_addr^, 1, len);
&endif
undef               := (operand_addr^ [1] = csp_undef_byte);
sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, -1);
IF  (sel.sfp_workbuf_len + cgg04_oradate_len_to_char + 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       := cgg04_oradate_len_to_char + 1;
    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
    def_byte := operand_addr^ [1];
    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len] := def_byte;
    move_len := 0;
    IF  len > 1
    THEN
        BEGIN
        move_len := len - 1;
        IF  move_len > cgg04_oradate_len_to_char
        THEN
            move_len := cgg04_oradate_len_to_char;
        (*ENDIF*) 
        IF  move_len > 0
        THEN
            g10mv ('VKB78 ',  35,
                  sizeof(operand_addr^), sel.sfp_workbuf_size,
                  @operand_addr^, 2,
                  @sel.sfp_workbuf_addr^, sel.sfp_workbuf_len + 1,
                  move_len, e);
        (*ENDIF*) 
        IF  e <> e_ok
        THEN
            goto 999;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  move_len < cgg04_oradate_len_to_char
    THEN
        SAPDB_PascalFill ('VKB78 ',  36,
              sel.sfp_workbuf_size, @sel.sfp_workbuf_addr^,
              sel.sfp_workbuf_len + move_len + 1,
              cgg04_oradate_len_to_char - move_len, def_byte, e);
    (*ENDIF*) 
    sel.sfp_workbuf_len := sel.sfp_workbuf_len +
          cgg04_oradate_len_to_char;
    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
      kb78toidentifier (
            VAR op     : tgg00_StackEntry;
            VAR sel    : tgg00_SelectFieldsParam;
            VAR e      : tgg00_BasisError);
 
VAR
      do_map         : boolean;
      is_unicode     : boolean;
      def_byte       : char;
      work_pos       : integer;
      len            : integer;
      pos            : integer;
      to_code        : integer;
      operand_addr   : tsp00_MoveObjPtr;
      aux_addr       : tsp00_MoveObjPtr;
 
      sqlmode : RECORD
            CASE boolean OF
                true :
                    (c : tsp00_C1);
                false :
                    (mode : tsp00_SqlMode);
                END;
            (*ENDCASE*) 
 
      mapped_operand : tsp00_C132;
 
LABEL
      999;
 
BEGIN
k71get_operand (sel, c_check_spec_null, operand_addr, len, e);
IF  e <> e_ok
THEN
    goto 999;
(*ENDIF*) 
def_byte := operand_addr^[1];
IF  def_byte <> csp_undef_byte
THEN
    BEGIN
    len  := a05lnr_space_defbyte (sel.sfp_acv_addr,
          operand_addr, def_byte, 2, len-1) + 1;
    is_unicode := def_byte = csp_unicode_def_byte;
    do_map     := (def_byte <> bsp_c1) AND NOT is_unicode;
    IF  do_map
    THEN
        BEGIN
        IF  g01code.ctype = csp_ascii
        THEN
            g02tebcdic_to_ascii (operand_addr^, mapped_operand, len)
        ELSE
            g02tascii_to_ebcdic (operand_addr^, mapped_operand, len);
        (*ENDIF*) 
        operand_addr := @mapped_operand
        END;
    (*ENDIF*) 
    aux_addr     := s35add_moveobj_ptr (operand_addr, 1);
    sqlmode.c[1] := op.ecol_tab[1];
    IF  (len > 1) AND
        NOT a01is_identifier (aux_addr^, len - 1, sqlmode.mode)
    THEN
        BEGIN
        work_pos := sel.sfp_workbuf_len + 1;
        IF  work_pos + 2 > sel.sfp_workbuf_size
        THEN
            BEGIN
            e := e_stack_overflow;
            goto 999
            END;
        (*ENDIF*) 
        IF  is_unicode
        THEN
            BEGIN
            sel.sfp_workbuf_addr^[work_pos  ] := csp_unicode_def_byte;
            sel.sfp_workbuf_addr^[work_pos+1] := csp_unicode_mark;
            sel.sfp_workbuf_addr^[work_pos+2] := '"';
            work_pos := work_pos + 2;
            pos      := 2;
            WHILE pos < len DO
                BEGIN
                IF  (operand_addr^[pos  ] = csp_unicode_mark) AND
                    (operand_addr^[pos+1] = '"')
                THEN
                    BEGIN
                    IF  work_pos + 6 > sel.sfp_workbuf_size
                    THEN
                        BEGIN
                        e := e_stack_overflow;
                        goto 999
                        END;
                    (*ENDIF*) 
                    sel.sfp_workbuf_addr^[work_pos+1] := csp_unicode_mark;
                    sel.sfp_workbuf_addr^[work_pos+2] := '"';
                    sel.sfp_workbuf_addr^[work_pos+3] := csp_unicode_mark;
                    sel.sfp_workbuf_addr^[work_pos+4] := '"';
                    work_pos := work_pos + 4
                    END
                ELSE
                    BEGIN
                    IF  work_pos + 4 > sel.sfp_workbuf_size
                    THEN
                        BEGIN
                        e := e_stack_overflow;
                        goto 999
                        END;
                    (*ENDIF*) 
                    sel.sfp_workbuf_addr^[work_pos+1] :=
                          operand_addr^[pos];
                    sel.sfp_workbuf_addr^[work_pos+2] :=
                          operand_addr^[pos+1];
                    work_pos := work_pos + 2
                    END;
                (*ENDIF*) 
                pos := pos + 2
                END;
            (*ENDWHILE*) 
            sel.sfp_workbuf_addr^[work_pos+1] := csp_unicode_mark;
            sel.sfp_workbuf_addr^[work_pos+2] := '"';
            work_pos := work_pos + 2
            END
        ELSE
            BEGIN
            sel.sfp_workbuf_addr^[work_pos] := bsp_c1;
            work_pos                        := work_pos + 1;
            sel.sfp_workbuf_addr^[work_pos] := '"';
            FOR pos := 2 TO len DO
                IF  operand_addr^[pos] = '"'
                THEN
                    BEGIN
                    IF  work_pos + 3 > sel.sfp_workbuf_size
                    THEN
                        BEGIN
                        e := e_stack_overflow;
                        goto 999
                        END;
                    (*ENDIF*) 
                    sel.sfp_workbuf_addr^[work_pos+1] := '"';
                    sel.sfp_workbuf_addr^[work_pos+2] := '"';
                    work_pos := work_pos + 2
                    END
                ELSE
                    BEGIN
                    IF  work_pos + 2 > sel.sfp_workbuf_size
                    THEN
                        BEGIN
                        e := e_stack_overflow;
                        goto 999
                        END;
                    (*ENDIF*) 
                    work_pos := work_pos + 1;
                    sel.sfp_workbuf_addr^[work_pos] := operand_addr^[pos]
                    END;
                (*ENDIF*) 
            (*ENDFOR*) 
            work_pos                        := work_pos + 1;
            sel.sfp_workbuf_addr^[work_pos] := '"';
            END;
        (*ENDIF*) 
        WITH sel.sfp_work_st_top^ DO
            BEGIN
            etype         := st_result;
            eop           := op_none;
            epos          := sel.sfp_workbuf_len + 1;
            elen_var      := work_pos - epos + 1;
            ecol_tab [1] := chr(0);
            ecol_tab [2] := chr(0);
            IF  do_map
            THEN
                BEGIN
                IF  g01code.ctype = csp_ebcdic
                THEN
                    to_code := cgg04_to_ascii
                ELSE
                    to_code := cgg04_to_ebcdic;
                (*ENDIF*) 
                s30map (g02codetables.tables[to_code],
                      sel.sfp_workbuf_addr^, epos,
                      sel.sfp_workbuf_addr^, epos, elen_var)
                END
            (*ENDIF*) 
            END;
        (*ENDWITH*) 
        sel.sfp_workbuf_len := work_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
        END;
    (*ENDIF*) 
    END;
(*ENDIF*) 
999 : ;
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb78dbyte_trim (
            VAR op     : tgg00_StackEntry;
            VAR sel    : tgg00_SelectFieldsParam;
            VAR e      : tgg00_BasisError);
 
VAR
      undef           : boolean;
      found           : boolean;
      operand_addr1   : tsp00_MoveObjPtr;
      operand_addr2   : tsp00_MoveObjPtr;
      para_count      : tsp00_Int2;
      define_pos      : integer;
      end_pos         : integer;
      pos1            : integer;
      pos2            : integer;
      len1            : integer;
      len2            : integer;
      unicode_letter  : tsp00_C2;
      define_chars    : tsp00_C3;
 
LABEL
      999;
 
BEGIN
e          := e_ok;
undef      := false;
para_count := ord (op.ecol_tab [1]);
&ifdef TRACE
t01int4 (kb_qual, 'cnt of param', para_count);
&endif
IF  (para_count = 2)
THEN
    BEGIN
    k71get_operand (sel, c_check_spec_null, operand_addr2, len2, e);
    IF  (NOT (sel.sfp_work_st_top^.etype in [st_value, st_result])) OR
        ((sel.sfp_work_st_top^.etype = st_value) AND (len2 = 1))
    THEN
        len2 := a05lnr_space_defbyte (sel.sfp_acv_addr,
              operand_addr2, operand_addr2^[1],
              2, len2 - 1) + 1;
    (*ENDIF*) 
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, - 1);
    IF  (e <> e_ok)
    THEN
        goto 999;
    (*ENDIF*) 
    undef := (operand_addr2^ [1] = csp_undef_byte);
&   ifdef TRACE
    t01sname (kb_qual, '2. Parameter');
    t01moveobj   (kb_qual, operand_addr2^, 1, len2);
&   endif
    END;
(*ENDIF*) 
IF  NOT undef
THEN
    BEGIN
    k71get_operand (sel, c_check_spec_null, operand_addr1, len1, e);
    IF  (e <> e_ok)
    THEN
        goto 999;
    (*ENDIF*) 
    undef := (undef OR (operand_addr1^ [1] = csp_undef_byte));
&   ifdef TRACE
    t01sname (kb_qual, '1. Parameter');
    t01moveobj   (kb_qual, operand_addr1^, 1, len1);
&   endif
    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;
    len1 := 1;
    END
ELSE
    BEGIN
    IF  (para_count = 1)
    THEN
        BEGIN
        define_chars[1]  := csp_unicode_def_byte;
        define_chars[2]  := csp_unicode_mark;
        define_chars[3]  := bsp_c1;
        operand_addr2    := @define_chars;
        len2             := 3;
        END;
    (*ENDIF*) 
    len1  := a05lnr_space_defbyte (sel.sfp_acv_addr,
          operand_addr1, operand_addr1^ [1], 2, len1 - 1) + 1;
    define_pos := 2;
    end_pos    := len1;
    IF  (op.eop_build_in IN  [op_b_dbyte_trim, op_b_dbyte_ltrim])
    THEN
        BEGIN
        pos1  := 2;
        found := true;
        WHILE ((pos1 < end_pos) AND found) DO
            BEGIN
            unicode_letter [1] := operand_addr1^ [pos1  ];
            unicode_letter [2] := operand_addr1^ [pos1+1];
            pos2   := 1;
            found  := false;
            WHILE (pos2 < len2) AND NOT found DO
                BEGIN
                IF  (operand_addr2^ [1+pos2  ] <> unicode_letter [1]) OR
                    (operand_addr2^ [1+pos2+1] <> unicode_letter [2])
                THEN
                    pos2 := pos2 + 2
                ELSE
                    BEGIN
                    found      := true;
                    define_pos := pos1 + 2;
                    END;
                (*ENDIF*) 
                END;
            (*ENDWHILE*) 
            pos1 := pos1 + 2;
            END;
        (*ENDWHILE*) 
        len1 := end_pos - define_pos + 2;
        END;
&   ifdef TRACE
    (*ENDIF*) 
    t01int4 (kb_qual, 'end_pos:    ', end_pos);
    t01int4 (kb_qual, 'define_pos: ', define_pos);
&   endif
    IF  (op.eop_build_in in  [op_b_dbyte_trim, op_b_dbyte_rtrim])
    THEN
        BEGIN
        pos1  := define_pos + len1 - 3;
        IF  (para_count = 2)
        THEN
            BEGIN
            found := true;
            WHILE ((define_pos <= pos1) AND found) DO
                BEGIN
                unicode_letter [1] := operand_addr1^ [pos1  ];
                unicode_letter [2] := operand_addr1^ [pos1+1];
                pos2   := 1;
                found  := false;
                WHILE (pos2 < len2) AND NOT found DO
                    BEGIN
                    IF  (operand_addr2^ [1+pos2  ] <> unicode_letter [1]) OR
                        (operand_addr2^ [1+pos2+1] <> unicode_letter [2])
                    THEN
                        pos2  := pos2 + 2
                    ELSE
                        BEGIN
                        found := true;
                        pos1  := pos1 - 2
                        END;
                    (*ENDIF*) 
                    END;
                (*ENDWHILE*) 
                END;
            (*ENDWHILE*) 
            END;
        (*ENDIF*) 
        len1 := pos1 + 2 - define_pos + 1;
        END;
    (*ENDIF*) 
    sel.sfp_workbuf_len := sel.sfp_workbuf_len + 1;
    IF  (sel.sfp_workbuf_len + len1 > sel.sfp_workbuf_size)
    THEN
        BEGIN
        e := e_stack_overflow;
        goto 999;
        END;
    (*ENDIF*) 
    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len] := operand_addr1^ [1];
    IF  len1 > 1
    THEN
        g10mv ('VKB78 ',  37,
              sizeof(operand_addr1^), sel.sfp_workbuf_size,
              @operand_addr1^, define_pos,
              @sel.sfp_workbuf_addr^, sel.sfp_workbuf_len + 1,
              len1 - 1, e);
    (*ENDIF*) 
    IF  e <> e_ok
    THEN
        goto 999;
    (*ENDIF*) 
    END;
(*ENDIF*) 
WITH sel.sfp_work_st_top^ DO
    BEGIN
    etype         := st_result;
    eop           := op_none;
    epos          := sel.sfp_workbuf_len;
    elen_var      := len1;
    ecol_tab [1] := chr(0);
    ecol_tab [2] := chr(0)
    END;
(*ENDWITH*) 
sel.sfp_workbuf_len := sel.sfp_workbuf_len + len1 - 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
      kb78trim (
            VAR op     : tgg00_StackEntry;
            VAR sel    : tgg00_SelectFieldsParam;
            VAR e      : tgg00_BasisError);
 
VAR
      undef         : boolean;
      found         : boolean;
      operand_addr1 : tsp00_MoveObjPtr;
      operand_addr2 : tsp00_MoveObjPtr;
      para_count    : tsp00_Int2;
      define_pos    : integer;
      end_pos       : integer;
      pos1          : integer;
      pos2          : integer;
      len1          : integer;
      len2          : integer;
      letter        : char;
      define_chars  : tsp00_C2;
      num_err       : tsp00_NumError;
      number        : tsp00_Number;
 
LABEL
      999;
 
BEGIN
e          := e_ok;
undef      := false;
para_count := ord (op.ecol_tab [1]);
&ifdef TRACE
t01int4 (kb_qual, 'cnt of param', para_count);
&endif
IF  (para_count = 2)
THEN
    BEGIN
&   ifdef TRACE
    t01sname (kb_qual, '2. Parameter');
&   endif
    k71get_operand (sel, c_check_spec_null, operand_addr2, len2, e);
    IF  (NOT (sel.sfp_work_st_top^.etype in [st_value, st_result])) OR
        ((sel.sfp_work_st_top^.etype = st_value) AND (len2 = 1))
    THEN
        len2 := a05lnr_space_defbyte (sel.sfp_acv_addr,
              operand_addr2, operand_addr2^[1],
              2, len2 - 1) + 1;
    (*ENDIF*) 
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, - 1);
    IF  e <> e_ok
    THEN
        goto 999;
    (*ENDIF*) 
    IF  operand_addr2^ [1] = csp_undef_byte
    THEN
        undef := true
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  NOT undef
THEN
    BEGIN
    k71get_operand (sel, c_check_spec_null, operand_addr1, len1, e);
    IF  e <> e_ok
    THEN
        goto 999;
    (*ENDIF*) 
    IF  operand_addr1^ [1] = csp_undef_byte
    THEN
        undef := true;
    (*ENDIF*) 
    IF  (NOT undef AND (operand_addr1^ [1] = csp_defined_byte))
    THEN
        BEGIN
        (* it's a number-value *)
        number := csp_null_number;
        g10mv ('VKB78 ',  38,
              len1, sizeof (number),
              @operand_addr1^, 2, @number, 1, len1 - 1, e);
        IF  e <> e_ok
        THEN
            goto 999;
        (*ENDIF*) 
        IF  sel.sfp_workbuf_len + mxsp_c40 > sel.sfp_workbuf_size
        THEN
            BEGIN
            e := e_stack_overflow;
            goto 999
            END;
        (*ENDIF*) 
        operand_addr1 := @sel.sfp_workbuf_addr^[sel.sfp_workbuf_len+1];
        IF  (op.elen_var <> ord (sqlm_oracle))
        THEN
            s42gchr (number, 1, ord (op.ecol_tab [2]),
                  ord (op.epos), ord (op.ecol_tab [2]),
                  operand_addr1^, 2, len1, num_err)
        ELSE
            s42gochr (number, 1, operand_addr1^, 2, len1, num_err);
        (*ENDIF*) 
        len1              := len1 + 1;
        operand_addr1^[1] := bsp_c1;
&       ifdef TRACE
        t01sname (kb_qual, 'Operand new ');
        t01moveobj   (kb_qual, operand_addr1^, 1, len1);
&       endif
        IF  (num_err <> num_ok)
        THEN
            BEGIN
&           ifdef TRACE
            t01int4  (kb_qual, 'numeric err.', ord (num_err));
&           endif
            k71num_err_to_b_err (num_err, e);
            IF  (e <> e_ok)
            THEN
                goto 999;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        END
    (*ENDIF*) 
    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;
    len1 := 1;
    END
ELSE
    BEGIN
    IF  (para_count = 1)
    THEN
        BEGIN
        define_chars [1] := operand_addr1^ [1];
        define_chars [2] := operand_addr1^ [1];
        operand_addr2    := @define_chars;
        len2             := 2;
        END
    ELSE
        IF  ((operand_addr1^ [1] <> operand_addr2^ [1]) AND
            (operand_addr2^  [1] <> csp_defined_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*) 
    (*ENDIF*) 
    len1  := a05lnr_space_defbyte (sel.sfp_acv_addr,
          operand_addr1, operand_addr1^ [1], 2, len1 - 1) + 1;
    define_pos := 1;
    end_pos    := len1;
    IF  (op.eop_build_in IN  [op_b_trim, op_b_ltrim])
    THEN
        BEGIN
        pos1  := 2;
        found := true;
        WHILE ((pos1 <= end_pos) AND found) DO
            BEGIN
            letter := operand_addr1^ [pos1];
            pos2   := 2;
            found  := false;
            WHILE (pos2 <= len2) AND NOT found DO
                BEGIN
                IF  (operand_addr2^ [pos2] <> letter)
                THEN
                    pos2       := succ (pos2)
                ELSE
                    BEGIN
                    found      := true;
                    define_pos := pos1;
                    END;
                (*ENDIF*) 
                END;
            (*ENDWHILE*) 
            pos1 := succ (pos1);
            END;
        (*ENDWHILE*) 
        len1 := end_pos - define_pos + 1;
        END;
&   ifdef TRACE
    (*ENDIF*) 
    t01int4 (kb_qual, 'end_pos:    ', end_pos);
    t01int4 (kb_qual, 'define_pos: ', define_pos);
&   endif
    IF  (op.eop_build_in in  [op_b_trim, op_b_rtrim])
    THEN
        BEGIN
        pos1  := define_pos + len1 - 1;
        IF  (para_count = 2)
        THEN
            BEGIN
            found := true;
            WHILE ((define_pos < pos1)  AND found) DO
                BEGIN
                letter := operand_addr1^ [pos1];
                pos2   := 2;
                found  := false;
                WHILE (pos2 <= len2) AND NOT found DO
                    BEGIN
                    IF  (operand_addr2^ [pos2] <> letter)
                    THEN
                        pos2  := succ (pos2)
                    ELSE
                        BEGIN
                        found := true;
                        pos1  := pred (pos1)
                        END;
                    (*ENDIF*) 
                    END;
                (*ENDWHILE*) 
                END;
            (*ENDWHILE*) 
            END;
        (*ENDIF*) 
        len1 := pos1 - define_pos + 1;
        END;
    (*ENDIF*) 
    sel.sfp_workbuf_len := sel.sfp_workbuf_top + 1;
    IF  (sel.sfp_workbuf_len + len1 > sel.sfp_workbuf_size)
    THEN
        BEGIN
        e := e_stack_overflow;
        goto 999;
        END;
    (*ENDIF*) 
    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len] := operand_addr1^ [1];
    IF  len1 > 1
    THEN
        BEGIN
        SAPDB_PascalOverlappingMove ('VKB78 ',  39,
              sizeof(operand_addr1^), sel.sfp_workbuf_size,
              @operand_addr1^, define_pos + 1,
              @sel.sfp_workbuf_addr^, sel.sfp_workbuf_len + 1,
              len1 - 1, e);
        IF  e <> e_ok
        THEN
            goto 999;
        (*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      := len1;
    ecol_tab [1] := chr(0);
    ecol_tab [2] := chr(0)
    END;
(*ENDWITH*) 
sel.sfp_workbuf_len := sel.sfp_workbuf_len + len1;
&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
      kb78value (
            VAR op      : tgg00_StackEntry;
            VAR sel     : tgg00_SelectFieldsParam;
            VAR e       : tgg00_BasisError);
 
VAR
      undef        : boolean;
      len          : integer;
      last_ptr     : tgg00_StEntryAddr;
      found_ptr    : tgg00_StEntryAddr;
      operand_addr : tsp00_MoveObjPtr;
 
LABEL
      999;
 
BEGIN
IF  s35le_bufaddr (s35inc_st (sel.sfp_work_st_top, - op.elen_var + 1),
    sel.sfp_work_st_bottom)
THEN
    BEGIN
    e := e_stack_type_illegal;
    goto 999;
    END;
(*ENDIF*) 
last_ptr            := sel.sfp_work_st_top;
found_ptr           := NIL;
sel.sfp_work_st_top := s35inc_st (last_ptr, - op.elen_var + 1);
WHILE s35le_bufaddr (sel.sfp_work_st_top, last_ptr) DO
    BEGIN
    IF  found_ptr <> NIL
    THEN
        BEGIN
        IF  sel.sfp_work_st_top^.etype = st_result
        THEN
            IF  sel.sfp_work_st_top^.epos < sel.sfp_workbuf_top
            THEN
                sel.sfp_workbuf_top := sel.sfp_work_st_top^.epos - 1
            (*ENDIF*) 
        (*ENDIF*) 
        END
    ELSE
        BEGIN
        k71get_operand (sel,
              NOT c_check_spec_null, operand_addr, len, e);
        IF  e <> e_ok
        THEN
            goto 999;
        (*ENDIF*) 
        IF  (operand_addr^[1] <> csp_undef_byte) AND
            (operand_addr^[1] <> csp_oflw_byte)
        THEN
            found_ptr := sel.sfp_work_st_top;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, 1)
    END;
(*ENDWHILE*) 
sel.sfp_work_st_top := s35inc_st (last_ptr, - op.elen_var + 1);
IF  found_ptr = NIL
THEN (* nothing found, return undef *)
    found_ptr := sel.sfp_work_st_top;
(*ENDIF*) 
IF  found_ptr^.etype = st_result
THEN
    BEGIN
    IF  found_ptr <> sel.sfp_work_st_top
    THEN
        BEGIN
        SAPDB_PascalOverlappingMove ('VKB78 ',  40,
              sel.sfp_workbuf_size, sel.sfp_workbuf_size,
              @sel.sfp_workbuf_addr^, found_ptr^.epos,
              @sel.sfp_workbuf_addr^, sel.sfp_workbuf_top + 1,
              found_ptr^.elen_var, e);
        IF  e <> e_ok
        THEN
            goto 999;
        (*ENDIF*) 
        found_ptr^.epos := sel.sfp_workbuf_top + 1
        END;
    (*ENDIF*) 
    sel.sfp_workbuf_len := sel.sfp_workbuf_top +
          found_ptr^.elen_var
    END
ELSE
    sel.sfp_workbuf_len  := sel.sfp_workbuf_top;
(*ENDIF*) 
sel.sfp_work_st_top^ := found_ptr^;
999 : ;
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb78uni_trans (
            VAR op      : tgg00_StackEntry;
            VAR sel     : tgg00_SelectFieldsParam;
            VAR e       : tgg00_BasisError);
 
VAR
      undef         : boolean;
      operand_addr1 : tsp00_MoveObjPtr;
      operand_addr2 : tsp00_MoveObjPtr;
      len1          : integer;
      len2          : integer;
      isostr        : tsp00_KnlIdentifier;
      messcode      : tsp00_CodeType;
      codewidth     : tsp00_Uint1;
      uni_err       : tsp8_uni_error;
 
CONST
      c_undef_mcode = csp_maxint1;
 
LABEL
      999;
 
BEGIN
e := e_ok;
undef := false;
&ifdef TRACE
t01stackentry (kb_qual, op, 0);
&endif
IF  op.ecol_tab [2] = chr (c_undef_mcode)
THEN
    BEGIN
    k71get_operand (sel, c_check_spec_null, operand_addr1, len1, e);
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, -1);
    IF  (e <> e_ok)
    THEN
        goto 999;
&   ifdef TRACE
    (*ENDIF*) 
    t01sname (kb_qual, '1. Parameter');
    t01moveobj   (kb_qual, operand_addr1^, 1, len1);
&   endif
    IF  len1 <> sizeof (isostr) + 1
    THEN
        BEGIN
        e := e_unknown_multibyte_set;
        goto 999;
        END;
    (*ENDIF*) 
    g10mv ('VKB78 ',  41,
          sizeof(operand_addr1^), sizeof(isostr), @operand_addr1^, 2,
          @isostr, 1, sizeof (isostr), e);
    IF  e <> e_ok
    THEN
        goto 999;
    (*ENDIF*) 
    g20get_uni_key (isostr, messcode, codewidth, uni_err);
    IF  uni_err <> uni_ok
    THEN
        BEGIN
        e := e_unknown_multibyte_set;
        goto 999;
        END;
    (*ENDIF*) 
    op.ecol_tab[2] := chr (messcode);
    END;
(*ENDIF*) 
IF  sel.sfp_workbuf_len + op.elen_var > sel.sfp_workbuf_size
THEN
    BEGIN
    e := e_stack_overflow;
    goto 999;
    END
ELSE
    BEGIN
    k71get_operand (sel, NOT c_check_spec_null, operand_addr2, len2, e);
    IF  (e <> e_ok)
    THEN
        goto 999;
&   ifdef TRACE
    (*ENDIF*) 
    t01sname (kb_qual, '2. Parameter');
    t01moveobj   (kb_qual, operand_addr2^, 1, len2);
&   endif
    (* PTS 1108925 E.Z. *)
    (* PTS 1117437 E.Z. *)
    IF  NOT (sel.sfp_work_st_top^.etype in [st_value, st_result])
    THEN
        len2 := a05lnr_space_defbyte (sel.sfp_acv_addr,
              operand_addr2, operand_addr2^[1],
              2, len2 - 1) + 1;
&   ifdef TRACE
    (*ENDIF*) 
    t01int4 (kb_qual, 'len2 new    ', len2);
&   endif
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, -1);
    END;
(*ENDIF*) 
k78unicode_transform (op, sel, operand_addr2, len2, e);
999 : ;
END;
 
(*------------------------------*) 
 
PROCEDURE
      k78unicode_transform (
            VAR op             : tgg00_StackEntry;
            VAR sel            : tgg00_SelectFieldsParam;
            operand_addr       : tsp00_MoveObjPtr;
            len                : integer;
            VAR e              : tgg00_BasisError);
 
VAR
      outlen       : integer;
      error        : tsp8_uni_error;
      len2         : integer;
      err_char_no  : tsp00_Int4;
 
LABEL
      999;
 
BEGIN
e := e_ok;
IF  sel.sfp_workbuf_len + op.elen_var > sel.sfp_workbuf_size
THEN
    BEGIN
    e := e_stack_overflow;
    goto 999;
    END;
(*ENDIF*) 
IF  operand_addr^ [1] = csp_undef_byte
THEN
    BEGIN
    sel.sfp_workbuf_len := sel.sfp_workbuf_len + 1;
    sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len] := csp_undef_byte;
    outlen := 0;
    END
ELSE
    BEGIN
    sel.sfp_workbuf_len := sel.sfp_workbuf_len + 1;
    IF  ord(op.ecol_tab [2]) = ord(csp_ascii)
    THEN
        sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len] := csp_ascii_blank
    ELSE
        sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len] :=
              csp_unicode_def_byte;
    (*ENDIF*) 
    IF  (op.elen_var = 0) OR
        (sel.sfp_workbuf_len + op.elen_var - 1 > sel.sfp_workbuf_size)
    THEN
        outlen := sel.sfp_workbuf_size - sel.sfp_workbuf_len
    ELSE
        outlen := op.elen_var-1;
    (*ENDIF*) 
    s80uni_trans (@operand_addr^ [2], len-1, ord(op.ecol_tab [1]),
          @sel.sfp_workbuf_addr^ [sel.sfp_workbuf_len + 1],
          outlen, ord(op.ecol_tab [2]),
          [], error, err_char_no);
    IF  error <> uni_ok
    THEN
        BEGIN
        (* PTS 1117437 E.Z. *)
        IF  error = uni_dest_too_short
        THEN
            BEGIN
            len2 := a05lnr_space_defbyte (sel.sfp_acv_addr,
                  operand_addr, operand_addr^[1],
                  2, len - 1);
            IF  len2 < err_char_no
            THEN
                error := uni_ok
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        IF  error <> uni_ok
        THEN
            BEGIN
            e := e_not_translatable;
            goto 999
            END
        (*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;
    elen_var      := outlen + 1;
    ecol_tab [1] := chr(0);
    ecol_tab [2] := chr(0)
    END;
(*ENDWITH*) 
sel.sfp_workbuf_len := sel.sfp_workbuf_len + outlen;
&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
      kb78float (
            VAR op : tgg00_StackEntry;
            VAR sel     : tgg00_SelectFieldsParam;
            VAR e       : tgg00_BasisError);
 
VAR
      num_err      : tsp00_NumError;
      def_byte     : char;
      len          : integer;
      operand_addr : tsp00_MoveObjPtr;
 
LABEL
      999;
 
BEGIN
e := e_ok;
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];
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  (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;
    s51kroun (operand_addr^, 2, len-1,
          sel.sfp_workbuf_addr^, sel.sfp_workbuf_top+2,
          op.epos, csp_float_frac, len, num_err);
    IF  num_err <> num_ok
    THEN
        k71num_err_to_b_err (num_err, e);
    (*ENDIF*) 
    IF  e = e_ok
    THEN
        BEGIN
        len := ((op.epos + 1) DIV 2) + 1;
        sel.sfp_workbuf_addr^ [sel.sfp_workbuf_top+1] :=
              csp_defined_byte;
        END
    ELSE
        goto 999;
    (*ENDIF*) 
    END;
(*ENDIF*) 
&ifdef TRACE
t01sname (kb_qual, '=== result: ');
t01moveobj   (kb_qual, sel.sfp_workbuf_addr^,
      sel.sfp_workbuf_len+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 : ;
END;
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
.PA 
