.ad 8
.bm 8
.fm 4
.bt $Copyright (c) 2000-2005 SAP AG$$Page %$
.tm 12
.hm 6
.hs 3
.tt 1 $SQL$Project Distributed Database System$VPC16$
.tt 2 $$$
.TT 3 $$Check_Usage$2001-08-15$
***********************************************************
.nf
 
 .nf

.nf

    ========== licence begin  GPL
    Copyright (c) 2000-2005 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

 
.fo
.nf
.sp
MODULE  : Check_Usage
=========
.sp
Purpose : Procedures for check usage option,.
          and inputs for data dictionary in SQLDB.
.CM *-END-* purpose -------------------------------------
.sp
.cp 3
Define  :
 
        VAR
              booladdr :  tsp00_BoolAddr;
 
        PROCEDURE
              p16sqlopcheck (VAR apc : tpc_globals);
 
        PROCEDURE
              p16offusage (VAR apc : tpc_globals);
 
        PROCEDURE
              p16tabledclgen (VAR apc : tpc_globals;
                    VAR dclgen : boolean);
 
        PROCEDURE
              p16finishcmd (VAR sqlca : sqlcatype;
                    VAR sqlxa : sqlxatype;
                    VAR ga : sqlgaentry;
                    VAR ka : sqlkaentry);
 
        PROCEDURE
              p16addspacevarpart (VAR sqlca : sqlcatype;
                    VAR sqlxa : sqlxatype;
                    VAR ga  : sqlgaentry;
                    VAR pos : integer;
                    VAR anf : integer;
                    VAR plus: integer);
 
        PROCEDURE
              p16macrosubstitution  (VAR sqlca : sqlcatype;
                    VAR sqlxa : sqlxatype;
                    VAR ga : sqlgaentry;
                    VAR anf : integer;
                    VAR mpos : integer;
                    VAR macrono  : integer;
                    VAR mline : tpr_macroline);
 
        PROCEDURE
              p16oldpartfinish (packet_ptr : tsp1_packet_ptr;
                    VAR old_part : tsp1_part_ptr;
                    addlen  : tsp00_Int4);
 
.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :
 
        FROM
              Search-Const-Type-Var-Namen   : VPC19C;
 
        PROCEDURE
              p19sqlsdallocate (VAR index : tsp00_Int2);
 
      ------------------------------ 
 
        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);
 
        PROCEDURE
              p11perrorlisting  (VAR apc : tpc_globals;
                    VAR nam : tsp00_Lname;
                    naml  : tsp00_Int2;
                    index : tsp00_Int2;
                    pointl: tsp00_Int2);
 
        PROCEDURE
              p11errorcheck (VAR apc : tpc_globals);
 
      ------------------------------ 
 
        FROM
              Precompiler_Runtime_Routinen  : VPR08;
 
        PROCEDURE
              p08privicmd (VAR sqlca : sqlcatype;
                    VAR sqlxa : sqlxatype;
                    VAR ka : sqlkaentry;
                    VAR cmdfetch : tsp00_Int2);
 
        PROCEDURE
              p08runtimeerror (VAR sqlca : sqlcatype;
                    VAR sqlxa : sqlxatype;
                    error : tpr_runtime_errors);
 
      ------------------------------ 
 
        FROM
              SQLDB-Auftrags-Schnittstelle  : VPR03;
 
        PROCEDURE
              p03find_part  (sqlrap : sqlrapointer;
                    part_kind        : tsp1_part_kind;
                    VAR part_ptr     : tsp1_part_ptr);
 
        PROCEDURE
              p03modulnameput  (VAR sqlca : sqlcatype;
                    VAR sqlxa : sqlxatype;
                    VAR ga : sqlgaentry;
                    VAR ka : sqlkaentry);
 
        PROCEDURE
              p03psqllinecmd (VAR sqlca : sqlcatype;
                    VAR s  : tpr_sqlline;
                    anfpos : integer;
                    len    : integer;
                    lenmax : integer;
                    part_ptr : tsp1_part_ptr);
 
        PROCEDURE
              p03gparsid (sqlrap : sqlrapointer;
                    sqlemp : sqlempointer;
                    VAR parsid : tpr_parsid;
                    VAR SessionID : tpr00_SessionID);
 
        PROCEDURE
              p03p1cmd  (part_ptr : tsp1_part_ptr;
                    VAR s : tsp00_C20;
                    l_s : integer);
 
      ------------------------------ 
 
        FROM
              C-Type-Checker-Module  : VPR102;
 
        PROCEDURE
              p08analyzeconnectstatm (VAR sqlca : sqlcatype;
                    VAR sqlxa : sqlxatype;
                    VAR sqlga : sqlgatype;
                    VAR ga : sqlgaentry;
                    VAR ka : sqlkaentry;
                    partlen   : tsp00_Int4;
                    VAR buf : tpc_partbuffer);
 
        PROCEDURE
              p07senderid (VAR xalang : tsp00_Int2;
                    VAR senderid : tsp00_C8;
                    VAR cmdkind  : tsp00_Int2);
 
        PROCEDURE
              p05cnext2symbol (VAR buf : tsp00_MoveObj;
                    buflen  : tsp00_Int4;
                    posanf     : tsp00_Int4;
                    VAR sympos : tsp00_Int4;
                    VAR symlen : tsp00_Int4;
                    VAR symb   : tpr_symbol;
                    VAR accpos : tsp00_Int4;
                    c_minus    : char );
 
        PROCEDURE
              p03csqlcaareainit (VAR sqlca : sqlcatype);
 
        PROCEDURE
              p03ccmdinit (
                    VAR xaSQLDesc : tpr01_SQLDesc;
                    VAR sqlca : sqlcatype;
                    VAR ga : sqlgaentry;
                    m_type   : tsp1_cmd_mess_type);
 
        FUNCTION
              p03cpacketinit  (
                    VAR xaSQLDesc : tpr01_SQLDesc;
                    sqlrap :sqlrapointer;
                    VAR ga   : sqlgaentry;
                    m_type   : tsp1_cmd_mess_type) : tsp1_packet_ptr;
 
        PROCEDURE
              p03connect  (
                    VAR sqlxa : sqlxatype;
                    sqlrap :sqlrapointer;
                    sqlgap   :  sqlgapointer;
                    VAR ga : sqlgaentry;
                    datetime : tsp00_Int2;
                    errmsg : sqlempointer);
 
        PROCEDURE
              p03sqlrelease  (sqlrap : sqlrapointer;
                    sqlgap :  sqlgapointer;
                    VAR ga : sqlgaentry;
                    errmsg : sqlempointer);
 
        PROCEDURE
              pc16cSearchFetch (VAR sqlca : sqlcatype;
                    VAR sqlxa : sqlxatype;
                    VAR ga : sqlgaentry;
                    VAR ergn  : tsp00_KnlIdentifier;
                    VAR descr : boolean;
                    VAR intopos : integer);
 
        PROCEDURE
              pr01TraceRuntimeError (VAR sqlca : sqlcatype;
                    VAR sqlxa : sqlxatype;
                    error : tpr_runtime_errors);
 
        PROCEDURE
              p03creqrecpacket (sqlrap : sqlrapointer;
                    VAR gaentry : sqlgaentry;
                    sqlemp : sqlempointer);
 
&       ifdef TRACE
 
        PROCEDURE
              m90int (layer : tsp00_ToolLayer;
                    nam : tsp00_Sname;
                    int : integer);
 
        PROCEDURE
              m90int2 (layer : tsp00_ToolLayer;
                    nam : tsp00_Sname;
                    int : tsp00_Int2);
 
        PROCEDURE
              m90int4 (layer : tsp00_ToolLayer;
                    nam : tsp00_Sname;
                    int : tsp00_Int4);
 
        PROCEDURE
              m90buf (layer : tsp00_ToolLayer;
                    VAR buf :  tsp00_MoveObj;
                    pos_anf : integer;
                    pos_end : integer);
 
        PROCEDURE
              m90buf2 (layer : tsp00_ToolLayer;
                    VAR buf :  tsp_varpart;
                    pos_anf : integer;
                    pos_end : integer);
 
        PROCEDURE
              m90buf3 (layer : tsp00_ToolLayer;
                    VAR buf :  char;
                    pos_anf : integer;
                    pos_end : integer);
&       endif
 
      ------------------------------ 
 
        FROM
              Runtime-Stringroutinen    : VPR05;
 
        PROCEDURE
              p05up1casebuf (VAR buf : tsp00_MoveObj;
                    lwb : tsp00_Int4;
                    upb : tsp00_Int4);
 
        FUNCTION
              p05eq (VAR a : tsp00_Sname;
                    VAR b  : tsp00_MoveObj;
                    b_pos  : tsp00_Int4;
                    length : tsp00_Int4) : boolean;
 
        PROCEDURE
              p05nextsymbol (VAR buf : tsp00_MoveObj;
                    buflen  : tsp00_Int4;
                    pasanf     : tsp00_Int4;
                    VAR sympos : tsp00_Int4;
                    VAR symlen : tsp00_Int4;
                    VAR symb   : tpr_symbol);
 
        PROCEDURE
              p05inttochr12 (int : integer;
                    VAR chr12 : tsp00_C12);
 
      ------------------------------ 
 
        FROM
              RTE_driver           : VEN102;
 
        PROCEDURE
              sqlinit (VAR component : tsp00_C64;
                    canceladdr : tsp00_BoolAddr);
 
        PROCEDURE
              sqlabort;
 
      ------------------------------ 
 
        FROM
              Kernel_move_and_fill   : VGG101;
 
        PROCEDURE
              SAPDB_PascalForcedOverlappingMove (
                    source_upb  : tsp00_Int4;
                    destin_upb  : tsp00_Int4;
                    source      : tsp00_MoveObjPtr;
                    source_pos  : tsp00_Int4;
                    destin      : tsp00_MoveObjPtr;
                    destin_pos  : tsp00_Int4;
                    length      : tsp00_Int4);
 
        PROCEDURE
              SAPDB_PascalForcedFill (
                    size        : tsp00_Int4;
                    m           : tsp00_MoveObjPtr;
                    pos         : tsp00_Int4;
                    len         : tsp00_Int4;
                    fillchar    : char);
 
        PROCEDURE
              SAPDB_PascalForcedMove (
                    source_upb  : tsp00_Int4;
                    destin_upb  : tsp00_Int4;
                    source      : tsp00_MoveObjPtr;
                    source_pos  : tsp00_Int4;
                    destin      : tsp00_MoveObjPtr;
                    destin_pos  : tsp00_Int4;
                    length      : tsp00_Int4);
 
        PROCEDURE
              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
              Packet_handling : VSP26;
 
        PROCEDURE
              s26finish_part (packet_ptr : tsp1_packet_ptr;
                    VAR finish_part      : tsp1_part);
 
        PROCEDURE
              s26new_part_init (packet_ptr : tsp1_packet_ptr;
                    VAR segm               : tsp1_segment;
                    VAR new_part_ptr       : tsp1_part_ptr);
 
        FUNCTION
              s26partlen (VAR part : tsp1_part) : tsp00_Int4;
 
      ------------------------------ 
 
        FROM
              RTE-Extension-30    : VSP30;
 
        FUNCTION
              s30len (VAR str : tpr_valuerec;
                    val : char; cnt : tsp00_Int4) : tsp00_Int4;
 
        FUNCTION
              s30klen (VAR str : tsp00_KnlIdentifier;
                    val : char; cnt : integer) : integer;
 
        FUNCTION
              s30lnr (VAR str : tpr_valuerec;
                    val : char;
                    pos : tsp00_Int4;
                    cnt : tsp00_Int4) : tsp00_Int4;
 
.CM *-END-* use -----------------------------------------
.sp;.cp 3
Synonym :
 
        PROCEDURE
              m90buf2;
 
              tsp00_Buf           tsp_varpart
 
        PROCEDURE
              p08analyzeconnectstatm;
 
              tsp00_MoveObj       tpc_partbuffer
 
        PROCEDURE
              p03p1cmd;
 
              tsp00_C24           tsp00_C20
 
        PROCEDURE
              m90buf;
 
              tsp00_Buf   tsp00_MoveObj
 
        PROCEDURE
              m90buf3;
 
              tsp00_Buf           char
              tsp00_Buf   tsp00_TermId
 
        PROCEDURE
              p05up1casebuf;
 
              tsp00_MoveObj  tsp00_MoveObj
 
        PROCEDURE
              s30len;
 
              tsp00_MoveObj  tpr_valuerec
 
        PROCEDURE
              s30lnr1;
 
              tsp00_MoveObj       tsp00_KnlIdentifier
 
        PROCEDURE
              s30lnr;
 
              tsp00_MoveObj tpr_valuerec
 
        PROCEDURE
              s30klen;
 
              tsp00_MoveObj       tsp00_KnlIdentifier
 
        PROCEDURE
              sqlinit;
 
              tsp00_CompName    tsp00_C64
              tsp00_BoolAddr    tsp00_BoolAddr
 
.CM *-END-* synonym -------------------------------------
.sp;.cp 3
Author  :
.sp
.cp 3
Created : 1986-07-07
.sp
.cp 3
Version : 2002-04-25
.sp
.cp 3
Release :  7.3    Date : 2001-08-15
.sp
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Specification:
.sp 2
PROCEDURE  P16_SQL_OP_CHECK:
.sp 2
The statement that is to be checked is described
in sqlxa.xakano and is located in the request segment.
.sp 4
PROCEDURE  P16_INIT_CHECK:
.sp 2
Initializes the variables for the reflex database connection.
Allocates user, location etc....
.sp 4
PROCEDURE  P16_CONNECT:
.sp 2
Performs the connect in the current session.
If the option user was specified, when the first connect is
performed the session is opened with these specifications.
.sp 4
PROCEDURE  P16_STATEMENT_CHECK:
.sp 2
Every SQL statement is checked here.
It is tested to see whether the statement can
be checked. If not, a warning is output and the syntax
check is only performed under certain circumstances.
If yes, the statement is parsed and subsequently the
short infos are checked with the information in the SQLVA area.
.sp
If the option 'explain' is specified, in the case of 'select'
statements the command is additionally issued with 'explain'
and message type m_adbs and the results from the 'show' results table
are written in the listing ft=pclist.
.sp 4
PROCEDURE  P16_GET_SQL_STATEMENT:
.sp 2
Creates the statement from the information in the xakano.
.sp 4
PROCEDURE  P16_ON_USAGE:
.sp 2
Inputs for data dictionary :
    defobjtype  ::  language-dependent
                     'PROGC' , 'PROGCOB', 'PROGPAS',
                     'PROGPL1', 'PROGFOR'
    defobjname1 ::  program name from the option information;
                      if none was specified, it is the
                      file name.
    defobjname2 ::  module name from the option information;
                      if none was specified, it is blank.
    All specified information is converted to upper-case letters so as
    to make it possible to find the entries again in the case of the
    'show usage' commands.
.sp 4
.cp 6
PROCEDURE  P16_OFF_USAGE:
.sp 2
Issues the following for each of the opened sessions:
   'rollback !'
   'usage off !'
   'commit release !'
.sp 4
.cp 6
PROCEDURE  P16_END_SESSION:
.sp 2
Issues the following for the current session:
   'rollback !'
   'usage off !'
   'commit release !'
.sp 4
.cp 4
PROCEDURE  P16_SHORTINFO_CHECK:
.sp 2
Checks the specified information of the data type definition in the
reflex database with the sql variables in the SQLVA area.
.sp
Issues a warning :
   Reflex permits zero values and no
   indicator variable is specified.
.sp
Issues a warning :
   Host variable cannot accept the maximum
   occurrence of the reflex values.
.sp 4
.cp 6
PROCEDURE  P16_EXPLAIN:
.sp 2
Writes the results of the 'explain command' to the listing file
(pclist or .pcl). If the option 'list' was not specified, the
statement is then also output beforehand.
.sp 4
.cp 6
PROCEDURE  P16_WRITE_SQLSTATEMENT:
.sp 2
Writes a command from the partbuf of the request buffer to the
listing file (pclist or .pcl).
.sp 4
.cp 6
PROCEDURE  P16_TABLE_DCLGEN:
.sp 2
If raactsession is not connected, an implicit connect
will be done.
The sqlda-area will be initialised with the statement
"select * from <dclgen tablename>" (p16_g_table_dclgen).
If an implicit connect was done the session will be released
"commit release".
.sp 4
.cp 6
PROCEDURE  P16_G_TABLE_DCLGEN:
.sp 2
To get the informations into the sqlda-area the following
commands will be send to the database:
   "select * from <table name>"  m_adbsparse  only parsing
   " describe "                  m_adbs command
   put the partbuf information into sqlda-area p16_sqlda_get.
.sp 4
.cp 6
PROCEDURE  P16_SQLDA_GET:
.sp 2
Put the information from the partbuf of a descibe command
into the sqlda-area.
.sp 4
PROCEDURE  P16_SUCHENEXTSUBCHAR:
.sp 2
Searches for certain characters in the var_part.
.br; ':', '??' --> parameters, '%' --> macros,
.br; '!', '~', '|' --> records (exclamation mark, tilde,
or vertical bar).
.sp 4
.cp 4
PROCEDURE  P16ADDSPACEVARPART:
.sp 2
Creates space from the position pos number plus bytes.
The varpart must not be modified from the position anf onwards.
.sp 4
.cp 4
PROCEDURE  P16MACROSUBSTITUTION:
.sp 2
Substitutes the macro string into the command string.
The command string is set blank from the position mpos
to the position anf, with if appropriate add_space brought in,
and the macro string set in the request segment.
The position after the macro information in the
request is set to anf, i.e. the request must be
analyzed further from this position anf.
.sp 4
.cp 4
PROCEDURE  P16FINISHCMD:
.sp 2
Ist kapacount der Sqlka_area < Null, so liegt eine
'describe Anweisung' vor.
.sp
Ist kaprindex <> null. so liegt ein 'prepare'
Kommando vor. In p08_declare_search wird untersucht,
ob es ein 'declare' Kommando ist, da?z ?uber eine Hostvariable
das Select-Statement bekommt. Bei ja, muss der Cursorname
noch in den Auftrag gesetzt werden.
.sp
Danach untersucht
die Procedure, ob noch Macros, Struckturvarible und
Fragezeichen umgesetzt oder expandiert werden m?ussen.
Aus den entsprechenden SQL-areas werden die Angaben in
das Auftragssegment SQLRA gesetzt.
.sp 4
.cp 4
PROCEDURE  P16_DECLARE_SEARCH:
.sp 2
If a 'DECLARE' is present with the command, a check
is carried out to see whether the select command was
specified via a host variable.
(prstate = cpr_state_command and prarea = in_vaarea)
In this case the cursor name of the declare command
prname must then also be inserted in the request.
If on return of the procedure pos = 0, this means that there is
an error, i.e. 'FROM' could not be found in the command.
.sp 4
PROCEDURE  P16_GET_MACRO_NUMBER:
.sp 2
Holt Macronummer als Integer aus dem Auftragssegment
von der Position mpos nach mind.
Nextpos gibt die Position nach der Macronummer im
Auftrag an.
.sp 4
.cp 4
PROCEDURE  P16OLDPARTFINISH:
.sp 2
Wurde der letzte packet_part noch Erweitert, so wird mit
dieser Procedure die sp1p_buf_len richtig gesetzt, und die
segment_len entsprechend berechnet.
.sp 4
.cp 4
PROCEDURE  P16_GET_MACRO_NUMBER:
.sp 2
Fetches a macro number as an integer from the request segment
from position mpos to mind.
Nextpos specifies the position after the macro number in
the request.
.sp 4
.cp 4
***********************************************************
.sp 2
 
PROCEDURE  P16_SQL_OP_CHECK:
.sp 2
Das Statement, das gecheckt werden soll, wird beschrieben
in sqlxa.xakano und steht im Auftragssegment.
.sp 4
PROCEDURE  P16_INIT_CHECK:
.sp 2
Initalisier die Variablen f?ur den Reflex_datenbankanschlu?z.
Belegt User, Location usw....
.sp 4
PROCEDURE  P16_CONNECT:
.sp 2
F?uhrt das Connect in der actuellen Session durch.
Falls Option User angegeben wurde, wird beim ersten
Connect die Session mit diesen Angaben er?offnet.
.sp 4
PROCEDURE  P16_STATEMENT_CHECK:
.sp 2
Jedes SQL_statement wird hier gecheckt.
Es wird gepr?uft, ob das Statement gecheckt
werden kann. Bei nein wird eine Warnung ausgegeben und nur
evtl. der Syntaxcheck durchgef?uhrt.
Bei ja wird das Statement geparst und anschlie?zend
die Shortinfos mit den Angaben in der SQLVA-Area ?uberpr?uft.
.sp
Bei Optionangabe 'explain' wird bei 'select'- Befehlen
zus?atzlich das Kommando noch mit 'explain' und Messagetype
m_adbs abgesetzt und die Ergebnisse aus der 'show'-Ergebnistabelle
werden in das Listing ft=pclist geschrieben.
.sp 4
PROCEDURE  P16_GET_SQL_STATEMENT:
.sp 2
Baut aus der Angabe in der  xakano das Statement auf.
.sp 4
PROCEDURE  P16_ON_USAGE:
.sp 2
Eingaben f?ur Datadictionary :
    defobjtype  ::  Sprachabh?angig
                     'PROGC' , 'PROGCOB', 'PROGPAS',
                     'PROGPL1', 'PROGFOR'
    defobjname1 ::  Programname aus der Optionsangabe,
                      wurde keine gemacht ist es der
                      Filename.
    defobjname2 ::  Modulname aus der Optionsangabe,
                      wurde keine gemacht ist er Blank.
    Alle Angaben werden in Gro?zbuchstaben umgewandelt, um
    bei dem Kommandos 'show usage' die Eintr?age wieder zufinden.
.sp 4
.cp 6
PROCEDURE  P16_OFF_USAGE:
.sp 2
Setzt f?ur die er?offneten Sessions jeweils ab:
   'rollback  '
   'usage off  '
   'commit release  '
.sp 4
.cp 6
PROCEDURE  P16_END_SESSION:
.sp 2
Setzt f?ur die actuelle Session ab:
   'rollback  '
   'usage off  '
   'commit release  '
.sp 4
.cp 4
PROCEDURE  P16_SHORTINFO_CHECK:
.sp 2
?uberpr?uft die Angaben der Datentypen Definition in der
Reflexdatenbank mit den Sql_variablen in der SQLVA-Area.
.sp
Meldet Warnung :
   Reflex erlaubt Nullwerte und es ist keine
   Indicatorvariable angegeben.
.sp
Meldet Warnung :
   Hostvariable kann nicht maximale Auspr?agung
   der Reflexwerte aufnehmen.
.sp 4
.cp 6
PROCEDURE  P16_EXPLAIN:
.sp 2
Schreibt die Ergebnisse des 'explain-kommnados' in das Listingfile
(pclist oder .pcl). Wurde die Option 'list' nicht angegeben, so wird
vorher noch das Statement mit ausgegeben.
.sp 4
.cp 6
PROCEDURE  P16_WRITE_SQLSTATEMENT:
.sp 2
Schreibt ein Kommando aus dem partbuf des Auftragspuffer in das
Listingfile (pclist oder .pcl).
PROCEDURE  P16_SUCHENEXTSUBCHAR:
.sp 2
Sucht in dem Var_part nach bestimmten Charakters.
.br; ':', '??' --> Parameter, '%' --> Macros,
.br; '!', '~', '|' --> Records (Ausrufezeichen, Tilde,
oder Senkrechterstrich).
.sp 4
.cp 4
PROCEDURE  P16ADDSPACEVARPART:
.sp 2
Schaft ab der Position pos Anzahl plus Bytes Platz.
Ab der Position anf darf der var-part nicht ge?andert werden.
.sp2
PROCEDURE  P16MACROSUBSTITUTION:
.sp 2
Substituiert den Macrostring in den Kommandostring.
Ab der Position mpos  bis Position anf  wird
der Kommandostring Blank gesetzt, evtl. add_space dazugeholt,
und der Macrostring in das Auftragssegment gesetzt.
Die Position nach der Macroangabe im Auftrag
wird auf anf gesetzt, d.h. ab dieser Position
anf muss der Auftrag weiter analysiert werden.
.sp 4
.cp 4
.sp 4
.cp 4
.sp 4
.CM *-END-* specification -------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Description:
 
.CM *-END-* description ---------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.CM -sss-
.nf
.oc _/1
Structure:
 
.CM *-END-* structure -----------------------------------
.sp 2
**********************************************************
.sp
.cp 10
.nf
.oc _/1
.CM -lll-
Code    :
 
 
(*------------------------------*) 
 
PROCEDURE
      p16sqlopcheck (VAR apc : tpc_globals);
 
BEGIN
&ifdef TRACE
m90int (pc, 'pcerror     ', ord (apc.pcerror) );
m90int (pc, 'sqlcode     ', apc.sqlca.sqlcode  );
m90int (pc, 'pcusage.usco', apc.pcusage.uscom );
&endif
IF  apc.pcerror = cpc_pre_ok
THEN
    WITH apc, pcan, pccmdpart, sqlca, sqlrap^, sqlgap^  DO
        BEGIN
        IF   (ancomtyp <> cpr_com_sql_open) AND
            (ancomtyp <> cpr_com_sql_open_keep)
        THEN
            IF  (ancomtyp in [cpr_com_command, cpr_com_cancel])
                OR  (pcusage.uscom = cpc_usage_prep)
            THEN
                BEGIN
                IF  (pcusage.uscom <> cpc_usage_prep)
                    AND  (pcusage.uscom <> cpc_usage_cancel)
                THEN
                    p11precomerror (apc, cpc_no_sql_statement_check)
                ELSE
                    IF   ancheck <> cpc_ch_no
                    THEN
                        BEGIN
                        IF   NOT anusage [raactsession ]
                        THEN
                            BEGIN
                            p16_init_check (apc);
                            p16_connect (apc);
                            p16_on_usage (apc);
                            anusage [ raactsession ] := true;
                            END;
                        (*ENDIF*) 
                        p16_add_usage  (apc);
                        END;
                    (*ENDIF*) 
                (*ENDIF*) 
                END
            ELSE
                IF   ancheck <> cpc_ch_no
                THEN
                    BEGIN
                    IF   NOT anusage [raactsession ]
                    THEN
                        BEGIN
                        p16_init_check (apc);
                        p16_connect (apc);
                        p16_on_usage (apc);
                        anusage [raactsession ] := true;
                        IF   ancomtyp = cpr_com_sql
                        THEN
                            BEGIN
                            p16_statement_check (apc);
                            p16_add_usage  (apc);
                            END
                        (*ENDIF*) 
                        END
                    ELSE
                        BEGIN
                        p16_statement_check (apc);
                        p16_add_usage  (apc);
                        END;
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
            (*ENDIF*) 
        (*ENDIF*) 
        END;
    (*ENDWITH*) 
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p16_init_check (VAR apc : tpc_globals);
 
VAR
      component : tsp00_C64;
 
BEGIN
WITH apc, sqlca, sqlgap^, sqlrap^ DO
    BEGIN
    p03csqlcaareainit (sqlca);
    WITH gaentry [ raactsession ]^, gaxuserrec  DO
        BEGIN
        IF  rasqlinit = cpr_is_false
        THEN
            BEGIN
            (* 1. aufruf in vpc*0  module *)
            component := bsp_c64;
            component [1] := racomponent [1];
            sqlinit (component, booladdr);
            rasqlinit      := cpr_is_init;
            END;
        (*ENDIF*) 
        IF  rasqlansi = cpr_kind_ansi
        THEN
            xu_isolation  := cpr_lo_isolev3
        ELSE
            xu_isolation  := cpr_lo_isolev10;
        (*ENDIF*) 
        (* sqlaid (raprocessid);   *)
        gareference := 0;
        p07senderid (ralang, ratermid, gacmpkind);
&       ifdef TRACE
        m90buf3 (pc, ratermid[1], 1, 18);
&       endif
        END;
    (*ENDWITH*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p16_connect (VAR apc : tpc_globals);
 
VAR
      retlock    : tsp00_Int2;
      retmodlock : tsp00_Int2;
 
BEGIN
(* in xakano steht statementno *)
WITH apc, pcopts, sqlca, sqlxa, sqlemp^,
     sqlrap^, sqlgap^, gaentry [raactsession]^,
     gaxuserrec DO
    BEGIN
    IF  NOT ((gasqlconntyp = cpr_ci_program)
        AND (raactsession = cpr_se_primary))
    THEN
        BEGIN
        IF   (pcan.ancomtyp = cpr_com_sql_conn)
            AND (sqlkap^ [xakano] .kapaindex = 0)
        THEN
            WITH pccmdpart DO
                BEGIN
                p08analyzeconnectstatm (sqlca, sqlxa, sqlgap^,
                      gaentry[raactsession]^, sqlkap^[xakano], part1len, partbufp^);
                END
            (*ENDWITH*) 
        ELSE
            IF   (pcan.ancomtyp = cpr_com_sql_conn)
            THEN
                BEGIN
                p11precomerror (apc, cpc_connect_no_syntax_check);
                pcerror := cpc_pre_ok;
                p03csqlcaareainit (sqlca);
                END;
            (*ENDIF*) 
        (*ENDIF*) 
        END;
    (********
          IF   oplockset <> cpr_lo_empty
          THEN
          xu_isolation := oplockset;
          ********)
    (*ENDIF*) 
    IF  (xu_user = bsp_knl_identifier)
        AND (gaopxuserrec.xu_user = bsp_knl_identifier)
        AND (xu_userUCS2[1] = ' ')
        AND (gaopxuserrec.xu_userUCS2[1] = ' ')
    THEN
        BEGIN
        p11precomerror (apc, cpc_missing_connect_user);
        pcerror := cpc_pre_reflex_start_required;
        END
    ELSE
        BEGIN
        retlock   := xu_isolation;
        retmodlock:= gamodisolation;
        IF  rasqlansi = cpr_kind_ansi
        THEN
            BEGIN
            xu_isolation := cpr_lo_isolev3;
            gamodisolation :=  cpr_lo_isolev3;
            END
        ELSE
            BEGIN
            xu_isolation := cpr_lo_isolev10;
            gamodisolation :=  cpr_lo_isolev10;
            END;
        (*ENDIF*) 
        p03connect (sqlxa, sqlrap, sqlgap, gaentry [raactsession]^,
              sqldatetime, sqlemp);
        xu_isolation := retlock;
        gamodisolation :=  retmodlock;
&       ifdef TRACE
        m90int (pc, 'ereturncode ',ereturncode );
        m90int (pc, 'ewarning    ',ord (ewarning[1])  );
        m90int (pc, 'eprerr      ',ord (eprerr) );
&       endif
        IF   ereturncode  <> 0
        THEN
            p11errorcheck  (apc);
        (*ENDIF*) 
        IF  ( elzu  <> sp1ce_ok)
        THEN
            pcerror := cpc_pre_reflex_start_required;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p16_statement_check (VAR apc : tpc_globals);
 
CONST
      lock_request_timeout = 500;
      session_timeout      = 700;
 
VAR
      loop        : integer;
      part_ptr : tsp1_part_ptr;
      returnc  : tsp00_Int2;
      ga : ^sqlgaentry;
 
BEGIN
(* in xakano steht statementno *)
WITH apc, pcan, pccmdpart, sqlca, sqlrap^,
     sqlgap^, sqlxa DO
    BEGIN
    ga := @gaentry[raactsession]^;
    IF   (pcerror <> cpc_pre_reflex_start_required)
        AND (ga^.gareqptr <> NIL)
    THEN
        BEGIN
        p03ccmdinit(sqlxa.xaSQLDesc^, sqlca, ga^, sp1m_parse);
        s26new_part_init (ga^.gareqptr, rasegptr^, part_ptr);
        part_ptr^.sp1p_part_header.sp1p_part_kind :=  sp1pk_command;
        part_ptr^.sp1p_part_header.sp1p_buf_len   :=  0;
        rasegmpartptr [ord(sp1pk_command)+1] := part_ptr;
        WITH part_ptr^, sp1p_part_header  DO
            BEGIN
            IF  pccmdpart.part1len > sp1p_buf_size
            THEN
                p11precomerror (apc, cpc_buffer_overflow)
            ELSE
                BEGIN
                s10mv (partsizlen, sp1p_buf_size,
                      @pccmdpart.partbufp^, 1,
                      @sp1p_buf, 1, pccmdpart.part1len);
                sp1p_buf_len :=  pccmdpart.part1len;
                END;
            (*ENDIF*) 
&           ifdef TRACE
            IF   sp1p_buf_len > 0
            THEN
                m90buf (pc, sp1p_buf, 1, sp1p_buf_len);
&           endif
            (*ENDIF*) 
            s26finish_part (ga^.gareqptr, part_ptr^);
            END;
        (*ENDWITH*) 
        IF   ancomtyp = cpr_com_sql_conn
        THEN
            BEGIN
            IF   NOT anusage [ raactsession ]
            THEN
                IF   (ga^.gaxuserrec.xu_serverdb = bsp_dbname)
                    AND  (ga^.gavaindex <> 0)
                    AND  (gaopxuserrec.xu_serverdb = bsp_dbname)
                    AND  (gaopxuserrec.xu_servernode = bsp_nodeid)
                THEN
                    p11precomerror (apc, cpc_missing_dbsname)
                ELSE
                    BEGIN
                    p16_connect (apc);
                    p16_on_usage (apc);
                    anusage [raactsession ] := true;
                    END
                (*ENDIF*) 
            ELSE
                p11precomerror (apc, cpc_connect_no_syntax_check);
            (*ENDIF*) 
            END
        ELSE
            BEGIN
            (* statement parsen *)
            IF   sqlkap^ [xakano] .kaprindex <> 0
            THEN
                p16_get_sql_statement (apc);
            (*ENDIF*) 
            IF   ancheck = cpc_ch_syntax
            THEN
                rasegptr^.sp1c_mess_type := sp1m_syntax
            ELSE
                rasegptr^.sp1c_mess_type := sp1m_parse;
            (*ENDIF*) 
            IF   sqlkap^ [xakano] .kapacount = -2
            THEN
                (* fetch ... using descriptor  command *)
                p11precomerror (apc, cpc_no_sql_statement_check)
            ELSE
                IF   pcerror = cpc_pre_ok
                THEN
                    BEGIN
                    p16finishcmd (sqlca, sqlxa, gaentry[raactsession]^,  sqlkap^[xakano]);
                    IF   sqlcode  < 0
                    THEN
                        IF   sqlcode  = -818
                        THEN
                            p11precomerror (apc, cpc_no_macro_init)
                        ELSE
                            p11precomerror (apc, cpc_no_sql_statement_check)
                        (*ENDIF*) 
                    ELSE
                        BEGIN
                        loop := 0;
                        returnc := 0;
                        p03modulnameput (sqlca, sqlxa, ga^, sqlkap^[xakano]);
                        p03creqrecpacket (sqlrap, ga^, sqlemp);
                        loop := loop + 1;
                        IF  ga^.garecptr = NIL
                        THEN
                            returnc := session_timeout
                        ELSE
                            returnc := ga^.garecptr^.sp1_segm.sp1r_returncode;
                        (*ENDIF*) 
&                       ifdef TRACE
                        IF  ga^.garecptr <> NIL
                        THEN
                            WITH ga^.garecptr^, sp1_segm DO
                                BEGIN
                                m90int2 (pc, 'sp1r_retcode', sp1r_returncode );
                                m90int4 (pc, 'sp1r_erropos', sp1r_errorpos );
                                END;
                            (*ENDWITH*) 
&                       endif
                        (*ENDIF*) 
                        IF   returnc <> 0
                        THEN
                            p11errorcheck  (apc)
                        ELSE
                            BEGIN
                            IF   (ancheck = cpc_ch_all)
                            THEN
                                p16_shortinfo_check (apc);
                            (*ENDIF*) 
                            END;
                        (*ENDIF*) 
                        END;
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p16_get_sql_statement (VAR apc : tpc_globals);
 
VAR
      i   : integer;
      ergn: tsp00_KnlIdentifier;
      descr: boolean;
      intopos : integer;
      part_ptr : tsp1_part_ptr;
      ga : ^sqlgaentry;
 
BEGIN
WITH apc, sqlca, sqlxa, sqlkap^ [xakano] , sqlprp^ [kaprindex ] DO
    BEGIN
    IF   kapacount = -1
    THEN
        (* descriptor wird verlangt *)
        IF   prDescribe = cpr_is_false
        THEN
            BEGIN
            pcda  := mxpr_sqln;
            prDescribe := cpr_is_true;
            END;
        (*ENDIF*) 
    (*ENDIF*) 
    IF   (prarea = cpr_in_sqlva) OR (kapacount < 0) OR (prStmtNameIndex <> 0)
    THEN
        p11precomerror (apc, cpc_no_sql_statement_check)
    ELSE
        WITH sqlrap^, sqlgap^ DO
            BEGIN
            ga := @gaentry[sqlrap^.raactsession]^;
            p03ccmdinit (sqlxa.xaSQLDesc^, sqlca, ga^, sp1m_parse);
            s26new_part_init (ga^.gareqptr, rasegptr^, part_ptr);
            part_ptr^.sp1p_part_header.sp1p_part_kind :=  sp1pk_command;
            part_ptr^.sp1p_part_header.sp1p_buf_len   :=  0;
            rasegmpartptr [ord(sp1pk_command)+1] := part_ptr;
            WITH part_ptr^, sp1p_part_header  DO
                BEGIN
                FOR i := kaStindex TO kaStindex + kaStcount - 1 DO
                    WITH sqlstp^ [i]  DO
                        p03psqllinecmd (sqlca, stline, 1, stllen,
                              mxpr_sqlline, part_ptr);
                    (*ENDWITH*) 
                (*ENDFOR*) 
&               ifdef TRACE
                IF   sp1p_buf_len > 0
                THEN
                    m90buf (pc, sp1p_buf, 1, sp1p_buf_len);
&               endif
                (*ENDIF*) 
                sp1p_buf[part_ptr^.sp1p_part_header.sp1p_buf_len+1] := cpr_nullchar;
                part_ptr^.sp1p_part_header.sp1p_buf_len := part_ptr^.sp1p_part_header.sp1p_buf_len + 1;
                s26finish_part (ga^.gareqptr, part_ptr^);
                pc16cSearchFetch (sqlca, sqlxa, ga^, ergn, descr, intopos);
                IF   descr
                THEN
                    p11precomerror (apc, cpc_no_sql_statement_check);
                (***               s26finish_part (gareqptr, part_ptr^);   ***)
                (*ENDIF*) 
                IF  sqlemp^.eprerr = cpr_request_area_overflow
                THEN
                    p11precomerror (apc, cpc_buffer_overflow);
                (*ENDIF*) 
                END;
            (*ENDWITH*) 
            END;
        (*ENDWITH*) 
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p16_add_usage (VAR apc : tpc_globals);
 
CONST
      n_usage_add = 'USAGE ADD   ';
      n_prepare   = ' PREPARE    ';
      n_command   = ' COMMAND    ';
      n_cancel    = ' CANCEL     ';
 
VAR
      snam: tsp00_Sname;
      nam : tsp00_KnlIdentifier;
      pos : integer;
      part_ptr : tsp1_part_ptr;
      ga : ^sqlgaentry;
 
BEGIN
WITH apc, pcusage, sqlca, sqlrap^, sqlgap^ DO
    BEGIN
    ga := @gaentry[sqlrap^.raactsession]^;
    IF  (uscom <> cpc_usage_empty) AND (ga^.gareqptr <> NIL)
    THEN
        BEGIN
        p03ccmdinit (sqlxa.xaSQLDesc^, sqlca, ga^, sp1m_dbs);
        rasegptr^.sp1s_segm_header.sp1c_sqlmode := sp1sm_internal;
        s26new_part_init (ga^.gareqptr, rasegptr^, part_ptr);
        part_ptr^.sp1p_part_header.sp1p_part_kind :=  sp1pk_command;
        part_ptr^.sp1p_part_header.sp1p_buf_len   :=  0;
        rasegmpartptr [ord(sp1pk_command)+1] := part_ptr;
        WITH part_ptr^, sp1p_part_header  DO
            BEGIN
            snam := n_usage_add;
            s10mv (SNAME_MXSP00, sp1p_buf_size, @snam, 1,
                  @sp1p_buf, 1, SNAME_MXSP00);
            sp1p_buf_len := SNAME_MXSP00;
&           ifdef TRACE
            IF   sp1p_buf_len > 0
            THEN
                m90buf (pc, sp1p_buf, 1, sp1p_buf_len);
&           endif
            (*ENDIF*) 
            s26finish_part (ga^.gareqptr, part_ptr^);
            END;
        (*ENDWITH*) 
        s26new_part_init (ga^.gareqptr, rasegptr^, part_ptr);
        part_ptr^.sp1p_part_header.sp1p_part_kind :=  sp1pk_data;
        part_ptr^.sp1p_part_header.sp1p_buf_len   :=  0;
        rasegmpartptr [ord(sp1pk_data)+1] := part_ptr;
        WITH part_ptr^, sp1p_part_header  DO
            BEGIN
            CASE uscom  OF
                cpc_usage_comm :
                    snam := n_command;
                cpc_usage_prep :
                    snam := n_prepare;
                cpc_usage_cancel:
                    snam := n_cancel;
                OTHERWISE:
                    snam := bsp_sname;
                END;
            (*ENDCASE*) 
            pos :=  1;
            s10mv (SNAME_MXSP00, sp1p_buf_size, @snam, 1,
                  @sp1p_buf, pos, mxsp_c8+1);
            pos := pos + mxsp_c8 + 1;
            nam := usdobjn1;
            sp1p_buf [pos ] := bsp_c1;
            s10mv (sizeof(nam), sp1p_buf_size, @nam, 1,
                  @sp1p_buf, pos+1, mxsp_name);
            pos := pos + mxsp_name + 1;
            nam := usdobjn2;
            sp1p_buf [pos ] := bsp_c1;
            s10mv (sizeof(nam), sp1p_buf_size, @nam, 1,
                  @sp1p_buf, pos+1, mxsp_name);
            pos := pos + mxsp_name + 1;
            sp1p_buf_len := pos - 1;
            p05up1casebuf (sp1p_buf, 1, pos -1);
&           ifdef TRACE
            IF   sp1p_buf_len > 0
            THEN
                m90buf (pc, sp1p_buf, 1, sp1p_buf_len);
&           endif
            (*ENDIF*) 
            s26finish_part (ga^.gareqptr, part_ptr^);
            END;
        (*ENDWITH*) 
        p03creqrecpacket (sqlrap, ga^, sqlemp);
        IF  ga^.garecptr <> NIL        (* PTS 1106043 *)
        THEN
            WITH ga^.garecptr^, sp1_segm DO
                BEGIN
&               ifdef TRACE
                m90int2 (pc, 'sp1r_retcode', sp1r_returncode );
                m90int4 (pc, 'sp1r_erropos', sp1r_errorpos );
&               endif
                IF   sp1r_returncode < 0
                THEN
                    BEGIN
                    p11errorcheck  (apc);
                    p11precomerror (apc, cpc_usage_add_error);
                    END;
                (*ENDIF*) 
                END;
            (*ENDWITH*) 
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p16_on_usage (VAR apc : tpc_globals);
 
CONST
      n_usage_on  = 'USAGE ON    ';
      n_progc     = ' PROGC      ';
      n_progcob   = ' PROGCOB    ';
      n_progpas   = ' PROGPAS    ';
      maxdeftype  = 8;
 
VAR
      snam: tsp00_Sname;
      nam : tsp00_KnlIdentifier;
      pos : integer;
      part_ptr : tsp1_part_ptr;
      pck : tsp1_packet_ptr;
 
BEGIN
WITH apc, sqlca, sqlrap^, sqlgap^, gaentry [raactsession]^ DO
    IF   (pcan.ancheck = cpc_ch_all) AND
        (pcerror <> cpc_pre_reflex_start_required)
        AND (gareqptr <> NIL)
    THEN
        BEGIN
        pck := p03cpacketinit (sqlxa.xaSQLDesc^, sqlrap, gaentry [raactsession]^, sp1m_dbs);
        s26new_part_init (gareqptr, rasegptr^, part_ptr);
        part_ptr^.sp1p_part_header.sp1p_part_kind :=  sp1pk_command;
        part_ptr^.sp1p_part_header.sp1p_buf_len   :=  0;
        rasegmpartptr [ord(sp1pk_command)+1] := part_ptr;
        WITH part_ptr^, sp1p_part_header  DO
            BEGIN
            snam := n_usage_on;
            s10mv (SNAME_MXSP00, sp1p_buf_size, @snam, 1,
                  @sp1p_buf, 1, SNAME_MXSP00);
            sp1p_buf_len := SNAME_MXSP00;
            s26finish_part (gareqptr, part_ptr^);
            END;
        (*ENDWITH*) 
        s26new_part_init (gareqptr, rasegptr^, part_ptr);
        part_ptr^.sp1p_part_header.sp1p_part_kind :=  sp1pk_data;
        part_ptr^.sp1p_part_header.sp1p_buf_len   :=  0;
        rasegmpartptr [ord(sp1pk_data)+1] := part_ptr;
        WITH part_ptr^, sp1p_part_header  DO
            BEGIN
            CASE ralang OF
                cpr_la_cobol, cpr_la_cobmic,cpr_la_cob8860 :
                    snam := n_progcob;
                cpr_la_c     :
                    snam := n_progc;
                cpr_la_pascallpi ,
                cpr_la_pascal, cpr_la_pascal31, cpr_la_pascalvax :
                    snam := n_progpas;
                END;
            (*ENDCASE*) 
            pos :=  1;
            s10mv (SNAME_MXSP00, sp1p_buf_size, @snam, 1,
                  @sp1p_buf, pos, maxdeftype+1);
            pos := pos + maxdeftype + 1;
            IF   pcopts.opt_progname = bsp_knl_identifier
            THEN
                nam := pcfilen
            ELSE
                nam := pcopts.opt_progname;
            (*ENDIF*) 
            sp1p_buf [pos ] := bsp_c1;
            s10mv (sizeof(nam), sp1p_buf_size, @nam, 1,
                  @sp1p_buf, pos+1, mxsp_name);
            pos := pos + sizeof(nam) + 1;
            IF   pcopts.opt_modulename <> bsp_knl_identifier
            THEN
                BEGIN
                nam := pcopts.opt_modulename;
                sp1p_buf [pos ] := bsp_c1;
                s10mv (sizeof(nam), sp1p_buf_size, @nam, 1,
                      @sp1p_buf, pos+1, mxsp_name);
                pos := pos + sizeof(nam) + 1;
                END;
            (*ENDIF*) 
            sp1p_buf_len := pos - 1;
            p05up1casebuf (sp1p_buf, 1, pos -1);
            s26finish_part (gareqptr, part_ptr^);
            END;
        (*ENDWITH*) 
        p03creqrecpacket (sqlrap, gaentry[raactsession]^, sqlemp);
        WITH garecptr^, sp1_segm DO
            BEGIN
&           ifdef TRACE
            m90int2 (pc, 'sp1r_retcode', sp1r_returncode );
            m90int4 (pc, 'sp1r_erropos', sp1r_errorpos );
&           endif
            IF   sp1r_returncode < 0
            THEN
                BEGIN
                p11errorcheck  (apc);
                p11precomerror (apc, cpc_usage_add_error);
                END;
            (*ENDIF*) 
            END;
        (*ENDWITH*) 
        END;
    (*ENDIF*) 
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p16offusage (VAR apc : tpc_globals);
 
VAR
      i : integer;
 
BEGIN
WITH apc, sqlca, sqlrap^, pcan DO
    FOR i := 1 TO mxpr_sqlga DO
        BEGIN
        IF   anusage [i]
        THEN
            BEGIN
            raactsession := i;
            p16_end_session (apc);
            END;
        (*ENDIF*) 
        END;
    (*ENDFOR*) 
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p16_end_session (VAR apc : tpc_globals);
 
CONST
      n_usage_off = 'USAGE OFF   ';
      n_rollback  = 'ROLLBACK  WORK    ';
      n_commit    = 'COMMIT WORK       ';
      n_release   = ' RELEASE          ';
 
VAR
      snam: tsp00_Sname;
      nam : tsp00_Name;
      part_ptr : tsp1_part_ptr;
 
BEGIN
WITH apc, sqlca, sqlrap^, sqlgap^, gaentry [raactsession]^ DO
    IF  (gareqptr <> NIL)
    THEN
        BEGIN
        p03ccmdinit (sqlxa.xaSQLDesc^, sqlca, gaentry[raactsession]^, sp1m_dbs);
        s26new_part_init (gareqptr, rasegptr^, part_ptr);
        part_ptr^.sp1p_part_header.sp1p_part_kind :=  sp1pk_command;
        part_ptr^.sp1p_part_header.sp1p_buf_len   :=  0;
        rasegmpartptr [ord(sp1pk_command)+1] := part_ptr;
        WITH part_ptr^, sp1p_part_header  DO
            BEGIN
            nam := n_rollback;
            s10mv (mxsp_name, sp1p_buf_size, @nam, 1,
                  @sp1p_buf, 1, mxsp_name);
            sp1p_buf_len := mxsp_name;
            s26finish_part (gareqptr, part_ptr^);
            END;
        (*ENDWITH*) 
        p03creqrecpacket (sqlrap, gaentry[raactsession]^, sqlemp);
        IF  (garecptr <> NIL)
        THEN
            BEGIN
            WITH garecptr^, sp1_segm DO
                BEGIN
&               ifdef TRACE
                m90int2 (pc, 'sp1r_retcode', sp1r_returncode );
                m90int4 (pc, 'sp1r_erropos', sp1r_errorpos );
&               endif
                IF   sp1r_returncode < 0
                THEN
                    BEGIN
                    p11errorcheck  (apc);
                    p11precomerror (apc, cpc_usage_add_error);
                    END;
                (*ENDIF*) 
                END;
            (*ENDWITH*) 
&           ifdef TRACE
            m90int (pc, 'ancheck     ', pcan.ancheck );
&           endif
            IF   pcopts.opt_mode = cpc_ch_all
            THEN
                BEGIN
                p03ccmdinit (sqlxa.xaSQLDesc^, sqlca, gaentry[raactsession]^, sp1m_dbs);
                s26new_part_init (gareqptr, rasegptr^, part_ptr);
                part_ptr^.sp1p_part_header.sp1p_part_kind :=   sp1pk_command;
                part_ptr^.sp1p_part_header.sp1p_buf_len   :=  0;
                rasegmpartptr [ord(sp1pk_command)+1] := part_ptr;
                WITH part_ptr^, sp1p_part_header  DO
                    BEGIN
                    snam := n_usage_off;
                    s10mv (SNAME_MXSP00, sp1p_buf_size, @snam, 1,
                          @sp1p_buf, 1, SNAME_MXSP00);
                    sp1p_buf_len := SNAME_MXSP00;
                    s26finish_part (gareqptr, part_ptr^);
                    END;
                (*ENDWITH*) 
                p03creqrecpacket (sqlrap, gaentry[raactsession]^, sqlemp);
                IF  (garecptr <> NIL)
                THEN
                    WITH garecptr^, sp1_segm DO
                        BEGIN
&                       ifdef TRACE
                        m90int2 (pc, 'sp1r_retcode', sp1r_returncode );
                        m90int4 (pc, 'sp1r_erropos', sp1r_errorpos );
&                       endif
                        IF   sp1r_returncode < 0
                        THEN
                            BEGIN
                            (*  p11errorcheck  (apc);  *)
                            p11precomerror (apc, cpc_usage_add_error);
                            p03csqlcaareainit (sqlca);    (* 3.0 vert *)
                            pcerror := cpc_pre_ok;      (* 3.0 vert *)
                            END;
                        (*ENDIF*) 
                        END;
                    (*ENDWITH*) 
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            p03ccmdinit (sqlxa.xaSQLDesc^, sqlca, gaentry[raactsession]^, sp1m_dbs);
            s26new_part_init (gareqptr, rasegptr^, part_ptr);
            part_ptr^.sp1p_part_header.sp1p_part_kind :=  sp1pk_command;
            part_ptr^.sp1p_part_header.sp1p_buf_len   :=  0;
            rasegmpartptr [ord(sp1pk_command)+1] := part_ptr;
            WITH part_ptr^, sp1p_part_header  DO
                BEGIN
                nam := n_commit;
                s10mv (mxsp_name, sp1p_buf_size, @nam, 1,
                      @sp1p_buf, 1, mxsp_name);
                sp1p_buf_len := mxsp_name;
                nam := n_release;
                s10mv (mxsp_name, sp1p_buf_size, @nam, 1,
                      @sp1p_buf, sp1p_buf_len+1, mxsp_name);
                sp1p_buf_len := sp1p_buf_len + mxsp_name;
                s26finish_part (gareqptr, part_ptr^);
                END;
            (*ENDWITH*) 
            p03creqrecpacket (sqlrap, gaentry[raactsession]^, sqlemp);
            IF  (garecptr <> NIL)
            THEN
                WITH garecptr^, sp1_segm DO
                    BEGIN
&                   ifdef TRACE
                    m90int2 (pc, 'sp1r_retcode', sp1r_returncode );
                    m90int4 (pc, 'sp1r_erropos', sp1r_errorpos );
&                   endif
                    IF   sp1r_returncode < 0
                    THEN
                        BEGIN
                        p11errorcheck  (apc);
                        p11precomerror (apc, cpc_usage_add_error);
                        END;
                    (*ENDIF*) 
                    END;
                (*ENDWITH*) 
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        p03sqlrelease (sqlrap, sqlgap, gaentry[raactsession]^, sqlemp);
        END;
    (*ENDIF*) 
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p16_shortinfo_check (VAR apc : tpc_globals);
 
VAR
      i     : integer;
      j     : integer;
      n     : integer;
      cnt   : integer;
      index : integer;
      pno   : integer;  (* parameterno *)
      pos   : integer;
      sflen : integer;
      sizelen : integer;
      var80   : tsp00_C80;
      cmdfetch : tsp00_Int2;
      vaname   : tsp00_Lname;
      vanaml   : tsp00_Int2;
      pointl   : integer;
      chartonumb : boolean;
      pasfinfo: tsp1_param_info;
      part_ptr : tsp1_part_ptr;
      infosize : integer;
      warnset  : tpr_error_warnset;
 
BEGIN
p03find_part (apc.sqlca.sqlrap, sp1pk_shortinfo, part_ptr);
IF  part_ptr <> NIL
THEN
    WITH apc, sqlca, pcsqlva, sqlrap^, sqlxa, sqlkap^ [xakano ],
         part_ptr^, sp1p_part_header  DO
        BEGIN
        IF   (sqlcode >= 0) AND (sp1p_buf_len > 0)
        THEN
            IF   (kapacount = -1)
            THEN
                BEGIN
                (* describe angaben werden in sqlda verlangt *)
                pcda := mxpr_sqln;
                END
            ELSE
                IF  (sp1p_buf_len = 2)
                    AND (kapacount = 1)
                THEN
                    p11precomerror (apc, cpc_p_loop_init_wrong)
                ELSE
                    BEGIN
&                   ifdef TRACE
                    IF   sp1p_buf_len > 0
                    THEN
                        m90buf (pc, sp1p_buf, 1, sp1p_buf_len);
&                   endif
                    (* rette variab_part bei fehlermeldungen *)
                    (*ENDIF*) 
                    s10mv (sp1p_buf_size, mxsp_c80, @sp1p_buf, 1,
                          @var80, 1, mxsp_c80);
                    pos := 1;
                    pno := 0;
                    IF  ((sqldbmode = cpr_kind_oracle)
                        OR  (sqldbmode = cpr_kind_sapr3)
                        OR  (sqldbmode = cpr_kind_internal))
                        AND (rasqlansi = cpr_kind_empty)
                    THEN
                        chartonumb := true
                    ELSE
                        chartonumb := false;
                    (*ENDIF*) 
&                   ifdef TRACE
                    m90int2 (pc, 'kapacount   ', kapacount);
                    m90int2 (pc, 'kapaindex   ', kapaindex);
&                   endif
                    cnt := 0;
                    FOR i := kapaindex TO kapaindex + kapacount - 1 DO
                        WITH  sqlpap^ [i]  DO
                            BEGIN
                            IF  pakindlo = sqlparst
                            THEN
                                cnt := paelcnt;
                            (*ENDIF*) 
                            IF  pakindlo = sqlparel
                            THEN
                                WITH sqlv1p^ [pavarno] DO
                                    BEGIN
                                    IF  cnt = 0
                                    THEN
                                        n  := 1
                                    ELSE
                                        n := cnt;
                                    (*ENDIF*) 
                                    cnt := 0;
                                    index := pavarno;
                                    IF  va1indi_st = sqlvast
                                    THEN
                                        BEGIN
                                        n     := va1cmpcnt_st;
                                        index := va1ix_st;
                                        END;
                                    (*ENDIF*) 
                                    IF  va1indi_st = sqlvapt
                                    THEN
                                        BEGIN
                                        index := va1ix_pt;
                                        WITH sqlv1p^ [va1ix_pt] DO
                                            BEGIN
                                            IF  va1indi_st = sqlvast
                                            THEN
                                                BEGIN
                                                index := va1ix_st;
                                                n     := va1cmpcnt_st;
                                                END;(*ENDIF*)
                                            (*ENDIF*) 
                                            END;
                                        (*ENDWITH*) 
                                        END;
                                    (*ENDIF*) 
                                    infosize :=  sizeof (tsp1_param_info);
                                    FOR j := 1 TO n DO
                                        WITH sqlv1p^ [index+j-1], sqlv2p^ [va1indva2_sc] DO
                                            BEGIN
                                            s10mv (sp1p_buf_size, mxsp_c80, @var80, 1,
                                                  @sp1p_buf, 1, mxsp_c80);
                                            IF   (pos < sp1p_buf_len)
                                            THEN
                                                BEGIN
                                                pno := pno + 1;
                                                vaname := sqlv3p^ [va1indva3_sc].va3name;
                                                vanaml := sqlv3p^ [va1indva3_sc].va3naml;
                                                s10mv (sp1p_buf_size, infosize, @sp1p_buf, pos,
                                                      @pasfinfo, 1, infosize);
                                                pos := pos + infosize;
                                                (*******
                                                      IF   pasfinfo.sp1i_mode =  sp1ot_default
                                                      THEN
                                                      pasfinfo.sp1i_mode := sp1ot_mandatory;
                                                      **********)
                                                IF   pasfinfo.sp1i_bufpos = 0
                                                THEN
                                                    p11precomerror (apc, cpc_too_long_paramlist)
                                                ELSE
                                                    BEGIN
                                                    IF   (NOT (sp1ot_mandatory in pasfinfo.sp1i_mode))
                                                     AND (paindno = 0) AND
                                                     ((pasfinfo.sp1i_io_type = sp1io_output)
                                                     OR (pasfinfo.sp1i_io_type = sp1io_inout))
                                                    THEN
                                                     BEGIN
                                                     p11precomerror (apc, cpc_missing_indicatorvariable);
                                                     p11nerrorlisting ( apc, vaname, vanaml, pno);
                                                     END;
&                                                   ifdef TRACE
                                                    (*ENDIF*) 
                                                    m90int2 (pc, 'va2const    ', va2const);
                                                    m90int2 (pc, 'sp1i_io_type', ord (pasfinfo.sp1i_io_type));
&                                                   endif
                                                    IF  ((pasfinfo.sp1i_io_type = sp1io_output)
                                                     OR (pasfinfo.sp1i_io_type = sp1io_inout))
                                                     AND (va2const > 0)
                                                    THEN
                                                     BEGIN
                                                     p11precomerror (apc, cpc_no_output_variable);
                                                     p11nerrorlisting ( apc, vaname, vanaml, pno);
                                                     END;
                                                    (*ENDIF*) 
                                                    sflen :=  ord(pasfinfo.sp1i_length);
                                                    IF  (pasfinfo.sp1i_data_type = ddbyteebcdic)
                                                    THEN
                                                     sflen := sflen + sflen;
                                                    (*ENDIF*) 
                                                    CASE sqlv2p^ [va1indva2_sc] .va2typ OF
                                                     cpr_vint2, cpr_vint4, cpr_vuns2, cpr_vuns4,
                                                     cpr_vint8, cpr_vdecimal,
                                                     cpr_vlzone, cpr_vzoned, cpr_vreal4,
                                                     cpr_vreal8, cpr_vreal8sun :
                                                      BEGIN
                                                      IF   (pasfinfo.sp1i_io_type = sp1io_output)
                                                       OR (pasfinfo.sp1i_io_type = sp1io_inout)
                                                      THEN
                                                       BEGIN
                                                       (* var : output *)
                                                       IF     (va2digit < sflen)
                                                       THEN
                                                        BEGIN
                                                        p11precomerror (apc, cpc_variable_will_be_truncated);
                                                        p11nerrorlisting ( apc, vaname, vanaml,
                                                           pno);
                                                        END
                                                       (*ENDIF*) 
                                                       END
                                                      ELSE
                                                       (* var : input  *)
                                                       IF     (va2digit > sflen)
                                                       THEN
                                                        BEGIN
                                                        p11precomerror (apc, cpc_variable_may_overflow);
                                                        p11nerrorlisting ( apc, vaname, vanaml, pno);
                                                        END;
                                                       (*ENDIF*) 
                                                      (*ENDIF*) 
                                                      IF   (pasfinfo.sp1i_data_type <> dfixed)
                                                       AND (pasfinfo.sp1i_data_type <> dfloat)
                                                       AND (pasfinfo.sp1i_data_type <> dsmallint)
                                                       AND (pasfinfo.sp1i_data_type <> dinteger)
                                                       AND (pasfinfo.sp1i_data_type <> dvfloat)
                                                      THEN
                                                       IF  NOT chartonumb
                                                       THEN
                                                        BEGIN
                                                        p11precomerror (apc, cpc_datatyp_not_compatible);
                                                        p11nerrorlisting  ( apc, vaname, vanaml, pno);
                                                        END;
                                                       (*ENDIF*) 
                                                      (*ENDIF*) 
                                                      END;
                                                     cpr_vlszon, cpr_vtszon :
                                                      BEGIN
                                                      IF   (pasfinfo.sp1i_io_type = sp1io_output)
                                                       OR (pasfinfo.sp1i_io_type = sp1io_inout)
                                                      THEN
                                                       BEGIN
                                                       (* var : output *)
                                                       IF     (va2digit - 1 < sflen)
                                                       THEN
                                                        BEGIN
                                                        p11precomerror (apc, cpc_variable_will_be_truncated);
                                                        p11nerrorlisting ( apc, vaname, vanaml,
                                                           pno);
                                                        END
                                                       (*ENDIF*) 
                                                       END
                                                      ELSE
                                                       (* var : input  *)
                                                       IF     (va2digit - 1 > sflen)
                                                       THEN
                                                        BEGIN
                                                        p11precomerror (apc, cpc_variable_will_be_truncated);
                                                        p11nerrorlisting ( apc, vaname, vanaml, pno);
                                                        END;
                                                       (*ENDIF*) 
                                                      (*ENDIF*) 
                                                      IF   (pasfinfo.sp1i_data_type <> dfixed)
                                                       AND (pasfinfo.sp1i_data_type <> dfloat)
                                                       AND (pasfinfo.sp1i_data_type <> dsmallint)
                                                       AND (pasfinfo.sp1i_data_type <> dinteger)
                                                       AND (pasfinfo.sp1i_data_type <> dvfloat)
                                                      THEN
                                                       IF  NOT chartonumb
                                                       THEN
                                                        BEGIN
                                                        p11precomerror (apc, cpc_datatyp_not_compatible);
                                                        p11nerrorlisting  ( apc, vaname, vanaml, pno);
                                                        END;
                                                       (*ENDIF*) 
                                                      (*ENDIF*) 
                                                      END;
                                                     cpr_vlong_desc :
                                                      BEGIN
                                                      IF  (NOT ( pasfinfo.sp1i_data_type in [dstra, dstre,
                                                       dstrb, dstrdb, dlonga, dlonge, dlongb, dlongdb,
                                                       dlonguni, dstruni ]))
                                                      THEN
                                                       BEGIN
                                                       p11precomerror (apc, cpc_datatyp_not_compatible);
                                                       p11nerrorlisting  ( apc, vaname, vanaml, pno);
                                                       END;
                                                      (*ENDIF*) 
                                                      END;
                                                     cpr_vchar , cpr_vcharc, cpr_vbchar, cpr_vdbchar,
                                                     cpr_vbuf, cpr_vstring, cpr_vstring1,
                                                     cpr_vunicode, cpr_vunicodec,
                                                     cpr_vraw, cpr_vrawc, cpr_vfile, cpr_vfilec,
                                                     cpr_vabaphandle, cpr_vucs2, cpr_vutf16 :
                                                      BEGIN
                                                      sizelen := va2size;
                                                      IF  va2typ = cpr_vstring
                                                      THEN
                                                       sizelen := sizelen - 2;
                                                      (*ENDIF*) 
                                                      IF  va2typ = cpr_vabaphandle
                                                      THEN
                                                       IF  (sizelen > sflen)
                                                       THEN
                                                        sizelen := sflen;
                                                       (*ENDIF*) 
                                                      (*ENDIF*) 
                                                      IF  va2typ = cpr_vstring1
                                                      THEN
                                                       sizelen := sizelen - 1;
                                                      (*ENDIF*) 
                                                      IF   (pasfinfo.sp1i_io_type = sp1io_output)
                                                       OR (pasfinfo.sp1i_io_type = sp1io_inout)
                                                      THEN
                                                       BEGIN
                                                       (* var : output *)
                                                       IF  (va2size = cpr_pointerlen) AND (ralang = cpr_la_c)
                                                       THEN
                                                        IF  sflen = cpr_pointerlen
                                                        THEN
                                                         BEGIN
                                                         p11precomerror (apc, cpc_no_pointer_allowed);
                                                         p11perrorlisting ( apc, vaname, vanaml,
                                                            pno, pointl);
                                                         END
                                                        ELSE
                                                         BEGIN
                                                         pointl := sflen;
                                                         IF  (pasfinfo.sp1i_data_type in [dstra, dstre,
                                                          dstrb, dstrdb, dlonga, dlonge, dlongb, dlongdb])
                                                         THEN
                                                          pointl := -1;
                                                         (*ENDIF*) 
                                                         p11precomerror (apc, cpc_pointer_variable);
                                                         p11perrorlisting ( apc, vaname, vanaml,
                                                            pno, pointl);
                                                         END
                                                        (*ENDIF*) 
                                                       ELSE
                                                        IF  (ralang =  cpr_la_c)
                                                         AND (sqldbmode <> cpr_kind_oracle)
                                                         AND (sqldbmode <> cpr_kind_sapr3)
                                                         AND (rasqlansi = cpr_kind_empty)
                                                         AND (sqlv2p^ [va1indva2_sc] .va2typ <> cpr_vstring)
                                                        THEN
                                                         BEGIN
                                                         IF  ((va2size-1) < sflen)
                                                          AND (va2size > 1)
                                                         THEN
                                                          BEGIN
                                                          p11precomerror (apc, cpc_variable_will_be_truncated);
                                                          p11nerrorlisting ( apc, vaname, vanaml,
                                                             pno);
                                                          END
                                                         (*ENDIF*) 
                                                         END
                                                        ELSE
                                                         IF   (sizelen < sflen)
                                                         THEN
                                                          BEGIN
                                                          p11precomerror (apc, cpc_variable_will_be_truncated);
                                                          p11nerrorlisting ( apc, vaname, vanaml,
                                                             pno);
                                                          END
                                                         (*ENDIF*) 
                                                        (*ENDIF*) 
                                                       (*ENDIF*) 
                                                       END
                                                      ELSE
                                                       (* var : input  *)
                                                       IF  (va2size = cpr_pointerlen) AND (ralang = cpr_la_c)
                                                       THEN
                                                        BEGIN
                                                        pointl := sflen;
                                                        IF  (pasfinfo.sp1i_data_type in [dstra, dstre,
                                                         dstrb, dstrdb, dlonga, dlonge, dlongb, dlongdb])
                                                        THEN
                                                         pointl := -1;
                                                        (*ENDIF*) 
                                                        p11precomerror (apc, cpc_pointer_variable);
                                                        p11perrorlisting ( apc, vaname, vanaml,
                                                           pno, pointl);
                                                        END
                                                       ELSE
                                                        IF  (ralang =  cpr_la_c)
                                                         AND (sqldbmode <> cpr_kind_oracle)
                                                         AND (sqldbmode <> cpr_kind_sapr3)
                                                         AND (rasqlansi = cpr_kind_empty)
                                                        THEN
                                                         BEGIN
                                                         IF   (sizelen-1 > sflen)
                                                         THEN
                                                          BEGIN
                                                          p11precomerror (apc, cpc_variable_will_be_truncated);
                                                          p11nerrorlisting ( apc, vaname, vanaml, pno);
                                                          END
                                                         (*ENDIF*) 
                                                         END
                                                        ELSE
                                                         IF   (sizelen > sflen)
                                                          AND (sizelen <> 1)
                                                         THEN
                                                          BEGIN
                                                          p11precomerror (apc, cpc_variable_will_be_truncated);
                                                          p11nerrorlisting ( apc, vaname, vanaml, pno);
                                                          END;
                                                         (*ENDIF*) 
                                                        (*ENDIF*) 
                                                       (*ENDIF*) 
                                                      (*ENDIF*) 
                                                      IF  sqlv2p^ [va1indva2_sc] .va2typ = cpr_vdbchar
                                                      THEN
                                                       BEGIN
                                                       IF  (pasfinfo.sp1i_data_type <> ddbyteebcdic)
                                                       THEN
                                                        BEGIN
                                                        p11precomerror (apc, cpc_datatyp_not_compatible);
                                                        p11nerrorlisting ( apc, vaname, vanaml, pno);
                                                        END;
                                                       (*ENDIF*) 
                                                       END
                                                      ELSE
                                                       IF   (pasfinfo.sp1i_data_type = dfixed)
                                                        OR  (pasfinfo.sp1i_data_type = dfloat)
                                                        OR  (pasfinfo.sp1i_data_type = dvfloat)
                                                       THEN
                                                        IF  NOT chartonumb
                                                        THEN
                                                         BEGIN
                                                         p11precomerror (apc, cpc_datatyp_not_compatible);
                                                         p11nerrorlisting ( apc, vaname, vanaml, pno);
                                                         END;
                                                        (*ENDIF*) 
                                                       (*ENDIF*) 
                                                      (*ENDIF*) 
                                                      END;
                                                     OTHERWISE:
                                                      BEGIN
                                                      p11precomerror (apc, cpc_invalid_datatype);
                                                      p11nerrorlisting ( apc, vaname, vanaml, pno);
                                                      END;
                                                     END
                                                    (*ENDCASE*) 
                                                    END
                                                (*ENDIF*) 
                                                END
                                            ELSE
                                                BEGIN
                                                p11precomerror (apc, cpc_too_long_paramlist);
                                                pos := pos + infosize;
                                                END;
                                            (*ENDIF*) 
&                                           ifdef TRACE
                                            m90int2 (pc, 'i           ', i);
                                            m90int2 (pc, 'j           ', j);
                                            m90int2 (pc, 'n           ', n);
                                            m90int2 (pc, 'pos         ', pos);
                                            m90int2 (pc, 'sp1p_buf_len', sp1p_buf_len);
&                                           endif
                                            END;
                                        (*ENDWITH*) 
                                    (*ENDFOR*) 
                                    END;
                                (*ENDWITH*) 
                            (*ENDIF*) 
                            END;
                        (*ENDWITH*) 
                    (*ENDFOR*) 
                    s10mv (sp1p_buf_size, mxsp_c80, @var80, 1,
                          @sp1p_buf, 1, mxsp_c80);
                    IF   sp1p_buf_len <> 0
                    THEN
                        IF   pos - 1 <>  sp1p_buf_len
                        THEN
                            p11precomerror (apc, cpc_too_short_paramlist);
                        (*ENDIF*) 
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
            (*ENDIF*) 
        (*ENDIF*) 
        WITH rasegptr^ DO
            BEGIN
            warnset.warn := sp1r_extern_warning;
            IF   (warnset.int2 <> 0)
            THEN
                BEGIN
                IF   warn3_output_not_into_columns in sp1r_extern_warning
                THEN
                    p11precomerror (apc, cpc_too_short_paramlist);
                (*ENDIF*) 
                IF   warn4_nullwhere in sp1r_extern_warning
                THEN
                    p11precomerror (apc, cpc_whole_table_del_upd);
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            END;
        (*ENDWITH*) 
        WITH  sqlkap^ [xakano] DO
            BEGIN
            p03gparsid (sqlrap, sqlemp, sqlkap^[xakano] .kaParseInfo.ParseId, sqlgap^.gaentry[sqlrap^.raactsession]^.gaKnlSessionID);
            cmdfetch := cpr_is_false;
            p08privicmd (sqlca, sqlxa, sqlkap^[xakano], cmdfetch);
            IF   sqlcode = cpr_err_cmd_not_available
            THEN
                p11precomerror (apc, cpc_pre_cmd_not_available);
            (*ENDIF*) 
            END;
        (*ENDWITH*) 
        END;
    (*ENDWITH*) 
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p16tabledclgen (VAR apc : tpc_globals;
            VAR dclgen : boolean);
 
VAR
      connect : boolean;
 
BEGIN
WITH apc, sqlca, sqlgap^, sqlrap^, gaentry [raactsession]^  DO
    BEGIN
    connect := false;
    sqlxa.xakano := 1;
    IF  gareference = 0
    THEN
        BEGIN
        (* implicites connect *)
        connect := true;
        p16_init_check (apc);
        p16_connect (apc);
        END;
    (*ENDIF*) 
    IF  pcdclgen.tabclause = cpc_i_table
    THEN
        p16_g_table_dclgen (apc, dclgen)
    ELSE
        p16_g_dbproc_dclgen (apc, dclgen);
    (*ENDIF*) 
    p11precomerror (apc, cpc_include_file_produced);
    sqlca.sqlcode := 0;
    sqlca.sqlemp^.ereturncode := 0;
    pcerror := cpc_pre_ok ;
    IF  connect
    THEN
        p16release (sqlca, sqlxa, gaentry[raactsession]^);
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p16_g_table_dclgen (VAR apc : tpc_globals;
            VAR dclgen : boolean);
 
CONST
      c_sel   = ' select * from      ';
      c_desc  = ' describe           ';
      c_close = ' close              ';
 
VAR
      s : tsp00_C20;
      retxakano : tsp00_Int2;
      part_ptr : tsp1_part_ptr;
 
BEGIN
WITH apc, sqlca, sqlemp^, sqlrap^, sqlgap^,
     pcdclgen, gaentry [raactsession]^  DO
    BEGIN
    retxakano    := sqlxa.xakano;
    sqlxa.xakano := 0;
    dclgen := false;
    p03ccmdinit (sqlxa.xaSQLDesc^, sqlca, gaentry[raactsession]^, sp1m_dbs); (*Peter 30.09.92*)
    s26new_part_init (gareqptr, rasegptr^, part_ptr);
    part_ptr^.sp1p_part_header.sp1p_part_kind :=  sp1pk_command;
    part_ptr^.sp1p_part_header.sp1p_buf_len   :=  0;
    rasegmpartptr [ord(sp1pk_command)+1] := part_ptr;
    WITH part_ptr^, sp1p_part_header  DO
        BEGIN
        s := c_sel;
        p03p1cmd (part_ptr, s, mxsp_c20);
        IF  dcluser <> bsp_knl_identifier
        THEN
            BEGIN
            s10mv (sizeof(dcluser), sp1p_buf_size, @dcluser, 1,
                  @sp1p_buf, sp1p_buf_len + 1, sizeof(dcluser));
            sp1p_buf_len := sp1p_buf_len + 1 + sizeof(dcluser);
            sp1p_buf [sp1p_buf_len] := '.';
            END;
        (*ENDIF*) 
        s10mv (sizeof(dcltab), sp1p_buf_size, @dcltab, 1,
              @sp1p_buf, sp1p_buf_len + 1, dcltabl);
        sp1p_buf_len := sp1p_buf_len + dcltabl;
        IF  dclmodul <> bsp_knl_identifier
        THEN
            BEGIN
            sp1p_buf [sp1p_buf_len+1] := '.';
            s10mv (sizeof(dclmodul), sp1p_buf_size, @dclmodul, 1,
                  @sp1p_buf, sp1p_buf_len + 2, sizeof(dclmodul));
            sp1p_buf_len := sp1p_buf_len + 1 + sizeof(dclmodul);
            END;
        (*ENDIF*) 
        s26finish_part (gareqptr, part_ptr^);
        END;
    (*ENDWITH*) 
    p03creqrecpacket (sqlrap, gaentry[raactsession]^, sqlemp);
    IF  elzu = sp1ce_ok
    THEN
        BEGIN
        IF  (sqlcode <> 0)
            AND (sqlcode <> 100)
        THEN
            p11errorcheck  (apc)
        ELSE
            BEGIN
            p03ccmdinit (sqlxa.xaSQLDesc^, sqlca, gaentry[raactsession]^, sp1m_dbs);
            s26new_part_init (gareqptr, rasegptr^, part_ptr);
            part_ptr^.sp1p_part_header.sp1p_part_kind :=  sp1pk_command;
            part_ptr^.sp1p_part_header.sp1p_buf_len   :=  0;
            rasegmpartptr [ord(sp1pk_command)+1] := part_ptr;
            s := c_desc;
            p03p1cmd (part_ptr, s, mxsp_c20);
            s26finish_part (gareqptr, part_ptr^);
            p03creqrecpacket (sqlrap, gaentry[raactsession]^, sqlemp);
            IF  elzu = sp1ce_ok
            THEN
                BEGIN
                IF  sqlcode = 0
                THEN
                    BEGIN
                    p16_sqlda_get (apc);
                    dclgen := true;
                    END
                ELSE
                    p11errorcheck  (apc);
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        (* close erg *)
        p03ccmdinit (sqlxa.xaSQLDesc^, sqlca, gaentry[raactsession]^, sp1m_dbs);
        s26new_part_init (gareqptr, rasegptr^, part_ptr);
        part_ptr^.sp1p_part_header.sp1p_part_kind :=  sp1pk_command;
        part_ptr^.sp1p_part_header.sp1p_buf_len   :=  0;
        rasegmpartptr [ord(sp1pk_command)+1] := part_ptr;
        s := c_close;
        p03p1cmd (part_ptr, s, mxsp_c20);
        s26finish_part (gareqptr, part_ptr^);
        p03creqrecpacket (sqlrap, gaentry[raactsession]^, sqlemp);
        IF  elzu = sp1ce_ok
        THEN
            BEGIN
            IF  sqlcode <> 0
            THEN
                BEGIN
                sqlemp^.ereturncode := 0;
                sqlcode := 0;
                END;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    sqlxa.xakano := retxakano;
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p16_g_dbproc_dclgen (VAR apc : tpc_globals;
            VAR dclgen : boolean);
 
CONST
      c_show  = ' show param dbproc  ';
      c_proc  = ' proc               ';
      c_close = ' close show         ';
 
VAR
      s : tsp00_C20;
      retxakano : tsp00_Int2;
      part_ptr : tsp1_part_ptr;
 
BEGIN
WITH apc, sqlca, sqlemp^, sqlrap^, sqlgap^,
     pcdclgen, gaentry [raactsession]^  DO
    BEGIN
    retxakano    := sqlxa.xakano;
    sqlxa.xakano := 0;
    dclgen := false;
    p03ccmdinit (sqlxa.xaSQLDesc^, sqlca, gaentry[raactsession]^, sp1m_dbs); (*Peter 30.09.92*)
    s26new_part_init (gareqptr, rasegptr^, part_ptr);
    part_ptr^.sp1p_part_header.sp1p_part_kind :=  sp1pk_command;
    part_ptr^.sp1p_part_header.sp1p_buf_len   :=  0;
    rasegmpartptr [ord(sp1pk_command)+1] := part_ptr;
    WITH part_ptr^, sp1p_part_header  DO
        BEGIN
        s := c_show;
        p03p1cmd (part_ptr, s, mxsp_c20);
        IF  dcluser <> bsp_knl_identifier
        THEN
            BEGIN
            s10mv (sizeof(dcluser), sp1p_buf_size, @dcluser, 1,
                  @sp1p_buf, sp1p_buf_len + 1, sizeof(dcluser));
            sp1p_buf_len := sp1p_buf_len + 1 + sizeof(dcluser);
            sp1p_buf [sp1p_buf_len] := '.';
            END;
        (*ENDIF*) 
        s10mv (sizeof(dcltab), sp1p_buf_size, @dcltab, 1,
              @sp1p_buf, sp1p_buf_len + 1, dcltabl);
        sp1p_buf_len := sp1p_buf_len + dcltabl;
        IF  dclmodul <> bsp_knl_identifier
        THEN
            BEGIN
            sp1p_buf [sp1p_buf_len+1] := '.';
            s10mv (sizeof(dclmodul), sp1p_buf_size, @dclmodul, 1,
                  @sp1p_buf, sp1p_buf_len + 2, sizeof(dclmodul));
            sp1p_buf_len := sp1p_buf_len + 1 + sizeof(dclmodul);
            END;
        (*ENDIF*) 
        s26finish_part (gareqptr, part_ptr^);
        END;
    (*ENDWITH*) 
    p03creqrecpacket (sqlrap, gaentry[raactsession]^, sqlemp);
    IF  elzu = sp1ce_ok
    THEN
        BEGIN
        IF  (sqlcode <> 0)
            AND (sqlcode <> 100)
        THEN
            p11errorcheck  (apc)
        ELSE
            BEGIN
            (* get colname *)
            p16_colname_sqlda_get (apc);
            p03ccmdinit (sqlxa.xaSQLDesc^, sqlca, gaentry[raactsession]^, sp1m_parse);
            s26new_part_init (gareqptr, rasegptr^, part_ptr);
            part_ptr^.sp1p_part_header.sp1p_part_kind :=  sp1pk_command;
            part_ptr^.sp1p_part_header.sp1p_buf_len   :=  0;
            rasegmpartptr [ord(sp1pk_command)+1] := part_ptr;
            WITH part_ptr^, sp1p_part_header  DO
                BEGIN
                s := c_proc;
                p03p1cmd (part_ptr, s, mxsp_c20);
                IF  dcluser <> bsp_knl_identifier
                THEN
                    BEGIN
                    s10mv (sizeof(dcluser), sp1p_buf_size, @dcluser, 1,
                          @sp1p_buf, sp1p_buf_len + 1, sizeof(dcluser));
                    sp1p_buf_len := sp1p_buf_len + 1 + sizeof(dcluser);
                    sp1p_buf [sp1p_buf_len] := '.';
                    END;
                (*ENDIF*) 
                s10mv (sizeof(dcltab), sp1p_buf_size, @dcltab, 1,
                      @sp1p_buf, sp1p_buf_len + 1, dcltabl);
                sp1p_buf_len := sp1p_buf_len + dcltabl;
                IF  dclmodul <> bsp_knl_identifier
                THEN
                    BEGIN
                    sp1p_buf [sp1p_buf_len+1] := '.';
                    s10mv (sizeof(dclmodul), sp1p_buf_size, @dclmodul, 1,
                          @sp1p_buf, sp1p_buf_len + 2, sizeof(dclmodul));
                    sp1p_buf_len := sp1p_buf_len + 1 + sizeof(dclmodul);
                    END;
                (*ENDIF*) 
                s26finish_part (gareqptr, part_ptr^);
                END;
            (*ENDWITH*) 
            p03creqrecpacket (sqlrap, gaentry[raactsession]^, sqlemp);
            IF  elzu = sp1ce_ok
            THEN
                BEGIN
                IF  sqlcode = 0
                THEN
                    BEGIN
                    p16_sqlda_get (apc);
                    dclgen := true;
                    END
                ELSE
                    p11errorcheck  (apc);
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        (* close erg *)
        p03ccmdinit (sqlxa.xaSQLDesc^, sqlca, gaentry[raactsession]^, sp1m_dbs);
        s26new_part_init (gareqptr, rasegptr^, part_ptr);
        part_ptr^.sp1p_part_header.sp1p_part_kind :=  sp1pk_command;
        part_ptr^.sp1p_part_header.sp1p_buf_len   :=  0;
        rasegmpartptr [ord(sp1pk_command)+1] := part_ptr;
        s := c_close;
        p03p1cmd (part_ptr, s, mxsp_c20);
        s26finish_part (gareqptr, part_ptr^);
        p03creqrecpacket (sqlrap, gaentry[raactsession]^, sqlemp);
        IF  elzu = sp1ce_ok
        THEN
            BEGIN
            IF  sqlcode <> 0
            THEN
                BEGIN
                (* p11errorcheck  (apc); *)
                sqlemp^.ereturncode := 0;
                sqlcode := 0;
                END;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    sqlxa.xakano := retxakano;
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p16_sqlda_get (VAR apc : tpc_globals);
 
VAR
      i      : integer;
      len      : integer;
      s_pos    : integer;
      c_pos    : integer;
      infolen    : integer;
      colinfo    : tsp1_param_info;
      s_part_ptr : tsp1_part_ptr;
      c_part_ptr : tsp1_part_ptr;
 
BEGIN
WITH apc, sqlca, sqlrap^, sqlxa,
     sqlgap^, gaentry [raactsession]^   DO
    BEGIN
    p03find_part (sqlrap, sp1pk_shortinfo, s_part_ptr);
    p03find_part (sqlrap, sp1pk_columnnames, c_part_ptr);
    IF  (s_part_ptr <> NIL) AND (c_part_ptr <> NIL)
    THEN
        WITH  s_part_ptr^, sp1p_part_header  DO
            IF   (sqlcode >= 0) AND (sp1p_buf_len > 0)
            THEN
                WITH sqlcxap^.xasqldap.sqldaptr^ DO
                    BEGIN
&                   ifdef TRACE
                    IF   sp1p_buf_len > 0
                    THEN
                        m90buf (pc, sp1p_buf, 1, sp1p_buf_len);
                    (*ENDIF*) 
                    IF   c_part_ptr^.sp1p_buf_len > 0
                    THEN
                        m90buf (pc, c_part_ptr^.sp1p_buf, 1,
                              c_part_ptr^.sp1p_buf_len);
&                   endif
                    (*ENDIF*) 
                    c_pos := 1;
                    s_pos := 1;
                    infolen := sizeof (colinfo);
                    i   := 1;
                    sqlkano := 0;
                    sqlprno := 0;
                    sqld    := 0;
                    WHILE (s_pos < sp1p_buf_len) DO
                        WITH sqlcxap^.xasqldap.sqldaptr^, sqlvar[i], colinfo DO
                            IF   i >= csp_maxint2
                            THEN
                                BEGIN
                                p11precomerror (apc, cpc_too_long_paramlist);
                                s_pos := sp1p_buf_len + 1;
                                END
                            ELSE
                                BEGIN
                                (* descibe commando abgesetzt *)
                                IF  pcdclgen.tabclause = cpc_i_table
                                THEN
                                    BEGIN
                                    len := ord(c_part_ptr^.sp1p_buf[c_pos]);
                                    IF  len > mxsp_name
                                    THEN
                                        len := mxsp_name;
                                    (*ENDIF*) 
                                    colname := bsp_knl_identifier;
                                    s10mv (c_part_ptr^.sp1p_buf_size,
                                          mxsp_name,
                                          @c_part_ptr^.sp1p_buf, c_pos+1,
                                          @colname, 1, len);
                                    c_pos := c_pos + len + 1;
                                    END;
                                (*ENDIF*) 
                                s10mv (sp1p_buf_size, infolen,
                                      @sp1p_buf, s_pos,
                                      @colinfo , 1, infolen);
                                s_pos := s_pos + infolen;
                                IF   colinfo .sp1i_bufpos = 0
                                THEN
                                    s_pos := sp1p_buf_len + 1
                                ELSE
                                    BEGIN
                                    colmode   := sp1i_mode;
                                    colio     := ord (sp1i_io_type);
                                    coltype   := ord (sp1i_data_type);
                                    collength := sp1i_length;
                                    colfrac   := sp1i_frac;
                                    IF  (sp1i_data_type in [dstra, dstre,
                                        dstrb, dstrdb,
                                        dlonga, dlonge,
                                        dlongb, dlongdb] )
                                    THEN
                                        BEGIN
                                        p11precomerror (apc,
                                              cpc_long_column_exist_in_table);
                                        collength := csp_maxint2;
                                        END;
                                    (*ENDIF*) 
                                    IF   (sp1i_data_type = dfloat)
                                        OR  (sp1i_data_type = dvfloat)
                                    THEN
                                        BEGIN
                                        colfrac := csp_float_frac;
                                        coltype := ord(dfloat);
                                        END;
                                    (*ENDIF*) 
                                    hostindicator := 0;
                                    hostvartype   := -1;
                                    hostvaraddr.intaddr := 0;
                                    hostindaddr.intaddr := 0;
&                                   ifdef TRACE
                                    m90int2 (pc, 'i           ', i);
                                    m90int2 (pc, 'colio       ', colio);
                                    m90int2 (pc, 'coltype     ', coltype);
                                    m90int2 (pc, 'collength   ', collength);
                                    m90int2 (pc, 'colfrac     ', colfrac);
&                                   endif
                                    IF   (sp1i_io_type  = sp1io_output)
                                        OR (sp1i_io_type = sp1io_inout)
                                    THEN
                                        (* anzahl output parameter *)
                                        sqld := sqld + 1;
                                    (*ENDIF*) 
                                    i := i + 1;
                                    END;
                                (*ENDIF*) 
                                END;
                            (*ENDIF*) 
                        (*ENDWITH*) 
                    (*ENDWHILE*) 
                    (* anzahl aller Parameter *)
                    sqln := i - 1;
&                   ifdef TRACE
                    m90int2 (pc, 'sqln all    ', sqln);
                    m90int2 (pc, 'sqld out    ', sqld);
                    m90int2 (pc, 'sqlkano     ', sqlkano);
                    m90int2 (pc, 'sqlprno     ', sqlprno);
&                   endif
                    END;
                (*ENDWITH*) 
            (*ENDIF*) 
        (*ENDWITH*) 
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p16_colname_sqlda_get (VAR apc : tpc_globals);
 
CONST
      c_fetch = ' fetch show into ?,?';
      col_pos = 14;
 
VAR
      s      : tsp00_C20;
      i      : integer;
      colinfo: tsp1_param_info;
      part_ptr : tsp1_part_ptr;
 
BEGIN
WITH apc, sqlca, sqlemp^, sqlrap^, sqlxa,
     sqlgap^, gaentry [raactsession]^   DO
    IF   (sqlcode >= 0)
    THEN
        WITH sqlcxap^.xasqldap.sqldaptr^ DO
            BEGIN
            i   := 1;
            sqlkano := 0;
            sqlprno := 0;
            sqld    := 0;
            WHILE (sqlcode = 0) DO
                WITH sqlcxap^.xasqldap.sqldaptr^, sqlvar [i] , colinfo  DO
                    IF   i >= csp_maxint2
                    THEN
                        BEGIN
                        p11precomerror (apc, cpc_too_long_paramlist);
                        END
                    ELSE
                        BEGIN
                        p03ccmdinit (sqlxa.xaSQLDesc^, sqlca, gaentry[raactsession]^, sp1m_dbs);
                        s26new_part_init (gareqptr, rasegptr^, part_ptr);
                        part_ptr^.sp1p_part_header.sp1p_part_kind
                              :=  sp1pk_command;
                        rasegmpartptr [ord(sp1pk_command)+1] := part_ptr;
                        part_ptr^.sp1p_part_header.sp1p_buf_len   :=  0;
                        s := c_fetch;
                        p03p1cmd (part_ptr, s, mxsp_c20);
                        s26finish_part (gareqptr, part_ptr^);
                        p03creqrecpacket (sqlrap, gaentry[raactsession]^, sqlemp);
                        IF  elzu = sp1ce_ok
                        THEN
                            BEGIN
                            IF  (sqlcode <> 0)
                                AND (sqlcode <> 100)
                            THEN
                                p11errorcheck  (apc)
                            ELSE
                                IF  sqlcode = 0
                                THEN
                                    BEGIN
                                    (* show param dbproc abgesetzt *)
                                    p03find_part (sqlrap, sp1pk_data,
                                          part_ptr);
                                    IF  (part_ptr <> NIL)
                                    THEN
                                        WITH  part_ptr^, sp1p_part_header  DO
                                            BEGIN
                                            colname := bsp_knl_identifier;
                                            s10mv (sp1p_buf_size, mxsp_name,
                                                  @sp1p_buf, col_pos,
                                                  @colname, 1, mxsp_name-1);
                                            END;
                                        (*ENDWITH*) 
                                    (*ENDIF*) 
                                    sqln := sqln + 1;
                                    i    := i + 1;
                                    END;
                                (*ENDIF*) 
                            (*ENDIF*) 
                            END;
                        (*ENDIF*) 
                        END;
                    (*ENDIF*) 
                (*ENDWITH*) 
            (*ENDWHILE*) 
            END;
        (*ENDWITH*) 
    (*ENDIF*) 
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p16finishcmd (VAR sqlca : sqlcatype;
            VAR sqlxa : sqlxatype;
            VAR ga : sqlgaentry;
            VAR ka : sqlkaentry);
 
VAR
      anf : integer;   (* such anfang *)
      pos : integer;
      plus   : integer;
      subchr : char;
      sypos  : tsp00_Int4;
      syml   : tsp00_Int4;
      symb   : tpr_symbol;
      makrofound : boolean;
      parfound : boolean;
      kind   : integer;
      parno  : integer;
      anz    : integer;
      mline   : tpr_macroline;
      part_ptr : tsp1_part_ptr;
      i : integer;
      macrono  : integer;
      mapos    : integer;
 
BEGIN
p03find_part (sqlca.sqlrap, sp1pk_command, part_ptr);
IF  part_ptr = NIL
THEN
    pr01TraceRuntimeError (sqlca, sqlxa,
          cpr_invalid_declare_command)
ELSE
    WITH sqlca, sqlrap^, sqlxa, part_ptr^, sp1p_part_header  DO
        IF  sqlemp^.ereturncode = 0
        THEN
            BEGIN
&           ifdef TRACE
            m90int  (pc, 'kaprindex   ', ka.kaprindex);
            m90int4 (pc, 'sp1p_buf_len', sp1p_buf_len);
&           endif
            IF   ka.kaprindex <> 0
            THEN
                BEGIN
                (* prepare kommando untersuche declare kommando *)
                p16_declare_search (sqlca, sqlxa, ga, ka, pos);
                (*   pos ist immer > 0 *)
                IF   pos = 0
                THEN
                    BEGIN
                    pr01TraceRuntimeError (sqlca, sqlxa,
                          cpr_invalid_declare_command);
                    END;
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            makrofound := false;
            IF  ( ka.kapacount >= -1)  (*** 0  **)
            THEN
                BEGIN
                anf  := 1;
                parno:= 1;
                ka.kaparamcnt := 0;
                p16_suchenextsubchar (sqlca, sqlxa, anf, pos, subchr);
                WHILE (pos <> 0) AND (sqlwarn0 = bsp_c1) DO
                    BEGIN
&                   ifdef TRACE
                    m90int     (pc, 'anf         ', anf );
                    m90int     (pc, 'pos         ', pos );
                    m90int     (pc, 'subchr      ', ord (subchr) );
&                   endif
                    IF   subchr = cpr_macrochr
                    THEN
                        BEGIN
                        IF  (sp1p_buf [pos-1] <> '"')
                        THEN
                            BEGIN
                            plus := 1;
                            p16addspacevarpart (sqlca, sqlxa, ga,
                                  pos, pos, plus);
                            sp1p_buf [pos] := '"';
                            mapos := pos;
                            pos := pos + plus;
                            makrofound := true;
                            p16macrosubstitution (sqlca, sqlxa, ga, anf, pos,
                                  macrono, mline);
                            p16addspacevarpart (sqlca, sqlxa, ga,
                                  anf, anf, plus);
                            IF  macrono >= 100
                            THEN
                                BEGIN
                                sp1p_buf [mapos] := ' ';
                                sp1p_buf [anf] := ' ';
                                END
                            ELSE
                                sp1p_buf [anf] := '"';
                            (*ENDIF*) 
                            anf := anf + 1;
                            IF  sqlcode <> 0
                            THEN
                                anf := pos + 1;
                            (*ENDIF*) 
                            END
                        (*ENDIF*) 
                        END
                    ELSE
                        (*** 24.11.94  ******)
                        IF  rasegptr^.sp1c_prepare
                        THEN
                            anf := pos + 1
                        ELSE
                            BEGIN
                            IF   ka.kapacount = 0
                            THEN
                                IF  ka.kastate <> cpr_state_command  (* PTS 1104492 *)
                                THEN
                                    pr01TraceRuntimeError (sqlca, sqlxa,
                                          cpr_paramlist_not_allowed);
                                (*ENDIF*) 
                            (*ENDIF*) 
                            IF  NOT ((sqlcode  = 0) AND (ka.kapaindex > 0))
                            THEN
                                anf := pos + 1
                            ELSE
                                BEGIN
                                parfound := false;
                                anz  := 1;
                                REPEAT
                                    WITH   sqlpap^ [ka.kapaindex+ka.kaparamcnt] DO
                                        BEGIN
                                        kind := pakindlo;
                                        CASE kind OF
                                            sqlparst :
                                                BEGIN
                                                ka.kaparamcnt := ka.kaparamcnt + 1;
                                                anz        := paelcnt;
                                                END;
                                            sqlparlo :
                                                BEGIN
                                                rasegptr^.sp1c_mass_cmd:=true;
                                                ka.kaparamcnt := ka.kaparamcnt + 1;
                                                END;
                                            OTHERWISE:
                                                parfound := true;
                                            END;
                                        (*ENDCASE*) 
                                        END;
                                    (*ENDWITH*) 
                                UNTIL
                                    (parfound);
                                (*ENDREPEAT*) 
&                               ifdef TRACE
                                m90int (pc, 'kaparamcnt  ', ka.kaparamcnt);
&                               endif
                                IF   ka.kaparamcnt >= ka.kapacount
                                THEN
                                    BEGIN
                                    pr01TraceRuntimeError(sqlca,sqlxa,
                                          cpr_paramlist_too_short);
                                    END
                                ELSE
                                    WITH   sqlpap^ [ka.kapaindex+ka.kaparamcnt] DO
                                        CASE subchr OF
                                            cpr_paramchr ,
                                            cpr_preparechr :
                                                BEGIN
                                                (***  : (58) ***)
                                                (*** ??? ***)
&                                               ifdef TRACE
                                                m90int (pc, 'pakindlo    ',
                                                      pakindlo  );
&                                               endif
                                                CASE  pakindlo OF
                                                    sqlparel :
                                                     BEGIN
                                                     WITH sqlv1p^ [pavarno] DO
                                                      BEGIN
&                                                     ifdef TRACE
                                                      m90int (pc, 'va1indi_st  ',va1indi_st );
                                                      m90int (pc, 'pavarno     ', pavarno);
&                                                     endif
                                                      IF  va1indi_sc = sqlvast
                                                      THEN
                                                       anz := va1cmpcnt_st;
                                                      (*ENDIF*) 
                                                      IF  va1indi_sc = sqlvapt
                                                      THEN
                                                       WITH sqlv1p^ [va1ix_pt] DO
                                                        (* pointer *)
                                                        IF  va1indi_sc = sqlvast
                                                        THEN
                                                         anz := va1cmpcnt_st;
                                                        (*ENDIF*) 
                                                       (*ENDWITH*) 
                                                      (*ENDIF*) 
                                                      END;
                                                     (*ENDWITH*) 
&                                                    ifdef TRACE
                                                     m90int (pc, 'anz         ', anz );
                                                     m90int (pc, 'pavarno     ', pavarno);
&                                                    endif
                                                     p16_expandiere_parameter
                                                        (sqlca,  sqlxa, ga,
                                                        anf, pos, subchr, anz, parno);
                                                     parno := parno + anz;
                                                     END;
                                                    sqlparlo :
                                                     BEGIN
                                                     (* keine expansion *)
                                                     p05nextsymbol (sp1p_buf,
                                                        sp1p_buf_len, pos,
                                                        sypos, syml, symb);
                                                     anf := sypos + syml;
                                                     p05nextsymbol (sp1p_buf,
                                                        sp1p_buf_len, anf,
                                                        sypos, syml, symb);
                                                     IF   symb =
                                                      cpr_s_parameter_name
                                                     THEN
                                                      BEGIN
                                                      anf := sypos + syml;
                                                      END;
                                                     (*ENDIF*) 
                                                     END;
                                                    OTHERWISE:
                                                     pr01TraceRuntimeError(sqlca,sqlxa,
                                                        cpr_paramlist_not_allowed)
                                                    END;
                                                (*ENDCASE*) 
                                                END;
                                            OTHERWISE:
                                                BEGIN
                                                (* describe - expandieren *)
                                                pr01TraceRuntimeError (sqlca,
                                                      sqlxa,
                                                      cpr_not_implemented);
                                                END;
                                            END;
                                        (*ENDCASE*) 
                                    (*ENDWITH*) 
                                (*ENDIF*) 
                                ka.kaparamcnt := ka.kaparamcnt + 1;
                                END;
                            (*ENDIF*) 
                            END;
                        (*ENDIF*) 
                    (*ENDIF*) 
                    p16_suchenextsubchar (sqlca, sqlxa, anf, pos, subchr);
                    END;
                (*ENDWHILE*) 
                END;
            (*ENDIF*) 
            IF  makrofound
            THEN
                p08_close_search (sqlca, sqlxa, pos);
            (*ENDIF*) 
            i := sp1p_buf_len;
            WHILE ( (sp1p_buf [i]  = bsp_c1) OR
                  (sp1p_buf [i]  = cpr_nullchar) OR
                  (sp1p_buf [i]  = cpr_pc_endsign))
                  AND (i > 1)   DO
                BEGIN
                sp1p_buf [i]  := bsp_c1;
                i := i - 1;
                END;
            (*ENDWHILE*) 
            END;
        (*ENDIF*) 
    (*ENDWITH*) 
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p16_declare_search (VAR sqlca : sqlcatype;
            VAR sqlxa : sqlxatype;
            VAR ga   : sqlgaentry;
            VAR ka   : sqlkaentry;
            VAR pos  : integer);
 
VAR
      inpos  : integer;
      sympos : tsp00_Int4;
      symlen : tsp00_Int4;
      plus   : integer;
      plus_2 : integer;
      symb   : tpr_symbol;
      v_nam   : tsp00_Sname;
      nam     : tsp00_Name;
      kapaind : integer;
      str24   : tsp00_C24;
      mline   : tpr_macroline;
      macrono : integer;
      part_ptr : tsp1_part_ptr;
 
BEGIN
p03find_part (sqlca.sqlrap, sp1pk_command, part_ptr);
WITH sqlca, sqlrap^, sqlxa, rasegptr^,
     part_ptr^, sp1p_part_header, sqlprp^ [ka.kaprindex ]  DO
    BEGIN
&   ifdef TRACE
    m90int (pc, 'prStmtNameIn', prStmtNameIndex);
    m90int (pc, 'prstate     ', prstate   );
    m90int (pc, 'prkaindex   ', prkaindex);
    m90int (pc, 'prarea      ', prarea    );
    m90int (pc, 'prdescribe  ', prdescribe);
    m90int (pc, 'kapaindex   ', kapaindex);
    m90int (pc, 'kapacount   ', kapacount);
    m90int (pc, 'kaprindex   ', kaprindex );
    IF   sp1p_buf_len > 0
    THEN
        m90int4 (pc, 'sp_segm_len ', sp1s_segm_len );
    (*ENDIF*) 
    m90buf2 (pc, rasegptr^, 1, sp1s_segm_len);
    m90buf (pc, sp1p_buf, 1, sp1p_buf_len);
&   endif
    pos := 1;
    IF   (prstate = cpr_state_prepare)
    THEN
        IF  ka.kapaindex <> 0
        THEN
            BEGIN
            IF  ka.kapaindex > 0
            THEN
                kapaind :=  ka.kapaindex
            ELSE
                kapaind := -ka.kapaindex;
            (*ENDIF*) 
            (* check array statement *)
            WITH sqlpap^ [kapaind] DO
                IF  pakindlo = sqlparlo
                THEN
                    BEGIN
                    rasegptr^.sp1c_mass_cmd := true;
                    END;
                (*ENDIF*) 
            (*ENDWITH*) 
            END;
        (*ENDIF*) 
    (*ENDIF*) 
    pos := 1;
    IF   (prstate = cpr_state_command)
        OR   (prstate = cpr_state_decl_with_hold)
        (*   AND (prarea = cpr_in_sqlva)   *) (*12.10.90*)
    THEN
        BEGIN
        (* declare kommando ?uber hostvariable *)
        (* setze ergname in select kommando *)
        p05nextsymbol (sp1p_buf, sp1p_buf_len, pos,
              sympos, symlen, symb);
        v_nam   := 'SELECT      ';
        inpos   := sympos;
        IF  (symb = cpr_s_leftpar)
        THEN
            BEGIN
            pos := sympos + symlen;
            p05nextsymbol (sp1p_buf, sp1p_buf_len, pos,
                  sympos, symlen, symb);
            END;
        (*ENDIF*) 
        IF  ( (p05eq (v_nam, sp1p_buf, sympos, 6))
            AND (symlen = 6))
        THEN
            BEGIN
            plus := 8;
            p16addspacevarpart (sqlca, sqlxa, ga,
                  inpos, inpos, plus);
            nam := 'DECLARE           ';
            s10mv (mxsp_name, sp1p_buf_size,
                  @nam, 1, @sp1p_buf, inpos, plus);
            inpos := inpos + plus;
&           ifdef TRACE
            m90int (pc, 'inpos vmacro', inpos );
            m90int4 (pc, 'sp_segm_len ', sp1s_segm_len );
            m90buf (pc, sp1p_buf, 1, sp1p_buf_len + 20);
&           endif
            (* plus := mxsp_name; *)
            plus := s30klen (prStmtName, bsp_c1, sizeof (prStmtName));
            plus_2 := plus + 1;
            p16addspacevarpart (sqlca, sqlxa, ga,
                  inpos, inpos, plus_2);
            (* ergname in ".." *)
            sp1p_buf [inpos] := '"';
            p16_putname (sqlca, sqlxa, ga, prCursorName, inpos+1, plus);
            pos := inpos + 1;
            inpos := inpos + plus + 1;
            IF  (ka.kamacro = cpr_is_true)
                AND (prCursorName[1] = cpr_macrochr)
            THEN
                BEGIN
                p16macrosubstitution (sqlca, sqlxa, ga, inpos, pos,
                      macrono, mline);
                END;
&           ifdef TRACE
            (*ENDIF*) 
            m90int (pc, 'inpos n     ', inpos );
            m90int4 (pc, 'sp_segm_len ', sp1s_segm_len );
            m90buf (pc, sp1p_buf, 1, sp1p_buf_len + 20);
&           endif
            IF   (prstate = cpr_state_command)
            THEN
                BEGIN
                plus := mxsp_c16;
                str24 := '" CURSOR FOR            ';
                END
            ELSE
                BEGIN
                plus := mxsp_c24;
                str24 := '" CURSOR WITH HOLD FOR  ';
                END;
            (*ENDIF*) 
            p16addspacevarpart (sqlca, sqlxa, ga,
                  inpos, inpos, plus);
&           ifdef TRACE
            m90int (pc, 'inpos v curs', inpos );
            m90int4 (pc, 'sp_segm_len ', sp1s_segm_len );
            m90buf (pc, sp1p_buf, 1, sp1p_buf_len + 20);
&           endif
            s10mv (mxsp_c24, sp1p_buf_size,
                  @str24, 1, @sp1p_buf, inpos, plus);
&           ifdef TRACE
            m90int (pc, 'inpos v curs', inpos );
            m90int4 (pc, 'sp_segm_len ', sp1s_segm_len );
            m90buf (pc, sp1p_buf, 1, sp1p_buf_len + 20);
&           endif
            END;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p08_close_search (VAR sqlca : sqlcatype;
            VAR sqlxa : sqlxatype;
            VAR pos   : integer);
 
VAR
      sympos : tsp00_Int4;
      symlen : tsp00_Int4;
      symb   : tpr_symbol;
      v_nam   : tsp00_Sname;
      part_ptr : tsp1_part_ptr;
 
BEGIN
p03find_part (sqlca.sqlrap, sp1pk_command, part_ptr);
WITH sqlca, sqlrap^, sqlxa,
     part_ptr^, sp1p_part_header  DO
    BEGIN
    pos := 1;
    (* setze ergname in ".."  bei close *)
    p05nextsymbol (sp1p_buf, sp1p_buf_len, pos,
          sympos, symlen, symb);
    v_nam   := 'CLOSE       ';
    IF   (p05eq (v_nam, sp1p_buf, sympos, 6))
    THEN
        BEGIN
        pos := sympos + symlen;
        p05nextsymbol (sp1p_buf, sp1p_buf_len, pos,
              sympos, symlen, symb);
        v_nam   := 'COLUMN      ';
        IF  NOT (p05eq (v_nam, sp1p_buf, sympos, 7))
        THEN
            IF  symb = cpr_s_identifier
            THEN
                BEGIN
                sp1p_buf [sympos-1] := '"';
                sp1p_buf [sympos+symlen] := '"';
                sp1p_buf_len := sympos + symlen + 1;
                END;
            (*ENDIF*) 
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p16_suchenextsubchar (VAR sqlca : sqlcatype;
            VAR sqlxa : sqlxatype;
            anf : integer;
            VAR pos : integer;
            VAR subchr : char);
 
CONST
&     if $OS in [ UNIX, OS2, WIN32 ]
      cr_code = '\0D';
      lf_code = '\0A';
&     endif
&     if $OS in [ MSDOS ]
      lf_code = '\012';
      cr_code = '\015';
&     endif
&     if $OS in [ VMS ]
      lf_code = '\0D';
      cr_code = '\0A';
&     endif
 
VAR
      i     : integer;
      quoch : char;
      ch    : char;
      str   : boolean;
      part_ptr : tsp1_part_ptr;
 
BEGIN
p03find_part (sqlca.sqlrap, sp1pk_command, part_ptr);
WITH sqlca, sqlrap^, sqlxa,
     part_ptr^, sp1p_part_header  DO
    BEGIN
&   ifdef TRACE
    m90int     (pc, 'anf         ', anf );
&   endif
    pos := 0;
    IF   sqlcode  = 0
    THEN
        BEGIN
        pos := 0;
        i   := anf;
        str := false;
        WHILE (i <= sp1p_buf_len) AND (pos = 0) DO
            BEGIN
            ch := sp1p_buf  [i] ;
            IF   str
            THEN
                BEGIN
                IF   ch = quoch
                THEN
                    IF   ch = ''''
                    THEN
                        BEGIN
                        IF   sp1p_buf [i+1 ] = ''''
                        THEN
                            i := i + 1
                        ELSE
                            str := false;
                        (*ENDIF*) 
                        END
                    ELSE
                        str := false;
                    (*ENDIF*) 
                (*ENDIF*) 
                END
            ELSE
                IF  (ch = '''') OR (ch = '"')
                THEN
                    BEGIN
                    quoch := ch;
                    str   := true;
                    END
                ELSE
                    IF  (ch = cpr_ht_code) OR (ch = cr_code) OR (ch = lf_code)
                    THEN
                        sp1p_buf  [i]  := bsp_c1
                    ELSE
                        CASE ch OF
                            cpr_macrochr :
                                (* '%' *)
                                IF   (sp1p_buf [i+1 ] >= '0')
                                    AND (sp1p_buf [i+1 ] <= '9')
                                THEN
                                    BEGIN
                                    subchr := ch;
                                    pos := i;
                                    END;
                                (*ENDIF*) 
                            cpr_paramchr :
                                (* ':' *)
                                IF  (sp1p_buf [i+1 ] <> '=')
                                    AND (sp1p_buf [i+1 ] <> bsp_c1)
                                THEN
                                    BEGIN
                                    subchr := ch;
                                    pos := i;
                                    END;
                                (*ENDIF*) 
                            cpr_preparechr :
                                (* '??' *)
                                BEGIN
                                subchr := ch;
                                pos := i;
                                END;
                            OTHERWISE:
                                BEGIN
                                END;
                            END;
                        (*ENDCASE*) 
                    (*ENDIF*) 
                (*ENDIF*) 
            (*ENDIF*) 
            i := i + 1;
            END;
        (*ENDWHILE*) 
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p16_putname  (VAR sqlca : sqlcatype;
            VAR sqlxa : sqlxatype;
            VAR ga : sqlgaentry;
            VAR name : tsp00_KnlIdentifier;
            varpos   : integer;
            VAR len  : integer);
 
VAR
      mline : tpr_macroline;
 
BEGIN
SAPDB_PascalForcedFill (mxpr_macroline, @mline, 1, mxpr_macroline, bsp_c1);
s10mv  (sizeof (name), mxpr_macroline ,
      @name, 1, @mline, 1, len);
p16_putmacroline (sqlca, sqlxa, ga, mline, varpos, len);
END;
 
(*------------------------------*) 
 
PROCEDURE
      p16_putmacroline  (VAR sqlca : sqlcatype;
            VAR sqlxa : sqlxatype;
            VAR ga : sqlgaentry;
            VAR mline : tpr_macroline;
            varpos   : integer;
            VAR len  : integer);
 
VAR
      i : integer;
      n : integer;
      pos : integer;
      plus : integer;
      part_ptr : tsp1_part_ptr;
 
BEGIN
p03find_part (sqlca.sqlrap, sp1pk_command, part_ptr);
IF  part_ptr = NIL
THEN
    p03find_part (sqlca.sqlrap,
          sp1pk_resulttablename, part_ptr);
(*ENDIF*) 
WITH sqlca, sqlrap^, sqlxa,
     part_ptr^, sp1p_part_header  DO
    BEGIN
    pos := varpos;
    n   := len;
    plus := 1;
&   ifdef TRACE
    m90int (pc, 'len         ', len   );
    m90int (pc, 'varpos      ', varpos);
    m90buf1(pc, mline, 1, len);
&   endif
    FOR i := 1 TO n DO
        BEGIN
        IF  mline [i] = '"'
        THEN
            BEGIN
            p16addspacevarpart (sqlca, sqlxa, ga,
                  pos, pos, plus);
            sp1p_buf [pos] := mline [i];
            pos := pos + 1;
            len := len + 1;
            END;
        (*ENDIF*) 
        sp1p_buf [pos] := mline [i];
        pos := pos + 1;
        END;
    (*ENDFOR*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p16addspacevarpart (VAR sqlca : sqlcatype;
            VAR sqlxa : sqlxatype;
            VAR ga  : sqlgaentry;
            VAR pos : integer;
            VAR anf : integer;
            VAR plus: integer);
 
VAR
      addlen : tsp00_Int4;
      part_ptr : tsp1_part_ptr;
      ptr  : tsp1_packet_ptr;
 
BEGIN
p03find_part (sqlca.sqlrap, sp1pk_command, part_ptr);
IF  part_ptr = NIL
THEN
    p03find_part (sqlca.sqlrap,
          sp1pk_resulttablename, part_ptr);
(*ENDIF*) 
WITH sqlca, sqlrap^, sqlxa, sqlgap^, part_ptr^, sp1p_part_header  DO
    IF   sqlcode  = 0
    THEN
        BEGIN
        (* ab pos sollen  plus bytes frei werden *)
        (* ab anf sollen bytes nicht ver?andert werden *)
        addlen := plus - (anf - pos);
&       ifdef TRACE
        m90int     (pc, 'pos freipos ', pos);
        m90int     (pc, 'anf fest    ', anf);
        m90int     (pc, 'plus        ', plus);
        m90int4    (pc, 'addlen      ', addlen);
        m90int     (pc, 'sp1p_buf_len', sp1p_buf_len);
&       endif
        IF   sp1p_buf_len + addlen  > sp1p_buf_size
        THEN
            p08runtimeerror (sqlca, sqlxa, cpr_request_area_overflow)
        ELSE
            BEGIN
            IF   anf - pos > 0
            THEN
                SAPDB_PascalForcedFill (sp1p_buf_size, @sp1p_buf, pos, anf-pos, bsp_c1);
            (*ENDIF*) 
            IF   addlen > 0
            THEN
                BEGIN
                SAPDB_PascalForcedOverlappingMove  (sp1p_buf_size, sp1p_buf_size, @sp1p_buf, anf,
                      @sp1p_buf, pos+plus, sp1p_buf_len-anf+1);
                    ptr := ga.gareqptr;
                (*ENDIF*) 
                p16oldpartfinish (ptr, part_ptr, addlen);
                END;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p16macrosubstitution  (VAR sqlca : sqlcatype;
            VAR sqlxa : sqlxatype;
            VAR ga : sqlgaentry;
            VAR anf : integer;
            VAR mpos : integer;
            VAR macrono : integer;
            VAR mline : tpr_macroline);
 
VAR
      len  : integer;
      nextpos : integer;
      part_ptr : tsp1_part_ptr;
 
BEGIN
p03find_part (sqlca.sqlrap, sp1pk_command, part_ptr);
IF  part_ptr = NIL
THEN
    p03find_part (sqlca.sqlrap,
          sp1pk_resulttablename, part_ptr);
(*ENDIF*) 
WITH sqlca, sqlrap^, sqlxa,
     part_ptr^, sp1p_part_header  DO
    IF   sqlcode  = 0
    THEN
        BEGIN
        p16_get_macro_number (sqlrap, mpos, macrono, nextpos);
&       ifdef TRACE
        m90int     (pc, 'macropos    ', mpos);
        m90int     (pc, 'macronr     ', macrono);
        m90int     (pc, 'nextpos     ', nextpos);
        m90int     (pc, 'anf         ', anf );
        m90int     (pc, 'malen       ', sqlmap^.maentry[macrono].malen);
&       endif
        SAPDB_PascalForcedFill (mxpr_macroline, @mline, 1, mxpr_macroline, bsp_c1);
        WITH sqlmap^, maentry [macrono ] DO
            IF   (malen = 0) OR ((malen < 0) AND (maversion = csp_maxint4))
            THEN
                p08runtimeerror (sqlca, sqlxa, cpr_macro_not_init)
            ELSE
                IF   malen > 0
                THEN
                    BEGIN
                    len := malen;
                    mline := maval;
                    p16addspacevarpart (sqlca, sqlxa, ga, mpos, nextpos, len);
                    p16_putmacroline (sqlca, sqlxa, ga, maval, mpos, len);
                    anf := mpos + len;
                    END
                ELSE
                    WITH sqlv1p^ [ -malen ], sqlv2p^ [va1indva2_sc] DO
                        BEGIN
                        (* hole wert aus parameter *)
                        IF   va2typ = cpr_vcharc
                        THEN
                            BEGIN
                            IF  va2size = cpr_pointerlen
                            THEN
                                len := mxpr_macroline
                            ELSE
                                len := va2size;
                            (*ENDIF*) 
                            len := s30len (va1addr_sc.vtypep^, chr(0), len)
                            END
                        ELSE
                            len := s30lnr (va1addr_sc.vtypep^, bsp_c1, 1,
                                  va2size);
                        (*ENDIF*) 
&                       ifdef TRACE
                        m90int     (pc, 'hostvar len ', len);
                        m90int     (pc, 'hostvar inde', malen);
&                       endif
                        p16addspacevarpart (sqlca, sqlxa, ga, mpos, nextpos, len);
                        s10mv (va2size, sp1p_buf_size, @va1addr_sc.vtypep^,
                              1, @mline, 1, len);
                        p16_putmacroline (sqlca, sqlxa, ga, mline, mpos, len);
                        anf := mpos + len;
                        END;
                    (*ENDWITH*) 
                (*ENDIF*) 
            (*ENDIF*) 
        (*ENDWITH*) 
        END;
    (*ENDIF*) 
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p16_expandiere_parameter (VAR sqlca : sqlcatype;
            VAR sqlxa : sqlxatype;
            VAR ga : sqlgaentry;
            VAR anf  : integer;
            VAR ppos  : integer;
            subchr    : char;
            anzpar     : integer;
            parno      : integer);
 
VAR
      i    : integer;
      pxind: integer;
      npos : integer;
      pos  : tsp00_Int4;
      len  : integer;
      lsym : tsp00_Int4;
      symb : tpr_symbol;
      strl : integer;
      str  : tsp00_C50;
      snam : tsp00_Sname;
      chr  : char;
      ch12 : tsp00_C12;
      pno  : tsp00_Int2;
      accp : tsp00_Int4;
      part_ptr : tsp1_part_ptr;
      first     : boolean;
      c_minus   : char;
 
BEGIN
p03find_part (sqlca.sqlrap, sp1pk_command, part_ptr);
WITH sqlca, sqlrap^, sqlxa, part_ptr^, sp1p_part_header  DO
    IF   sqlcode  = 0
    THEN
        BEGIN
        IF   (subchr = cpr_paramchr) OR (subchr = cpr_preparechr)
        THEN
            chr := ':'
        ELSE
            chr := bsp_c1;
        (*ENDIF*) 
        pno := parno;
        first := true;
        FOR i := 1  TO anzpar DO
            BEGIN
            IF  first
            THEN
                BEGIN
                IF   (subchr = cpr_paramchr)
                THEN
                    (* only ??  eleminieren *)
                    first := false;
                (*ENDIF*) 
                c_minus := 'a';
                IF  (ralang = cpr_la_cobol)
                THEN
                    c_minus := '-';
                (*ENDIF*) 
                p05cnext2symbol (sp1p_buf, sp1p_buf_len, ppos, pos,
                      lsym, symb, accp, c_minus);
                npos := pos +lsym;
                IF   symb = cpr_s_comma
                THEN
                    BEGIN
                    p05cnext2symbol (sp1p_buf, sp1p_buf_len, npos, pos,
                          lsym, symb, accp, c_minus);
                    npos := pos + lsym;
                    END;
                (*ENDIF*) 
                pxind := 0;
                anf := pos + lsym;
                p05nextsymbol (sp1p_buf, sp1p_buf_len, npos, pos,
                      lsym, symb);
                IF   symb = cpr_s_parameter_name
                THEN
                    BEGIN
                    pxind := 1;
                    anf := pos + lsym;
                    END;
                (*ENDIF*) 
                IF   sp1p_buf [anf ] = bsp_c1
                THEN
                    WHILE (sp1p_buf [anf+1 ] = bsp_c1)
                          AND (sp1p_buf_len > anf) DO
                        anf := anf + 1;
                    (*ENDWHILE*) 
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            pno := parno + i - 1;
&           ifdef TRACE
            m90int     (pc, 'i           ', i);
            m90int     (pc, 'parno       ', parno);
            m90int     (pc, 'pno         ', pno  );
            m90int     (pc, 'pos         ', pos  );
            m90int     (pc, 'anf         ', anf  );
&           endif
            SAPDB_PascalForcedFill (mxsp_c50, @str, 1, mxsp_c50, bsp_c1);
            str  [1]  := chr;
            snam  := 'P_          ';
            len  := 2;
            s10mv (SNAME_MXSP00, mxsp_c50, @snam, 1, @str, 2, len);
            strl := 2 + len;
            p05inttochr12 (pno, ch12);
            s10mv (mxsp_c12, mxsp_c50, @ch12, 2,
                  @str, strl, 4);
            strl := strl + 4;
            IF   (pxind <> 0) AND (chr <> bsp_c1)
            THEN
                BEGIN
                (* parameter with indicator *)
                str [ strl+1 ] := ':';
                snam  := 'IND         ';
                len  := 3;
                s10mv (SNAME_MXSP00, mxsp_c50, @snam, 1, @str, strl+2,
                      len);
                strl := strl + 2 + len;
                END;
            (*ENDIF*) 
            IF   (i <> anzpar)
            THEN
                str [strl ] := ',';
            (*ENDIF*) 
            p16addspacevarpart (sqlca, sqlxa, ga, ppos, anf, strl);
            s10mv (mxsp_c50, sp1p_buf_size, @str, 1,
                  @sp1p_buf, ppos, strl);
            anf := ppos + strl;
            ppos:= anf;
&           ifdef TRACE
            IF   sp1p_buf_len > 0
            THEN
                m90buf (pc, sp1p_buf, 1, sp1p_buf_len);
            (*ENDIF*) 
            m90int     (pc, 'pos         ', pos  );
            m90int     (pc, 'anf         ', anf  );
            m90int     (pc, 'ppos        ', ppos );
&           endif
            END;
        (*ENDFOR*) 
        END;
    (*ENDIF*) 
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p16oldpartfinish (packet_ptr : tsp1_packet_ptr;
            VAR old_part : tsp1_part_ptr;
            addlen  : tsp00_Int4);
 
VAR
      i        : tsp00_Int4;
      len      : tsp00_Int4;
      oldlen   : tsp00_Int4;
      segm_ptr : tsp1_segment_ptr;
 
BEGIN
WITH old_part^ DO
    BEGIN
    IF  addlen < 0
    THEN
        FOR i := sp1p_buf_len DOWNTO sp1p_buf_len + addlen DO
            sp1p_buf [i] := bsp_c1;
        (*ENDFOR*) 
    (*ENDIF*) 
    IF  addlen > 0
    THEN
        BEGIN
        oldlen := s26partlen (old_part^) - sizeof (sp1p_part_header);
        IF  oldlen > sp1p_buf_size
        THEN
            sqlabort;
        (*ENDIF*) 
        IF  oldlen - sp1p_buf_len > addlen
        THEN
            sp1p_buf_len := sp1p_buf_len + addlen
        ELSE
            BEGIN
            sp1p_buf_len := sp1p_buf_len + addlen;
            len := s26partlen (old_part^) - sizeof (sp1p_part_header);
            IF  len > sp1p_buf_size
            THEN
                sqlabort;
            (*ENDIF*) 
            FOR i := sp1p_buf_len + 1 TO len DO
                sp1p_buf [i] := csp_undef_byte;
            (*ENDFOR*) 
            segm_ptr := @packet_ptr^.sp1_varpart [sp1p_segm_offset + 1];
            WITH segm_ptr^ DO
                sp1s_segm_len := sp1s_segm_len + len - oldlen
            (*ENDWITH*) 
            END;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p16_get_macro_number  (VAR sqlrap : sqlrapointer;
            mpos  : integer;
            VAR macrono : integer;
            VAR nextpos : integer);
 
VAR
      next : boolean;
      part_ptr : tsp1_part_ptr;
 
BEGIN
p03find_part (sqlrap, sp1pk_command, part_ptr);
IF  part_ptr = NIL
THEN
    p03find_part (sqlrap, sp1pk_resulttablename, part_ptr);
(*ENDIF*) 
WITH  sqlrap^,  part_ptr^, sp1p_part_header  DO
    BEGIN
    next := true;
    nextpos := mpos + 1;
    macrono := 0;
    REPEAT
        IF   ((sp1p_buf [nextpos] ) >= '0')
            AND ((sp1p_buf [nextpos] ) <= '9')
        THEN
            BEGIN
            macrono := macrono * 10 +
                  (ord(sp1p_buf [nextpos] ) - ord('0'));
            nextpos := nextpos + 1;
            END
        ELSE
            next := false;
        (*ENDIF*) 
    UNTIL
        (NOT next) OR (nextpos > sp1p_buf_len);
    (*ENDREPEAT*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p16release  (VAR sqlca : sqlcatype;
            VAR sqlxa : sqlxatype;
            VAR gae    : sqlgaentry);
 
CONST
      c_str = 'COMMIT WORK RELEASE ';
      c_str_len = 20;
 
VAR
      s          : tsp00_C20;
      part_ptr : tsp1_part_ptr;
 
BEGIN
WITH sqlca, sqlrap^, sqlgap^ DO
    IF   sqlcode >= 0
    THEN
        BEGIN
        p03ccmdinit(sqlxa.xaSQLDesc^, sqlca, gae, sp1m_dbs);
        s26new_part_init (gae.gareqptr, rasegptr^, part_ptr);
        part_ptr^.sp1p_part_header.sp1p_part_kind :=  sp1pk_command;
        part_ptr^.sp1p_part_header.sp1p_buf_len   :=  0;
        rasegmpartptr [ord(sp1pk_command)+1] := part_ptr;
        s := c_str;
        p03p1cmd (part_ptr, s, c_str_len);
        s26finish_part (gae.gareqptr, part_ptr^);
        p03creqrecpacket (sqlrap, gae, sqlemp);
        END;
    (*ENDIF*) 
(*ENDWITH*) 
p03sqlrelease (sqlca.sqlrap, sqlca.sqlgap, gae, sqlca.sqlemp);
END;  (* p03release *)
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
*-PRETTY-*  statements    :       1095
*-PRETTY-*  lines of code :       2999        PRETTYX 3.10 
*-PRETTY-*  lines in file :       4075         1997-12-10 
.PA 
