.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$VPR01E$
.tt 2 $$$
.TT 3 $$SQL Runtime System Init $$$$2001-03-26$
.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
.pb '$'
***********************************************************
.nf
.sp
MODULE  : SQL_runtime_routinen_init
=========
.sp
Purpose : Initial procedures for runtime system and
          call interface.
          Initalisierungs Runtime-Routinen
          f?ur Runtimesystem und Callinterface.
.CM *-END-* purpose -------------------------------------
.sp
.cp 3
Define  :
 
        PROCEDURE
              p01xhalt    (result : integer);
&       ifdef OLDBF
 
        PROCEDURE
              p01xcheck (VAR sqlca : sqlcatype;
                    VAR sqlxa : sqlxatype);
&       endif
 
        PROCEDURE
              p01xvfopentrace  (VAR sqlca : sqlcatype);
 
        PROCEDURE
              p01xvfclosetrace  (VAR sqlca : sqlcatype);
 
        PROCEDURE
              p01xtracefilecheck  (VAR sqlca : sqlcatype;
                    VAR sqlxa : sqlxatype);
 
        PROCEDURE
              p01xbinit (VAR sqlca : sqlcatype);
 
        PROCEDURE
              p01xballocate  (VAR sqlca : sqlcatype;
                    VAR ga : sqlgaentry;
                    index : integer);
 
        PROCEDURE
              p01xcmdclose  (VAR sqlca : sqlcatype;
                    VAR sqlxa : sqlxatype;
                    VAR gae : sqlgaentry);
 
        PROCEDURE
              p01xpagethostvariable (VAR sqlca : sqlcatype;
                    VAR sqlxa : sqlxatype;
                    VAR gae    : sqlgaentry;
                    paind     : tsp00_Int2;
                    VAR len   : tsp00_Int4);
 
        PROCEDURE
              p01xprofinit (VAR sqlca : sqlcatype;
                    VAR sqlxa : sqlxatype;
                    VAR gae : sqlgaentry);
 
        PROCEDURE
              p01xtimetrace (VAR sqlca : sqlcatype;
                    VAR sqlxa : sqlxatype;
                    VAR gae : sqlgaentry);
 
        PROCEDURE
              p01xchangerror (VAR sqlca : sqlcatype);
 
        PROCEDURE
              p01xpidpos (VAR tracefn : tsp00_VFilename;
                    VAR pidpos  : tsp00_Int2);
 
        FUNCTION
              pr01eIsEmptyFileName(filename : tsp00_VFilename) : boolean;
 
        PROCEDURE
              pr01eInitFileName(VAR filename : tsp00_VFilename);
 
.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :
 
        FROM
              SQLDB-Program-Options  : VPR15;
 
        PROCEDURE
              p15optionsget (VAR sclca : sqlcatype);
 
      ------------------------------ 
 
        FROM
              Precompiler_Runtime_Routinen  : VPR08;
 
        PROCEDURE
              p08runtimeerror (VAR sqlca : sqlcatype;
                    VAR sqlxa : sqlxatype;
                    error : tpr_runtime_errors);
 
        PROCEDURE
              p08vfwritetrace (sqlrap : sqlrapointer);
 
      ------------------------------ 
 
        FROM
              Runtime-Stringroutinen   : VPR05;
 
        PROCEDURE
              p05inttochr12 (int : integer;
                    VAR chr12 : tsp00_C12);
 
      ------------------------------ 
 
        FROM
              SQLDB-Auftrags-Schnittstelle   : VPR03;
 
        PROCEDURE
              p03sysproferror  (VAR sqlca : sqlcatype;
                    VAR gae : sqlgaentry);
 
        PROCEDURE
              p03getparameteraddr (VAR sqlca : sqlcatype;
                    VAR sqlxa : sqlxatype;
                    VAR paix : integer;
                    VAR cmcnt : integer;
                    VAR vaaddr : tpr_vtypepointer;
                    VAR vaind  : integer;
                    VAR indaddr : tpr_vtypepointer;
                    VAR indind  : integer);
 
      ------------------------------ 
 
        FROM
              C-Type-Checker-Module  : VPR102;
 
        PROCEDURE
              pr01TraceSQLResultName (sqlrap : sqlrapointer;
                    sqlresn : tsp00_KnlIdentifier);
 
        PROCEDURE
              pr03mAllocatP (len : tsp00_Int4;
                    VAR bufpointer : tpr_intaddr;
                    nam :tsp00_Name);
 
        PROCEDURE
              pr03mFreeP (sfpointer : tpr_intaddr; nam :tsp00_Name);
 
        PROCEDURE
              p03dynalloc (VAR desc: tpr_sqlmdesc);
 
        PROCEDURE
              p03csqlcaareainit (VAR sqlca : sqlcatype);
 
        PROCEDURE
              p03pointerinit (VAR sqlca : sqlcatype;
                    VAR ok  : boolean);
 
        PROCEDURE
              p03sqlfree (VAR sqlca : sqlcatype);
 
        PROCEDURE
              p03connect  (
                    VAR sqlxa : sqlxatype;
                    sqlrap : sqlrapointer;
                    sqlgap   :  sqlgapointer;
                    VAR ga : sqlgaentry;
                    datetime : tsp00_Int2;
                    errmsg : sqlempointer);
 
        PROCEDURE
              p03gaxuserinit (sqlga : sqlgapointer;
                    errmsg : sqlempointer);
 
        PROCEDURE
              p03csqlinit (sqlrap : sqlrapointer;
                    comp  : char;
                    language : tsp00_Int2);
 
        PROCEDURE
              p03tvfopentrace (sqlrap : sqlrapointer;
                    read_write : tsp00_VFileOpCodes;
                    errmsg : sqlempointer);
 
        PROCEDURE
              p03tvfclosetrace (sqlrap : sqlrapointer;
                    errmsg : sqlempointer);
 
        PROCEDURE
              p03csqlclock   (sqlra : sqlrapointer;
                    cmd   : integer);
 
        PROCEDURE
              p03getpidtrace (VAR pidtracename : tsp00_VFilename);
 
        PROCEDURE
              p03getpid (VAR pid : tsp00_Int4);
 
        PROCEDURE
              p03csqlemptosqlca (VAR sqlca : sqlcatype;
                    errmsg : sqlempointer);
 
        PROCEDURE
              p07senderid (VAR xalang : tsp00_Int2;
                    VAR senderid : tsp00_C8;
                    VAR cmpkind  : tsp00_Int2);
 
        PROCEDURE
              p07trversion(sqlrap : sqlrapointer);
 
        PROCEDURE
              pr01TraceRuntimeError (VAR sqlca : sqlcatype;
                    VAR sqlxa : sqlxatype;
                    error : tpr_runtime_errors);
 
        PROCEDURE
              pr01TraceErrorPos (VAR sqlca : sqlcatype;
                    ConDesc : tsp00_Addr);
&       ifdef TRACE
 
        PROCEDURE
              m90filename (
                    layer : tsp00_ToolLayer;
                    fn    : tsp00_VFilename);
 
        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
              m90buf3 (layer : tsp00_ToolLayer;
                    VAR buf : tsp00_TermId;
                    von,bis : integer);
 
        PROCEDURE
              m90buf1 (layer : tsp00_ToolLayer;
                    VAR buf : char;
                    von,bis : integer);
 
        PROCEDURE
              m90buf5  (layer : tsp00_ToolLayer;
                    VAR buf : tsp1_segment;
                    posanf : integer;
                    posend : integer);
&       endif
 
        PROCEDURE
              pr03ConConnect (ConDesc : tsp00_Addr);
 
      ------------------------------ 
 
        FROM
              SQLCA_INIT : VPR03CAC;
 
        PROCEDURE
              p03caci (VAR sqlca : sqlcatype;
                    VAR sqlxa: sqlxatype;
                    pcfor : integer);
 
        PROCEDURE
              p16profinit (
                    sqlrap : sqlrapointer;
                    VAR ga : sqlgaentry;
                    prog  : tsp00_KnlIdentifier;
                    lang      : tsp00_Int2;
                    errmsg : sqlempointer);
 
        PROCEDURE
              p16profexec (
                    sqlrap : sqlrapointer;
                    VAR ga : sqlgaentry;
                    stmt   : tpr_intaddr;
                    prog   : tsp00_KnlIdentifier;
                    modn   : tsp00_KnlIdentifier;
                    lang       : tsp00_Int2;
                    lino       : tsp00_Int4;
                    pid    : tpr_parsid;
                    errmsg : sqlempointer);
 
      ------------------------------ 
 
        FROM
              RTE_driver       : VEN102;
 
        PROCEDURE
              sqlresult ( result : tsp00_Uint1);
 
        PROCEDURE
              sqltermid (VAR terminalid : tsp00_TermId);
 
        PROCEDURE
              sqlfinish (term : boolean);
 
        PROCEDURE
              sqlallocat (len : tsp00_Int4;
                    VAR bufpointer : tpr_intaddr;
                    VAR ok  : boolean);
 
        PROCEDURE
              sqlfree (sfpointer : tpr_intaddr);
 
        PROCEDURE
              sqldattime (VAR date : tsp00_C8;
                    VAR time : tsp00_C8);
 
        PROCEDURE
              sqlfopenp (
                    VAR fname       : tsp00_VFilename;
                    datakind        : tsp05_RteDataKind;
                    filemode        : tsp05_RteFileMode;
                    buffering       : tsp05_RteBufferingKind;
                    VAR fhandle     : tsp00_Int4;
                    VAR err         : tsp05_RteFileError);
 
        PROCEDURE
              sqlfwritep (
                    fhandle         : tsp00_Int4;
                    VAR buf         : tsp00_C80;
                    inlen           : tsp00_Longint;
                    VAR err         : tsp05_RteFileError);
 
        PROCEDURE
              sqlfreadp (
                    fhandle         : tsp00_Int4;
                    VAR buf         : tsp00_C80;
                    bufsize         : tsp00_Longint;
                    VAR outlen      : tsp00_Longint;
                    VAR err         : tsp05_RteFileError);
 
      ------------------------------ 
 
        FROM
              SQLSTATEs    : VSP03;
 
        PROCEDURE
              s03getsqlstate (returncode : tsp00_Int2;
                    warnings     : tsp00_WarningSet;
                    VAR sqlstate : sqlstatetype);
 
      ------------------------------ 
 
        FROM
              Kernel_move_and_fill   : VGG101;
 
        PROCEDURE
              SAPDB_PascalForcedFill (
                    size        : tsp00_Int4;
                    m           : tsp00_MoveObjPtr;
                    pos         : tsp00_Int4;
                    len         : tsp00_Int4;
                    fillchar    : char);
 
        PROCEDURE
              SAPDB_PascalForcedMove (
                    source_upb  : tsp00_Int4;
                    destin_upb  : tsp00_Int4;
                    source      : tsp00_MoveObjPtr;
                    source_pos  : tsp00_Int4;
                    destin      : tsp00_MoveObjPtr;
                    destin_pos  : tsp00_Int4;
                    length      : tsp00_Int4);
 
        PROCEDURE
              s10mv (
                    source_upb  : tsp00_Int4;       
                    destin_upb  : tsp00_Int4;
                    source      : tsp00_MoveObjPtr;    
                    source_pos  : tsp00_Int4;
                    destin      : tsp00_MoveObjPtr;    
                    destin_pos  : tsp00_Int4;
                    length      : tsp00_Int4);
 
      ------------------------------ 
 
        FROM
              RTE-Extension-30    : VSP30;
 
        FUNCTION
              s30eq (VAR a : tsp00_Sname;
                    VAR b : tsp00_C80;
                    bi,cnt : tsp00_Int4) : boolean;
 
        FUNCTION
              s30klen (VAR str : tpr_valuerec;
                    val : char; cnt : integer) : integer;
 
        FUNCTION
              s30len (VAR str : tpr_valuerec;
                    val : char; cnt : tsp00_Int4) : tsp00_Int4;
 
        FUNCTION
              s30len1 (VAR str : tsp00_VFilename;
                    val : char; cnt : tsp00_Int4) : tsp00_Int4;
 
        FUNCTION
              s30len2 (VAR str : tsp00_KnlIdentifier;
                    val : char; cnt : tsp00_Int4) : tsp00_Int4;
 
        FUNCTION
              s30gad (VAR b : sqlmfentptr) : tpr_intaddr;
 
      ------------------------------ 
 
        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);
 
        PROCEDURE
              s26find_part (VAR segm  : tsp1_segment;
                    part_kind         : tsp1_part_kind;
                    VAR new_part_ptr  : tsp1_part_ptr);
 
      ------------------------------ 
 
        FROM
              GET-Conversions   : VSP40;
 
        PROCEDURE
              s40glint (VAR buf : tsp00_MoveObj;
                    pos : tsp00_Int4;
                    len : integer;
                    VAR dest : tsp00_Int4;
                    VAR res : tsp00_NumError);
 
.CM *-END-* use -----------------------------------------
.sp;.cp 3
Synonym :
 
        PROCEDURE
              pr03mAllocatP;
 
              tpr_vtypepointer tpr_intaddr
 
        PROCEDURE
              sqlresult;
 
              tsp00_Uint1       tsp00_Uint1
 
        PROCEDURE
              sqltermid;
 
              tsp00_TermId      tsp00_TermId
 
        PROCEDURE
              sqlfopenp;
 
              tsp00_VFilename   tsp00_VFilename
              tsp00_Int4        tsp00_Int4
 
        PROCEDURE
              sqlfwritep;
 
              tsp00_Int4        tsp00_Int4
              tsp00_MoveObj     tsp00_C80
              tsp00_Longint     tsp00_Longint
 
        PROCEDURE
              sqlfreadp;
 
              tsp00_Int4        tsp00_Int4
              tsp00_MoveObj     tsp00_C80
              tsp00_Longint     tsp00_Longint
              tsp00_Longint     tsp00_Longint
 
        PROCEDURE
              m90buf1;
 
              tsp00_Buf    char
 
        PROCEDURE
              m90buf3;
 
              tsp00_Buf   tsp00_TermId
 
        PROCEDURE
              m90buf5;
 
              tsp00_Buf tsp1_segment;
 
        PROCEDURE
              sqlfopen;
 
              tsp00_VFilename    tpr_hostname
              tsp00_VFileOpCodes tsp00_VFileOpCodes
              tsp00_VfResource  tsp00_VfResource
              tsp00_Int4        tsp00_Int4
              tsp00_VfFormat    tsp00_VfFormat
              tsp00_Int4        tsp00_Int4
              tsp00_Int4        tsp00_Int4
              tsp00_Int2        tsp00_Int2
              tsp00_VfBufaddr   tpr_intaddr
              tsp00_VfReturn    tsp00_VfReturn
              tsp00_ErrText     tsp00_ErrText
 
        PROCEDURE
              sqlfwrite;
 
              tsp00_Int4        tsp00_Int4
              tsp00_VfBufaddr   tsp00_C80
              tsp00_Int4        tsp00_Int4
              tsp00_VfReturn    tsp00_VfReturn
              tsp00_ErrText     tsp00_ErrText
 
        PROCEDURE
              sqlfread;
 
              tsp00_Int4        tsp00_Int4
              tsp00_VfBufaddr   tsp00_C80
              tsp00_Int4        tsp00_Int4
              tsp00_VfReturn    tsp00_VfReturn
              tsp00_ErrText     tsp00_ErrText
 
        PROCEDURE
              s03getsqlstate;
 
              tsp00_SqlState   sqlstatetype
 
        PROCEDURE
              s30eq;
 
              tsp00_MoveObj   tsp00_Sname
              tsp00_MoveObj   tsp00_C80
 
        PROCEDURE
              s30klen;
 
              tsp00_MoveObj   tpr_valuerec
 
        PROCEDURE
              s30len;
 
              tsp00_MoveObj   tpr_valuerec
 
        PROCEDURE
              s30len1;
 
              tsp00_MoveObj   tsp00_VFilename
 
        PROCEDURE
              s30len2;
 
              tsp00_MoveObj       tsp00_KnlIdentifier
 
        PROCEDURE
              s30gad;
 
              tsp00_MoveObj sqlmfentptr
              tsp00_Addr tpr_intaddr;
 
        PROCEDURE
              sqlallocat;
 
              tsp00_Int4        tsp00_Int4
              tsp00_ObjAddr     tpr_intaddr
 
        PROCEDURE
              sqlfree;
 
              tsp00_BufAddr     tpr_intaddr
 
        PROCEDURE
              sqldattime;
 
              tsp00_Date        tsp00_C8
              tsp00_Time        tsp00_C8
 
.CM *-END-* synonym -------------------------------------
.sp;.cp 3
Author  :
.sp
.cp 3
Created : 1985-08-02
.sp
.cp 3
.sp
.cp 3
Release :  7.3    Date : 2001-03-26
.sp
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Specification:
.sp 2
.cp 6
PROCEDURE  P01XBNEW:
.sp 2
A new buffer for results from mfetch is allocated.
.sp 4
.cp 6
PROCEDURE  P01XBALLOCATE:
.sp 2
Allocates a buffer for results from fetch.
.sp 4
.cp 6
PROCEDURE  P01XBINIT:
.sp 2
Initializes the SQLM fetch area.
.sp 4
.cp 6
PROCEDURE  P01_CHECK:
.sp 2
Checks whether the local variables have to be initialized
(xalcheck), if yes, p01_l_init is called.
The variable sqlxa.xainit is set to cpr_is_true if the
local variables have to be initialized. (sqlstart)
Checks whether the global variables have to be initialized
(sqlext); if yes, p01_g_init is called.
.br
In addition a check is also run to see whether the global
SQLCA area has been modified by the user from a certain position
onwards.
.sp 4
.cp 6
PROCEDURE  P01_G_INIT:
.sp 2
Initializes the virtual file (vfinit).
Fetches the options of the program.
The procedure checks whether a connect is to be
made via program options.
If no, values for a program connect at
a later point or
an implicit connect are made available.
Initializes global variables in the SQLCA area.
.sp 4
.cp 6
PROCEDURE  P01_L_INIT:
.sp 2
This procedure initializes the module-specific
local variables before the initialization requests
generated by the precompiler are called.
.sp 4
.cp 6
PROCEDURE  P01_TRACEFILE_CHECK:
.sp 2
This procedure checks whether a trace file exists;
if not, whether it should be opened.
If yes, it is opened.
.sp
Since this procedure is called with each command, both with all
languages and with the call interface,
the language for output in the event of error
messages is set correctly here (sqlcxa.xalang := sqlxa.xalang).
In the case of call interface sqlcxa = sqlxa.
.sp 4
.cp 6
PROCEDURE  SQLHALT:
.sp 2
This procedure sends back the return code and terminates
the database normally. In the case of result error = 6 and 7
the program is stopped. (Option or trace file error)
.sp 2
***********************************************************
.sp 2
 
.cp 6
PROCEDURE  P01XBNEW:
.sp 2
Ein Neuer Puffer f?ur Ergebnisse von mfetch wird allociert.
.sp 4
.cp 6
PROCEDURE  P01XBALLOCATE:
.sp 2
Allociert einen Puffer f?ur Ergebnisse von mfetch.
.sp 4
.cp 6
PROCEDURE  P01XBINIT:
.sp 2
Initialisiert die SQLMfetch-area.
.sp 4
.cp 6
PROCEDURE  P01_CHECK:
.sp 2
Pr?uft, ob die Lokalen Variablen initialisiert weren m?ussen
(xalcheck), bei ja wird p01_l_init aufgerufen.
Die Variable sqlxa.xainit wird auf cpr_is_true gesetzt, wenn die
lokalen Variablen initialisiert werden m?ussen.(sqlstart)
Pr?uft, ob die GLobalen Variablen initialisiert weren m?ussen
(sqlext), bei ja wird p01_g_init aufgerufen.
.br
Au?zerdem wird noch gepr?uft, ob die Globale SQLCA-Area ab
einer bestimmten Position vom Anwender ge?andert wurde.
.sp 4
.cp 6
PROCEDURE  P01_G_INIT:
.sp 2
Initialisiert das Virtuellefile (vfinit).
Holt die Options des Programms.
Die Procedure pr?uft, ob ?uber Programmoptions ein
Connect gemacht werden soll.
Bei nein werden Werte f?ur ein sp?aters
Programm Connect oder
ein implicites Connect bereitgestellt.
Initialisiert globalen Variablen in der SQLCA-Area.
.sp 4
.cp 6
PROCEDURE  P01_L_INIT:
.sp 2
Die Procedure initialisiert die modulspecifischen
localen Variablen vor dem Aufruf der vom Precompiler
erzeugten Initalisierungsauftr?age.
.sp 4
.cp 6
PROCEDURE  P01_TRACEFILE_CHECK:
.sp 2
Die Procedure pr?uft, ob ein Tracefile existiert,
wenn nicht, ob er er?offnet werden soll.
Bei ja, wird er er?offnet.
.sp
Tracefile wird geschrieben :
.nf
  1. runtime option ist gesetzt   --> immer
  2. precompile option ist f?ur einen Module gesetzt ---> nur in diesem Modul
  3. im programm stehen set trace Anweisungen ---> Kommandos werden ?uber
          alle Module in der Reihenfolge des Progammflu?z ausgef?uhrt.
          Ist 2. oder 1. gegeben tritt 3. ausser Kraft.
 
  Informatione werden abgelegt in :
  zu 1.  sqlca.tatracety  init  cpr_trace_empty :: 0   p15_option_get
                           -xt   cpr_trace_formal:: 2
                           -xtl  cpr_trace_long  :: 3
  zu 2.  sqlca.sqlgap^.oamodtrace  init  cpr_is_false  :: 1   p01_l_init
                           -xt, -xtl cpr_is_true   :: 0
         sqlca.sqlgap^.oamodtracety init cpr_trace_off    :: 1  p01_l_init
                                -xt  cpr_trace_formal :: 2 / 4
                                -xtl cpr_trace_long   :: 3 / 5
  zu 3.  sqlca.sqlgap^.oamodsettrty init cpr_trace_off   :: 1   p01_g_init
                         set trace on   cpr_trace_formal:: 2
                         set trace long cpr_trace_long  :: 3
                         set trace off  cpr_trace_off   :: 1
.sp
Da diese Procedure bei jedem Kommando sowohl bei allen Sprachen als
auch beim Call-Interface aufgerufen wird,
wird hier die Sprache f?ur die Ausgabe bei
Fehlermeldungen richtig gesetzt (sqlcxa.xalang := sqlxa.xalang).
Beim Call-Interface ist sqlcxa = sqlxa.
.sp 4
.cp 6
PROCEDURE  SQLHALT:
.sp 2
Die Procedure gibt den returncode zur?uck, und beendet
ordnungsgem?a?z die Datenbank. Bei result-error = 6 und 7
wird das Programm gestoppet. (Option oder Tracefile error).
.sp 4
.cp 6
PROCEDURE  p01xcmdclose:
.sp 2
Diese Procedure wird nach jedem Kommando abgesetzt.
Daher werden hier einige Operationen durchgef?uhrt, die
immmer am Ende eines Kommandos gemacht werden m?ussen.
.sp
Bei der Option profiling, wird die Zeitmessung in die
sysprofile Tabelle eingetragen.
.sp
If the sqlcode = 800 database crash occurs, an implicit
connect is performed again, and error +800 issued to the user.
.sp
Ist das implizite Ende eines Programms gefunden worden (rasqlinit =
 cpr_is_false), wird wenn ein Tracefile er?offnet war (tatraceno <> 0)
dieser geschlossen und rasqlinit = cpr_is_end gesetzt.
.sp
Bei der Option cpr_kind_ansi werden einige positive Fehlermeldungen
negativ gesetzt.
.sp 4
.CM *-END-* specification -------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Description:
.fo
.sp 2
.cp 6
PROCEDURE  P01XVFOPENTRACE:
.sp 2
Er?offnet den Tracefile ?ubers virtuelle File.
.sp 4
.cp 6
PROCEDURE  P01XVFCLOSETRACE:
.sp 2
Schlie?zt  den Tracefile ?ubers virtuelle File.
.sp 4
PROCEDURE  P01XTRACEFILECHECK:
.sp 2
 sqlxa.xatrace ist Variable, die trace-output veranla?zt.
xatrace wird gesetzt :
.nf
   zu 1. if tatracety <> cpr_trace_empty  (* runtime option *)
         then
              xatrace := tatracety
         else
             begin
   zu 2.     if xatrace = cpr_trace_empty  (* module option init
             then                           1.durchlauf   *)
                  (* 1. locale initialisierung *)
                  if sqlgap^.oamodtrace = cpr_is_true
                  then
                      xatrace := 2 + sqlmodtracety;
                      (* +2 wird z.Z. nicht abgefragt *)
   zu 3.     if  xatrace <= cpr_trace_long
             then
                 xatrace := oamodsettrty;
             end;
.sp 4
PROCEDURE  p01xmaxsectrinit;
.sp 2
Werden im Traceoutput "*.pct" nur Kommandos verlangt, die
l?anger als maximale Sekunden laufen, so wird ein hier
ein Record allokiert, ?uber den die Steuerung l?auft.
Es wird eine tempr?are Datei er?offnet "SQLTMP.pct", in
der jeweils nur von einem Komando der Trace geschrieben wird.
Falls dieses Kommando l?anger als maxsec l?auft wird
am Ende des Kommandos diese File "SQLTMP.pct" an den "<prog-name>.pct"
File kopiert.
.sp
Da beim Executen eines Kommandos das Komando nicht mehr
bekannt ist,  wird jedes Kommando nach dem Parsen mit der Parsid
und jedes Kommand nach executen mit der Parsid,
das l?anger als maxsec l?auft, in den original
Trace-output geschrieben. Ob ein Kommando nur geparst wurde, wird
in tamaxsecoutp mit cpr_is_true gekennzeichnet.
.sp 4
PROCEDURE p01xwrtrmaxsec;
.sp 2
Sollen nur langlaufende Komandos protokolliert werden, so
wird dies in dieser Procedure untersucht, und anschlie?zend mit
p01xcopy_trmaxsec in den Tracefile kopiert.
Der tempor?are 'SQLTMP.pct" file wird vorher geschlossen und
abschlie?zend wieder neu er?offnet.
.sp 4
PROCEDURE  p01xopentrmaxsec;
.sp 2
Er?offnet den tempor?aren File "SQLTMP.pct" zum Lesen.
.sp 4
PROCEDURE p01xcopy_trmaxsec;
.sp 2
Er?offnet den tempor?aren file zum Lesen und
pr?uft welche Zeilen nach dem Lesen an den originar *.pct
File angeh?angt werden sollen.
.sp 4
.CM *-END-* description ---------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.nf
.oc _/1
Structure:
 
 
(*------------------------------*) 
 
PROCEDURE
      g_init (VAR sqlca : sqlcatype);
 
BEGIN
initialisiere sqlca;
Hole programm Options;
Soll Tracefile er?offnet werden;
IF   NOT options connect
THEN
    BEGIN
    stelle werte f?ur connect im programm bereit;
    END
ELSE
    options_connect;
(*ENDIF*) 
END;
 
.CM *-END-* structure -----------------------------------
.sp 2
**********************************************************
.sp
.cp 10
.nf
.oc _/1
.CM -lll-
Code    :
 
 
(*------------------------------*) 
 
PROCEDURE
      p01xballocate  (VAR sqlca : sqlcatype;
            VAR ga : sqlgaentry;
            index : integer);
 
VAR
      len : tsp00_Int4;
      oldlen : tsp00_Int4;
      ok : boolean;
      var_tsp1_packet_header : tsp1_packet_header;
 
BEGIN
WITH sqlca, sqlmfp^, mfentry^ [index], sqlrap^,
     sqlgap^, var_tsp1_packet_header DO
    IF   (mfBufinit = cpr_is_false)
        OR (mfBufpointer.intaddr = 0)
    THEN
        BEGIN
        ok  := true;
        len := ga.garecptr^.sp1_header.sp1h_varpart_size
              + sizeof (var_tsp1_packet_header);
        pr03mAllocatP(len, mfBufpointer.intaddr, 'mfBufPointer      ');
        IF  (mfBufpointer.intaddr = 0 )
        THEN
            ok := false;
&       ifdef TRACE
        (*ENDIF*) 
        m90int  (pc, 'index       ', index        );
        m90int4 (pc, 'mf_buf len  ', len          );
        m90int4 (pc, 'mf_bufpointe', mfBufpointer.intaddr);
&       endif
        IF  ok
        THEN
            BEGIN
            (* record buffer allocieren *)
            mfrecptrlen := mfReclen;
            (* ADIS 1001675 *)
            IF  (mfReclen > 0)
            THEN
                BEGIN
                pr03mAllocatP(mfrecptrlen, mfrecpointer.intaddr, 'mfrecpointer      ');
                IF  (mfrecpointer.intaddr = 0)
                THEN
                    ok := false;
                (*ENDIF*) 
                END
            ELSE
                BEGIN
                mfrecpointer.intaddr := 0;
                ok : = true
                END;
            (*ENDIF*) 
&           ifdef TRACE
            m90int  (pc, 'mfrecptrlen ', mfrecptrlen  );
&           endif
            IF  ok
            THEN
                mfBufinit := cpr_is_true;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        END
    ELSE
        BEGIN
        ok  := true;
        len := ga.garecptr^.sp1_header.sp1h_varpart_size
              + sizeof (var_tsp1_packet_header);
        oldlen := mfBufpointer.vtypep^.sp1_header.sp1h_varpart_size
              + sizeof (var_tsp1_packet_header);
        IF  oldlen < len
        THEN
            BEGIN
            pr03mFreeP(mfBufpointer.intaddr, 'mfBufpointer      ');
            pr03mAllocatP(len, mfBufpointer.intaddr, 'mfBufpointer      ');
            IF  (mfBufpointer.intaddr = 0)
            THEN
                ok := false;
&           ifdef TRACE
            (*ENDIF*) 
            m90int4 (pc, 'mf_buf len  ', len          );
            m90int4 (pc, 'mf_bufoldlen', oldlen       );
            m90int4 (pc, 'mf_bufpointe', mfBufpointer.intaddr);
&           endif
            END;
        (*ENDIF*) 
        IF  ok
        THEN
            BEGIN
            IF  (mfrecptrlen < mfReclen)
            THEN
                BEGIN
                pr03mFreeP (mfrecpointer.intaddr, 'mfrecpointer      ');
                (* record buffer allocieren *)
                mfrecptrlen := mfReclen;
                pr03mAllocatP(mfrecptrlen, mfrecpointer.intaddr, 'mfrecpointer      ');
&               ifdef TRACE
                m90int  (pc, 'mfrecptrlen ', mfrecptrlen  );
&               endif
                END;
            (*ENDIF*) 
            IF  ok
            THEN
                mfBufinit := cpr_is_true;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        END
    (*ENDIF*) 
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p01xbinit (VAR sqlca : sqlcatype);
 
VAR
      i   : integer;
 
BEGIN
WITH sqlca, sqlmfp^ DO
    BEGIN
    mfselcnt  := 0;
    mfmfetch  := cpr_is_false;
    mffiller  := 0;
    END;
(*ENDWITH*) 
END;
 
&ifdef OLDBF
(*------------------------------*) 
 
PROCEDURE
      p01xcheck (VAR sqlca : sqlcatype;
            VAR sqlxa : sqlxatype);
 
VAR
      ok : boolean;
      pcfor : integer;
 
BEGIN
pcfor := 0;
IF   sqlxa.xalcheck  <> cpr_lhatzelcheck
THEN
    BEGIN
    IF   sqlca.sqlext <> cpr_ghatzelcheck
    THEN
        BEGIN
        IF  sqlxa.xalang = cpr_la_pascal
        THEN
            BEGIN
            p03pointerinit (sqlca, ok);
            sqlca.sqlrap^.ralang := sqlxa.xalang;
            END
        ELSE
            IF  (sqlxa.xalang = cpr_la_cobol){Horst, 5.11.96, PTS 2671}
            THEN
                p03caci (sqlca, sqlxa, pcfor);
            (*ENDIF*) 
        (*ENDIF*) 
        sqlca.sqlcxap^.xalang := sqlxa.xalang; {Horst, 3.6.97, PTS 4570}
        p01_g_init (sqlca);
        END;
    (*ENDIF*) 
    p01_l_init (sqlca, sqlxa);
    sqlxa.xainit := cpr_is_true;
&   ifdef TRACE
    m90int2 (pc, 'oamodtracety', sqlca.sqloap^.oamodtracety );
    m90int2 (pc, 'oamodtrace  ', sqlca.sqloap^.oamodtrace   );
    m90int2 (pc, 'modsettraty ', sqlca.sqloap^.oamodsettrty   );
    m90int2 (pc, 'gamodisolati', sqlca.sqlgap^.gamodisolation );
    m90int2 (pc, 'gaopxuisolat', sqlca.sqlgap^.gaopxuserrec.xu_isolation );
&   endif
    END
ELSE
    BEGIN
    sqlxa.xainit := cpr_is_false;
    END;
(*ENDIF*) 
END;
 
&endif
(*------------------------------*) 
 
PROCEDURE
      p01_g_init (VAR sqlca : sqlcatype);
 
VAR
      i     : integer;
      err   : boolean;
 
BEGIN
WITH sqlca, sqlrap^, sqlgap^, sqlmap^, rasqltap^ DO
    BEGIN
    p03csqlinit (sqlrap, 'R', ralang);
    raactsession := cpr_se_primary;
    sqlmfetch      := 0;
    WITH sqlmfp^, mfdesc DO
        BEGIN
        descMaxelem := 0;
        descNelem := 0;
        descElemSize := sizeof(tpr_mfetchentry);
        descIncr := mxpr_mfetch;
        descElemPtr := s30gad (mfentry);
        END;
    (*ENDWITH*) 
    (* initialisiere sqlca *)
    sqlcaid := cpr_caidconst;
    sqlcabc := sizeof (sqlca);
    p03csqlcaareainit (sqlca);
    sqlext        := cpr_ghatzelcheck;
    pr01eInitFileName(tatracefn);
    tastartdate  := bsp_c8;
    tastarttime  := bsp_c8;
    taenddate    := bsp_c8;
    taendtime    := bsp_c8;
    IF   ralang = cpr_la_c
    THEN
        sqlcaid  [6]  := chr(0);
    (*ENDIF*) 
    sqlmap^.maversion  := 0;
    FOR i := 1 TO mxpr_sqlma DO
        maentry [i] .malen := 0;
    (*ENDFOR*) 
    WITH gaentry[ cpr_se_primary ]^ DO
        BEGIN
        p07senderid (ralang, ratermid, gacmpkind);
        END;
    (*ENDWITH*) 
    WITH gaopxuserrec DO
        BEGIN
        gamodisolation:= cpr_lo_empty;
        xu_key       := bsp_c18;
        xu_fill      := 0;
        xu_servernode:= bsp_nodeid;
        xu_serverdb  := bsp_dbname;
        xu_user      := bsp_knl_identifier;
        xu_password  := bsp_c24;
        xu_sqlmode   := bsp_c8;
        xu_cachelimit:= -1;
        xu_timeout   := -1;
        xu_isolation := cpr_lo_empty;
        xu_dblang    := bsp_knl_identifier;
        xu_userUCS2[1]     := '\0';
        xu_userUCS2[2]     := '\0';
        xu_passwordUCS2[1] := '\0';
        xu_passwordUCS2[2] := '\0';
        END;
    (*ENDWITH*) 
    p03gaxuserinit (sqlgap, sqlemp);
    IF  sqlemp^.elzu = sp1ce_notok
    THEN
        BEGIN
        p01xhalt (cpr_result_xuser_read_err);
        END;
    (*ENDIF*) 
    raactsession := cpr_se_primary;
    sqloap^.oamaxtrstm   := 0;   (* option max f?ur *.pct *)
    (* belege programm parameter *)
    p15optionsget (sqlca);
&   ifdef TRACE
    m90int2 (pc, 'gamodisolati', sqlca.sqlgap^.gamodisolation    );
    m90int2 (pc, 'gaopisolatio', sqlca.sqlgap^.gaopxuserrec.xu_isolation);
&   endif
    IF   sqlemp^.eprerr  <> cpr_p_ok
    THEN
        p01xhalt (cpr_result_option_error);
    (* ermittle ob  connect erfolgen soll *)
    (*ENDIF*) 
    p01xbinit (sqlca);
    sqlca.sqlfill5     := 0;
    sqlca.sqltermref   := 0;
    sqlca.sqldatetime  := cpr_dt_empty;
    sqlca.sqldbmode    := cpr_kind_empty;
    sqlca.sqlrap^.rasqlansi    := cpr_kind_empty;
    sqlca.sqlrap^.ramodeswitch := cpr_kind_empty;
    sqloap^.oamodsettrty    := cpr_trace_off;
    pr01eInitFileName(sqloap^.oamodtracefn);
    sqlresult (0);
    END;
(*ENDWITH*) 
END; (* p01_g_init *)
 
(*------------------------------*) 
 
PROCEDURE
      p01_l_init (VAR sqlca : sqlcatype;
            VAR sqlxa : sqlxatype);
 
BEGIN
WITH sqlca, sqlxa, sqlrap^, rasqltap^, sqloap^  DO
    BEGIN
    xalcheck  := cpr_lhatzelcheck;
    tatrout   := cpr_trace_empty;
    xaprogn   := bsp_knl_identifier;
    xaprogn [1]  := 'T';
    xamodn    := bsp_knl_identifier;
    xaprogc   := 1;
    xamodc    := 0;
    xakano    := 0;
    oamodtrace  := cpr_is_false;
    oamodtracety:= cpr_trace_off;
    IF   sqlrap^.ralang <> cpr_la_call
    THEN
        BEGIN
        sqlxa.sqlsnp.snentcnt := -1;
        sqlxa.xaatmax        := 0;
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p01xvfopentrace  (VAR sqlca : sqlcatype);
 
BEGIN
WITH sqlca, sqlrap^, sqlemp^  DO
    (* ADIS 1000756 *)
    (*    IF   sqlcode >= 0 *)
    (*    THEN *)
    BEGIN
    p03tvfopentrace (sqlrap, vwrite, sqlemp);
    IF  sqlemp^.ereturncode <> 0
    THEN
        p03csqlemptosqlca (sqlca, sqlemp)
    ELSE
        p07trversion(sqlrap);
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p01xvfclosetrace  (VAR sqlca : sqlcatype);
 
BEGIN
WITH sqlca, sqlrap^, sqlemp^  DO
    BEGIN
    p03tvfclosetrace (sqlrap, sqlemp);
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p01xtracefilecheck  (VAR sqlca : sqlcatype;
            VAR sqlxa : sqlxatype);
 
VAR
      nam     : tsp00_Name;
      trlen   : integer;
      retgasqlinit : tsp00_Int2;
      pid : tsp00_Int4;
      pid_open  : boolean;
      pidpos    : tsp00_Int2;
      tracepid  : tsp00_VFilename;
 
BEGIN
WITH sqlca, sqlxa, sqlgap^, sqlrap^, rasqltap^, sqloap^  DO
    BEGIN
    pid_open := false;
    IF  oapidflag = 0
    THEN
        BEGIN
        p01xpidpos (oamodtracefn, pidpos);
        IF  pidpos > 0
        THEN
            oapidflag := pidpos
        ELSE
            oapidflag := - 1;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  oapidflag > 0
    THEN
        BEGIN
        (* filename = 'pid' *)
        p03getpid (pid);
        IF  pid <> oapid
        THEN
            BEGIN
            (** init trace output information **)
            tatraceno := 0;
            oapid     := pid;
            pid_open  := true;
            END;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    sqlca.sqlrap^.ralang   := sqlxa.xalang;
    (*p03csqlcaareainit (sqlca);*)
&   ifdef TRACE
    m90int2 (pc, 'tatracety   ', tatracety );
    m90int2 (pc, 'oamodtracety', oamodtracety );
    m90int2 (pc, 'oamodtrace  ', oamodtrace   );
    m90int2 (pc, 'modsettraty ', oamodsettrty   );
&   endif
    IF  (rasqlinit = cpr_is_end)
    THEN
        BEGIN
        IF  (tatraceno = 0)
        THEN
            BEGIN
            p01xvfopentrace (sqlca);
            END;
        (*ENDIF*) 
        sqlrap^.rasqlinit := cpr_is_false;
        END;
    (*ENDIF*) 
    IF  (sqlrap^.rasqlinit = cpr_is_false)
    THEN
        BEGIN
&       if $OS in  [ UNIX, OS2, WIN32 ]
        p03csqlinit (sqlrap, 'R', sqlrap^.ralang);
&       endif
        END;
    (*ENDIF*) 
    IF   (tatracety <> cpr_trace_empty)
    THEN
        tatrout := tatracety
    ELSE
        BEGIN
        IF  tatrout = cpr_trace_empty
        THEN
            BEGIN
            (* 1. locale initialisierung *)
            IF   (sqloap^.oamodtrace = cpr_is_true)
            THEN
                IF  sqloap^.oamodtracety = cpr_trace_off
                THEN
                    tatrout := cpr_trace_off
                ELSE
                    IF  sqloap^.oamodtracety = cpr_trace_formal
                    THEN
                        tatrout := cpr_trace_modformal
                    ELSE
                        tatrout := cpr_trace_modlong;
                    (*ENDIF*) 
                (*ENDIF*) 
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        IF  tatrout <= cpr_trace_long
        THEN
            tatrout := sqloap^.oamodsettrty;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
&   ifdef TRACE
    m90int2 (pc, 'tatrout     ', tatrout );
    m90int4 (pc, 'tatraceno   ', tatraceno);
    (*  m90buf1 (pc, tatracefn [1], 1, 20); *)
    (*  m90buf1 (pc, xaprogn  [1], 1, 18); *)
&   endif
    IF   (tatraceno = 0)
    THEN
        IF   (tatrout <> cpr_trace_off)
        THEN
            BEGIN
            IF  pid_open
            THEN
                (* prozessid an tracefile setzen "pid<processid>.pct" **)
                BEGIN
                p03getpidtrace (tracepid);
                trlen := s30len1 (tracepid, bsp_c1,
                      VFILENAME_MXSP00);
                s10mv (sizeof(tracepid), sizeof(tatracefn),
                      @tracepid, 1, @tatracefn, oapidflag, trlen);
                END
            ELSE
                BEGIN
                IF   pr01eIsEmptyFileName(tatracefn)
                THEN
                    IF   NOT pr01eIsEmptyFileName(sqloap^.oamodtracefn)
                    THEN
                        tatracefn := sqloap^.oamodtracefn
                    ELSE
                        BEGIN
                        s10mv (sizeof(xaprogn), sizeof(tatracefn),
                              @xaprogn, 1, @tatracefn, 1, xaprogc);
                        trlen := s30len1 (tatracefn, bsp_c1,
                              VFILENAME_MXSP00);
                        IF   rasqlos in [os_unix, os_windows,
                            os_os2, os_win32 ]
                        THEN
                            BEGIN
                            nam := '.pct              '
                            END
                        ELSE
                            IF   rasqlos = os_vms
                            THEN
                                BEGIN
                                nam := 'RVXULG:           ';
                                s10mv (sizeof(nam), sizeof(tatracefn),
                                      @nam, 1, @tatracefn, 1, mxsp_name);
                                trlen := s30len1 (tatracefn, bsp_c1,
                                      sizeof(tatracefn));
                                s10mv (sizeof(xaprogn), sizeof(tatracefn),
                                      @xaprogn, 1, @tatracefn, trlen+1, xaprogc);
                                trlen := s30len1 (tatracefn, bsp_c1,
                                      sizeof(tatracefn));
                                nam := '.PCT              ';
                                END
                            ELSE
                                nam := '  PCTRACE         ';
                            (*ENDIF*) 
                        (*ENDIF*) 
                        s10mv (mxsp_name, sizeof(tatracefn),
                              @nam, 1, @tatracefn, trlen+1, mxsp_name);
                        END;
                    (*ENDIF*) 
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            p01xmaxsectrinit (sqlca, sqlxa);
            retgasqlinit := sqlrap^.rasqlinit;
&           ifdef UNBUFFER
            (* Problem with reopening under windows B.D. *)
            IF  rasqlos = os_windows
            THEN
                BEGIN
                sqlrap^.rasqlinit := cpr_is_end;
                p01xvfopentrace (sqlca);
                sqlrap^.rasqlinit := retgasqlinit;
                END;
&           endif
            (*ENDIF*) 
            p01xvfopentrace (sqlca);
            IF   sqlcode <> 0
            THEN
                BEGIN
                tatraceno := 0;
                tatracety := cpr_trace_off;
                tatrout    := cpr_trace_off;
                END;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
    (*ENDIF*) 
    IF  (raopprof = cpr_is_true)
        OR (raopprof = cpr_is_only_pc)
    THEN
        p03csqlclock (sqlrap, cpr_is_init);
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p01xcmdclose  (VAR sqlca : sqlcatype;
            VAR sqlxa : sqlxatype;
            VAR gae : sqlgaentry);
 
VAR
      ret  : tsp00_Int2;
      cput : tsp00_Int4;
      lineno  : tsp00_Int4;
      i       : integer;
      found   : boolean;
      modname : tsp00_KnlIdentifier;    (* modul-name  *)
 
BEGIN
WITH sqlca, sqlxa, sqlgap^, sqlrap^, sqloap^, rasqltap^ DO
    BEGIN
    IF  (raopprof = cpr_is_true)
        OR (raopprof = cpr_is_only_pc)
    THEN
        BEGIN
        p03csqlclock (sqlrap, cpr_is_end);
&       ifdef TRACE
        m90int4 (pc, 'raprofsec   ', raprofsec);
&       endif
        IF  raactsession > 0
        THEN
            WITH sqlrap^, gae, gaxuserrec, sqlkap^ [xakano] DO
                BEGIN
&               ifdef TRACE
                m90int4 (pc, 'xakano      ', xakano );
                m90int4 (pc, 'kalineno    ', kalineno );
&               endif
                cput := raprofsec;
                lineno := kalineno;
                modname := xamodn;
                IF  lineno <  0
                THEN
                    BEGIN
                    i := 1;
                    found := false;
                    lineno := -kalineno;
                    REPEAT
                        WITH sqlfnp^ [i] DO
                            BEGIN
                            IF  (fnkanomin <= xakano)
                                AND (xakano <= fnkanomax)
                            THEN
                                BEGIN
                                modname := fnfilen;
                                found := true;
                                END;
                            (*ENDIF*) 
                            i := i + 1;
                            END;
                        (*ENDWITH*) 
                    UNTIL
                        (found);
                    (*ENDREPEAT*) 
                    END;
                (*ENDIF*) 
                p16profexec (sqlrap, gae, raprofstmtp, xaprogn,
                      modname, ralang, lineno, kaParseInfo.ParseId, sqlemp);
                p03sysproferror (sqlca, gae);
                END;
            (*ENDWITH*) 
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF   (sqlcode = cpr_database_crash)
    THEN
        BEGIN
        (* implicites connect nach crash_error *)
        sqlcode := 0;
        pr03ConConnect (sqlxa.xaSQLDesc^.ConDesc);
        ret:= gae.gareference;
        p08runtimeerror (sqlca, sqlxa, cpr_reflex_crash);
        gae.gareference := ret;
        END;
    (*ENDIF*) 
    IF  rasqlinit = cpr_is_false
    THEN
        BEGIN
        p03sqlfree (sqlca);
        IF  tatraceno <> 0
        THEN
            BEGIN
            (* implicites programm ende found *)
            p01xvfclosetrace (sqlca);
            rasqlinit := cpr_is_end;
            END;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    p01xchangerror (sqlca);
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p01xchangerror (VAR sqlca : sqlcatype);
 
CONST
      sql801_ora1400  = -1400;
      sql804_ora1007  = -1007;
      sql809_ora1405  = -1405; { PTS 2603, 28.10.96, Horst}
      sql813_ora1034  = -1034;
      sqlw0w3_ora1008 = -1008;
 
BEGIN
WITH sqlca,  sqlrap^  DO
    BEGIN
    IF  (sqldbmode = cpr_kind_oracle)
        OR (sqldbmode = cpr_kind_sapr3)
    THEN
        BEGIN
        IF  (sqlcode = -801)
        THEN
            sqlcode := sql801_ora1400;
        (*ENDIF*) 
        IF  (sqlcode = -804)
        THEN
            sqlcode := sql804_ora1007;
        (*ENDIF*) 
        IF  (sqlcode = -809) { PTS 2603, 28.10.96, Horst}
        THEN
            sqlcode := sql809_ora1405;
        (*ENDIF*) 
        IF  (sqlcode = -813)
        THEN
            sqlcode := sql813_ora1034;
        (*ENDIF*) 
        IF  ( sqlwarn0 = 'W') AND (sqlwarn3 = 'W')
            AND (sqlcode = 0)
        THEN
            BEGIN
            sqlcode  := sqlw0w3_ora1008;
            sqlwarn3 := bsp_c1;
            IF  (sqlwarn1 <> 'W') AND (sqlwarn2 <> 'W')
                AND (sqlwarn3 <> 'W') AND (sqlwarn4 <> 'W')
                AND (sqlwarn5 <> 'W') AND (sqlwarn6 <> 'W')
                AND (sqlwarn7 <> 'W') AND (sqlwarn8 <> 'W')
                AND (sqlwarn8 <> 'W') AND (sqlwarn9 <> 'W')
                AND (sqlwarna <> 'W') AND (sqlwarnb <> 'W')
                AND (sqlwarnc <> 'W') AND (sqlwarnd <> 'W')
                AND (sqlwarne <> 'W') AND (sqlwarnf <> 'W')
            THEN
                sqlwarn0 := bsp_c1;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  (sqldbmode = cpr_kind_oracle)
    THEN
        BEGIN
        IF  (sqlwarn0 = 'W')
        THEN
            BEGIN
            (* warning 1-8 nur an anwender *)
            IF  (sqlwarn1 <> 'W') AND (sqlwarn2 <> 'W')
                AND (sqlwarn3 <> 'W') AND (sqlwarn4 <> 'W')
                AND (sqlwarn5 <> 'W') AND (sqlwarn6 <> 'W')
                AND (sqlwarn7 <> 'W')
            THEN
                sqlwarn0 := bsp_c1;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        IF  (rasqlansi <> cpr_kind_ansi)
            AND  ( sqlcode = 100)
        THEN
            (* row not found = 1403 *)
            sqlcode := 1403;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  (rasqlansi = cpr_kind_ansi)
        AND (radbmode = cpr_kind_internal)
    THEN
        p01xsqlstateget (sqlca);
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p01xsqlstateget (VAR sqlca : sqlcatype);
 
VAR
      warnings     : tsp00_WarningSet;
      i :integer;
 
BEGIN
WITH sqlca DO
    BEGIN
    IF  (sqlcode = 250)
        OR (sqlcode = 300)
        OR (sqlcode = 320)
    THEN
        sqlcode := - sqlcode;
    (*ENDIF*) 
    warnings := [];
    i := sizeof(sqlstate);
    ;
    IF  (sqlcode <> 0)
    THEN
        BEGIN
        i := 1;
        WHILE ( (i < sizeof(sqlstate) ) AND (sqlstate [i] = '0') ) DO
            i := i + 1;
        (*ENDWHILE*) 
        END;
    (*ENDIF*) 
    IF  (sqlwarn1 = 'W')
    THEN
        warnings := [ warn1 ]
    ELSE
        IF  (sqlwarn2 = 'W')
        THEN
            warnings := [ warn2_null_in_builtin_func ];
        (*ENDIF*) 
    (*ENDIF*) 
    IF  (i = sizeof(sqlstate))
    THEN
        s03getsqlstate (sqlcode, warnings, sqlstate);
    (*ENDIF*) 
    sqlstate[6] := chr(0);
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p01xpagethostvariable (VAR sqlca : sqlcatype;
            VAR sqlxa : sqlxatype;
            VAR gae    : sqlgaentry;
            paind     : tsp00_Int2;
            VAR len   : tsp00_Int4);
 
VAR
      error : tpr_runtime_errors;
      vptr      : tpr_vtypepointer;
      iptr      : tpr_vtypepointer;
      va1ind   : integer;
      indind   : integer;
      paix     : integer;
      cnt      : integer;
 
BEGIN
WITH sqlca, sqlxa, sqlpap^ [paind] DO
    BEGIN
    error := cpr_p_ok;
    paix  := paind;
    p03getparameteraddr (sqlca, sqlxa, paix (* paindex *),
          cnt, vptr, va1ind,
          iptr, indind );
    IF  vptr.intaddr = 0
    THEN
        error :=  cpr_missing_variable_addr;
    (*ENDIF*) 
    IF  error = cpr_p_ok
    THEN
        p01xptrgethostvariable (sqlca, sqlxa, gae,
              va1ind , len , error, vptr );
    (*ENDIF*) 
    IF  error <> cpr_p_ok
    THEN
        pr01TraceRuntimeError (sqlca, sqlxa, error);
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p01xptrgethostvariable (VAR sqlca : sqlcatype;
            VAR sqlxa : sqlxatype;
            VAR ga    : sqlgaentry;
            vaind     : tsp00_Int2;
            VAR len   : tsp00_Int4;
            VAR error : tpr_runtime_errors;
            VAR ptr   : tpr_vtypepointer);
 
VAR
      in4 : tsp00_Int4;
      in2 : tsp00_Int2;
      i   : integer;
      part_ptr : tsp1_part_ptr;
 
BEGIN
WITH sqlca, sqlxa, sqlrap^, sqlgap^, ga,
     sqlv1p^ [vaind] DO
    BEGIN
    WITH  sqlv2p^ [va1indva2_sc] DO
        BEGIN
        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
&           ifdef TRACE
            m90int2 (pc, 'va2typ      ', va2typ);
&           endif
            IF  error = cpr_p_ok
            THEN
                BEGIN
                CASE va2typ OF
                    cpr_vbuf, cpr_vchar, cpr_vbchar :
                        BEGIN
                        len := s30klen (ptr.vtypep^, bsp_c1, va2size);
&                       ifdef TRACE
                        m90int2 (pc, 'len         ', len   );
&                       endif
                        IF  len+2 > sp1p_buf_size
                        THEN
                            BEGIN
                            len   := sp1p_buf_size - 2;
                            error := cpr_cmd_too_long;
                            END;
                        (*ENDIF*) 
                        s10mv (sp1p_buf_size, sp1p_buf_size, @ptr.vtypep^, 1,
                              @sp1p_buf, 1, len);
                        sp1p_buf_len := len + 1;
                        END;
                    cpr_vstring4 :
                        BEGIN
                        s10mv (mxsp_c4, mxsp_c4, @ptr.vtypep^, 1,
                              @in4, 1, mxsp_c4);
                        len := in4;
&                       ifdef TRACE
                        m90int4 (pc, 'len         ', len  );
&                       endif
                        IF  len+4 > sp1p_buf_size
                        THEN
                            BEGIN
                            len   := sp1p_buf_size - 4 ;
                            error := cpr_cmd_too_long;
                            END;
                        (*ENDIF*) 
                        s10mv (sp1p_buf_size, sp1p_buf_size, @ptr.vtypep^, 5,
                              @sp1p_buf, 1, len);
                        sp1p_buf_len := len + 1;
                        END;
                    cpr_vstring :
                        BEGIN
                        s10mv (mxsp_c2, mxsp_c2, @ptr.vtypep^, 1,
                              @in2, 1, mxsp_c2);
                        len := in2;
&                       ifdef TRACE
                        m90int2 (pc, 'len         ', len   );
&                       endif
                        IF  len+2 > sp1p_buf_size
                        THEN
                            BEGIN
                            len   := 60;
                            error := cpr_cmd_too_long;
                            END;
                        (*ENDIF*) 
                        s10mv (sp1p_buf_size, sp1p_buf_size, @ptr.vtypep^, 3,
                              @sp1p_buf, 1, len);
                        sp1p_buf_len := len + 1;
                        END;
                    cpr_vstring1 :
                        BEGIN
                        len := ord (ptr.vtypep^.buf[1]);
                        s10mv (sp1p_buf_size, sp1p_buf_size, @ptr.vtypep^, 2,
                              @sp1p_buf, 1, len);
                        sp1p_buf_len := len + 1;
                        END;
                    cpr_vcharc, cpr_vcharz  :
                        BEGIN
                        IF  va2size = cpr_pointerlen
                        THEN
                            len := sp1p_buf_size
                        ELSE
                            len := va2size;
                        (*ENDIF*) 
                        len := s30len (ptr.vtypep^ , chr(0), len);
&                       ifdef TRACE
                        m90int2 (pc, 'len         ', len   );
&                       endif
                        IF  len+2 > sp1p_buf_size
                        THEN
                            BEGIN
                            len   := 60;
                            error := cpr_cmd_too_long;
                            END;
                        (*ENDIF*) 
                        s10mv (sp1p_buf_size, sp1p_buf_size, @ptr.vtypep^, 1,
                              @sp1p_buf, 1, len);
                        sp1p_buf_len := len + 1;
                        END;
                    OTHERWISE:
                        BEGIN
                        error :=  cpr_unknown_datatype;
                        sp1p_buf_len :=  1;
                        END;
                    END;
                (*ENDCASE*) 
                sp1p_buf [sp1p_buf_len] := bsp_c1;
                FOR i := 1 TO sp1p_buf_len DO
                    IF  sp1p_buf [i] = chr (10)
                    THEN
                        (* neue zeile = blank setzen *)
                        sp1p_buf [i] := bsp_c1;
                    (*ENDIF*) 
                (*ENDFOR*) 
                END;
            (*ENDIF*) 
            s26finish_part (gareqptr, part_ptr^);
            END;
        (*ENDWITH*) 
        END;
    (*ENDWITH*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p01xhalt    (result : integer);
 
BEGIN
sqlresult (result);
sqlfinish(true);
END;
 
(*------------------------------*) 
 
PROCEDURE
      p01xprofinit (VAR sqlca : sqlcatype;
            VAR sqlxa : sqlxatype;
            VAR gae : sqlgaentry);
 
BEGIN
IF  (sqlca.sqlrap^.raopprof = cpr_is_true)
    OR (sqlca.sqlrap^.raopprof = cpr_is_only_pc)
THEN
    WITH sqlca, sqlrap^, sqlgap^, gae,
         gaxuserrec, sqlxa DO
        BEGIN
        p03csqlclock (sqlrap, cpr_is_end);
        IF  gaprofinit = cpr_is_false
        THEN
            BEGIN
            p16profinit (sqlrap, gae, xaprogn, ralang, sqlemp) ;
            (*  row nor found = 100 *)
            IF  sqlemp^.ereturncode <> 100
            THEN
                p03sysproferror (sqlca, gae) ;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        IF  sqlca.sqlcode = 0
        THEN
            BEGIN
            gaprofinit := cpr_is_true;
            END;
        (*ENDIF*) 
        p03csqlclock (sqlrap, cpr_is_first);
        (*   ELSE  *)
        (* option switch off  *)
        (* 1.10.91 ** sqlca.sqlrap^.raopprof := cpr_is_false;*)
        END;
    (*ENDWITH*) 
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p01xtimetrace (VAR sqlca : sqlcatype;
            VAR sqlxa : sqlxatype;
            VAR gae : sqlgaentry);
 
VAR
      i       : integer;
      posa    : integer;
      pose    : integer;
      len     : integer;
      nam     : tsp00_Name;
      chr12   : tsp00_C12;
      trfn_pcp : tsp00_VFilename;
      sw   : boolean;
      part_ptr : tsp1_part_ptr;
 
BEGIN
WITH sqlca, sqlxa, sqlrap^, rasqltap^   DO
    IF   (tatrout <> cpr_trace_off)
    THEN
        BEGIN
        IF   sqlresn  <> bsp_knl_identifier
        THEN
            BEGIN
            pr01TraceSQLResultName(sqlrap, sqlresn);
            END;
        (*ENDIF*) 
        IF   (sqlerrd [3] <> 0)
        THEN
            BEGIN
            SAPDB_PascalForcedFill (mxsp_c256, @tastr80, 1, mxsp_c256, bsp_c1);
            nam := 'SQLERRD(INDEX_3) :';
            s10mv (mxsp_name, mxsp_c256, @nam, 1, @tastr80, 1, mxsp_name);
            tastr80l := mxsp_name;
            p05inttochr12 (sqlerrd[3], chr12);
            FOR i := 1 TO mxsp_c12 DO
                tastr80 [tastr80l+i] := chr12 [i];
            (*ENDFOR*) 
            tastr80l := tastr80l + mxsp_c12;
            p08vfwritetrace (sqlca.sqlrap);
            END;
        (*ENDIF*) 
        IF   (sqlerrd [6] <> 0) AND (sqlcode < 0)
            AND  (gae.gareqptr <> NIL)
        THEN
            BEGIN
            pr01TraceErrorPos(sqlca, sqlxa.xaSQLDesc^.ConDesc);
            END;
        (*ENDIF*) 
        IF  ranotrtimeoutp = cpr_is_false
        THEN
            BEGIN
            (* ausgabe max_sec for statement nach sqlerrd[5] *)
            p01x_p_second (sqlca, sqlxa);
            IF   (sqlerrd [5] <> 0)
            THEN
                BEGIN
                SAPDB_PascalForcedFill (mxsp_c256, @tastr80, 1, mxsp_c256, bsp_c1);
                nam := 'SQLERRD(INDEX_5) :';
                s10mv (mxsp_name, mxsp_c256, @nam, 1, @tastr80, 1, mxsp_name);
                tastr80l := mxsp_name;
                p05inttochr12 (sqlerrd[5], chr12);
                FOR i := 1 TO mxsp_c12 DO
                    tastr80 [tastr80l+i] := chr12 [i];
                (*ENDFOR*) 
                tastr80l := tastr80l + mxsp_c12;
                nam := 'SEC. FOR STATEMENT';
                s10mv (mxsp_name, mxsp_c256, @nam, 1,
                      @tastr80, tastr80l, mxsp_name);
                tastr80l := tastr80l+ mxsp_name;
                p08vfwritetrace (sqlca.sqlrap);
                END;
            (*ENDIF*) 
            IF  (rasqlansi = cpr_kind_ansi)
                AND (radbmode = cpr_kind_internal)
            THEN
                BEGIN
                (* sqlstate  ausgabe *)
                p01xsqlstateget (sqlca);
                SAPDB_PascalForcedFill (mxsp_c256, @tastr80, 1, mxsp_c256, bsp_c1);
                nam := 'SQLSTATE   :      ';
                s10mv (mxsp_name, mxsp_c256, @nam, 1, @tastr80, 1, mxsp_name);
                tastr80l := mxsp_name - 3;
                FOR i := 1 TO 5 DO
                    tastr80 [tastr80l+i] := sqlstate [i];
                (*ENDFOR*) 
                tastr80l := tastr80l+ 5;
                p08vfwritetrace (sqlca.sqlrap);
                END;
            (*ENDIF*) 
            nam := 'START  :  DATE :  ';
            (* ausgabe date start   *)
            s10mv (mxsp_name, mxsp_c256, @nam, 1,
                  @tastr80, 1, mxsp_name);
            tastr80l := mxsp_name;
            IF  (tastartdate = bsp_c8)
            THEN
                BEGIN
                sqldattime (tastartdate, tastarttime);
                taenddate := tastartdate;
                taendtime := tastarttime;
                END;
            (*ENDIF*) 
            p01x_p_date (tastartdate, nam);
            s10mv (mxsp_name, mxsp_c256, @nam, 1,
                  @tastr80, tastr80l+1, mxsp_name);
            tastr80l := tastr80l + mxsp_date + 2;
            nam := '    TIME :        ';
            s10mv (mxsp_name, mxsp_c256, @nam, 1,
                  @tastr80, tastr80l+1, mxsp_name);
            tastr80l := tastr80l + mxsp_name - 6;
            p01x_p_time (tastarttime, nam);
            s10mv (mxsp_name, mxsp_c256, @nam, 1,
                  @tastr80, tastr80l+1, mxsp_name);
            tastr80l := tastr80l + mxsp_time + 2;
            p08vfwritetrace (sqlca.sqlrap);
            (* ausgabe date end    *)
            nam := 'END    :  DATE :  ';
            s10mv (mxsp_name, mxsp_c256, @nam, 1,
                  @tastr80, 1, mxsp_name);
            tastr80l := mxsp_name;
            p01x_p_date (taenddate, nam);
            s10mv (mxsp_name, mxsp_c256, @nam, 1,
                  @tastr80, tastr80l+1, mxsp_name);
            tastr80l := tastr80l + mxsp_date + 2;
            nam := '    TIME :        ';
            s10mv (mxsp_name, mxsp_c256, @nam, 1,
                  @tastr80, tastr80l+1, mxsp_name);
            tastr80l := tastr80l + mxsp_name - 6;
            p01x_p_time (taendtime, nam);
            s10mv (mxsp_name, mxsp_c256, @nam, 1,
                  @tastr80, tastr80l+1, mxsp_name);
            tastr80l := tastr80l + mxsp_time + 2;
            p08vfwritetrace (sqlca.sqlrap);
            IF   sqloap^.oamaxsec > 0
            THEN
                p01xwrtrmaxsec (sqlca)
            ELSE
                IF  sqloap^.oamaxtrstm > 0
                THEN
                    BEGIN
                    tacnttrstm := tacnttrstm + 1;
                    IF  tacnttrstm >=  sqloap^.oamaxtrstm
                    THEN
                        BEGIN
                        sw := true;
                        tacnttrstm := 0;
                        trfn_pcp := tatracefn;
                        i := VFILENAME_MXSP00;
                        WHILE (trfn_pcp[i] = bsp_c1) DO
                            i := i - 1;
                        (*ENDWHILE*) 
&                       ifdef TRACE
                        m90int4 (pc, 'i           ', i        );
                        m90filename  (pc, trfn_pcp );
&                       endif
                        IF  i > 4
                        THEN
                            BEGIN
                            IF  (trfn_pcp [i-3] = '.')
                                AND (trfn_pcp [i-2] = 'p')
                                AND (trfn_pcp [i-1] = 'c')
                                AND (trfn_pcp [i]   = 't')
                            THEN
                                BEGIN
                                (* .port *)
                                trfn_pcp [i-1] := 'r';
                                trfn_pcp [i  ] := 'o';
                                trfn_pcp [i+1] := 't';
                                END
                            ELSE
                                IF  (trfn_pcp [i-4] = '.')
                                    AND (trfn_pcp [i-3] = 'p')
                                    AND (trfn_pcp [i-2] = 'r')
                                    AND (trfn_pcp [i-1] = 'o')
                                    AND (trfn_pcp [i]   = 't')
                                THEN
                                    BEGIN
                                    (* .pct *)
                                    trfn_pcp [i-2] := 'c';
                                    trfn_pcp [i-1] := 't';
                                    trfn_pcp [i  ] := ' ';
                                    END
                                ELSE
                                    BEGIN
                                    sw := false;
                                    sqloap^.oamaxtrstm := 0;
                                    END;
                                (*ENDIF*) 
                            (*ENDIF*) 
                            IF  sw
                            THEN
                                BEGIN
                                p01xvfclosetrace (sqlca);
                                tatracefn := trfn_pcp;
                                p01xvfopentrace (sqlca);
                                END;
                            (*ENDIF*) 
                            END;
                        (*ENDIF*) 
                        END;
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
            (*ENDIF*) 
            END;
&       ifdef UNBUFFER
        (*ENDIF*) 
        IF  rasqlos = os_windows
        THEN
            p01xvfclosetrace (sqlca);
&       endif
        (*ENDIF*) 
        END;
    (*ENDIF*) 
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p01x_p_date (VAR dat : tsp00_C8;
            VAR nam : tsp00_Name);
 
VAR
      k : integer;
      n : integer;
 
BEGIN
nam := bsp_name;
n := 2;
FOR k := mxsp_date DOWNTO 1 DO
    BEGIN
    IF   (k = mxsp_date-2)
        OR (k = mxsp_date-4)
    THEN
        BEGIN
        nam [k+n] := '-';
        n := n - 1;
        END;
    (*ENDIF*) 
    nam [k+n] := dat [k] ;
    END;
(*ENDFOR*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p01x_p_time  (VAR tim : tsp00_C8;
            VAR nam : tsp00_Name);
 
VAR
      k : integer;
      n : integer;
 
BEGIN
nam := bsp_name;
n := 2;
FOR k := mxsp_time DOWNTO 1 DO
    BEGIN
    IF   (k = mxsp_time-2)
        OR (k = mxsp_time-4)
    THEN
        BEGIN
        nam [k+n] := ':';
        n := n - 1;
        END;
    (*ENDIF*) 
    nam [k+n] := tim [k] ;
    END;
(*ENDFOR*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p01x_p_second (VAR sqlca : sqlcatype;
            VAR sqlxa : sqlxatype);
 
VAR
      seca : integer;
      sece : integer;
 
BEGIN
WITH sqlca, sqlxa, sqlrap^, rasqltap^ DO
    BEGIN
    sqlerrd [5] := 0;
    IF  tastartdate = taenddate
    THEN
        IF  tastarttime <> taendtime
        THEN
            BEGIN
            seca :=
                  ord (tastarttime[8]) + ord (tastarttime[7]) * 10;
            seca := seca + 60   *
                  (ord (tastarttime[6]) + ord (tastarttime[5]) * 10) ;
            seca := seca + 3600 *
                  (ord (tastarttime[4]) + ord (tastarttime[3]) * 10) ;
            sece :=
                  ord (taendtime[8]) + ord (taendtime[7]) * 10;
            sece := sece + 60   *
                  (ord (taendtime[6]) + ord (taendtime[5]) * 10) ;
            sece := sece + 3600 *
                  (ord (taendtime[4]) + ord (taendtime[3]) * 10) ;
            IF  sece - seca > sqloap^.oamaxsec
            THEN
                sqlerrd [5] := sece - seca;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p01xmaxsectrinit  (VAR sqlca : sqlcatype;
            VAR sqlxa : sqlxatype);
 
VAR
      rec_len : tsp00_Int4;
      hosterr : tsp00_ErrText;
      vferr   : tsp05_RteFileError;
      sqltmppct : tsp00_VFilename;
      nam     : tsp00_Name;
 
BEGIN
WITH sqlca, sqlxa, sqlgap^, sqlrap^, rasqltap^, sqloap^ DO
    IF  (oamaxsec > 0) AND (tamaxsecno = 0)
    THEN
        BEGIN
        pr01eInitFileName(sqltmppct);
        nam := 'SQLTMP.pct        ';
        s10mv (sizeof(nam), sizeof(tatracefn),
              @nam, 1, @tatracefn, 1, mxsp_name);
        tamaxsecfn  := tatracefn;
        tatracefn    := sqltmppct;
        tamaxsecoutp := cpr_is_false;
        sqlfopenp(tamaxsecfn, sp5vf_text, sp5vf_write, sp5bk_buffered,
              tamaxsecno, vferr);
&       ifdef TRACE
        m90int4 (pc, 'tamaxsecno  ', tamaxsecno);
        m90filename  (pc, tamaxsecfn);
&       endif
        END;
    (*ENDIF*) 
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p01xwrtrmaxsec  (VAR sqlca : sqlcatype);
 
BEGIN
WITH sqlca, sqloap^, sqlrap^, rasqltap^ DO
    IF  oamaxsec > 0
    THEN
        BEGIN
        p01xvfclosetrace (sqlca);
        IF  (tamaxsecoutp = cpr_is_true)
            OR (sqlerrd [5] > 0)
        THEN
            BEGIN
            p01xcopy_trmaxsec  (sqlca);
            tamaxsecoutp := cpr_is_false;
            END;
        (*ENDIF*) 
        p01xvfopentrace (sqlca);
        END;
    (*ENDIF*) 
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p01xopentrmaxsec  (VAR sqlca : sqlcatype);
 
BEGIN
WITH sqlca, sqlrap^, sqlemp^  DO
    BEGIN
    p03tvfopentrace (sqlrap, vread, sqlemp);
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p01xcopy_trmaxsec  (VAR sqlca : sqlcatype);
 
VAR
      vferr : tsp05_RteFileError;
      hosterr : tsp00_ErrText;
      len   : tsp00_Longint;
      str80 : tsp00_C80;
      nam_out  : tsp00_Sname;
      nam_sta  : tsp00_Sname;
      writ_ok  : boolean;
 
BEGIN
WITH sqlca, sqlrap^, rasqltap^, sqloap^ DO
    BEGIN
    p01xopentrmaxsec (sqlca);
&   ifdef TRACE
    m90int4 (pc, 'tamaxsecno  ', tamaxsecno);
    m90int4 (pc, 'tatraceno   ', tatraceno );
    m90filename  (pc, tamaxsecfn);
&   endif
    IF  tatraceno <> 0
    THEN
        BEGIN
        sqlfreadp (tatraceno, str80, sizeof(str80), len, vferr);
        nam_out := ': OUTPUT:   ';
        nam_sta := 'START  :  DA';
        writ_ok := true;
        WHILE (vferr.sp5fe_result = vf_ok) DO
            BEGIN
            IF  writ_ok
            THEN
                sqlfwritep(tamaxsecno, str80, len, vferr);
            (*ENDIF*) 
            IF   (s30eq (nam_out, str80, 8, 9))
                AND (sqlerrd [5] = 0)
            THEN
                writ_ok := false
            ELSE
                IF   (s30eq (nam_sta, str80, 1, 9))
                THEN
                    writ_ok := true;
                (*ENDIF*) 
            (*ENDIF*) 
            IF  vferr.sp5fe_result = vf_ok
            THEN
                sqlfreadp  (tatraceno, str80, sizeof(str80), len, vferr);
            (*ENDIF*) 
            END;
        (*ENDWHILE*) 
        END;
    (*ENDIF*) 
    p01xvfclosetrace (sqlca);
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p01xpidpos (VAR tracefn : tsp00_VFilename;
            VAR pidpos  : tsp00_Int2);
 
VAR
      trlen  : tsp00_Int2;
 
BEGIN
pidpos := 0;
trlen := s30len1 (tracefn, bsp_c1,
      VFILENAME_MXSP00);
IF  trlen = 3
THEN
    BEGIN
    IF  (    (tracefn[1] = 'p') OR (tracefn[1] = 'P'))
        AND ((tracefn[2] = 'i') OR (tracefn[2] = 'I'))
        AND ((tracefn[3] = 'd') OR (tracefn[3] = 'D'))
    THEN
        pidpos := 1;
    (*ENDIF*) 
    END
ELSE
    IF  trlen > 3
    THEN
        BEGIN
        IF  (  ((tracefn [trlen] = 'd') OR (tracefn [trlen] = 'D'))
            AND ((tracefn [trlen-1] = 'i') OR (tracefn [trlen-1] = 'I'))
            AND ((tracefn [trlen-2] = 'p') OR (tracefn [trlen-2] = 'P')) )
        THEN
            IF  (tracefn [trlen-3] = '/')
            THEN
                pidpos := trlen - 2;
            (*ENDIF*) 
        (*ENDIF*) 
        END;
    (*ENDIF*) 
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      pr01eklen (VAR str : tsp00_VFilename;
            val : char;
            cnt : integer) : integer;
 
VAR
      i : integer;
      finish : boolean;
 
BEGIN
i := cnt;
finish := false;
pr01eklen := 0;
WHILE  (i >= 1) AND NOT finish DO
    IF  str [ i ] <> val
    THEN
        BEGIN
        pr01eklen := i;
        finish := true;
        END
    ELSE
        i := i-1;
    (*ENDIF*) 
(*ENDWHILE*) 
IF  NOT finish
THEN
    pr01eklen := 0;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      pr01eIsEmptyFileName(filename : tsp00_VFilename) : boolean;
 
BEGIN
IF  pr01eklen(filename, bsp_c1, sizeof(tsp00_VFilename)) <= 0
THEN
    pr01eIsEmptyFileName := true
ELSE
    pr01eIsEmptyFileName := false;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      pr01eInitFileName(VAR filename : tsp00_VFilename);
 
BEGIN
SAPDB_PascalForcedFill (sizeof(filename), @filename, 1, sizeof(filename), bsp_c1);
END;
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
.PA 
