.ad 8
.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$VPC14E$
.tt 2 $$$
.TT 3 $$Analyze_SQLDB_Commands$2000-09-05$
***********************************************************
.nf
 
.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
 
 
.fo
.nf
.sp
MODULE  : Analyse_SQLDB_Kommandos  with new structures
=========
.sp
Purpose : Analysed all SQLDB_Kommandos independent from languages
.CM *-END-* purpose -------------------------------------
.sp
.cp 3
Define  :
 
        FUNCTION
              p14symb (
                    PROCEDURE next_symbol (VAR p1: tpc_globals;
                    VAR p2: tpc_partbuffer; p3: integer);
                    VAR apc : tpc_globals) : tpr_symbol;
 
        PROCEDURE
              p14binitsqlvan (VAR apc : tpc_globals);
 
        PROCEDURE
              p14ansqlstatement (
                    PROCEDURE next_symbol (VAR p1: tpc_globals;
                    VAR p2: tpc_partbuffer; p3: integer);
                    VAR apc : tpc_globals);
 
        PROCEDURE
              p14an1sqlstatement (
                    PROCEDURE next_symbol (VAR p1: tpc_globals;
                    VAR p2: tpc_partbuffer; p3: integer);
                    VAR apc : tpc_globals);
 
        PROCEDURE
              p14anaparameter (
                    PROCEDURE next_symbol (VAR p1: tpc_globals;
                    VAR p2: tpc_partbuffer; p3: integer);
                    VAR apc : tpc_globals;
                    VAR pos : tsp00_Int4;
                    VAR nextsa : boolean);
 
        PROCEDURE
              p14btypentget (
                    PROCEDURE next_symbol (VAR p1: tpc_globals;
                    VAR p2: tpc_partbuffer; p3: integer);
                    VAR apc : tpc_globals;
                    VAR typentix : tsp00_Int2;
                    VAR vatyp    : tsp00_Int2;
                    VAR lastvatyp: tsp00_Int2;
                    resolve      : tsp00_Int2);
 
        PROCEDURE
              p14putsqlstarea   (VAR apc : tpc_globals);
 
        PROCEDURE
              p14var (
                    PROCEDURE next_symbol (VAR p1: tpc_globals;
                    VAR p2: tpc_partbuffer; p3: integer);
                    VAR apc:tpc_globals; VAR i: tsp00_Int2;
                    VAR typentry:tpc_typent);
 
.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :
 
        FROM
              Analyse_ORACLE_Kommandos   : VPC14B;
 
        PROCEDURE
              p14batconn (
                    PROCEDURE next_symbol (VAR p1: tpc_globals;
                    VAR p2: tpc_partbuffer; p3: integer);
                    VAR apc : tpc_globals);
 
        PROCEDURE
              p14busingdb (
                    PROCEDURE next_symbol (VAR p1: tpc_globals;
                    VAR p2: tpc_partbuffer; p3: integer);
                    VAR apc : tpc_globals);
 
        PROCEDURE
              p14bsetupsession (VAR apc : tpc_globals;
                    VAR error : tpc_pre_errors);
 
      ------------------------------ 
 
        FROM
              Analyse_SQLDB_Kommandos   : VPC14;
 
        PROCEDURE
              p14kaentryinit (VAR apc : tpc_globals);
 
      ------------------------------ 
 
        FROM
              Search-Const-Type-Var-Namen   : VPC19C;
 
        PROCEDURE
              p19sqlstallocate (VAR index : tsp00_Int2);
 
        PROCEDURE
              p19ndallocate (VAR index : tsp00_Int2);
 
        FUNCTION
              p19ndcnt : tpr_intaddr;
 
        PROCEDURE
              p19cinitnamdesc (VAR apc : tpc_globals;
                    resolve      : tsp00_Int2;
                    parlen       : integer;
                    VAR  parnemr : tsp00_C264);
 
        PROCEDURE
              p19cparentry  (VAR apc : tpc_globals;
                    kindentry: tsp00_Int2;
                    parm2 : tsp00_Int4;
                    parm3 : tsp00_Int4;
                    parm4 : tsp00_Int4);
 
      ------------------------------ 
 
        FROM
              Search-Const-Type-Var-Namen   : VPC19;
 
        PROCEDURE
              p19addspacevarpart (VAR apc : tpc_globals;
                    VAR pos : integer;
                    VAR anf : integer;
                    VAR plus: integer);
 
        PROCEDURE
              p19lgetname (VAR apc : tpc_globals;
                    VAR  nam  : tsp00_Lname;
                    VAR  len  : integer);
 
        PROCEDURE
              p19putname  (VAR apc : tpc_globals;
                    VAR pos : integer;
                    VAR anf : integer;
                    naml: integer;
                    VAR nam : tsp00_Name);
 
        PROCEDURE
              p19snextsubchar (VAR apc : tpc_globals;
                    anf : integer;
                    VAR pos : integer;
                    VAR subchr : char);
 
        PROCEDURE
              p19gmacronumber  (VAR apc : tpc_globals;
                    mpos  : integer;
                    VAR mind : integer;
                    VAR nextpos : integer);
 
        PROCEDURE
              p19mstruct (VAR apc : tpc_globals;
                    varix_in : tsp00_Int2;
                    VAR varix_out : tsp00_Int2);
 
      ------------------------------ 
 
        FROM
              Precompiler_Syntax_Erkennung  : VPC10;
 
        PROCEDURE
              p10getkeyword (VAR apc : tpc_globals;
                    VAR buf : tpc_partbuffer;
                    VAR index : integer);
 
        PROCEDURE
              p10int4unsignedget (VAR apc : tpc_globals;
                    VAR buf : tpc_partbuffer;
                    VAR int : tsp00_Int4);
 
        PROCEDURE
              p10int2unsignedget (VAR apc : tpc_globals;
                    VAR buf : tpc_partbuffer;
                    VAR int : tsp00_Int2);
 
        PROCEDURE
              p10rmspace (VAR buf : tpc_partbuffer;
                    cpr_quotsym, escsym : char;
                    ind, inplen : tsp00_Int4;
                    VAR  maxbuf, outlen : tsp00_Int4);
&       ifdef TRACE
 
        PROCEDURE
              p10areaprint  (VAR apc : tpc_globals);
&       endif
 
      ------------------------------ 
 
        FROM
              Kommunikation mit Ein-Ausgabeger?ate : VPC11;
 
        PROCEDURE
              p11precomerror (VAR apc : tpc_globals;
                    error : tpc_pre_errors);
 
        PROCEDURE
              p11nerrorlisting  (VAR apc : tpc_globals;
                    VAR nam : tsp00_Lname;
                    naml  : tsp00_Int2;
                    index : tsp00_Int2);
 
      ------------------------------ 
 
        FROM
              Runtime-Stringroutinen   : VPR05;
 
        PROCEDURE
              p05inttochr12 (int : integer;
                    VAR chr12 : tsp00_C12);
 
        PROCEDURE
              p05int2tochr12 (int : tsp00_Int2;
                    VAR chr12 : tsp00_C12);
 
        PROCEDURE
              p05searchword  (VAR buf : tpc_partbuffer;
                    lwb : integer;
                    upb : integer;
                    word : tsp00_Sname;
                    lw   : integer;
                    VAR pos : integer);
 
        FUNCTION
              p05eq (VAR a : tsp00_Sname;
                    VAR b  : tpc_partbuffer;
                    b_pos  : tsp00_Int4;
                    length : tsp00_Int4) : boolean;
 
      ------------------------------ 
 
        FROM
              C-Type-Checker-Module  : VPR102;
 
        PROCEDURE
              p03csqlcaareainit (VAR sqlca : sqlcatype);
&       ifdef TRACE
 
        PROCEDURE
              m90int (layer : tsp00_ToolLayer;
                    nam : tsp00_Sname;
                    int : integer);
 
        PROCEDURE
              m90int4 (layer : tsp00_ToolLayer;
                    nam : tsp00_Sname;
                    int  : tsp00_Int4);
 
        PROCEDURE
              m90int2 (layer : tsp00_ToolLayer;
                    nam : tsp00_Sname;
                    int  : tsp00_Int2);
 
        PROCEDURE
              m90name (layer : tsp00_ToolLayer;
                    nam : tsp00_Name);
 
        PROCEDURE
              m90lname (layer : tsp00_ToolLayer;
                    nam : tsp00_Lname);
 
        PROCEDURE
              m90buf (layer : tsp00_ToolLayer;
                    VAR buf : char;
                    pos_anf : integer;
                    pos_end : integer);
&       endif
 
      ------------------------------ 
 
        FROM
              Kernel_move_and_fill   : VGG101;
 
        PROCEDURE
              SAPDB_PascalForcedMove (
                    source_upb  : tsp00_Int4;
                    destin_upb  : tsp00_Int4;
                    source      : tsp00_MoveObjPtr;
                    source_pos  : tsp00_Int4;
                    destin      : tsp00_MoveObjPtr;
                    destin_pos  : tsp00_Int4;
                    length      : tsp00_Int4);
 
        PROCEDURE
              s10mv (
                    source_upb  : tsp00_Int4;
                    destin_upb  : tsp00_Int4;
                    source      : tsp00_MoveObjPtr;
                    source_pos  : tsp00_Int4;
                    destin      : tsp00_MoveObjPtr;
                    destin_pos  : tsp00_Int4;
                    length      : tsp00_Int4);
 
      ------------------------------ 
 
        FROM
              RTE-Extension-30    : VSP30;
 
        FUNCTION
              s30eq (VAR a : tsp00_Sname;
                    VAR b : tpc_partbuffer;
                    bi,cnt : tsp00_Int4) : boolean;
 
        FUNCTION
              s30len (VAR str : tpr_hostname;
                    val : char; cnt : tsp00_Int4) : tsp00_Int4;
 
        FUNCTION
              s30len1 (VAR str : tsp00_Name;
                    val : char; cnt : tsp00_Int4) : tsp00_Int4;
 
        FUNCTION
              s30lnr (VAR str : tsp00_C80;
                    val : char;
                    start : tsp00_Int4;
                    cnt : tsp00_Int4) : tsp00_Int4;
 
.CM *-END-* use -----------------------------------------
.sp;.cp 3
Synonym :
 
        PROCEDURE
              p10int4unsignedget;
 
              tsp00_Buf           tpc_partbuffer
 
        FUNCTION
              p05eq;
 
              tsp00_MoveObj       tpc_partbuffer
 
        PROCEDURE
              m90buf;
 
              tsp00_Buf   char
 
        PROCEDURE
              p10int2unsignedget;
 
              tsp00_Buf   tpc_partbuffer
 
        PROCEDURE
              p05searchword;
 
              tsp00_MoveObj  tpc_partbuffer
 
        PROCEDURE
              s30eq;
 
              tsp00_MoveObj  tpc_partbuffer
              tsp00_MoveObj  tsp00_Sname
 
        PROCEDURE
              s30lnr;
 
              tsp00_MoveObj  tsp00_C80
 
        PROCEDURE
              s30len;
 
              tsp00_MoveObj  tpr_hostname
 
        PROCEDURE
              s30len1;
 
              tsp00_MoveObj  tsp00_Name
 
.CM *-END-* synonym -------------------------------------
.sp;.cp 3
Author  :
.sp
.cp 3
Created : 1986-07-07
.sp
.cp 3
.sp
.cp 3
Release :      Date : 2000-09-05
.sp
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Specification:
.sp 2
PROCEDURE  P14B_INIT_SQLVAN:
.sp 2
The vartable, typetable, cmdtable sqlva1, sqlva2 and sqlva3 will
be written in a slow version into the protfile.
.sp 4
PROCEDURE  P14_AN_SQL_STATEMENT:
.sp 2
Initializes an SQLKA entry.
Searches for special characters (subchr) in the statement.
.sp
.hi 9
 cpr_macrochr '%' : Kamacro is set and checked to see whether the
macro number is between 1 and 128.
.sp
 cpr_recordchr '!' : Checks whether the host record variable name exists.
The substructure names are inserted as a name list in the
statement.
.sp
 cpr_recordchr2 '~'(tilde) : Checks whether the host record variable name exists.
The substructure names are inserted as a name list in the
statement.
.sp
 cpr_recordchr3 '|' : Checks whether the host record variable name exists.
The substructure names are inserted as a name list in the
statement.
.sp
 cpr_paramchr ':' : Checks whether a record host variable or host
variable exists. Corresponding entries are incorporated in the
SQLSA and SQLPA areas.
.sp
 cpr_preparechr '??' : error message; must not appear here.
.hi
.sp 4
.cp 6
PROCEDURE  P14_EXP_RECORDNAMES:
.sp 2
At the position pos of thr partbuf
the record name is expanded
into substructure names, and written into the request
segment.
In the case of arrays in records, the consecutive number (1,2,  . ]
is appended to the name of the array.
.br
In the case of structures the names are connected with an underline.
.sp
The procedure p14btypentget put into
ndtable [ndcnt]
the informations how to expand the names.
Parameter 'resolve' gibt an, ob beim Erzeugen der sqlva1-entry's
die letzte Array-angabe aufgel?ost werden soll.
.nf
resolve := cpr_is_true   last array aufl?osen,
resolve := cpr_is_false  last nicht array aufl?osen,
resolve := cpr_is_init   kein Eintrag in sqlva1-entry.
.fo
.sp 4
.cp 6
PROCEDURE  P14B_RECORD_NAME_EXPAND:
.sp 2
This procdure expands recursive from a structure definition the
names.
ndtable [ndcnt] contains
the informations how to do the expansion.
.br
Positiv varentix is the index of vartable, which name will
be expand.
.br
Negativ varentix is the index of typtable, which array type
or structure type will be expand.
.sp
The main structure name will be not expand and then arrays of
the main structure. If the main structure is an array of scalar
it will be expand.
.sp 4
.cp 6
P14_ANA_PARAMETER:
.sp 2
At the position pos analyzes the parameter found
with indicator and allocates the specified information
for the SQLsa and SQLPA areas accordingly.
In nextsa, if = true is specified, last parameter
was a record specification, = false last parameter
was a variable specification.
.sp 4
.cp 6
PROCEDURE P14B_TYPENT_GET:
.sp 2
At the positon syposacc of the partbuf the hostvariblename
will be analysed.
The informations are  put into
ndtable [ndcnt]  :
.sp
ndvarmainix  :: contains the vartable index of the main strucutre
.sp
ndvarentix   :: contains the vartable index at the last described
structure field of the hostvariable, and
at which the expansion of the names begins.
.sp
ndtypentix   :: contains the typtable index of the last structure
of the described hostvariable
.sp
ndsqlva1ix   :: contains the index into the sqlva1 table
of the first element of the described hostvariable
.sp
ndsqlva1cnt  :: contains the numbers of elements of the structure
wich are used for the described hostvariable.
.sp
ndarrcnt    :: contains the numbers of all indices, which are
declared in the described hostvariable.
.sp
ndarrayix  :: it is an array 4 long, it contains all declared indices
in the described hostvariable.
.sp
lastvatyp contains the last type, which is found during analizing the
parametervariable.
.sp 2
The procedure are working recursiv and add index and numbers
during analyzing.
.sp 4
.cp 6
PROCEDURE P14_S_VARNAME:
.sp 2
The procedure searches the vartable index and typtable index
and the vatype datatype of parameter nam.
.sp 4
.cp 6
PROCEDURE P14B_VARINDEX:
.sp 2
If strix is positive the vna (name) will be searched in the
typtable of the structure (tyindi = -1) with index strix.
.sp
If strix is equal 0 the vna (name) will be searched in the vartable,
only main structures with vastrix = 0.
.sp
If strix is negative the vna (name) will be searched in the complete
vartable. It is a structure field. The variable name of
the containing main structure
will  be searched in the procedure p19mstruct.
.sp 4
.cp 6
PROCEDURE p14getname:
.sp 2
Fuer 'declare <cursorname> ' wird der Curorname geholt.
Er kann als Name oder Macro angegeben werden.
Parameter macro gibt an, welche Definition gefunden wurde.
macro = cpr_is_true :: cursor ist als Macro angegeben.
Die Angabe wird in kamacro gesetzt.
.sp 4
 
.CM *-END-* specification -------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Description:
 
.CM *-END-* description ---------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.nf
.oc _/1
Structure:
 
.CM *-END-* structure -----------------------------------
.sp 2
**********************************************************
.sp
.cp 10
.nf
.oc _/1
.CM -lll-
Code    :
 
 
TYPE
      tvaarrix   = PACKED ARRAY [1..4] OF tsp00_Int2;
 
 
(*------------------------------*) 
 
FUNCTION
      p14symb (
            PROCEDURE next_symbol (VAR p1: tpc_globals;
            VAR p2: tpc_partbuffer; p3: integer);
            VAR apc : tpc_globals) : tpr_symbol;
 
VAR
      ret_scan :  tpr_scannertype;
 
BEGIN
WITH apc, pcscan, pccmdpart DO
    BEGIN
    ret_scan := pcscan;
    IF   symb = cpr_s_minus
    THEN
        BEGIN
        next_symbol (apc, partbufp^, part1len);
        IF  symb = cpr_s_greater
        THEN
            symb := cpr_s_point
        ELSE
            pcscan := ret_scan;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    p14symb := symb;
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p14ansqlstatement (
            PROCEDURE next_symbol (VAR p1: tpc_globals;
            VAR p2: tpc_partbuffer; p3: integer);
            VAR apc : tpc_globals);
 
BEGIN
p14an1sqlstatement (next_symbol, apc);
p14putsqlstarea  (apc);
&ifdef TRACE
m90name(xx, 'END p14ansqlstatem');
&endif
END;
 
(*------------------------------*) 
 
PROCEDURE
      p14an1sqlstatement (
            PROCEDURE next_symbol (VAR p1: tpc_globals;
            VAR p2: tpc_partbuffer; p3: integer);
            VAR apc : tpc_globals);
 
VAR
      err   : tpc_pre_errors;
      pos2  : tsp00_Int4;
      pos   : integer;
      posab : integer;
      subc  : char;
      mnr   : integer;
      firstpa: integer;
      nextsa : boolean;
      retscan : tpr_scannertype;
      retpos  : integer;
 
BEGIN
WITH apc, sqlxa, pcscan, sqlca, sqlrap^, pccmdpart  DO
    BEGIN
    retpos    := sypos;
    WHILE  (symb <> cpr_s_eof) AND (symb <> cpr_s_bufeof) DO
        next_symbol (apc, partbufp^, part1len);
    (*ENDWHILE*) 
&   ifdef TRACE
    m90int  (pc, 'retpos      ', retpos  );
    m90int  (pc, 'part1len    ', part1len);
    m90buf (pc, partbufp^ [1], 1 , part1len );
&   endif
    pcsqlcom := true;
    symb     := cpr_s_unknown;
    syposacc := retpos;
    retscan  := pcscan;
    err  := cpc_pre_ok;
    pcscan   := retscan;
    p14kaentryinit (apc);
    WITH sqlkap^ [pcka ] DO
        BEGIN
        IF  ( ( katyp = cpr_com_sql_fetch )
            OR  ( katyp = cpr_com_sql_close )
            OR  ( katyp = cpr_com_sql_getval )
            OR  ( katyp = cpr_com_sql_putval ))
        THEN
            BEGIN
            kafaindex  := pcfa;
            kaprindex := pcpr;
            END
        ELSE
            kafaindex  := 0;
        (*ENDIF*) 
        nextsa := true;
        firstpa:= pcpa + 1;
        posab  := retpos;
        pcscan.symb := cpr_s_unknown;
        p19snextsubchar (apc, posab, pos, subc);
        WHILE (pos <> 0) AND (err = cpc_pre_ok) DO
            BEGIN
&           ifdef TRACE
            m90int  (pc, 'posab       ', posab);
            m90int  (pc, 'pos         ', pos);
            m90int  (pc, 'subc        ', ord(subc));
&           endif
            CASE  subc  OF
                cpr_macrochr :   (* % *)
                    BEGIN
                    p11precomerror (apc, cpc_macros_not_allowed);
                    p19gmacronumber (apc, pos, mnr, pos); (* Eat macro number *)
                    END;
                cpr_recordchr, cpr_recordchr2, cpr_recordchr3 : (*!,*)
                    BEGIN
                    p14_exp_recordnames (next_symbol, apc, pos );
                    END;
                cpr_paramchr :  (* : *)
                    BEGIN
                    IF  (katyp <> cpr_com_sql_close)
                    THEN
                        BEGIN
                        BEGIN
                        pos2 := pos;
                        p14anaparameter (next_symbol, apc, pos2, nextsa);
                        pos  := pos2;
                        END;
                        END
                    ELSE
                        BEGIN
                        kapacount := -1;
                        pos := pos + 1;
                        END;
                    (*ENDIF*) 
                    IF  pcerror <> cpc_pre_ok
                    THEN
                        pos := pos + 1;
&                   ifdef TRACE
                    (*ENDIF*) 
                    m90int2 (pc, 'part1length ', part1len)  ;
&                   endif
                    END;
                cpr_preparechr :  (* ?? *)
                    BEGIN
                    IF  katyp <> cpr_com_declare_cursor
                    THEN
                        err := cpc_invalid_sql_command;
                    (*ENDIF*) 
                    pos := pos + 1;
                    END;
                OTHERWISE:
                    err := cpc_invalid_sql_command;
                END;
            (*ENDCASE*) 
            posab := pos;
            p19snextsubchar (apc, posab, pos, subc);
&           ifdef TRACE
            m90buf (pc, partbufp^ [1], 1 , part1len );
&           endif
            END;
        (*ENDWHILE*) 
        IF   firstpa <= pcpa
        THEN
            BEGIN
            kapaindex := firstpa;
            kapacount := pcpa - firstpa + 1;
            END;
        (*ENDIF*) 
        END;
    (*ENDWITH*) 
    IF  pcan.ancomtyp = cpr_com_sql_conn
    THEN
        BEGIN
&       ifdef TRACE
        m90buf (pc, partbufp^ [1], 1 , part1len );
        m90int2 (pc, 'pos         ', pos);
        m90int2 (pc, 'raactsession', raactsession);
&       endif
        p05searchword (partbufp^, 1, part1len,
              ' SQLMODE    ', 9, pos);
        IF  pos = 0
        THEN
            p05searchword (partbufp^, 1, part1len,
                  ' sqlmode    ', 9, pos);
        (*ENDIF*) 
        IF  pos <> 0
        THEN
            err := cpc_invalid_sql_command;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  err = cpc_pre_ok
    THEN
        IF  (rakamode = cpr_kind_oracle )
            OR  (rakamode = cpr_kind_sapr3 )
        THEN
            BEGIN
            IF  pcan.ancomtyp = cpr_com_sql_conn
            THEN
                BEGIN
                pcscan.symb := cpr_s_unknown;
                p14batconn (next_symbol, apc);
                p14busingdb (next_symbol, apc);
                END;
            (*ENDIF*) 
            p14bsetupsession (apc, err);
            END;
        (*ENDIF*) 
    (*ENDIF*) 
    symb := cpr_s_eof;
    (* apc.pcsqlcom := false; *)
    IF   err <> cpc_pre_ok
    THEN
        p11precomerror (apc, err)
    ELSE
        BEGIN
        pcan.ancheck := pcopts.opt_mode;
        sqlxa.xakano := pcka;
        sqlkap^[pcka].kaatindex := pckaatind;
        pckaatind := 0;
&       ifdef TRACE
        m90int2 (pc, 'kaatindex xx', sqlkap^[pcka].kaatindex);
        m90int2 (pc, 'pcka,xakano ', pcka );
        m90int2 (pc, 'pckaatind xx', pckaatind );
        m90int2 (pc, 'raactsession', raactsession);
&       endif
        sqlkap^[pcka].kacuindex := pckacuind;
        pckacuind := 0;
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
&ifdef TRACE
m90name(xx, 'END p14an1sqlstate');
&endif
END;
 
(*------------------------------*) 
 
PROCEDURE
      p14putsqlstarea   (VAR apc : tpc_globals);
 
VAR
      pos     : tsp00_Int4;
      len     : tsp00_Int4;
      partlen : tsp00_Int4;
      stmlen : tsp00_Int4;
 
BEGIN
WITH apc, sqlca, sqlxa, sqlkap^ [pcka], sqlrap^, pccmdpart DO
    BEGIN
    kaStcount := 0;
    kaStindex := pcst + 1;
    IF  ralang <> cpr_la_cobol
    THEN
        p10rmspace (partbufp^, cpr_quotsym , cpr_quotsym ,
              1,part1len-1,part1len,stmlen);
    (*ENDIF*) 
    pos := 1;
    IF   (partbufp^ [part1len] = cpr_pc_endsign)
        OR   (partbufp^ [part1len] = cpr_nullchar)
    THEN
        partlen := part1len - 1
    ELSE
        partlen := part1len;
    (*ENDIF*) 
    WHILE pos <= partlen DO
        BEGIN
        IF   pos + mxpr_sqlline
            > partlen
        THEN
            len := partlen - pos + 1
        ELSE
            len := mxpr_sqlline;
        (*ENDIF*) 
        p19sqlstallocate (pcst);
        IF  pcst > pcstmax
        THEN
            pcstmax := pcst;
        (*ENDIF*) 
        kaStcount := kaStcount + 1;
        s10mv (partsizlen,mxpr_sqlline, @partbufp^, pos,
              @sqlstp^ [pcst].stline, 1, len);
        sqlstp^ [pcst].stllen  := len;
        sqlstp^ [pcst].stkano := pcka;
        pos := pos + len;
        END;
    (*ENDWHILE*) 
    END;
(*ENDWITH*) 
&ifdef TRACE
m90name(xx, 'END p14putsqlst   ');
&endif
END;
 
(*------------------------------*) 
 
PROCEDURE
      p14_exp_recordnames  (
            PROCEDURE next_symbol (VAR p1: tpc_globals;
            VAR p2: tpc_partbuffer; p3: integer);
            VAR apc : tpc_globals;
            VAR pos : integer);
 
VAR
      nam  : tsp00_Name;
      naml : integer;
      anf  : integer;
      vaix : tsp00_Int2;
      ptypentix : tsp00_Int2;
      pvatyp    : tsp00_Int2;
      first     : boolean;
      expand    : boolean;
      arrcnt    : integer;
      lastvatyp : tsp00_Int2;
      resolve   : tsp00_Int2;
      intp : tpr_vtypepointer ;
      tnpos : integer;
      tnlen : integer;
 
BEGIN
WITH apc, pcscan, sqlxa, pcsqlva, pcsymtab,
     pccmdpart  DO
    BEGIN
    p14searchtablen  (apc, pos, tnpos, tnlen );
    partbufp^ [ pos ] := cpr_paramchr;
    syposacc := pos;
    next_symbol (apc, partbufp^, part1len);
    IF   symb <> cpr_s_parameter_name
    THEN
        p11precomerror (apc, cpc_invalid_recordname)
    ELSE
        BEGIN
        syposacc := sypos + 1;
        ptypentix := 0;
        resolve   := cpr_is_init;
        p14btypentget (next_symbol, apc, ptypentix, pvatyp,
              lastvatyp, resolve);
        IF  ptypentix = 0
        THEN
            p11precomerror (apc, cpc_unknown_recordname)
        ELSE
            BEGIN
            vaix := ndtabp^ [ndcnt].ndvarmainix;
            first := true;
            expand:= false;
            nam   := bsp_name;
            naml  := 0;
            IF  partbufp^ [sypos-1] = bsp_c1
            THEN
                anf   := sypos-1
            ELSE
                anf := sypos;
            (*ENDIF*) 
            arrcnt  :=  0;
            p14b_record_name_expand (apc, vaix,
                  nam, naml, pos, anf, arrcnt, first, expand,
                  tnpos, tnlen);
            (* nd-entry l?oschen *)
            intp.intaddr := p19ndcnt ;
            intp.vtypep^.i4 :=  intp.vtypep^.i4 - 1;
            ndmax := ndmax - 1;
            END;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
&   ifdef TRACE
    m90buf (pc, partbufp^ [1], 1 , part1len );
&   endif
    END;
(*ENDWITH*) 
&ifdef TRACE
m90name(xx, 'END p14_exp_record');
&endif
END;
 
(*------------------------------*) 
 
PROCEDURE
      p14searchtablen  (VAR apc : tpc_globals;
            VAR pos : integer;
            VAR tnpos : integer;
            VAR tnlen : integer);
 
VAR
      i    : integer;
      tnfound : boolean;
      tnposend : integer;
 
BEGIN
WITH apc, pcscan, sqlxa, pcsqlva, pcsymtab,
     pccmdpart  DO
    BEGIN
    tnpos := 0;
    tnlen := 0;
    tnfound := false;
    i := pos - 1;
    WHILE (i > 1) AND (partbufp^ [i] = bsp_c1) DO
        i := i -1;
    (*ENDWHILE*) 
    IF  partbufp^ [i] = '.'
    THEN
        BEGIN
        (* table name *)
        tnposend := i;
        i := i -1;
        WHILE (i > 1) AND (partbufp^ [i] = bsp_c1) DO
            i := i -1;
        (*ENDWHILE*) 
        REPEAT
            i := i - 1;
        UNTIL
            NOT (partbufp^ [ i ] IN
            [ 'a'..'i', 'j'..'r', 's'..'z',
            'A'..'I', 'J'..'R', 'S'..'Z',
            '^', '#', '$', '0'..'9','_' ] );
        (*ENDREPEAT*) 
        tnpos := i + 1;
        tnlen := tnposend - i;
        WHILE (i > 1) AND (partbufp^ [i] = bsp_c1) DO
            i := i - 1;
        (*ENDWHILE*) 
        IF  partbufp^ [i] = '.'
        THEN
            BEGIN
            (*  authid *)
            i := i -1;
            WHILE (i > 1) AND (partbufp^ [i] = bsp_c1) DO
                i := i -1;
            (*ENDWHILE*) 
            REPEAT
                i := i - 1;
            UNTIL
                NOT (partbufp^ [ i ] IN
                [ 'a'..'i', 'j'..'r', 's'..'z',
                'A'..'I', 'J'..'R', 'S'..'Z',
                '^', '#', '$', '0'..'9','_' ] );
            (*ENDREPEAT*) 
            tnpos := i + 1;
            tnlen := tnposend - i;
            END;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p14b_record_name_expand (VAR apc : tpc_globals;
            VAR varentix : tsp00_Int2;
            VAR nam  : tsp00_Name;
            VAR naml : integer;
            VAR pos  : integer;
            VAR anf  : integer;
            VAR arrcnt: integer;
            VAR first : boolean;
            VAR expand: boolean;
            tnpos : integer;
            tnlen : integer);
 
VAR
      i : integer;
      j : integer;
      v_comma : tsp00_Name;
      ch12    : tsp00_C12;
      vname   : tsp00_Lname;
      vnaml   : integer;
      vaix    : tsp00_Int2;
      lastexpand : boolean;
      retnaml  : integer;
      retarrcnt: integer;
      typindex   : tsp00_Int2;
      vastrindex : tsp00_Int2;
      index      : integer;
      ia         : integer;
      ie         : integer;
 
BEGIN
&ifdef TRACE
m90int2 (pc, 'varentix    ', varentix);
m90int2 (pc, 'naml        ', naml );
m90int2 (pc, 'arrcnt      ', arrcnt );
&endif
lastexpand := expand;
IF  varentix <= 0
THEN
    BEGIN
    (* array of array expansion *)
    typindex   := -varentix;
    vastrindex :=  varentix;
    vnaml      := 0;
    END
ELSE
    WITH apc, pcsymtab, sqlxa, pcsqlva, vartablep^ [varentix] DO
        BEGIN
        IF  NOT expand
        THEN
            IF  (varentix = ndtabp^ [ndcnt]. ndvarentix)
            THEN
                expand := true;
            (*ENDIF*) 
        (*ENDIF*) 
        typindex    := vatypix;
        vastrindex  := vastrix;
        vname       := vaname;
        vnaml       := vanaml;
        END;
    (*ENDWITH*) 
(*ENDIF*) 
WITH apc, pcsymtab, sqlxa, pcsqlva  DO
    BEGIN
    v_comma := ',                 ';
    IF  naml > 0
    THEN
        BEGIN
        naml := naml + 1;
        nam [naml] := '_';
        END
    ELSE
        naml := 0;
    (*ENDIF*) 
    IF  vastrindex = 0
    THEN
        (* expand of scalar  arrays  *)
        IF  (typtablep^ [typindex].tyindi = cpr_varray)
        THEN
            WITH   typtablep^ [typindex] DO
                IF  (typtablep^ [tytypix].tyindi <> cpr_varray)
                    AND (typtablep^ [tytypix].tyindi <> cpr_vstruct)
                THEN
                    IF  naml + vnaml > mxsp_name
                    THEN
                        p11precomerror (apc,cpc_invalid_listname_expansion)
                    ELSE
                        BEGIN
                        s10mv (LNAME_MXSP00, mxsp_name, @vname, 1,
                              @nam, naml+1, vnaml);
                        naml := naml + vnaml;
                        END;
                    (*ENDIF*) 
                (*ENDIF*) 
            (*ENDWITH*) 
        (*ENDIF*) 
    (*ENDIF*) 
    IF  vastrindex > 0
    THEN
        IF  naml + vnaml > mxsp_name
        THEN
            p11precomerror (apc,cpc_invalid_listname_expansion)
        ELSE
            BEGIN
            s10mv (LNAME_MXSP00, mxsp_name, @vname, 1,
                  @nam, naml+1, vnaml);
            naml := naml + vnaml;
            END;
        (*ENDIF*) 
&   ifdef TRACE
    (*ENDIF*) 
    m90buf (pc, nam [1], 1 , naml );
&   endif
    WITH  typtablep^ [typindex]  DO
        CASE tyindi OF
            cpr_vstruct :
                BEGIN
                FOR i := 0 TO tycmcnt-1 DO
                    BEGIN
                    vaix := cmpindexp^ [tycmpix+i];
                    p14b_record_name_expand (apc, vaix,
                          nam, naml, pos, anf,
                          arrcnt, first, expand, tnpos, tnlen);
                    END;
                (*ENDFOR*) 
                naml := naml - vnaml - 1;
                END;
            cpr_varray :
                BEGIN
                IF  (typtablep^ [tytypix].tyindi = cpr_vstruct )
                    AND (vastrindex = 0)
                THEN
                    WITH typtablep^ [tytypix] DO
                        BEGIN
                        FOR i := 0 TO tycmcnt-1 DO
                            BEGIN
                            vaix := cmpindexp^ [tycmpix+i];
                            p14b_record_name_expand (apc, vaix,
                                  nam, naml, pos, anf,
                                  arrcnt, first, expand, tnpos, tnlen);
                            END;
                        (*ENDFOR*) 
                        naml := naml - vnaml - 1;
                        END
                    (*ENDWITH*) 
                ELSE
                    IF  (typtablep^ [tytypix].tyindi = cpr_vstruct)
                        OR (typtablep^ [tytypix].tyindi =  cpr_varray)
                        (*     OR  (naml+3  > maxnamelength)  *)
                    THEN
                        IF  naml + 3  > mxsp_name
                        THEN
                            p11precomerror (apc,cpc_invalid_listname_expansion)
                        ELSE
                            BEGIN
                            index := ndtabp^ [ndcnt].ndarrayix [arrcnt+1];
                            retarrcnt := arrcnt;
                            IF  arrcnt + 1 <= ndtabp^ [ndcnt].ndarraycnt
                            THEN
                                BEGIN
                                arrcnt  :=  arrcnt + 1;
                                ia := index - tyfix + 1;
                                ie := ia;
                                END
                            ELSE
                                BEGIN
                                ia := 1;
                                ie := tydim;
                                END;
                            (*ENDIF*) 
                            IF  (ie < 1) OR (ie > tydim)
                            THEN
                                p11precomerror (apc,cpc_invalid_rlistname_range);
                            (*ENDIF*) 
                            retnaml := naml;
&                           ifdef TRACE
                            m90int2 (pc, 'retnaml     ', retnaml );
                            m90int2 (pc, 'for ia      ', ia   );
                            m90int2 (pc, ' to ie      ', ie   );
                            m90int2 (pc, '(pix).tyindi', typtablep^ [tytypix]
                                  .tyindi);
                            m90int2 (pc, 'varentix    ', varentix );
                            IF  varentix > 0
                            THEN
                                m90int2 (pc, '(var).vanaml',
                                      vartablep^ [varentix].vanaml);
&                           endif
                            (*ENDIF*) 
                            FOR i := ia TO ie DO
                                BEGIN
                                IF  naml > 0
                                THEN
                                    BEGIN
                                    p05inttochr12 (i, ch12);
                                    s10mv (mxsp_c12, mxsp_name, @ch12, 2,
                                          @nam, naml+1, 3);
                                    naml := naml + 3;
                                    WHILE nam [naml] = bsp_c1 DO
                                        naml := naml - 1;
                                    (*ENDWHILE*) 
                                    END;
                                (*ENDIF*) 
                                CASE typtablep^ [tytypix].tyindi OF
                                    cpr_vstruct :
                                        WITH typtablep^ [tytypix] DO
                                            BEGIN
                                            FOR j := 0 TO tycmcnt-1 DO
                                                BEGIN
                                                vaix := cmpindexp^[tycmpix+j];
                                                p14b_record_name_expand (apc,
                                                      vaix, nam,naml, pos, anf,
                                                      arrcnt, first, expand,
                                                      tnpos, tnlen);
                                                END;
                                            (*ENDFOR*) 
                                            END;
                                        (*ENDWITH*) 
                                    cpr_varray :
                                        BEGIN
                                        vaix := - tytypix;
                                        p14b_record_name_expand (apc, vaix,
                                              nam, naml, pos, anf,
                                              arrcnt, first, expand,
                                              tnpos, tnlen);
                                        END;
                                    END;
                                (*ENDCASE*) 
                                naml  := retnaml;
                                END;
                            (*ENDFOR*) 
                            arrcnt:=  retarrcnt;
                            IF  varentix > 0
                            THEN
                                naml  :=  naml - vartablep^ [varentix].vanaml;
                            (*ENDIF*) 
                            END
                        (*ENDIF*) 
                    ELSE
                        (* scalar array *)
                        IF  naml + 3  > mxsp_name
                        THEN
                            p11precomerror (apc,cpc_invalid_listname_expansion)
                        ELSE
                            BEGIN
                            retarrcnt := arrcnt;
                            index := ndtabp^ [ndcnt].ndarrayix [arrcnt+1];
                            IF  arrcnt + 1 <= ndtabp^ [ndcnt].ndarraycnt
                            THEN
                                BEGIN
                                arrcnt  :=  arrcnt + 1;
                                ia := index - tyfix + 1;
                                ie := ia;
                                END
                            ELSE
                                BEGIN
                                ia := 1;
                                ie := tydim;
                                END;
                            (*ENDIF*) 
                            IF  (ie < 1) OR (ie > tydim)
                            THEN
                                p11precomerror (apc,cpc_invalid_rlistname_range);
                            (*ENDIF*) 
                            retnaml := naml;
                            FOR i := ia  TO ie  DO
                                BEGIN
                                p05inttochr12 (i, ch12);
                                s10mv (mxsp_c12, mxsp_name, @ch12, 2,
                                      @nam, naml+1, 3);
                                IF  expand
                                THEN
                                    BEGIN
                                    IF  first
                                    THEN
                                        first := false
                                    ELSE
                                        BEGIN
                                        p19putname (apc, pos,anf, 1, v_comma);
                                        pos := pos + 1;
                                        IF  tnpos <> 0
                                        THEN
                                            (* expandiere tablename *)
                                            p14exp_tablen (apc, pos, anf,
                                                  tnpos, tnlen);
                                        (*ENDIF*) 
                                        END;
                                    (*ENDIF*) 
                                    p19putname (apc, pos, anf, naml+3, nam);
                                    pos := pos + naml + 3;
                                    END;
                                (*ENDIF*) 
                                END;
                            (*ENDFOR*) 
                            arrcnt:=  retarrcnt;
                            naml  := retnaml - vnaml - 1;
                            END;
                        (*ENDIF*) 
                    (*ENDIF*) 
                (*ENDIF*) 
                END;
            OTHERWISE:
                BEGIN
                IF  expand
                THEN
                    BEGIN
                    IF  first
                    THEN
                        first := false
                    ELSE
                        BEGIN
                        p19putname (apc, pos, anf, 1, v_comma);
                        pos := pos + 1;
                        IF  tnpos <> 0
                        THEN
                            (* expandiere tablename *)
                            p14exp_tablen (apc, pos, anf,
                                  tnpos, tnlen);
                        (*ENDIF*) 
                        END;
                    (*ENDIF*) 
                    p19putname (apc, pos, anf, naml, nam);
                    pos := pos + naml;
                    END;
                (*ENDIF*) 
                naml := naml - vnaml - 1;
                END;
            END;
        (*ENDCASE*) 
    (*ENDWITH*) 
    expand := lastexpand;
    END;
(*ENDWITH*) 
&ifdef TRACE
m90name(xx, 'END p14b_recname  ');
&endif
END;
 
(*------------------------------*) 
 
PROCEDURE
      p14exp_tablen (VAR apc : tpc_globals;
            VAR pos : integer;
            VAR anf : integer;
            tnpos   : integer;
            tnlen   : integer);
 
VAR
      i       : integer;
 
BEGIN
WITH apc, sqlca, pccmdpart, sqlrap^ DO
    BEGIN
&   ifdef TRACE
    m90int2 (pc, 'pos         ', pos  );
    m90int2 (pc, 'anf         ', anf);
    m90int2 (pc, 'tnpos       ', tnpos);
    m90int2 (pc, 'tnlen       ', tnlen);
&   endif
&   ifdef TRACE
    m90buf (pc, partbufp^ [1], 1 , part1len);
&   endif
    p19addspacevarpart (apc, pos, anf, tnlen);
    IF  ralang in [cpr_la_cobol, cpr_la_cobmic, cpr_la_cob8860]
    THEN
        FOR i:=tnpos TO tnlen+tnpos-1 DO
            IF  partbufp^[i]='-'
            THEN
                partbufp^[i]:='_';
&           ifdef TRACE
            (*ENDIF*) 
        (*ENDFOR*) 
    (*ENDIF*) 
    m90int2 (pc, 'pos         ', pos  );
    m90int2 (pc, 'anf         ', anf);
    m90int2 (pc, 'tnpos       ', tnpos);
    m90int2 (pc, 'tnlen       ', tnlen);
&   endif
    s10mv (partsizlen, partsizlen,
          @partbufp^, tnpos, @partbufp^, pos, tnlen);
    pos := pos + tnlen;
&   ifdef TRACE
    m90buf (pc, partbufp^ [1], 1 , part1len );
&   endif
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p14anaparameter (
            PROCEDURE next_symbol (VAR p1: tpc_globals;
            VAR p2: tpc_partbuffer; p3: integer);
            VAR apc : tpc_globals;
            VAR pos : tsp00_Int4;
            VAR nextsa : boolean);
 
VAR
      prec : boolean;
      irec : boolean;
      lastvatyp : tsp00_Int2;
      precint2  : tsp00_Int2;
      irecint2  : tsp00_Int2;
      ptypentix : tsp00_Int2;
      itypentix : tsp00_Int2;
      pvatyp    : tsp00_Int2;
      ivatyp    : tsp00_Int2;
      pind      : tsp00_Int2;
      iind      : tsp00_Int2;
      pcnt      : tsp00_Int2;
      icnt      : tsp00_Int2;
      parpos    : integer;
      i         : integer;
      keyind    : integer;
      snam      : tsp00_Sname;
      resolve   : tsp00_Int2;
      pstind     : tsp00_Int2;
      istind     : tsp00_Int2;
 
BEGIN
WITH apc, pcscan, sqlxa, pcsqlva, pcsymtab, pccmdpart DO
    BEGIN
    syposacc := pos;
    next_symbol (apc, partbufp^, part1len);
    IF   symb <> cpr_s_parameter_name
    THEN
        p11precomerror (apc,cpc_invalid_parametername)
    ELSE
        BEGIN
        precint2  := cpr_is_false;
        irecint2  := cpr_is_false;
        ptypentix := 0;
        itypentix := 0;
        pind  := 0;
        iind  := 0;
        pcnt  := 0;
        icnt  := 0;
        pstind  := 0;
        istind  := 0;
        parpos   := syposacc;
        syposacc := sypos + 1;
        pvatyp := 0;
        lastvatyp := 0;
        IF  pcopts.opt_comp = 0
        THEN
            (* compatibilit?at Option gesetzt keine array statements *)
            resolve   := cpr_is_true
        ELSE
            resolve   := cpr_is_false;
        (*ENDIF*) 
        p14btypentget (next_symbol, apc, ptypentix, pvatyp,
              lastvatyp, resolve);
        IF  ptypentix <> 0
        THEN
            BEGIN
            IF  ndtabp^ [ndcnt].ndLoopPar = sqlparel
            THEN
                resolve := cpr_is_true;
            (*ENDIF*) 
            p14isforloop (apc, precint2, lastvatyp, cpc_i_var);
            prec :=  (pvatyp = cpr_vstruct) OR
                  (pvatyp = cpr_varray);
            IF  (precint2 = cpr_is_false) AND (prec)
            THEN
                precint2 := cpr_is_true;
            (*ENDIF*) 
            pind   := ndtabp^ [ndcnt].ndsqlva1ix;
            pcnt   := ndtabp^ [ndcnt].ndsqlva1cnt;
            pstind := ndtabp^ [ndcnt].ndsqlva1st;
            IF  pind = pstind
            THEN
                pstind := 0;
            (*ENDIF*) 
            IF  pvatyp = cpr_vstruct
            THEN
                pcnt := typtablep^[ptypentix].tyvacnt;
            (*ENDIF*) 
            FOR i := parpos TO sypos-1 DO
                partbufp^ [i] := bsp_c1;
            (*ENDFOR*) 
            END;
        (*ENDIF*) 
        IF  symb = cpr_s_identifier
        THEN
            BEGIN
            (* ansi standart keyword 'indicator' delete *)
            p10getkeyword (apc, partbufp^, keyind);
            IF  keyind = cpc_i_indicator
            THEN
                BEGIN
                snam := bsp_sname;
                s10mv (SNAME_MXSP00, partsizlen, @snam, 1,
                      @partbufp^, sypos, sylen);
                next_symbol (apc, partbufp^, part1len);
                IF   symb <> cpr_s_parameter_name
                THEN
                    p11precomerror (apc, cpc_invalid_parametername);
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        IF   symb = cpr_s_parameter_name
        THEN
            BEGIN
            parpos   := syposacc;
            syposacc := sypos + 1;
            p14btypentget (next_symbol, apc, itypentix, ivatyp,
                  lastvatyp, resolve);
            p14isforloop (apc, irecint2, lastvatyp, cpc_i_indicator);
            irec :=  (ivatyp = cpr_vstruct) OR
                  (ivatyp = cpr_varray);
            IF  itypentix <> 0
            THEN
                BEGIN
                iind   := ndtabp^ [ndcnt].ndsqlva1ix;
                icnt   := ndtabp^ [ndcnt].ndsqlva1cnt;
                istind := ndtabp^ [ndcnt].ndsqlva1st;
                IF  iind = istind
                THEN
                    istind := 0;
                (*ENDIF*) 
                FOR i := parpos TO sypos-1 DO
                    partbufp^ [i] := bsp_c1;
                (*ENDFOR*) 
                END;
&           ifdef TRACE
            (*ENDIF*) 
            m90int2 (pc, 'prec        ', ord(prec));
            m90int2 (pc, 'irec        ', ord(irec));
            m90int2 (pc, 'pcnt        ', pcnt);
            m90int2 (pc, 'icnt        ', icnt);
            m90int2 (pc, 'pvatyp      ', pvatyp);
            m90int2 (pc, 'ivatyp      ', ivatyp);
            m90int2 (pc, 'ptypentix   ', ptypentix);
            m90int2 (pc, 'itypentix   ', itypentix);
&           endif
            IF   (prec <> irec)
                OR (pcnt > icnt)
            THEN
                IF   (pcerror = cpc_pre_ok)
                THEN
                    BEGIN
                    p11precomerror (apc, cpc_invalid_param_indicator);
                    p11nerrorlisting ( apc,
                          vartablep^ [ndtabp^[ndcnt].ndvarentix].vaname,
                          vartablep^ [ndtabp^[ndcnt].ndvarentix].vanaml, 0);
                    END
                (*ENDIF*) 
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF   (pcerror = cpc_pre_ok)
    THEN
        BEGIN
        IF   prec
        THEN
            BEGIN
            (* parameterstruktur *)
            nextsa := true;
            END;
        (*ENDIF*) 
        IF  (pstind <> 0 ) OR  (istind <> 0)
        THEN
            p19cparentry (apc, sqlparst, pstind,
                  istind, pcnt);
        (* with  ind =0 ohne indicator variable *)
        (*ENDIF*) 
        p19cparentry (apc, sqlparel, pind,
              iind, 0);
        IF  NOT prec
        THEN
            nextsa := false;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    pos := sypos;
&   ifdef TRACE
    m90int2 (pc, 'part1length ', part1len)  ;
&   endif
    END;
(*ENDWITH*) 
&ifdef TRACE
m90name(xx, 'END p14anaparamete');
&endif
END;
 
(*------------------------------*) 
 
PROCEDURE
      p14btypentget (
            PROCEDURE next_symbol (VAR p1: tpc_globals;
            VAR p2: tpc_partbuffer; p3: integer);
            VAR apc : tpc_globals;
            VAR typentix : tsp00_Int2;
            VAR vatyp    : tsp00_Int2;
            VAR lastvatyp: tsp00_Int2;
            resolve      : tsp00_Int2);
 
VAR
      pname  : tsp00_Lname;
      plen   : integer;
      index  : tsp00_Int2;
      varentix : tsp00_Int2;
      firstvarentix : tsp00_Int2;
      vcnt     : tsp00_Int2;
      retvatyp : tsp00_Int2;
      first    : boolean;
      found    : boolean;
      anz    : integer;
      ind    : integer;
      count  : integer;
      index_comma : boolean;
      parposbeg   : integer;
      parposend   : integer;
      parlen      : integer;
      parname     : tsp00_C264;
      i           : integer;
      j           : integer;
      lowindex    : tsp00_Int2;
      chr12       : tsp00_C12;
      schr        : tsp00_C1;
      ptr         : tpr_vtypepointer;
      compix      : integer;
      vaarrix     : tvaarrix;
      arrix       : tsp00_Int2;
      compfound   : boolean;
 
BEGIN
WITH apc, pcscan, pcsymtab, sqlxa, pcsqlva,
     sqlca,sqlrap^, pccmdpart DO
    BEGIN
    pcerror := cpc_pre_ok;
    first := true;
    found := false;
    parposbeg := syposacc;
    parposend := syposacc;
    REPEAT
        next_symbol (apc, partbufp^, part1len);
        IF  symb <> cpr_s_identifier
        THEN
            p11precomerror (apc, cpc_invalid_parametername)
        ELSE
            BEGIN
            p19lgetname (apc, pname, plen);
            p14_s_varname (apc, pname, typentix, varentix, vatyp, vcnt);
            IF  typentix = 0
            THEN
                BEGIN
&               ifdef TRACE
                m90int(pc, 'ndcnt       ', ndcnt);
                IF  first
                THEN
                    m90name(pc, 'first             ');
&               endif
                (*ENDIF*) 
                IF  first
                THEN
                    BEGIN
                    typentix := -1;
                    p14_s_varname (apc, pname, typentix, varentix,
                          vatyp, vcnt);
                    IF  typentix = 0
                    THEN
                        BEGIN
                        p11precomerror (apc, cpc_unknown_parametername);
                        p11nerrorlisting ( apc, pname, plen, 0);
                        END;
                    (*ENDIF*) 
                    END
                ELSE
                    BEGIN
                    p11precomerror (apc, cpc_unknown_parametername);
                    p11nerrorlisting ( apc, pname, plen, 0);
                    END;
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            IF  pcerror = cpc_pre_ok
            THEN
                BEGIN
                IF  first
                THEN
                    BEGIN
                    first := false;
                    (* init ndtable entry   *)
                    p19ndallocate (ndmax);
                    ndcnt :=  ndmax;
                    IF  vartablep^ [varentix]. vastrix = 0
                    THEN
                        ndtabp^ [ndcnt].ndvarmainix := varentix
                    ELSE
                        ndtabp^ [ndcnt].ndvarmainix := 0;
                    (*ENDIF*) 
                    firstvarentix              := varentix;
                    ndtabp^ [ndcnt].ndvarentix := varentix;
                    ndtabp^ [ndcnt].ndvararrix  := varentix;
                    ndtabp^ [ndcnt].ndsqlva1ix  := 0;
                    ndtabp^ [ndcnt].ndsqlva1cnt := 0;
                    ndtabp^ [ndcnt].ndCompIx    := -1;
                    ndtabp^ [ndcnt].ndarraycnt  := 0;
                    ndtabp^ [ndcnt].ndarrayix[1]:= 0;
                    ndtabp^ [ndcnt].ndarrayix[2]:= 0;
                    ndtabp^ [ndcnt].ndarrayix[3]:= 0;
                    ndtabp^ [ndcnt].ndarrayix[4]:= 0;
                    vaarrix [1] := 0;
                    vaarrix [2] := 0;
                    vaarrix [3] := 0;
                    vaarrix [4] := 0;
                    ndtabp^ [ndcnt].ndsqlva1st := 0;
                    ndtabp^ [ndcnt].ndkano     := pcka;
                    ndtabp^ [ndcnt].ndLoopPar  := 0;
                    ndtabp^ [ndcnt].ndcompexpan:= cpr_is_false;
                    ndtabp^ [ndcnt].ndExpanlen  := 0;
                    ndtabp^ [ndcnt].ndNamelen  := 0;
                    ndtabp^ [ndcnt].ndBlockId  := 0;
&                   ifdef TRACE
                    m90int2 (pc, 'first ndcnt ', ndcnt);
                    m90int2 (pc, 'vasqlix     ',
                          vartablep^ [varentix].vasqlix);
                    m90int2 (pc, 'ndvarentix  ',
                          ndtabp^ [ndcnt].ndvarentix );
                    m90int2 (pc, 'ndCompIx    ',
                          ndtabp^ [ndcnt].ndCompIx );
&                   endif
                    END
                ELSE
                    BEGIN
                    (* new sqlva1 index   *)
                    ndtabp^ [ndcnt].ndvarentix := varentix;
                    ndtabp^ [ndcnt].ndCompIx :=
                          ndtabp^ [ndcnt].ndCompIx + vcnt;
                    (* new variable sub-structure with count *)
                    ndtabp^ [ndcnt].ndsqlva1cnt :=
                          vartablep^ [varentix].vacnt;
                    END;
                (*ENDIF*) 
                anz  := 1;
                vcnt := 0;
                retvatyp := vatyp;
                lastvatyp := vatyp;
                index_comma := false;
                REPEAT
&                   ifdef TRACE
                    m90int2 (pc, 'case vatyp  ', vatyp);
                    m90int2 (pc, 'syposacc    ', syposacc);
                    m90int2 (pc, 'vcnt        ', vcnt);
                    m90int2 (pc, 'anz         ', anz);
                    m90int2 (pc, 'ndCompIx    ',
                          ndtabp^ [ndcnt].ndCompIx );
&                   endif
                    CASE vatyp OF
                        cpr_vstruct :
                            BEGIN
                            next_symbol (apc, partbufp^, part1len);
                            symb := p14symb (next_symbol, apc);
                            IF  symb <> cpr_s_point
                            THEN
                                IF  (symb = cpr_s_leftpar)
                                    OR  (symb = cpr_s_leftindpar)
                                THEN
                                    BEGIN
                                    p11precomerror(apc,cpc_invalid_parametername);
                                    p11nerrorlisting (apc, pname, plen, 0);
                                    END
                                ELSE
                                    BEGIN
                                    found := true;
                                    lastvatyp := vatyp;
                                    ndtabp^ [ndcnt].ndCompIx :=
                                          ndtabp^ [ndcnt].ndCompIx + 1;
&                                   ifdef TRACE
                                    m90int2 (pc, 'ndCompIx str',
                                          ndtabp^ [ndcnt].ndCompIx );
&                                   endif
                                    END;
                                (*ENDIF*) 
                            (*ENDIF*) 
                            END;
                        cpr_varray :
                            WITH ndtabp^ [ndcnt] DO
                                BEGIN
                                IF  (symb <> cpr_s_comma)
                                    AND (symb <> cpr_s_eof)
                                THEN
                                    next_symbol (apc, partbufp^, part1len);
                                (*ENDIF*) 
                                IF  (symb <> cpr_s_leftpar)
                                    AND (symb <> cpr_s_leftindpar)
                                    AND (NOT index_comma)
                                THEN
                                    BEGIN
                                    syposacc := sypos;
                                    anz  := anz * typtablep^ [typentix].tydim;
&                                   ifdef TRACE
                                    m90int2 (pc, 'typentix 0  ', typentix);
                                    m90int2 (pc, 'anz      0  ', anz );
                                    m90int2 (pc, 'lastvatyp0  ', lastvatyp);
&                                   endif
                                    lastvatyp := vatyp;
                                    ind := typtablep^ [typentix].tytypix;
                                    vatyp    := typtablep^ [ind].tyindi;
                                    IF  (vatyp = cpr_varray)
                                        OR  (vatyp = cpr_vstruct)
                                    THEN
                                        BEGIN
                                        typentix := typtablep^ [typentix]
                                              .tytypix;
                                        (* structure elemente *)
                                        count := 0;
                                        ind := typentix;
                                        p14_vacnt_get (apc, ind, count);
                                        anz  := anz  * count;
&                                       ifdef TRACE
                                        m90int2 (pc, 'typentix fou',typentix);
                                        m90int2 (pc, 'count       ', count);
                                        m90int2 (pc, 'anz         ', anz  );
&                                       endif
                                        (*  variable array count *)
                                        ndtabp^ [ndcnt].ndsqlva1cnt := anz;
                                        found := true;
                                        ndtabp^ [ndcnt].ndCompIx :=
                                              ndtabp^ [ndcnt].ndCompIx + 1;
&                                       ifdef TRACE
                                        m90int2 (pc, 'ndCompIx f+1',
                                              ndtabp^ [ndcnt].ndCompIx );
&                                       endif
                                        END;
                                    (*ENDIF*) 
                                    END
                                ELSE
                                    BEGIN
                                    next_symbol (apc, partbufp^, part1len);
                                    IF  (symb <> cpr_s_unsigned_integer)
                                        OR  (ndarraycnt >= mxpc_ndarray)
                                    THEN
                                        p11precomerror (apc,
                                              cpc_invalid_parametername)
                                    ELSE
                                        BEGIN
                                        p10int2unsignedget (apc, partbufp^,
                                              index);
                                        IF  (index < typtablep^ [typentix]
                                            .tyfix)
                                            OR  (index > typtablep^ [typentix]
                                            .tyfix +
                                            typtablep^ [typentix].tydim)
                                        THEN
                                            p11precomerror (apc,
                                                  cpc_invalid_rlistname_range);
                                        (*ENDIF*) 
                                        vcnt := index - typtablep^ [typentix]
                                              .tyfix ;
&                                       ifdef TRACE
                                        m90int2 (pc,'typentix    ', typentix);
                                        m90int2 (pc,'vcnt        ', vcnt);
&                                       endif
                                        ndarraycnt := ndarraycnt + 1;
                                        ndarrayix [ndarraycnt] := index;
                                        vaarrix [ndarraycnt]   := varentix;
                                        typentix := typtablep^ [typentix]
                                              .tytypix;
                                        vatyp    := typtablep^ [typentix]
                                              .tyindi;
                                        retvatyp := vatyp;
                                        IF  (vatyp = cpr_vstruct)
                                        THEN
                                            BEGIN
                                            count := 0;
                                            ind := typentix;
                                            p14_vacnt_get (apc, ind, count);
                                            ndtabp^[ndcnt].ndsqlva1cnt:=count;
                                            vcnt := vcnt * count;
                                            ndtabp^ [ndcnt].ndCompIx :=
                                                  ndtabp^ [ndcnt].ndCompIx
                                                  + vcnt;
                                            anz  := 1;
                                            vcnt := 0;
                                            END
                                        ELSE
                                            IF   (vcnt > 0)
                                            THEN
                                                BEGIN
                                                (* ndCompIx add     *)
                                                (* index components *)
                                                anz := 1;
                                                ind := typentix;
                                                count := 0;
                                                p14_vacnt_get (apc,ind,count);
                                                vcnt := vcnt * count;
                                                anz  := anz  * count;
&                                               ifdef TRACE
                                                m90int (pc, 'ind         ',
                                                      ind );
                                                m90int (pc, 'count       ',
                                                      count);
                                                m90int (pc, 'vcnt        ',
                                                      vcnt);
                                                m90int (pc, 'anz         ',
                                                      anz );
&                                               endif
                                                ndtabp^ [ndcnt].ndsqlva1cnt
                                                      :=  anz;
                                                ndtabp^ [ndcnt].ndCompIx  :=
                                                      ndtabp^ [ndcnt].ndCompIx
                                                      + vcnt;
                                                anz  := 1;
                                                vcnt := 0;
                                                END;
&                                           ifdef TRACE
                                            (*ENDIF*) 
                                        (*ENDIF*) 
                                        m90int2 (pc, 'ndCompIx    ',
                                              ndtabp^ [ndcnt].ndCompIx );
&                                       endif
                                        next_symbol (apc, partbufp^,
                                              part1len);
                                        anz  := 1;
                                        vcnt := 0;
                                        CASE symb OF
                                            cpr_s_rightpar, cpr_s_rightindpar:
                                                index_comma := false;
                                            cpr_s_comma :
                                                index_comma := true;
                                            OTHERWISE:
                                                BEGIN
                                                p11precomerror (apc,
                                                      cpc_invalid_parametername);
                                                p11nerrorlisting (apc, pname,
                                                      plen, 0);
                                                END;
                                            END;
                                        (*ENDCASE*) 
&                                       ifdef TRACE
                                        m90int2(pc, 'symb case   ',ord(symb));
                                        m90int2(pc, 'vatyp       ', vatyp);
                                        m90int2(pc, 'typentix    ', typentix);
&                                       endif
                                        END;
                                    (*ENDIF*) 
                                    END;
                                (*ENDIF*) 
                                END;
                            (*ENDWITH*) 
                        OTHERWISE:
                            BEGIN
                            (* scalar found  *)
                            found := true;
                            ndtabp^ [ndcnt].ndCompIx :=
                                  ndtabp^ [ndcnt].ndCompIx + 1;
&                           ifdef TRACE
                            m90int2 (pc, 'ndCompIxsf+1',
                                  ndtabp^ [ndcnt].ndCompIx );
&                           endif
                            vatyp := retvatyp;
                            lastvatyp := vatyp;
                            IF  (vatyp <> cpr_varray)
                                AND (vatyp <> cpr_vstruct)
                            THEN
                                BEGIN
                                (* scalar parameter *)
                                ndtabp^ [ndcnt].ndsqlva1cnt := 1;
                                ndtabp^ [ndcnt].ndCompIx :=
                                      ndtabp^ [ndcnt].ndCompIx + vcnt;
&                               ifdef TRACE
                                m90int2 (pc, 'ndCompIx sca',
                                      ndtabp^ [ndcnt].ndCompIx );
&                               endif
                                END;
                            (*ENDIF*) 
                            IF  (symb <> cpr_s_eof) AND (symb <> cpr_s_bufeof)
                            THEN
                                next_symbol (apc, partbufp^, part1len);
                            (*ENDIF*) 
                            END;
                        END;
                    (*ENDCASE*) 
                    symb := p14symb (next_symbol, apc);
                UNTIL
                    (symb = cpr_s_point) OR (pcerror <> cpc_pre_ok)
                    OR (found);
                (*ENDREPEAT*) 
                END;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
    UNTIL
        (found) OR (pcerror <> cpc_pre_ok);
    (*ENDREPEAT*) 
    IF  found
    THEN
        BEGIN
        WITH ndtabp^ [ndcnt] DO
            BEGIN
            parposend  := sypos -1;
            ndtypentix := typentix;
&           ifdef TRACE
            m90int2 (pc, 'varentix****', varentix);
            m90int2 (pc, 'ndvarentix  ', ndvarentix);
            m90int2 (pc, 'ndvararrix  ', ndvararrix);
            m90int2 (pc, 'firstvarenti', firstvarentix);
            m90int2 (pc, 'lastvatyp   ', lastvatyp);
            m90int2 (pc, 'typentix    ', typentix);
            m90int2 (pc, 'ndBlockId*  ', ndBlockId);
            m90int2 (pc, 'vablockid*  ', vartablep^ [varentix].vablockid);
&           endif
            arrix := 0;
            IF  (lastvatyp = cpr_varray) AND (resolve = cpr_is_false)
            THEN
                BEGIN
                arrix      := ndarraycnt;
                ndvararrix := ndvarentix;
                END
            ELSE
                ndvararrix := ndvarmainix;
            (*ENDIF*) 
            IF  ndvarmainix = 0
            THEN
                BEGIN
                p19mstruct (apc, firstvarentix, ndvarmainix);
                IF  ndvarmainix = 0
                THEN
                    BEGIN
                    p11precomerror (apc, cpc_duplicate_substructure_name);
                    p11nerrorlisting (apc, pname, plen, 0);
                    END
                ELSE
                    BEGIN
                    IF  ndvararrix = 0
                    THEN
                        ndvararrix := ndvarmainix;
                    (* brechne ndCompIx *)
                    (************
                          compix := 0;
                          arrix  := 0;
                          p14_compix_get (apc, ndvararrix, ndvarentix,
                          arrix, compfound, compix);
                          ndCompIx :=  compix;
&                         ifdef TRACE
                          m90int2 (pc, 'compix  typb', compix);
                          m90int2 (pc, 'ndvarmainix ', ndvarmainix);
                          m90int2 (pc, 'ndvararrix  ', ndvararrix);
                          m90int2 (pc, 'ndvarentix  ', ndvarentix);
                          m90int2 (pc, 'ndCompIx    ', ndCompIx);
&                         endif
                          *************)
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            IF  pcerror = cpc_pre_ok
            THEN
                BEGIN
                WITH vartablep^ [ndvararrix] DO
                    BEGIN
                    ndmaintyindi   := typtablep^ [vatypix ].tyindi;
&                   ifdef TRACE
                    m90int2 (pc, 'varentix****', varentix);
                    m90int2 (pc, 'vatypix ****', vatypix);
                    m90int2 (pc, 'ndvarentix  ', ndvarentix);
                    m90int2 (pc, 'ndvararrix  ', ndvararrix);
                    m90int2 (pc, 'ndvarmainix ', ndvarmainix);
                    m90int2 (pc, 'firstvarenti', firstvarentix);
                    m90int2 (pc, 'typentix    ', typentix);
                    m90int2 (pc, 'lastvatyp   ', lastvatyp);
                    m90int2 (pc, 'ndmaintyindi', ndmaintyindi);
                    m90int2 (pc, 'ndCompIx    ', ndCompIx);
                    m90int2 (pc, 'ndBlockId*  ', ndBlockId);
                    m90int2 (pc, 'vablockid*  ', vartablep^ [varentix].vablockid);
&                   endif
                    compix := 0;
                    (*    arrix  := 0;  *)
                    p14_compix_get (apc, ndvararrix, ndvarentix,
                          arrix, vaarrix, compfound, compix);
                    ndCompIx :=  compix;
&                   ifdef TRACE
                    m90int2 (pc, 'compix 2 get', compix);
                    m90int2 (pc, 'ndvarmainix ', ndvarmainix);
                    m90int2 (pc, 'ndvararrix  ', ndvararrix);
                    m90int2 (pc, 'ndvarentix  ', ndvarentix);
                    m90int2 (pc, 'ndmaintyindi', ndmaintyindi);
                    m90int2 (pc, 'ndCompIx    ', ndCompIx);
                    m90int2 (pc, 'ndBlockId*  ', ndBlockId);
                    m90int2 (pc, 'vablockid*  ', vartablep^ [varentix].vablockid);
&                   endif
                    (***********
                          IF  ( (ndvarmainix <> ndvararrix)
                          AND (ndmaintyindi = cpr_varray)
                          AND  (resolve = cpr_is_false) )
                          %*  bf 2.5.95  *%
                          OR ( (ndCompIx <> -1)
                          AND (ndarraycnt = 0 )
                          AND (ndmaintyindi = cpr_vstruct)
                          AND  (resolve = cpr_is_false) )
                          THEN
                          BEGIN
                          compix := 0;
                          arrix  := 0;
                          p14_compix_get (apc, ndvararrix, ndvarentix,
                          arrix, compfound, compix);
                          ndCompIx :=  compix;
&                         ifdef TRACE
                          m90int2 (pc, 'compix 2 get', compix);
                          m90int2 (pc, 'ndvarmainix ', ndvarmainix);
                          m90int2 (pc, 'ndvararrix  ', ndvararrix);
                          m90int2 (pc, 'ndvarentix  ', ndvarentix);
                          m90int2 (pc, 'ndmaintyindi', ndmaintyindi);
                          m90int2 (pc, 'ndCompIx    ', ndCompIx);
&                         endif
                          END;
                          ***********)
                    END;
                (*ENDWITH*) 
                WITH vartablep^ [ndvarentix] DO
                    BEGIN
                    IF  (lastvatyp <> cpr_varray)
                        AND (lastvatyp <> cpr_vstruct)
                    THEN
                        count := 1
                    ELSE
                        BEGIN
                        ind   := vatypix;
                        count      := 0;
                        p14_vacnt_get (apc, ind, count);
                        END;
                    (*ENDIF*) 
                    ndsqlva1cnt := count;
&                   ifdef TRACE
                    m90int2 (pc, 'ndvarentix  ', ndvarentix);
                    m90int2 (pc, 'lastvatyp   ', lastvatyp );
                    m90int2 (pc, 'vatypix     ', vatypix );
                    m90int2 (pc, 'count       ', count);
                    m90int2 (pc, 'ndBlockId*  ', ndBlockId);
                    m90int2 (pc, 'vablockid*  ', vartablep^ [varentix].vablockid);
&                   endif
                    END;
                (*ENDWITH*) 
                IF  (symb = cpr_s_leftpar)
                    OR (symb = cpr_s_leftindpar)
                THEN
                    BEGIN
                    p11precomerror (apc, cpc_invalid_parametername);
                    p11nerrorlisting (apc, pname, plen, 0);
                    END;
                (*ENDIF*) 
                parlen := 0;
                FOR i := parposbeg TO parposend DO
                    IF  partbufp^ [i] <> bsp_c1
                    THEN
                        BEGIN
                        parlen  := parlen + 1;
                        parname [parlen] := partbufp^ [i];
                        END;
                    (* eventuell [0] einf?ugen, daher 3 blanks *)
                    (*ENDIF*) 
                (*ENDFOR*) 
                parname [parlen+1] := chr (0);
&               ifdef TRACE
                m90int2 (pc, 'ndcnt*****  ', ndcnt);
                m90int2 (pc, 'ndmax*****  ', ndmax);
                m90int2 (pc, 'lastvatyp   ', lastvatyp );
                m90int2 (pc, 'reslove     ', resolve );
                m90int2 (pc, 'ndCompIx    ', ndtabp^ [ndcnt].ndCompIx );
&               endif
                IF  (resolve <> cpr_is_init)
                THEN
                    BEGIN
                    IF  (resolve = cpr_is_true)
                    THEN
                        ndvararrix := ndvarmainix;
                    (**bf 20.3.96**)
                    (*ENDIF*) 
                    ndBlockId := vartablep^ [varentix].vablockid;
&                   ifdef TRACE
                    m90int2 (pc, 'ndmaintyindi', ndmaintyindi);
                    m90int2 (pc, 'ndvarmainix ', ndvarmainix);
                    m90int2 (pc, 'ndvararrix  ', ndvararrix);
                    m90int2 (pc, 'ndvarentix  ', ndvarentix);
                    m90int2 (pc, 'ndBlockId*  ', ndBlockId);
                    m90int2 (pc, 'vablockid*  ', vartablep^ [varentix].vablockid);
&                   endif
                    p19cinitnamdesc (apc, resolve, parlen, parname);
                    (* belegt ein name_descriptor_entry *)
                    (* und sqlva1-v2 und va3-Area, wenn     *)
                    (* Hostvariable noch nicht in namdesclist existierte *)
                    WITH ndtabp^ [ndcnt] DO
                        BEGIN
                        ptr.intaddr := ndNamePtr;
                        schr[1] := '.';
                        IF  ndmaintyindi = cpr_varray
                        THEN
                            IF  ralang = cpr_la_cobol
                            THEN
                                IF  ndCompIx = -1
                                THEN
                                    schr[1]  := ')'
                                ELSE
                                    schr[1]  := '('
                                (*ENDIF*) 
                            ELSE
                                IF  ndCompIx = -1
                                THEN
                                    schr[1]  := ']'
                                ELSE
                                    schr[1]  := '[';
                                (*ENDIF*) 
                            (*ENDIF*) 
                        (*ENDIF*) 
                        IF  (ndarraycnt = 0) AND (ndcompexpan = cpr_is_true)
                            AND (ndExpanlen <> 0)
                        THEN
                            BEGIN
                            schr[1] := '.';
                            i := vartablep^ [ndvarmainix]. vatypix;
                            lowindex := typtablep^ [i].tyfix;
                            IF  ralang = cpr_la_cobol
                            THEN
                                ptr.vtypep^.buf [ndNamelen+1] := '('
                            ELSE
                                ptr.vtypep^.buf [ndNamelen+1] := '[';
                            (*ENDIF*) 
                            p05int2tochr12 (lowindex, chr12);
                            j := 2;
                            FOR i := 1 TO  mxsp_c12 DO
                                IF  chr12[i] <> bsp_c1
                                THEN
                                    BEGIN
                                    ptr.vtypep^.buf [ndNamelen+j] := chr12[i];
                                    j := j + 1;
                                    END;
                                (*ENDIF*) 
                            (*ENDFOR*) 
                            IF  ralang = cpr_la_cobol
                            THEN
                                ptr.vtypep^.buf [ndNamelen+j] := ')'
                            ELSE
                                ptr.vtypep^.buf [ndNamelen+j] := ']';
                            (*ENDIF*) 
                            ptr.vtypep^.buf [ndNamelen+j+1] := chr(0);
                            ndNamelen  := ndNamelen + j;
                            ndExpanlen := ndNamelen;
                            END;
                        (*ENDIF*) 
                        IF  ndExpanlen <> 0
                        THEN
                            BEGIN
                            i    := 1;
                            plen := 0;
                            REPEAT
                                IF  ptr.vtypep^.buf [i] = schr [1]
                                THEN
                                    BEGIN
                                    IF  (schr[1] = ']') OR (schr[1] = ')')
                                    THEN
                                        ndExpanlen := i
                                    ELSE
                                        ndExpanlen := i-1;
                                    (*ENDIF*) 
                                    plen := i;
                                    END;
                                (*ENDIF*) 
                                i := i + 1;
                            UNTIL
                                (plen <> 0) OR (i >= ndNamelen);
                            (*ENDREPEAT*) 
                            END;
                        (*ENDIF*) 
                        END;
                    (*ENDWITH*) 
                    END;
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            WITH ndtabp^ [ndcnt] DO
                BEGIN
&               ifdef TRACE
                m90int2 (pc, 'ndcnt*****  ', ndcnt);
                m90int2 (pc, 'ndmax*****  ', ndmax);
                m90int2 (pc, 'count       ', count);
                m90int2 (pc, 'ndvarmainix ', ndvarmainix);
                m90int2 (pc, 'ndvararrix  ', ndvararrix);
                m90int2 (pc, 'ndvarentix  ', ndvarentix);
                m90int2 (pc, 'ndtypentix  ', ndtypentix);
                m90int2 (pc, 'ndmaintyind ', ndmaintyindi);
                m90int2 (pc, 'ndcompexpan ', ndcompexpan);
                m90int2 (pc, 'ndarraycnt  ', ndarraycnt );
                m90int2 (pc, 'ndarray 1   ', ndarrayix [1] );
                m90int2 (pc, 'ndarray 2   ', ndarrayix [2] );
                m90int2 (pc, 'ndarray 3   ', ndarrayix [3] );
                m90int2 (pc, 'ndarray 4   ', ndarrayix [4] );
                m90int2 (pc, 'ndsqlva1st  ', ndsqlva1st);
                m90int2 (pc, 'ndsqlva1ix  ', ndsqlva1ix);
                m90int2 (pc, 'ndsqlva1cnt ', ndsqlva1cnt);
                m90int2 (pc, 'ndBlockId   ', ndBlockId );
                m90int2 (pc, 'ndkano      ', ndkano    );
                m90int2 (pc, 'ndLoopPar   ', ndLoopPar );
                m90int2 (pc, 'ndCompIx    ', ndCompIx  );
                m90int2 (pc, 'ndExpanlen  ', ndExpanlen);
                m90int2 (pc, 'ndNamelen   ', ndNamelen);
                m90int2 (pc, 'resolve     ', resolve  );
                m90int2 (pc, 'parposbeg   ', parposbeg);
                m90int2 (pc, 'parposend   ', parposend);
                m90int2 (pc, 'parlen      ', parlen);
                m90int2 (pc, 'lastvatyp   ', lastvatyp);
                m90int2 (pc, 'vatyp       ', vatyp );
                m90int2 (pc, 'lowindex    ', lowindex );
&               endif
                END;
            (*ENDWITH*) 
            END;
        (*ENDWITH*) 
        END
    ELSE
        typentix := 0;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
&ifdef TRACE
p14binitsqlvan (apc);
p10areaprint (apc);
m90name(xx, 'END   p14btype    ');
&endif
END;
 
(*------------------------------*) 
 
PROCEDURE
      p14_vacnt_get (VAR apc : tpc_globals;
            tyix  : integer;
            VAR anz  : integer);
 
VAR
      ant : integer;
      i   : integer;
 
BEGIN
WITH apc, pcsqlva, pcsymtab DO
    WITH typtablep^ [tyix] DO
        BEGIN
        CASE tyindi OF
            cpr_varray :
                BEGIN
                tyix := tytypix;
                p14_vacnt_get (apc, tyix, anz);
                anz  := anz  * tydim;
                END;
            cpr_vstruct :
                BEGIN
                FOR i := tycmpix TO tycmpix+tycmcnt-1 DO
                    BEGIN
                    ant := 0;
                    tyix := vartablep^ [cmpindexp^ [i]].vatypix;
                    p14_vacnt_get (apc, tyix, ant);
                    anz  := anz + ant;
                    END;
                (*ENDFOR*) 
                END;
            OTHERWISE:
                BEGIN
                anz  := anz + 1;
                END;
            END;
        (*ENDCASE*) 
        END;
    (*ENDWITH*) 
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p14_compix_get (VAR apc : tpc_globals;
            vmainix : tsp00_Int2;
            ventix  : tsp00_Int2;
            VAR arrix  : tsp00_Int2;
            VAR vaarrix  : tvaarrix;
            VAR found  : boolean;
            VAR compix : integer);
 
VAR
      i   : integer;
      anz : integer;
 
BEGIN
(* brechne ndCompIx *)
found := false;
&ifdef TRACE
m90int2 (pc, 'vmainix     ', vmainix  );
m90int2 (pc, 'ventix      ', ventix   );
m90int2 (pc, 'compix      ', compix);
&endif
WITH apc, pcsqlva, pcsymtab, ndtabp^ [ndcnt]  DO
    WITH vartablep^[vmainix] DO
        IF  vmainix = ventix
        THEN
            BEGIN
            found := true;
            (* componente gefunden *)
            (* rest array noch abarbeiten *)
            WHILE (arrix < ndarraycnt) DO
                p14_typ_compix_get (apc, vatypix,
                      ventix, arrix, vaarrix, vmainix, found, compix);
            (*ENDWHILE*) 
&           ifdef TRACE
            m90int2 (pc, 'compix  foun', compix);
&           endif
            END
        ELSE
            BEGIN
&           ifdef TRACE
            m90int2 (pc, 'tyindi      ', typtablep^[vatypix].tyindi);
&           endif
            WITH typtablep^[vatypix] DO
                CASE tyindi OF
                    cpr_varray :
                        BEGIN
                        anz := 0;
                        p14_vacnt_get (apc, tytypix, anz);
                        IF  vaarrix [arrix + 1] = vmainix
                        THEN
                            BEGIN
                            arrix  := arrix + 1;
                            IF  sqlca.sqlrap^.ralang = cpr_la_c
                            THEN
                                compix := (ndarrayix[arrix]) * anz + compix
                            ELSE
                                compix := (ndarrayix[arrix] - 1) * anz + compix;
                            (*ENDIF*) 
                            END
                        ELSE
                            compix := (tydim - 1) * anz + compix;
                        (*ENDIF*) 
&                       ifdef TRACE
                        m90int2 (pc, 'arrix   typ_', arrix );
                        IF  arrix <> 0
                        THEN
                            m90int2 (pc, 'vaarrix typ_', vaarrix[arrix]);
                        (*ENDIF*) 
                        m90int2 (pc, 'tydim   typ_', tydim );
                        m90int2 (pc, 'anz     typ_', anz   );
                        m90int2 (pc, 'compix  typ_', compix);
&                       endif
                        p14_typ_compix_get (apc, tytypix,
                              ventix, arrix, vaarrix, vmainix, found, compix);
                        END;
                    cpr_vstruct :
                        BEGIN
                        i     := tycmpix;
                        WHILE (i <= tycmpix+tycmcnt-1) AND (NOT found) DO
                            BEGIN
                            p14_compix_get (apc, cmpindexp^ [i],
                                  ventix, arrix, vaarrix, found, compix);
                            IF  NOT found
                            THEN
                                compix := compix + 1;
                            (*ENDIF*) 
                            i     := i + 1;
                            END;
                        (*ENDWHILE*) 
                        IF  NOT found
                        THEN
                            compix := compix - 1;
                        (*ENDIF*) 
                        END;
                    OTHERWISE:
                        BEGIN
                        END;
                    END;
                (*ENDCASE*) 
            (*ENDWITH*) 
&           ifdef TRACE
            m90int2 (pc, 'arrix       ', arrix );
            m90int2 (pc, 'compix  retu', compix);
&           endif
            END;
        (*ENDIF*) 
    (*ENDWITH*) 
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p14_typ_compix_get (VAR apc : tpc_globals;
            typix   : tsp00_Int2;
            ventix  : tsp00_Int2;
            VAR arrix  : tsp00_Int2;
            VAR vaarrix  : tvaarrix;
            VAR vmainix  : tsp00_Int2;
            VAR found  : boolean;
            VAR compix : integer);
 
VAR
      i : integer;
      anz : integer;
 
BEGIN
(* brechne ndCompIx *)
&ifdef TRACE
m90int2 (pc, 'typix       ', typix  );
m90int2 (pc, 'ventix      ', ventix   );
m90int2 (pc, 'compix      ', compix);
&endif
WITH apc, pcsqlva, pcsymtab, ndtabp^ [ndcnt]  DO
    BEGIN
&   ifdef TRACE
    m90int2 (pc, 'tyindi      ', typtablep^[typix].tyindi);
&   endif
    WITH typtablep^[typix] DO
        CASE tyindi OF
            cpr_varray :
                BEGIN
                anz := 0;
                p14_vacnt_get (apc, tytypix, anz);
                IF  vaarrix [arrix + 1] = vmainix
                THEN
                    BEGIN
                    arrix  := arrix + 1;
                    IF  sqlca.sqlrap^.ralang = cpr_la_c
                    THEN
                        compix := (ndarrayix[arrix]) * anz + compix
                    ELSE
                        compix := (ndarrayix[arrix] - 1) * anz + compix;
                    (*ENDIF*) 
                    END
                ELSE
                    compix := (tydim - 1) * anz + compix;
                (*ENDIF*) 
&               ifdef TRACE
                m90int2 (pc, 'arrix   typ_', arrix );
                IF  arrix <> 0
                THEN
                    m90int2 (pc, 'vaarrix typ_', vaarrix[arrix]);
                (*ENDIF*) 
                m90int2 (pc, 'tydim   typ_', tydim );
                m90int2 (pc, 'anz     typ_', anz   );
                m90int2 (pc, 'compix  typ_', compix);
&               endif
                IF  NOT found
                THEN
                    p14_typ_compix_get (apc, tytypix,
                          ventix, arrix, vaarrix, vmainix, found, compix);
                (*ENDIF*) 
                END;
            cpr_vstruct :
                BEGIN
                i     := tycmpix;
                WHILE (i <= tycmpix+tycmcnt-1) AND (NOT found) DO
                    BEGIN
                    p14_compix_get (apc, cmpindexp^ [i],
                          ventix, arrix, vaarrix, found, compix);
                    IF  NOT found
                    THEN
                        compix := compix + 1;
                    (*ENDIF*) 
                    i     := i + 1;
                    END;
                (*ENDWHILE*) 
                IF  NOT found
                THEN
                    compix := compix - 1;
                (*ENDIF*) 
                END;
            OTHERWISE:
                BEGIN
                END;
            END;
        (*ENDCASE*) 
    (*ENDWITH*) 
&   ifdef TRACE
    m90int2 (pc, 'arrix   typ_', arrix );
    m90int2 (pc, 'compix  typ_', compix);
&   endif
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p14isforloop  ( VAR apc : tpc_globals;
            VAR loopstruc : tsp00_Int2;
            VAR lastvatyp : tsp00_Int2;
            var_typ   : tsp00_Int2);
 
VAR
      typindex : integer;
 
BEGIN
WITH apc, pcsqlva, pcsymtab, pcopts DO
    IF   pcerror = cpc_pre_ok
    THEN
        BEGIN
        loopstruc := cpr_is_false;
        IF  pcopts.opt_comp = 1
        THEN
            WITH ndtabp^ [ndcnt], vartablep^ [ndvarentix] DO
                BEGIN
                typindex := vatypix;
                WITH typtablep^ [typindex] DO
                    IF  lastvatyp <> cpr_varray
                    THEN
                        BEGIN
                        IF  (pcpaloop < csp_maxint4)
                            AND (pcpaloop > 0)
                        THEN
                            BEGIN
                            p11precomerror (apc, cpc_missing_array);
                            p11nerrorlisting ( apc,
                                  vartablep^ [ndtabp^[ndcnt].ndvarentix]
                                  .vaname,
                                  vartablep^ [ndtabp^[ndcnt].ndvarentix]
                                  .vanaml, 0);
                            END;
                        (*ENDIF*) 
                        END
                    ELSE
                        IF  (pcpaloop = csp_maxint4)
                        THEN
                            BEGIN
                            (* abfrage ob first pcpaloop,
                                  pcpaloop = csp_maxint4 no mass command *)
                            IF  (var_typ = cpc_i_var)
                            THEN
                                BEGIN
                                p11precomerror (apc,
                                      cpc_variable_not_allowed_as_array);
                                p11nerrorlisting ( apc,
                                      vartablep^ [ndtabp^[ndcnt].ndvarentix]
                                      .vaname,
                                      vartablep^ [ndtabp^[ndcnt].ndvarentix]
                                      .vanaml, 0);
                                END
                            (*ENDIF*) 
                            END
                        ELSE
                            BEGIN
                            WITH  typtablep^ [tytypix]  DO
                                (* massen commandos *)
                                CASE tyindi OF
                                    cpr_vstruct :
                                        (* structure count *)
                                        ndsqlva1cnt :=  tycmcnt;
                                    cpr_varray :
                                        ndsqlva1cnt :=  tydim;
                                    OTHERWISE :
                                        (* scalar count *)
                                        ndsqlva1cnt :=  1;
                                    END;
                                (*ENDCASE*) 
                            (*ENDWITH*) 
                            IF  pcpaloop = 0
                            THEN
                                BEGIN
                                (* first entry for sqlparlo= cpr_is_loop_cnt*)
                                (* first entry for sqlparlo = max_loop_cnt *)
                                p19cparentry (apc, sqlparlo, tydim,
                                      tydim , 0);
                                pcpaloop := pcpa;
                                END;
                            (*ENDIF*) 
                            IF  pcpaloop <= 0
                            THEN
                                BEGIN
                                pcpaloop := pcpa;
                                sqlxa.sqlpap^ [pcpaloop]. paloopmin := tydim;
                                END;
                            (*ENDIF*) 
                            loopstruc := cpr_is_loop;
                            (* maximum count for loop *)
                            IF  tydim  <> sqlxa.sqlpap^ [pcpaloop]. paloopmin
                            THEN
                                BEGIN
                                IF  tydim  <  sqlxa.sqlpap^ [pcpaloop]
                                    .paloopmin
                                THEN
                                    sqlxa.sqlpap^[pcpaloop].paloopmin :=tydim;
                                (* loop arrays count not equal *)
                                (*ENDIF*) 
                                p11precomerror (apc, cpc_loop_error_count);
                                pcerror := cpc_pre_ok;
                                p03csqlcaareainit (sqlca);
                                END;
                            (*ENDIF*) 
                            END;
                        (*ENDIF*) 
                    (*ENDIF*) 
                (*ENDWITH*) 
                END;
            (*ENDWITH*) 
        (*ENDIF*) 
        IF  loopstruc = cpr_is_false
        THEN
            pcpaloop := csp_maxint4;
        (*ENDIF*) 
        END;
&   ifdef TRACE
    (*ENDIF*) 
(*ENDWITH*) 
m90name(xx, 'END   p14isfor    ');
&endif
END;
 
(*------------------------------*) 
 
PROCEDURE
      p14_s_varname  (VAR apc : tpc_globals;
            VAR  nam  : tsp00_Lname;
            VAR typentix : tsp00_Int2;
            VAR varentix : tsp00_Int2;
            VAR vatyp    : tsp00_Int2;
            VAR cnt    : tsp00_Int2);
 
BEGIN
WITH apc, pcsymtab DO
    BEGIN
&   ifdef TRACE
    m90lname  (pc, nam);
&   endif
    p14b_varindex (apc, nam, typentix, varentix, cnt);
    IF  varentix <= 0
    THEN (* not found*)
        typentix := varentix
    ELSE
        BEGIN
        typentix := vartablep^ [varentix].vatypix;
        IF  typentix <= 0
        THEN
            vatyp := 0
        ELSE
            vatyp    := typtablep^ [typentix].tyindi;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
&   ifdef TRACE
    m90int2 (pc, 'typentix    ', typentix );
    m90int2 (pc, 'varentix    ', varentix );
    m90int2 (pc, 'vatyp       ', vatyp    );
    m90int2 (pc, 'cnt         ', cnt   );
&   endif
    END;
(*ENDWITH*) 
&ifdef TRACE
m90name(xx, 'END p14_s_varname ');
&endif
END;
 
(*------------------------------*) 
 
PROCEDURE
      p14b_varindex (VAR apc : tpc_globals;
            VAR vna  : tsp00_Lname;
            strix    : tsp00_Int2;
            VAR vaindex : tsp00_Int2;
            VAR cnt   : tsp00_Int2);
 
VAR
      i , cmpix: tsp00_Int2;
      found : boolean;
      index : tsp00_Int2;
 
BEGIN
WITH apc, pcsymtab, sqlca, sqlrap^ DO
    BEGIN
    found := false;
    cnt := 0;
    IF  strix > 0
    THEN
        WITH typtablep^ [strix] DO
            BEGIN
            cmpix := tycmpix - 1;
            i :=  tycmpix;
            WHILE (i < tycmpix + tycmcnt) AND (NOT found) DO
                BEGIN
                IF  vna = vartablep^ [cmpindexp^ [i]].vaname
                THEN
                    BEGIN
                    cmpix := i;
                    found := true;
                    END
                ELSE
                    cnt := cnt + vartablep^ [cmpindexp^ [i]].vacnt;
                (*ENDIF*) 
                i := i + 1;
                END;
            (*ENDWHILE*) 
            IF  cmpix < tycmpix
            THEN
                vaindex := 0
            ELSE
                vaindex := cmpindexp^ [cmpix];
            (*ENDIF*) 
            END
        (*ENDWITH*) 
    ELSE
        IF  strix = 0
        THEN
            BEGIN
            vaindex := varbot;
            i := varcnt;
            WHILE i > vaindex DO
                BEGIN
                IF  (vna = vartablep^ [i].vaname) AND
                    (vartablep^ [i].vastrix = 0)
                THEN
                    vaindex := i;
                (*ENDIF*) 
                i := i - 1;
                END;
            (*ENDWHILE*) 
            IF  vaindex = varbot
            THEN
                IF  (ralang = cpr_la_cobol) AND (varbot > 0)
                THEN
                    BEGIN
                    vaindex := 0 ;
                    i := varbot;
                    WHILE i > vaindex DO
                        BEGIN
                        IF  (vna = vartablep^ [i].vaname) AND
                            (vartablep^ [i].vastrix = 0)  AND
                            (vartablep^ [i].vaglobl = 1)
                        THEN
                            vaindex := i;
                        (*ENDIF*) 
                        i := i - 1;
                        END;
                    (*ENDWHILE*) 
                    END
                ELSE
                    vaindex := 0;
                (*ENDIF*) 
            (*ENDIF*) 
            END
        ELSE
            IF  strix < 0
            THEN
                BEGIN
                vaindex := varbot;
                i := varcnt;
                WHILE i > varbot DO
                    BEGIN
                    IF  (vna = vartablep^ [i].vaname)
                    THEN
                        BEGIN
                        p19mstruct (apc, i, index);
                        IF  index <  0
                        THEN
                            BEGIN
                            p11precomerror (apc, cpc_duplicate_substructure_name);
                            p11nerrorlisting (apc, vna, LNAME_MXSP00, 0);
                            vaindex := varbot;
                            i := varbot;
                            END
                        ELSE
                            IF  index > 0
                            THEN
                                BEGIN
                                vaindex := i;
                                i := varbot;
                                END;
                            (*ENDIF*) 
                        (*ENDIF*) 
                        END;
                    (*ENDIF*) 
                    i := i - 1;
                    END;
                (*ENDWHILE*) 
                IF  vaindex = varbot
                THEN
                    IF  (ralang = cpr_la_cobol) AND (varbot > 0)
                    THEN
                        BEGIN
                        vaindex := 0 ;
                        i := varbot ;
                        WHILE i > vaindex DO
                            BEGIN
                            IF     (vna = vartablep^ [i].vaname)
                                AND (vartablep^ [i].vaglobl = 1)
                            THEN
                                BEGIN
                                p19mstruct (apc, i, index);
                                IF  index <  0
                                THEN
                                    BEGIN
                                    p11precomerror (apc,
                                          cpc_duplicate_substructure_name);
                                    p11nerrorlisting(apc, vna, LNAME_MXSP00, 0);
                                    i := 0;
                                    END
                                ELSE
                                    IF  index > 0
                                    THEN
                                        BEGIN
                                        vaindex := i;
                                        i := 0 ;
                                        END;
                                    (*ENDIF*) 
                                (*ENDIF*) 
                                END;
                            (*ENDIF*) 
                            i := i - 1;
                            END;
                        (*ENDWHILE*) 
                        END
                    ELSE
                        vaindex := 0;
                    (*ENDIF*) 
                (*ENDIF*) 
                END;
            (*ENDIF*) 
        (*ENDIF*) 
    (*ENDIF*) 
    END;
(*ENDWITH*) 
&ifdef TRACE
m90name(xx, 'END p14b_varindex ');
&endif
END;
 
(*------------------------------*) 
 
PROCEDURE
      p14var (
            PROCEDURE next_symbol (VAR p1: tpc_globals;
            VAR p2: tpc_partbuffer; p3: integer);
            VAR apc:tpc_globals; VAR i: tsp00_Int2;
            VAR typentry : tpc_typent);
 
VAR
      longind, typind, keyind, plen : integer ;
      pname  : tsp00_Lname;
      (**  size   : tsp _int2; **)
      precision, scale, typentix, vatyp, vcnt : tsp00_Int2 ;
      length : tsp00_Int4 ;
      tpentry : tpc_typent ;
 
BEGIN
WITH apc, pcscan, pccmdpart, pcsymtab, pcinpline DO
    BEGIN
    typentry := typentry;
    typind := 0 ;
    longind := 0 ;
    length := 0 ;
    precision := 0 ;
    scale := 0 ;
    next_symbol (apc, partbufp^, part1len);
    p10getkeyword (apc, partbufp^, keyind);
    p19lgetname (apc, pname, plen);
    i := varcnt ;
    WHILE (pname <> vartablep^[i].vaname) AND (i>=1)
          DO
        BEGIN
        i := i-1 ;
        END;
    (*ENDWHILE*) 
    IF  i > 0
    THEN
        BEGIN
        typentix := -1;
        p14_s_varname (apc, pname, typentix, i, vatyp, vcnt);
        IF  typentix = 0
        THEN
            BEGIN
            p11precomerror (apc, cpc_unknown_parametername);
            p11nerrorlisting ( apc, pname, plen, 0);
            END
        ELSE
            IF  (typtablep^[typentix].tyindi = cpr_vstruct) OR
                (typtablep^[typentix].tyindi = cpr_vnone)
            THEN
                BEGIN
                p11precomerror (apc, cpc_invalid_parametername);
                p11nerrorlisting ( apc, pname, plen, 0);
                END
            ELSE
                BEGIN
                IF  typtablep^[typentix].tyindi = cpr_varray
                THEN
                    tpentry := typtablep^[typtablep^[typentix].tytypix]
                ELSE
                    tpentry := typtablep^[typentix];
                (*ENDIF*) 
                next_symbol (apc, partbufp^, part1len);
                p10getkeyword (apc, partbufp^, keyind);
                IF  keyind = cpc_i_is
                THEN
                    BEGIN
                    next_symbol (apc, partbufp^, part1len);
                    p10getkeyword (apc, partbufp^, typind);
                    END;
                (*ENDIF*) 
                IF  typind = cpc_i_long
                THEN
                    BEGIN
                    next_symbol (apc, partbufp^, part1len);
                    p10getkeyword (apc, partbufp^, longind);
                    IF  (longind = cpc_i_raw)
                        OR  (longind = cpc_i_varchar)
                        OR  (longind = cpc_i_varraw)
                    THEN
                        next_symbol (apc, partbufp^, part1len);
                    (*ENDIF*) 
                    END
                ELSE
                    next_symbol (apc, partbufp^, part1len);
                (*ENDIF*) 
                IF  symb = cpr_s_leftpar
                THEN
                    BEGIN
                    next_symbol (apc, partbufp^, part1len);
                    IF  (typind = cpc_i_decimal) OR (typind= cpc_i_display)
                    THEN
                        BEGIN
                        p10int2unsignedget (apc, partbufp^, precision);
                        next_symbol (apc, partbufp^, part1len);
                        IF  symb = cpr_s_comma
                        THEN
                            BEGIN
                            next_symbol (apc, partbufp^, part1len);
                            p10int2unsignedget (apc, partbufp^, scale);
                            END;
                        (*ENDIF*) 
                        END
                    ELSE
                        p10int4unsignedget (apc, partbufp^, length);
                    (*ENDIF*) 
                    next_symbol (apc, partbufp^, part1len);
                    IF  symb <> cpr_s_rightpar
                    THEN
                        p11precomerror (apc, cpc_invalid_sql_command);
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
                WITH tpentry DO
                    BEGIN
                    CASE typind OF
                        cpc_i_varchar2:
                            BEGIN
                            tydigit := 0 ;
                            tyfrac  := 0 ;
                            tyindi := cpr_vchar ;
                            IF  length > tysize
                            THEN
                                p11precomerror (apc, cpc_del_oracle_statement);
                            (*ENDIF*) 
                            END;
                        cpc_i_long :
                            BEGIN
                            tydigit := 0 ;
                            tyfrac  := 0 ;
                            IF  length > tysize
                            THEN
                                p11precomerror (apc, cpc_del_oracle_statement)
                            ELSE
                                CASE longind OF
                                    cpc_i_raw :
                                        tyindi := cpr_vchar ;
                                    cpc_i_varchar, cpc_i_varraw :
                                        tyindi := cpr_vstring ;
                                    OTHERWISE :
                                        tyindi := cpr_vchar ;
                                    END;
                                (*ENDCASE*) 
                            (*ENDIF*) 
                            END;
                        cpc_i_number  :
                            BEGIN
                            p11precomerror (apc, cpc_del_oracle_statement);
                            END;
                        cpc_i_integer :
                            p11precomerror (apc, cpc_del_oracle_statement);
                        {  IF  length > tysize
                              THEN
                              p11precomerror (apc, cpc_del_oracle_statement)
                              ELSE
                              IF  length > 2
                              THEN
                              BEGIN
                              tyindi := cpr_vint4;
                              tysize := 4 ;
                              tydigit := 9 ;
                              tyfrac  := 0 ;
                              END
                              ELSE
                              BEGIN
                              tyindi := cpr_vint2;
                              tysize := 2;
                              tydigit := 4 ;
                              tyfrac  := 0 ;
                              END;}
                        cpc_i_float   :
                            p11precomerror (apc, cpc_del_oracle_statement);
                        {IF  length > tysize
                              THEN
                              p11precomerror (apc, cpc_del_oracle_statement)
                              ELSE
                              IF  length > 4
                              THEN
                              BEGIN
                              tyindi := cpr_vreal8;
                              tysize := 8 ;
                              tydigit := 15 ;
                              tyfrac  := 0 ;
                              END
                              ELSE
                              BEGIN
                              tyindi := cpr_vreal4;
                              tysize := 4;
                              tydigit := 6 ;
                              tyfrac  := 0 ;
                              END;}
                        cpc_i_varnum  :
                            p11precomerror (apc, cpc_del_oracle_statement);
                        cpc_i_decimal :
                            p11precomerror (apc, cpc_del_oracle_statement);
                        {      IF  precision > 0
                              THEN
                              BEGIN
                              IF  ((precision+scale) DIV 2)+1 < tysize
                              THEN BEGIN
                              tydigit := precision+scale ;
                              size := (tydigit DIV 2)+1;
                              tydigit := tydigit+(tysize-size)*2;
                              tyfrac := scale ;
                              END
                              ELSE
                              IF  ((precision+scale) DIV 2)+1 = tysize
                              THEN BEGIN
                              tydigit := precision+scale ;
                              tyfrac := scale ;
                              END
                              ELSE
                              BEGIN
                              tydigit := tysize*2-1;
                              IF (scale=0)
                              THEN tyfrac := 0
                              ELSE
                              IF (tydigit>=precision+scale)
                              THEN tyfrac:=tydigit-precision
                              ELSE tyfrac:=precision-tydigit;
                              END;
                              tyindi := cpr_vdecimal ;
                              END
                              ELSE
                              p11precomerror (apc, cpc_invalid_sql_command);}
                        cpc_i_varchar :
                            IF  length > tysize
                            THEN
                                p11precomerror (apc, cpc_del_oracle_statement)
                            ELSE
                                BEGIN
                                tydigit := 0 ;
                                tyfrac  := 0 ;
                                tyindi := cpr_vstring ;
                                END;
                            (*ENDIF*) 
                        cpc_i_rowid   :
                            BEGIN
                            p11precomerror (apc, cpc_del_oracle_statement)
                            END;
                        cpc_i_date    :
                            BEGIN
                            tydigit := 0 ;
                            tyfrac  := 0 ;
                            tyindi := cpr_vchar ;
                            END;
                        cpc_i_varraw  :
                            IF  length > tysize
                            THEN
                                p11precomerror (apc, cpc_del_oracle_statement)
                            ELSE
                                BEGIN
                                tyindi := cpr_vstring ;
                                tydigit := 0 ;
                                tyfrac  := 0 ;
                                END;
                            (*ENDIF*) 
                        cpc_i_raw     :
                            IF  length > tysize
                            THEN
                                p11precomerror (apc, cpc_del_oracle_statement)
                            ELSE
                                BEGIN
                                tyindi := cpr_vchar ;
                                tydigit := 0 ;
                                tyfrac  := 0 ;
                                END;
                            (*ENDIF*) 
                        cpc_i_unsigned:
                            p11precomerror (apc, cpc_del_oracle_statement);
                        { IF  length > tysize
                              THEN
                              p11precomerror (apc, cpc_del_oracle_statement)
                              ELSE
                              IF  length > 2
                              THEN
                              BEGIN
                              tyindi := cpr_vuns4;
                              tysize := 4 ;
                              tydigit := 10 ;
                              tyfrac  := 0 ;
                              END
                              ELSE
                              BEGIN
                              tyindi := cpr_vuns2;
                              tysize := 2;
                              tydigit := 5 ;
                              tyfrac  := 0 ;
                              END;}
                        cpc_i_display     :
                            p11precomerror (apc, cpc_del_oracle_statement);
                        {IF  precision > 0
                              THEN
                              BEGIN
                              tyindi := cpr_vlszon ;
                              IF  precision+scale+1 <= tysize
                              THEN
                              tysize := precision+scale+1 ;
                              tyfrac := scale ;
                              tydigit := tysize ;
                              END
                              ELSE
                              p11precomerror (apc, cpc_invalid_sql_command); }
                        cpc_i_char    :
                            IF  length > tysize
                            THEN
                                p11precomerror (apc, cpc_del_oracle_statement)
                            ELSE
                                BEGIN
                                tyindi := cpr_vchar ;
                                tydigit := 0 ;
                                tyfrac  := 0 ;
                                END;
                            (*ENDIF*) 
                        cpc_i_charz   :
                            IF  length > tysize
                            THEN
                                p11precomerror (apc, cpc_del_oracle_statement)
                            ELSE
                                BEGIN
                                tyindi := cpr_vcharc ;
                                tydigit := 0 ;
                                tyfrac  := 0 ;
                                END;
                            (*ENDIF*) 
                        cpc_i_mlslabel:
                            IF  length > tysize
                            THEN
                                p11precomerror (apc, cpc_del_oracle_statement)
                            ELSE
                                BEGIN
                                tyindi := cpr_vstring ;
                                tydigit := 0 ;
                                tyfrac  := 0 ;
                                END;
                            (*ENDIF*) 
                        OTHERWISE :
                            BEGIN
                            p11precomerror (apc, cpc_unknown_typename);
                            END;
                        END;
                    (*ENDCASE*) 
                    END;
                (*ENDWITH*) 
                IF  typtablep^[typentix].tyindi = cpr_varray
                THEN
                    typtablep^[typtablep^[typentix].tytypix] := tpentry
                ELSE
                    typtablep^[typentix] := tpentry;
                (*ENDIF*) 
                END;
            (*ENDIF*) 
        (*ENDIF*) 
        END
    ELSE
        BEGIN
        p11precomerror (apc, cpc_unknown_parametername);
        p11nerrorlisting ( apc, pname, plen, 0);
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p14binitsqlvan (VAR apc : tpc_globals);
&     ifdef TRACE
 
VAR
      i : integer;
      nam : tsp00_Name;
&     endif
 
BEGIN
WITH apc, pcsymtab, sqlxa, pcsqlva DO
    BEGIN
&   ifdef TRACE
    nam := '** VAR----TABLE **';
    m90name (pc, nam);
    FOR i := 1 TO varcnt DO
        WITH vartablep^ [i] DO
            BEGIN
            m90int  (pc, 'var-index***', i);
            m90lname (pc, vaname );
            m90int2 (pc, 'vanaml      ', vanaml);
            m90int2 (pc, 'vacnt       ', vacnt );
            m90int2 (pc, 'vastrix     ', vastrix);
            m90int2 (pc, 'vatypix     ', vatypix);
            m90int2 (pc, 'vasqlix     ', vasqlix);
            m90int2 (pc, 'vaglobl     ', vaglobl);
            m90int2 (pc, 'vablockid   ', vablockid);
            END;
        (*ENDWITH*) 
    (*ENDFOR*) 
    nam := '** TYP----TABLE **';
    m90name (pc, nam);
    FOR i := 1 TO typcnt DO
        WITH typtablep^ [i] DO
            BEGIN
            m90int  (pc, 'typ-index***', i);
            m90int2 (pc, 'tyref       ', tyref );
            m90int2 (pc, 'tyindi      ', tyindi);
            m90int2 (pc, 'typtr       ', typtr);
            CASE tyindi OF
                cpr_vstruct :
                    BEGIN
                    m90int2 (pc, 'tycmcnt 1.  ', tycmcnt);
                    m90int2 (pc, 'tycmpix 2.  ', tycmpix);
                    m90int2 (pc, 'tyvacnt 3.  ', tyvacnt);
                    END;
                cpr_varray :
                    BEGIN
                    m90int4 (pc, 'tydim   1.  ', tydim  );
                    m90int2 (pc, 'tyfix   2.  ', tyfix  );
                    m90int2 (pc, 'tytypix 3.  ', tytypix);
                    END;
                OTHERWISE:
                    BEGIN
                    m90int2 (pc, 'tydigit 0.  ', tydigit );
                    m90int4 (pc, 'tysize  1.  ', tysize );
                    m90int2 (pc, 'tyfrac  2.  ', tyfrac );
                    END;
                END;
            (*ENDCASE*) 
            END;
        (*ENDWITH*) 
    (*ENDFOR*) 
    nam := '** CMP----TABLE **';
    m90name (pc, nam);
    FOR i := 1 TO cmpcnt DO
        BEGIN
        m90int  (pc, 'cmp-index***', i);
        m90int2 (pc, 'cmp         ', cmpindexp^ [i]);
        END;
    (*ENDFOR*) 
    nam := '** SQLVA1-TABLE **';
    m90name (pc, nam);
    FOR i := 1 TO va1cnt DO
        WITH sqlv1p^ [i] DO
            BEGIN
            m90int  (pc, 'va1-index***', i);
            m90int2 (pc, 'va1indva2_sc', va1indva2_sc);
            m90int2 (pc, 'va1indva3_sc', va1indva3_sc);
            END;
        (*ENDWITH*) 
    (*ENDFOR*) 
    nam := '** SQLVA2-TABLE **';
    m90name (pc, nam);
    FOR i := 1 TO va2cnt DO
        WITH sqlv2p^ [i] DO
            BEGIN
            m90int  (pc, 'va2-index***', i);
            m90int2 (pc, 'va2typ      ', va2typ);
            m90int2 (pc, 'va2digit    ', va2digit);
            m90int4 (pc, 'va2size     ', va2size );
            m90int2 (pc, 'va2frac     ', va2frac);
            m90int2 (pc, 'va2const    ', va2const);
            END;
        (*ENDWITH*) 
    (*ENDFOR*) 
    nam := '** SQLVA3-TABLE **';
    m90name (pc, nam);
    FOR i := 1 TO va3cnt DO
        WITH sqlv3p^ [i] DO
            BEGIN
            m90int  (pc, 'va3-index***', i);
            m90int2 (pc, 'va3naml     ', va3naml);
            m90lname (pc, va3name);
            END;
        (*ENDWITH*) 
    (*ENDFOR*) 
&   endif
    END;
(*ENDWITH*) 
&ifdef TRACE
m90name(xx, 'END p14binitsqlvan');
&endif
END;
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
.PA 
