.ad 8
.bm 8
.fm 4
.bt $Copyright (c) 2000-2004 SAP AG$$Page %$
.tm 12
.hm 6
.hs 3
.tt 1 $SQL$Project Distributed Database System$VPC19$
.tt 2 $$$
.TT 3 $$Search-Const_Type_Var-Namen$2000-01-03$
***********************************************************
.nf

.nf


    ========== licence begin  GPL
    Copyright (c) 2000-2004 SAP AG

    This program is free software; you can redistribute it and/or
    modify it under the terms of the GNU General Public License
    as published by the Free Software Foundation; either version 2
    of the License, or (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
    ========== licence end

.fo


.fo
.nf
.sp
MODULE  : Search-Const-Type-Var-Namen
=========
.sp
Purpose : Procedures for get values from sql_packet
          and search from  Const- Type-
          oder Var-names.
.CM *-END-* purpose -------------------------------------
.sp
.cp 3
Define  :
 
        PROCEDURE
              p19getname (VAR apc : tpc_globals;
                    VAR  nam  : tsp00_KnlIdentifier;
                    VAR  len  : integer);
 
        PROCEDURE
              p19sgetname (VAR apc : tpc_globals;
                    VAR  nam  : tsp00_Sname;
                    VAR  len  : integer);
 
        PROCEDURE
              p19lgetname (VAR apc : tpc_globals;
                    VAR  nam  : tsp00_Lname;
                    VAR  len  : integer);
 
        PROCEDURE
              p19scname (VAR apc : tpc_globals;
                    VAR  nam  : tsp00_Lname;
                    VAR  ind  : integer);
 
        PROCEDURE
              p19sprepareprname (VAR apc : tpc_globals;
                    VAR  nam  : tsp00_KnlIdentifier;
                    VAR  ind  : integer);
 
        PROCEDURE
              p19sstatementprname (VAR apc : tpc_globals;
                    VAR  nam  : tsp00_KnlIdentifier;
                    VAR  ind  : integer);
 
        PROCEDURE
              p19scursorprname (VAR apc : tpc_globals;
                    VAR  nam  : tsp00_KnlIdentifier;
                    VAR  ind  : integer);
 
        PROCEDURE
              p19snextsubchar (VAR apc : tpc_globals;
                    anf : integer;
                    VAR pos : integer;
                    VAR subchr : char);
 
        PROCEDURE
              p19addspacevarpart (VAR apc : tpc_globals;
                    VAR pos : integer;
                    VAR anf : integer;
                    VAR plus: integer);
 
        PROCEDURE
              p19putname  (VAR apc : tpc_globals;
                    VAR pos : integer;
                    VAR anf : integer;
                    naml: integer;
                    VAR nam : tsp00_Name);
 
        PROCEDURE
              p19lputname  (VAR apc : tpc_globals;
                    VAR pos : integer;
                    VAR anf : integer;
                    naml: integer;
                    VAR nam : tsp00_Lname);
 
        PROCEDURE
              p19gmacronumber  (VAR apc : tpc_globals;
                    mpos  : integer;
                    VAR mind : integer;
                    VAR nextpos : integer);
 
        FUNCTION
              p19quotecount(VAR apc:tpc_globals;
                    pos,len:integer):integer;
 
        PROCEDURE
              p19cicsexec  (VAR apc : tpc_globals);
 
        FUNCTION
              p19equtm (VAR apc : tpc_globals) : boolean;
 
        PROCEDURE
              p19sgoback (VAR apc : tpc_globals);
 
        PROCEDURE
              p19cobsection  (VAR apc : tpc_globals);
 
        PROCEDURE
              p19mstruct (VAR apc: tpc_globals;
                    varix_in: tsp00_Int2;
                    VAR varix_out: tsp00_Int2);
 
        PROCEDURE
              p19varindex (VAR apc: tpc_globals;
                    VAR vna : tsp00_Lname;
                    strix   : tsp00_Int2;
                    VAR vaindex : tsp00_Int2);
 
        PROCEDURE
              p19typindex (VAR apc: tpc_globals;
                    vtyp: tsp00_Int2;
                    vsize : tsp00_Int4;
                    vdigit: tsp00_Int2;
                    vfrac: tsp00_Int2;
                    VAR index: tsp00_Int2);
 
        PROCEDURE
              p19ptrindex (VAR apc: tpc_globals;
                    vtyp: tsp00_Int2;
                    typar1: tsp00_Int4;
                    typar2: tsp00_Int2;
                    typar3: tsp00_Int2;
                    VAR index: tsp00_Int2);
&       ifdef PASSRC
 
        PROCEDURE
              p19glova (VAR apc : tpc_globals;
                    vaindex: tsp00_Int2);
 
        PROCEDURE
              p19sqlva (VAR apc : tpc_globals;
                    vaindex: tsp00_Int2);
&       endif
 
        PROCEDURE
              p19dydatova (VAR apc : tpc_globals);
 
        PROCEDURE
              p19datova (VAR apc : tpc_globals);
 
        FUNCTION
              p19needvinit  (VAR apc : tpc_globals ;
                    va1index : tsp00_Int2) : boolean;
 
        FUNCTION
              p19need2vinit  (VAR apc : tpc_globals ;
                    va2index : tsp00_Int2) : boolean;
&       ifdef TRACE
 
        PROCEDURE
              p19dmpctvsec (VAR apc : tpc_globals);
&       endif
 
.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :
 
        FROM
              Name table management: VPC19C;
 
        PROCEDURE
              p19varallocate (VAR index : tsp00_Int2);
 
        PROCEDURE
              p19cmpallocate (VAR index : tsp00_Int2);
 
        PROCEDURE
              p19typallocate (VAR index : tsp00_Int2);
 
        PROCEDURE
              p19sqlva (VAR apc : tpc_globals;
                    vaindex: tsp00_Int2);
 
        PROCEDURE
              p19glova (VAR apc : tpc_globals;
                    vaindex: tsp00_Int2);
 
      ------------------------------ 
 
        FROM
              Kommunikation mit Ein-Ausgabeger?ate : VPC11;
 
        PROCEDURE
              p11nerrorlisting  (VAR apc : tpc_globals;
                    VAR nam : tsp00_Lname;
                    naml  : tsp00_Int2;
                    index : tsp00_Int2);
 
        PROCEDURE
              p11precomerror (VAR apc : tpc_globals;
                    error : tpc_pre_errors);
 
      ------------------------------ 
 
        FROM
              Kommunikation mit Ein-Ausgabeger?ate : VPC11B;
 
        PROCEDURE
              p11sebuf (VAR apc: tpc_globals;
                    buflen: tsp00_Int4);
 
      ------------------------------ 
 
        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
              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
              s10mv (
                    source_upb  : tsp00_Int4;       
                    destin_upb  : tsp00_Int4;
                    source      : tsp00_MoveObjPtr;    
                    source_pos  : tsp00_Int4;
                    destin      : tsp00_MoveObjPtr;    
                    destin_pos  : tsp00_Int4;
                    length      : tsp00_Int4);
 
      ------------------------------ 
 
        FROM
              RTE-Extension-30    : VSP30;
 
        FUNCTION
              s30eq (VAR a : tsp00_Sname;
                    VAR b : tpc_prelinetype;
                    bi,cnt : tsp00_Int4) : boolean;
 
        FUNCTION
              s30len (VAR str: tsp00_Lname;
                    val: char; cnt: tsp00_Int4): tsp00_Int4;
&       ifdef TRACE
 
      ------------------------------ 
 
        FROM
              C-Type-Checker-Module  : VPR102;
  
        PROCEDURE
              m90int (layer : tsp00_ToolLayer;
                    nam : tsp00_Sname;
                    int : integer);
 
        PROCEDURE
              m90int2 (layer : tsp00_ToolLayer;
                    nam : tsp00_Sname;
                    int  : tsp00_Int2);
 
        PROCEDURE
              m90name (layer : tsp00_ToolLayer;
                    nam : tsp00_Name);
 
        PROCEDURE
              m90lname (layer : tsp00_ToolLayer;
                    nam : tsp00_Lname);
&       endif
 
.CM *-END-* use -----------------------------------------
.sp;.cp 3
Synonym :
 
        PROCEDURE
              s30eq;
 
              tsp00_MoveObj  tsp00_Sname
              tsp00_MoveObj  tpc_prelinetype
 
        FUNCTION
              s30len;
 
              tsp00_MoveObj  tsp00_Lname
 
.CM *-END-* synonym -------------------------------------
.sp;.cp 3
Author  : 
.sp
.cp 3
Created : 1986-07-07
.sp
.cp 3
Version : 1998-03-12
.sp
.cp 3
Release :      Date : 2000-01-03
.sp
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Specification:
.sp 2
PROCEDURE  P19_GET_NAME:
.sp 2
Fetches a name nam :name of the length len out
of the request segment from the position sypos onwards.
.sp 4
PROCEDURE  P19_SGET_NAME:
.sp 2
Fetches an Sname nam :sname of the length len out
of the request segment from the position sypos onwards.
.sp 4
PROCEDURE  P19_lGET_NAME:
.sp 2
Fetches an Lname nam :lname of the length len out
of the request segment from the position sypos onwards.
.sp 4
PROCEDURE  P19_S_CNAME:
.sp 2
Searches for the name nam in the constants list.
The index ind to the list is = 0, if not found.
.sp 4
PROCEDURE  P19_S_TNAME:
.sp 2
Searches for the name nam in the types list.
The index ind to the list is = 0, if not found.
.sp 4
PROCEDURE  P19_S_FNAME:
.sp 2
Searches in tstruc for the field name nam of the structure (record)
identified by ttypent [strind ]. The index ind points to the
entry in tstruc and is 0 if this has not been found.
.sp 4
PROCEDURE  P19_S_RNAME:
.sp 2
Searches for the name nam in the record variables list.
The index ind to the list is = 0, if not found.
.sp 4
PROCEDURE  P19_S_RVNAME:
.sp 2
Searches for the name nam of the substructure in the reccord
variables list rind. The index ind to the list is = 0, if not found.
.sp 4
PROCEDURE  P19_S_VNAME:
.sp 2
Searches for the name nam in the variables list.
The index ind to the list of the SQLVA area
is = 0, if not found.
.sp 4
PROCEDURE  P19_S_1VNAME:
.sp 2
Searches for the name nam in the variables list and the record
variables list. The index ind to the list is = 0, if not found.
.sp 4
PROCEDURE  P19_S_ARRNAME:
.sp 2
Searches for the name nam in the list of array declarations.
The index ind to the list is = 0, if not found.
.sp 4
PROCEDURE  P19_S_SQLVANAME:
.sp 2
Searches for nam in the SQLVA area; the first
name found is taken. There is no check to see whether
the name occurs in duplicate in substructures.
The index ind to the list is = 0, if not found.
.sp 4
PROCEDURE  P19_S_PREPARE_PRNAME:
.sp 2
Searches for the statement name nam in the SQLPR area with
prstate = cpr_state_prepare or cpr_state_decl_statem.
The index ind to the list is = 0, if not found.
.sp 4
PROCEDURE  P19_S_STATEMENT_PRNAME:
.sp 2
Searches for the statement name nam in the SQLPR area with
prstate = cpr_state_prepare or cpr_state_decl_statem.
The index ind to the list is = 0, if not found.
.sp 4
PROCEDURE  P19_S_CURSOR_PRNAME:
.sp 2
Searches backwards in the list for the cursor name nam
in the SQLPR area with prstate = cpr_state_command.
This means that duplicate cursor names may occur in the case of
'declare' if 'declare' and 'open' always follow
one another statically.
The index ind to the list is = 0, if not found.
.sp 4
PROCEDURE  P19_S_NEXT_SUBCHAR:
.sp 2
Searches in the request segment from the position anf onwards for a
special character (macro = '&', record = '%', parameter = ':',
prepare parameter = '??').
When found the character is sent back in subchar;
the position of the character is given in pos.
Tabs are converted to blanks.
.sp 4
PROCEDURE  P19_S_EXEC_REFLEX:
.sp 2
Searches in the pc_inputline from position anf for the keyword 'exec'.
If found, the position is sent back in pos, otherwise = 0.
In comment the information sent back is: = true , comments are continued
in the next line, = false comments are completed.
.sp 4
PROCEDURE  P19_ADD_SPACE_VARPART:
.sp 2
In the request segment from this position onwards space is made
for plus characters. From the position anf the contents are not
changed.
Part1_length is incremented.
.sp 4
PROCEDURE  P19_PUT_NAME:
.sp 2
Inserts the name nam (max name length) of the length nl in the
request segment from the position pos onwards. The request segment
is not overwritten from the position anf.
.br
If anf is shifted, after the call the new position
is given in anf. Part1_length is set to the new
length.
.sp 4
PROCEDURE  P19_LPUT_NAME:
.sp 2
Inserts the name nam (max lname length) of the length nl in the
request segment from the position pos onwards. The request segment
is not overwritten from the position anf.
.br
If anf is shifted, after the call the new position
is given in anf. Part1_length is set to the new
ausgepr?agte length.
.sp 4
PROCEDURE p19_G_MACRO_NUMBER:
.sp 2
From the position mpos+1 the macro number is fetched as an integer
to mind. In next_pos the position from which point on the command must
still be analyzed is sent back.
.sp 4
PROCEDURE p19_PSA_SQLSA:
.sp 2
Writes the next entries in the SQLSA area.
If nextsa = true a new entry in inserted; if
false only the sacount is incremented.
Area, count, index and struc specify the contents of the entry.
(See vpc00 and vpr01).
.sp 4
PROCEDURE p19_PPA_SQLPA:
.sp 2
Writes the next entry into the SQLPA area (vind, ind).
If ind <> 0 it is checked whether the indicator variable
of the integer data type is 2-byte or 4-byte, otherwise error.
.sp 4
PROCEDURE p19_CICS_EXEC:
.sp 2
Analyzes pc_input lines for CICS evaluations.
.sp 4
PROCEDURE p19_COB_SECTION:
.sp 2
 
.sp 4
FUNCTION  P19_QUOTE_COUNT
.sp 2
Searches for quotes in "partbuf" from the position "pos" for the
length "len", counts them and provides the
number as a result.
.sp 4
PROCEDURE p19_S_FORTEND:
.sp 2
Searches for the keyword 'end ' or 'END ' in the pc_input line
for Fortran. When found, endfound = true is set.
.sp 4
PROCEDURE p19dmpctvsec (VAR apc : tpc_globals);
.sp 2
Dump for the const, type and var sections.
.sp 4
        PROCEDURE
              p19varindex (var apc: tpc_globals;
                    var vna : lname;
                    strix   : int2;
                    VAR vaindex : int2);
 
.sp 4
Search by name an entry in the tpr_symbol table vartable.
.nf
vna     - the name to be searched for
strix   - 0 means, search for a variable,
        > 0 means, search for structure component
vaindex - index into vartable returned, 0 if not found
.fo
.sp 2
        PROCEDURE
              p19_oldvar (VAR apc : tpc_globals;
                    vaindex: int2);
.sp 2
Transformes the entry vaindex of the new tpr_symbol table vartable
into an entry of the old format described by varent. The old
varcnt is incremented by one and entries in the old sqlva are
generated starting with pcva + 1 while updating pcva.
 
***********************************************************
.sp 2
 
PROCEDURE  P19_GET_NAME:
.sp 2
Holt aus dem Auftragssegment ab des Position sypos
einen Namen nam :name  der L?ange len.
.sp 4
PROCEDURE  P19_SGET_NAME:
.sp 2
Holt aus dem Auftragssegment ab des Position sypos
einen Snamen nam :sname der L?ange len.
.sp 4
PROCEDURE  P19_lGET_NAME:
.sp 2
Holt aus dem Auftragssegment ab des Position sypos
einen Lnamen nam :lname der L?ange len.
.sp 4
PROCEDURE  P19_S_CNAME:
.sp 2
Sucht den Namen nam in der Constantenliste.
Der Index ind  auf die  Liste ist = 0,  bei nicht gefunden.
.sp 4
PROCEDURE  P19_S_TNAME:
.sp 2
Sucht den Namen nam in der Typenliste.
Der Index ind auf die  Liste ist = 0,  bei nicht gefunden.
.sp 4
PROCEDURE  P19_S_FNAME:
.sp 2
Sucht in tstruc nach dem Feldnamen nam der durch ttypent [strind ]
bezeichneten Struktur ( Record ). Der Index ind zeigt auf den
Eintrag in tstruc und ist 0, falls dieser nicht gefunden wurde.
.sp 4
PROCEDURE  P19_S_RNAME:
.sp 2
Sucht den Namen nam in der Recordvariablenliste.
Der Index ind auf die  Liste ist = 0,  bei nicht gefunden.
.sp 4
PROCEDURE  P19_S_RVNAME:
.sp 2
Sucht den Namen nam der Unterstrucktur in der Recordvariablenliste rind.
Der Index ind auf die  Liste ist = 0,  bei nicht gefunden.
.sp 4
PROCEDURE  P19_S_VNAME:
.sp 2
Sucht den Namen nam in der Variablenliste.
Der Index ind  auf die  Liste der SQLVA-area
ist = 0,  bei nicht gefunden.
.sp 4
PROCEDURE  P19_S_1VNAME:
.sp 2
Sucht den Namen nam in der Variablenliste und der Recordvariablenliste.
Der Index ind  auf die  Liste ist = 0,  bei nicht gefunden.
.sp 4
PROCEDURE  P19_S_ARRNAME:
.sp 2
Sucht den Namen nam in der Liste der Array - Deklarationen.
Der Index ind  auf die  Liste ist = 0,  bei nicht gefunden.
.sp 4
PROCEDURE  P19_S_SQLVANAME:
.sp 2
Sucht den  nam in der SQLVA-Area, der erste
gefundene Name wird genommen. Es wird nicht gepr?uft,
ob der Name in Unterstruckturen doppelt vorkommt.
Der Index ind  auf die  Liste ist = 0,  bei nicht gefunden.
.sp 4
PROCEDURE  P19_S_PREPARE_PRNAME:
.sp 2
Sucht den Statementnamen nam in der SQLPR-Area mit
prstate = cpr_state_prepare or cpr_state_decl_statem.
Der Index ind  auf die  Liste ist = 0,  bei nicht gefunden.
.sp 4
PROCEDURE  P19_S_STATEMENT_PRNAME:
.sp 2
Sucht den Statementnamen nam in der SQLPR-Area mit
prstate = cpr_state_prepare or cpr_state_decl_statem.
Der Index ind  auf die  Liste ist = 0,  bei nicht gefunden.
.sp 4
PROCEDURE  P19_S_CURSOR_PRNAME:
.sp 2
Sucht den Cursornamen nam in der SQLPR-Area mit
prstate = cpr_state_command r?uckw?arts in der Liste.
Das bedeutet Doppelte Cursornamen  bei 'declare' d?urfen
auftreten, wenn 'declare' und 'open' immer statisch
aufeinander folgen.
Der Index ind  auf die  Liste ist = 0,  bei nicht gefunden.
.sp 4
PROCEDURE  P19_S_NEXT_SUBCHAR:
.sp 2
Sucht im Auftragssegment ab der Positon anf nach einem
Sonderzeichen (Macro = '&', Record = '%', Parameter = ':',
Prepare-Parameter = '??').
In subchar wird das gefundene Zeichen zur?uckgegeben,
in pos steht die Position des Zeichens.
Tab's werden in Blank umgesetzt.
.sp 4
PROCEDURE  P19_S_EXEC_REFLEX:
.sp 2
Sucht in der Pc_inputline ab Position anf das Schl?usselwort 'exec'.
In pos wird die Position bei gefunden zur?uckgegeben, sonst = 0.
In comment wird zur?uckgegeben = true Kommentare werden in n?achster
Zeile fortgesetzt, = false Kommentare sind abgeschlossen.
.sp 4
PROCEDURE  P19_ADD_SPACE_VARPART:
.sp 2
Im Auftragssegment wird ab der Position f?ur plus Charakter
Platz gemacht. Ab der Position anf wird der Inhalt nicht
ver?andert.
Part1_length wird hochgesetzt.
.sp 4
PROCEDURE  P19_PUT_NAME:
.sp 2
F?ugt in das Auftragssegment ab der Position pos
den Namen nam (maxnamelength) der L?ange nl ein. Ab Position anf
wird das Auftragssegment nicht ?uberschrieben.
.br
Bei Verschiebung von anf steht nach dem Aufruf
in anf die neue Position. Part1_length wird auf die neue
ausgepr?agte L?ange gesetzt.
.sp 4
PROCEDURE  P19_LPUT_NAME:
.sp 2
F?ugt in das Auftragssegment ab der Position pos
den Namen nam (maxlnamelength) der L?ange nl ein. Ab Position anf
wird das Auftragssegment nicht ?uberschrieben.
.br
Bei Verschiebung von anf steht nach dem Aufruf
in anf die neue Position. Part1_length wird auf die neue
ausgepr?agte L?ange gesetzt.
.sp 4
PROCEDURE p19_G_MACRO_NUMBER:
.sp 2
Ab der Position mpos+1 wird die Macronummer als Integer nach
mind geholt. In next_pos wird die Position, ab der das Kommando
weiter untersucht werden muss, zur?uck gegeben.
.sp 4
PROCEDURE p19_PSA_SQLSA:
.sp 2
Schreibt in die SQLSA-Area den n?achsten Eintr?age.
Ist nextsa = true  wird ein neuer Eintrag eingef?ugt, bei;
false wird nur der sacount hochgez?ahlt.
area, count, index und struc geben den Inhalt des Eintrags an.
(siehe dazu vpc00 und vpr01).
.sp 4
PROCEDURE p19_PPA_SQLPA:
.sp 2
Schreibt in die SQLPA-Area den n?achsten Eintrag,(vind, ind)..
Es wird gepr?uft bei ind <> 0 , ob die Indicatorvariable
vom Datentyp Integer 2-Byte oder 4-Byte ist, sonst error.
.sp 4
PROCEDURE p19_CICS_EXEC:
.sp 2
Analysiert pc_input Zeilen f?ur CICS Auswertungen.
.sp 4
PROCEDURE p19_COB_SECTION:
.sp 2
 
.sp 4
FUNCTION  P19_QUOTE_COUNT
.sp 2
Sucht in "partbuf" ab der Position "pos" in der L?ange
"len" nach Hochkommas (quotes), z?ahlt sie und liefert die
Anzahl als Ergebnis.
.sp 4
PROCEDURE p19_S_FORTEND:
.sp 2
Sucht in der pc_input Zeile f?ur Fortran nach dem Schl?usselword
'end ' oder 'END '. Bei gefunden wird endfound = true gesetzt.
.sp 4
PROCEDURE p19dmpctvsec (VAR apc : tpc_globals);
.sp 2
Dump der const-, type- und var- sections.
.sp 4
        PROCEDURE
              p19varindex (var apc: tpc_globals;
                    var vna  : lname;
                    strix    : int2;
                    VAR vaindex : int2);
 
.sp 2
Siehe englische Beschreibung oben.
.sp 4
        PROCEDURE
              p19_oldvar (VAR apc : tpc_globals;
                    vaindex: int2);
.sp 2
Siehe englische Beschreibung oben.
.CM *-END-* specification -------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Description:
 
.CM *-END-* description ---------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.nf
.oc _/1
Structure:
 
.CM *-END-* structure -----------------------------------
.sp 2
**********************************************************
.sp
.cp 10
.nf
.oc _/1
.CM -lll-
Code    :
	      
TYPE
      cpr00_MapDatatype = RECORD
         CASE boolean OF
            TRUE  :
                (coltype : tsp00_Int2);
            FALSE :
                (datatype : tsp00_DataType)
            END;
         (*ENDCASE*) 
 
(*------------------------------*) 
 
PROCEDURE
      p19getname (VAR apc : tpc_globals;
            VAR  nam  : tsp00_KnlIdentifier;
            VAR  len  : integer);
 
BEGIN
WITH apc, sqlca, pccmdpart, pcscan DO
    BEGIN
    nam := bsp_knl_identifier;
    IF   sylen > sizeof(tsp00_KnlIdentifier)
    THEN
        len := sizeof(tsp00_KnlIdentifier)
    ELSE
        len := sylen;
    (*ENDIF*) 
    s10mv (partsizlen, sizeof(tsp00_KnlIdentifier), @partbufp^, sypos,
          @nam, 1, len);
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p19sgetname (VAR apc : tpc_globals;
            VAR  nam  : tsp00_Sname;
            VAR  len  : integer);
 
BEGIN
WITH apc, sqlca, pccmdpart, pcscan DO
    BEGIN
    nam := bsp_sname;
    IF   sylen > SNAME_MXSP00
    THEN
        len := SNAME_MXSP00
    ELSE
        len := sylen;
    (*ENDIF*) 
    s10mv (partsizlen, SNAME_MXSP00, @partbufp^, sypos,
          @nam, 1, len);
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p19lgetname (VAR apc : tpc_globals;
            VAR  nam  : tsp00_Lname;
            VAR  len  : integer);
 
BEGIN
WITH apc, sqlca, pccmdpart, pcscan DO
    BEGIN
    nam := bsp_lname;
    IF   sylen > LNAME_MXSP00
    THEN
        len := LNAME_MXSP00
    ELSE
        len := sylen;
    (*ENDIF*) 
    s10mv (partsizlen, LNAME_MXSP00, @partbufp^, sypos,
          @nam, 1, len);
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p19scname (VAR apc : tpc_globals;
            VAR  nam  : tsp00_Lname;
            VAR  ind  : integer);
 
VAR
      i : integer;
 
BEGIN
WITH apc, pccse  DO
    BEGIN
    i := ccnt;
    ind := cbot;
    WHILE i > ind DO
        BEGIN
        IF   csec^ [i] .cname = nam
        THEN
            ind := i;
        (*ENDIF*) 
        i := i - 1;
        END;
    (*ENDWHILE*) 
    IF   ind = cbot
    THEN
        ind := 0;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p19sprepareprname (VAR apc : tpc_globals;
            VAR  nam  : tsp00_KnlIdentifier;
            VAR  ind  : integer);
 
VAR
      i : integer;
 
BEGIN
WITH apc,  sqlxa   DO
    BEGIN
    i := pcpr-1;
    ind := 0;
    WHILE i > ind DO
        BEGIN
&       ifdef TRACE
        m90int2(pc,'i           ',i);
        m90int2(pc,'prstate     ',sqlprp^ [i] .prstate);
&       endif
        IF  (sqlprp^ [i] .prstate = cpr_state_prepare)
            OR  (sqlprp^ [i] .prstate = cpr_state_decl_statem)
            OR  (sqlprp^ [i] .prstate = cpr_state_empty)
        THEN
            IF   sqlprp^ [i] .prStmtName  = nam
            THEN
                ind := i;
            (*ENDIF*) 
        (*ENDIF*) 
        i := i - 1;
        END;
    (*ENDWHILE*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p19sstatementprname (VAR apc : tpc_globals;
            VAR  nam  : tsp00_KnlIdentifier;
            VAR  ind  : integer);
 
VAR
      i : integer;
 
BEGIN
WITH apc,  sqlxa   DO
    BEGIN
    i := pcpr;
    ind := 0;
    WHILE i > ind DO
        BEGIN
        IF  (sqlprp^ [i] .prstate = cpr_state_prepare)
            OR  (sqlprp^ [i] .prstate = cpr_state_decl_statem)
        THEN
            IF   sqlprp^ [i] .prStmtName  = nam
            THEN
                ind := i;
            (*ENDIF*) 
        (*ENDIF*) 
        i := i - 1;
        END;
    (*ENDWHILE*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p19scursorprname (VAR apc : tpc_globals;
            VAR  nam  : tsp00_KnlIdentifier;
            VAR  ind  : integer);
 
VAR
      i : integer;
 
BEGIN
WITH apc,  sqlxa   DO
    BEGIN
    i := pcpr;
    ind := 0;
    WHILE i > ind DO
        BEGIN
        IF  ( sqlprp^ [i] .prstate = cpr_state_command)
            (**** with hold 4.3.94****)
            OR ( sqlprp^ [i] .prstate =  cpr_state_decl_with_hold)
        THEN
            IF   sqlprp^ [i] .prCursorName  = nam
            THEN
                ind := i;
            (*ENDIF*) 
        (*ENDIF*) 
        i := i - 1;
        END;
    (*ENDWHILE*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p19snextsubchar (VAR apc : tpc_globals;
            anf : integer;
            VAR pos : integer;
            VAR subchr : char);
 
VAR
      i     : integer;
      quoch : char;
      ch    : char;
      str   : boolean;
 
BEGIN
pos := 0;
WITH apc, sqlca, pccmdpart DO
    BEGIN
    pos := 0;
    i   := anf;
    str := false;
    subchr := bsp_c1;
    WHILE (i <= part1len) AND (pos = 0) DO
        BEGIN
        ch := partbufp^  [i] ;
        IF   str
        THEN
            BEGIN
            IF   ch = quoch
            THEN
                IF   ch = ''''
                THEN
                    BEGIN
                    IF   partbufp^ [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)
                THEN
                    partbufp^ [i]  := bsp_c1
                ELSE
                    (***** 4.1.94 ******)
                    CASE ch OF
                        cpr_macrochr :
                            IF  (partbufp^ [i+1 ] >= '0')
                                AND (partbufp^ [i+1 ] <= '9')
                            THEN
                                BEGIN
                                subchr := ch;
                                pos := i;
                                END;
                            (*ENDIF*) 
                        cpr_paramchr, cpr_preparechr,  cpr_recordchr2 :
                            BEGIN
                            subchr := ch;
                            pos := i;
                            END;
                        cpr_recordchr3 :
                            IF  (partbufp^ [i+1 ] = cpr_recordchr3)
                            THEN
                                i := i + 1
                            ELSE
                                BEGIN
                                subchr := ch;
                                pos := i;
                                END;
                            (*ENDIF*) 
                        cpr_recordchr :
                            IF   (i <> part1len)
                                AND (partbufp^ [i+1] <> '=')
                            THEN
                                BEGIN
                                subchr := ch;
                                pos := i;
                                END;
                            (*ENDIF*) 
                        OTHERWISE :
                            BEGIN
                            END;
                        END;
                    (*ENDCASE*) 
                (*ENDIF*) 
            (*ENDIF*) 
        (*ENDIF*) 
        (*********   old
              IF   (ch = cpr_macrochr) OR (ch = cpr_paramchr)
              OR (ch = cpr_preparechr)
              OR (ch = cpr_recordchr2)
              OR (ch = cpr_recordchr3)
              OR ((ch = cpr_recordchr) AND
              (i <> part1len))
              THEN
              IF   (((ch = cpr_paramchr) OR (ch = cpr_recordchr)
              OR (ch = cpr_recordchr2)
              OR( (ch = cpr_recordchr3)
              AND (partbufp^ [i+1] <> cpr_recordchr3)))
              AND  (partbufp^ [i+1 ] <> '=')
              AND (partbufp^ [i+1 ] <> bsp_c1))
              OR  ((ch = cpr_macrochr)
              AND  (partbufp^ [i+1 ] >= '0')
              AND (partbufp^ [i+1 ] <= '9'))
              OR (ch = cpr_preparechr)
              THEN
              BEGIN
              subchr := ch;
              pos := i;
              END;
              *********)
        i := i + 1;
        END;
    (*ENDWHILE*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p19addspacevarpart (VAR apc : tpc_globals;
            VAR pos : integer;
            VAR anf : integer;
            VAR plus: integer);
 
VAR
      addlen : integer;
 
BEGIN
WITH apc, sqlca, pccmdpart DO
    BEGIN
    (* ab pos sollen  plus bytes frei werden *)
    (* ab anf sollen bytes nicht ver?andert werden *)
    addlen := plus - (anf - pos);
    IF   part1len + addlen > partsizlen
    THEN
        p11precomerror (apc, cpc_pre_request_area_overflow)
    ELSE
        BEGIN
        IF   anf - pos > 0
        THEN
            SAPDB_PascalForcedFill (partsizlen, @partbufp^, pos, anf-pos, bsp_c1);
        (*ENDIF*) 
        IF   addlen > 0
        THEN
            BEGIN
            SAPDB_PascalForcedOverlappingMove  (partsizlen, partsizlen, @partbufp^, anf,
                  @partbufp^, pos+plus, part1len-anf+1);
            part1len := part1len + addlen;
            anf := pos + plus;
            p11sebuf (apc, part1len);
            END;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p19putname  (VAR apc : tpc_globals;
            VAR pos : integer;
            VAR anf : integer;
            naml: integer;
            VAR nam : tsp00_Name);
 
VAR
      colname : tsp00_Name;
      i       : integer;
 
BEGIN
WITH apc, sqlca, sqlrap^, pccmdpart DO
    BEGIN
    p19addspacevarpart (apc, pos, anf, naml);
    colname := nam;
    IF  ralang in [cpr_la_cobol,cpr_la_cobmic,cpr_la_cob8860]
    THEN
        FOR i:=1 TO naml DO
            IF  colname[i]='-'
            THEN
                colname[i]:='_';
            (*ENDIF*) 
        (*ENDFOR*) 
    (*ENDIF*) 
    s10mv (mxsp_name, partsizlen, @colname, 1, @partbufp^, pos, naml);
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p19lputname  (VAR apc : tpc_globals;
            VAR pos : integer;
            VAR anf : integer;
            naml: integer;
            VAR nam : tsp00_Lname);
 
BEGIN
WITH apc, sqlca, pccmdpart DO
    BEGIN
    p19addspacevarpart (apc, pos, anf, naml);
    s10mv (LNAME_MXSP00, partsizlen, @nam, 1, @partbufp^, pos, naml);
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p19gmacronumber  (VAR apc : tpc_globals;
            mpos  : integer;
            VAR mind : integer;
            VAR nextpos : integer);
 
VAR
      next : boolean;
 
BEGIN
WITH apc, sqlca, pccmdpart DO
    BEGIN
    next := true;
    nextpos := mpos + 1;
    mind := 0;
    REPEAT
        IF   ((partbufp^ [nextpos] ) >= '0')
            AND ((partbufp^ [nextpos] ) <= '9')
        THEN
            BEGIN
            mind := mind * 10 +
                  (ord(partbufp^ [nextpos] ) - ord('0'));
            nextpos := nextpos + 1;
            END
        ELSE
            next := false;
        (*ENDIF*) 
    UNTIL
        (NOT next) OR (nextpos > part1len);
    (*ENDREPEAT*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p19cicsexec  (VAR apc : tpc_globals);
 
VAR
      ready : boolean;
      sec: tsp00_Sname;
      i  : integer;
      hl : tpc_prelinetype;
 
BEGIN
ready := false;
WITH apc,pcinpline,pcopts DO
    BEGIN
    hl := lline;
    FOR i:= opt_begmar TO opt_endmar
          DO
        IF   (hl [i]  in [ 'a'..'i', 'j'..'r',  's'..'z'] )
        THEN
            hl [i] := chr(ord(hl [i] ) + ord('A') - ord('a'));
        (*ENDIF*) 
    (*ENDFOR*) 
    i:=opt_begmar+1;
    sec:=' PROGRAM-ID ';
    WHILE (i<opt_endmar) AND (NOT ready)
          DO
        BEGIN
        IF  (s30eq (sec,hl,i,11)) AND (hl [i+11] IN [' ','.'])
        THEN
            BEGIN
            pccobsect:=cpc_cob_p_id;
            ready := true;
            END;
        (*ENDIF*) 
        i:=i+1;
        END;
    (*ENDWHILE*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      p19equtm  (VAR apc : tpc_globals) : boolean;
 
VAR
      i  : integer;
      hl, sec : tsp00_Name;
 
BEGIN
WITH apc,pcopts DO
    BEGIN
    hl := opt_tpmonid;
    FOR i:= 1 TO mxsp_name
          DO
        IF   (hl [i]  in [ 'a'..'i', 'j'..'r',  's'..'z'] )
        THEN
            hl [i] := chr(ord(hl [i] ) + ord('A') - ord('a'));
        (*ENDIF*) 
    (*ENDFOR*) 
    sec:='UTM               ';
    IF   hl = sec
    THEN
        p19equtm := true
    ELSE
        p19equtm := false;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p19sgoback (VAR apc : tpc_globals);
 
VAR
      ready : boolean;
      sec: tsp00_Sname;
      i  : integer;
      hl : tpc_prelinetype;
 
BEGIN
ready := false;
WITH apc,pcinpline,pcopts DO
    BEGIN
    hl := lline;
    FOR i:= opt_begmar TO opt_endmar
          DO
        IF   (hl [i]  in [ 'a'..'i', 'j'..'r',  's'..'z'] )
        THEN
            hl [i] := chr(ord(hl [i] ) + ord('A') - ord('a'));
        (*ENDIF*) 
    (*ENDFOR*) 
    i:=opt_begmar+1;
    sec:='GOBACK      ';
    WHILE (i<opt_endmar) AND (NOT ready)
          DO
        BEGIN
        IF   s30eq (sec,hl,i,6)
        THEN
            BEGIN
            pccobsect:=cpc_f_goback;
            ready := true;
            END;
        (*ENDIF*) 
        i:=i+1;
        END;
    (*ENDWHILE*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p19cobsection  (VAR apc : tpc_globals);
 
VAR
      sec: tsp00_Sname;
      i  : integer;
      hl : tpc_prelinetype;
 
BEGIN
WITH apc,pcinpline,pcopts DO
    BEGIN
    hl := lline;
    FOR i:= opt_begmar TO opt_endmar
          DO
        IF   (hl [i]  in [ 'a'..'i', 'j'..'r',  's'..'z'] )
        THEN
            hl [i] := chr(ord(hl [i] ) + ord('A') - ord('a'));
        (*ENDIF*) 
    (*ENDFOR*) 
    i:=opt_begmar+1;
    WHILE i<opt_begmar+20
          DO
        BEGIN
        sec:='FILE        ';
        IF   s30eq (sec,hl,i,5)
        THEN
            pccobsect:=cpc_cob_file;
        (*ENDIF*) 
        sec:='WORKING-STOR';
        IF   s30eq (sec,hl,i,12)
        THEN
            pccobsect:=cpc_cob_work;
        (*ENDIF*) 
        sec:='REPORT      ';
        IF   s30eq (sec,hl,i,6)
        THEN
            pccobsect:=cpc_cob_link;
        (*ENDIF*) 
        sec:='LINKAGE     ';
        IF   s30eq (sec,hl,i,7)
        THEN
            pccobsect:=cpc_cob_link;
        (*ENDIF*) 
        sec:='SCREEN      ';
        IF   s30eq (sec,hl,i,6)
        THEN
            pccobsect:=cpc_cob_scre;
        (*ENDIF*) 
        sec:='PROCEDURE   ';
        IF   s30eq (sec,hl,i,9)
        THEN
            pccobsect:=cpc_cob_proc;
        (*ENDIF*) 
        sec:='DECLARATIVES';
        IF   s30eq (sec,hl,i,12)
        THEN
            pccobsect:=cpc_cob_decl;
        (*ENDIF*) 
        sec:='INSPECT     ';
        IF   s30eq (sec,hl,i,7)
        THEN
            pccobsect:=cpc_cob_insp;
        (*ENDIF*) 
        sec:='SQLARGL     ';
        IF   s30eq (sec,hl,i,7)
        THEN
            pccobsect:=cpc_cob_argl;
        (*ENDIF*) 
        sec:='END         ';
        IF   s30eq (sec,hl,i,3)
        THEN
            BEGIN
            i:=i+3;
            WHILE hl [i] =bsp_c1
                  DO
                i:=i+1;
            (*ENDWHILE*) 
            sec:='DECLARATIVES';
            IF   s30eq (sec,hl,i,12)
            THEN
                pccobsect:=cpc_cob_decen;
            (*ENDIF*) 
            END;       (*ENDIF*)
        (*ENDIF*) 
        i:=i+1;
        END;
    (*ENDWHILE*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      p19quotecount(VAR apc:tpc_globals; pos,len:integer):integer;
 
VAR
      i, count : integer;
 
BEGIN
count:=0;
WITH apc, sqlca, pccmdpart DO
    FOR i:= pos TO pos+len
          DO
        IF   partbufp^ [i] = cpr_quotsym
        THEN
            count := count+1;
        (*ENDIF*) 
    (*ENDFOR*) 
(*ENDWITH*) 
p19quotecount := count;
END;
 
(*------------------------------*) 
 
PROCEDURE
      p19dmpctvsec (VAR apc : tpc_globals);
&     ifdef TRACE
 
VAR
      i : integer;
&     endif
 
BEGIN
WITH apc,pccse  DO
&   ifdef TRACE
    BEGIN
    m90int2(pc,'cbot        ',cbot);
    m90int2(pc,'ccnt        ',ccnt);
    IF   ccnt > cbot
    THEN
        BEGIN
        m90name(pc,'pccse.csec        ');
        FOR i := cbot+1 TO ccnt DO
            WITH csec^ [i]  DO
                BEGIN
                m90name(pc,'==================');
                m90int(pc, 'csec-index  ',i);
                m90name(pc,'cname        :    ');
                m90lname(pc,cname);
                m90int2(pc,'cwert       ',cwert)
                END
            (*ENDWITH*) 
        (*ENDFOR*) 
        END;
    (*ENDIF*) 
    END
(*ENDWITH*) 
&endif
END;
 
(*------------------------------*) 
 
PROCEDURE
      p19varindex (VAR apc : tpc_globals;
            VAR vna  : tsp00_Lname;
            strix    : tsp00_Int2;
            VAR vaindex : tsp00_Int2);
 
VAR
      i, cmpix: tsp00_Int2;
 
BEGIN
WITH apc, pcsymtab DO
    BEGIN
    IF  strix > 0
    THEN
        WITH typtablep^ [strix] DO
            BEGIN
            cmpix := tycmpix - 1;
            i := cmpix + tycmcnt;
            WHILE i > cmpix DO
                BEGIN
                IF  vna = vartablep^ [cmpindexp^ [i]].vaname
                THEN
                    cmpix := i;
                (*ENDIF*) 
                i := i - 1;
                END;
            (*ENDWHILE*) 
            IF  cmpix < tycmpix
            THEN
                vaindex := 0
            ELSE
                vaindex := cmpindexp^ [cmpix];
            (*ENDIF*) 
            END
        (*ENDWITH*) 
    ELSE
        BEGIN
        vaindex := varbot;
        i := varcnt;
        WHILE i > vaindex DO
            BEGIN
            IF  (vna = vartablep^ [i].vaname) AND
                (vartablep^ [i].vastrix = 0)
            THEN
                vaindex := i;
            (*ENDIF*) 
            i := i - 1;
            END;
        (*ENDWHILE*) 
        IF  vaindex = varbot
        THEN
            vaindex := 0;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p19mstruct (VAR apc: tpc_globals;
            varix_in: tsp00_Int2;
            VAR varix_out: tsp00_Int2);
 
VAR
      strix: tsp00_Int2;
 
BEGIN
WITH apc, pcsymtab DO
    BEGIN
    varix_out := varix_in;
    strix := vartablep^ [varix_in].vastrix;
&   ifdef TRACE
    m90int2 (pc, 'varix_in ---', varix_in);
    m90int2 (pc, 'varix_out   ', varix_out);
    m90int2 (pc, 'strix       ', strix);
&   endif
    WHILE strix > 0 DO
        BEGIN
        p19_tyvar (apc, strix, varix_out);
&       ifdef TRACE
        m90int2 (pc, 'strix       ', strix);
        m90int2 (pc, 'varix_out   ', varix_out);
&       endif
        IF  varix_out > 0
        THEN
            strix := vartablep^ [varix_out].vastrix
        ELSE
            IF  (varix_out = 0) AND (typtablep^ [strix].typtr = 0)
            THEN
                WITH typtablep^ [strix] DO
                    p19ptrindex (apc, tyindi, 0, tycmpix, 0, strix)
                (*ENDWITH*) 
            ELSE
                strix := 0;
            (*ENDIF*) 
        (*ENDIF*) 
        END;
    (*ENDWHILE*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p19_tyvar (VAR apc: tpc_globals;
            typix: tsp00_Int2;
            VAR vaindex: tsp00_Int2);
 
VAR
      i, j: tsp00_Int2;
 
BEGIN
WITH apc, pcsymtab DO
    BEGIN
    vaindex := varbot;
    i := varcnt;
    WHILE i > vaindex DO
        BEGIN
        IF  vartablep^ [i].vatypix = typix
        THEN
            vaindex := i;
        (*ENDIF*) 
        i := i - 1;
        END;
    (*ENDWHILE*) 
    IF  vaindex = varbot
    THEN
        vaindex := 0;
    (*ENDIF*) 
    IF  vaindex > 0
    THEN
        BEGIN
        j := varbot;
        i := vaindex - 1;
        WHILE i > j DO
            BEGIN
            IF  vartablep^ [i].vatypix = typix
            THEN
                j := i;
            (*ENDIF*) 
            i := i - 1;
            END;
        (*ENDWHILE*) 
        IF  j > varbot
        THEN
            vaindex := -1;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p19typindex (VAR apc: tpc_globals;
            vtyp: tsp00_Int2;
            vsize : tsp00_Int4;
            vdigit: tsp00_Int2;
            vfrac: tsp00_Int2;
            VAR index: tsp00_Int2);
 
VAR
      i: tsp00_Int2;
 
BEGIN
WITH apc, pcsymtab DO
    BEGIN
    index := 0;
    IF  (vtyp <> cpr_vstruct) AND
        (vtyp <> cpr_varray)
    THEN
        BEGIN
        i := typcnt;
        IF  vtyp = cpr_vdecimal
        THEN
            WHILE i > index DO
                WITH typtablep^ [i] DO
                    BEGIN
                    IF  tyindi = vtyp
                    THEN
                        IF  (tydigit = vdigit) AND (tyfrac = vfrac) AND
                            (typtr = 0)
                        THEN
                            index := i;
                        (*ENDIF*) 
                    (*ENDIF*) 
                    i := i - 1;
                    END
                (*ENDWITH*) 
            (*ENDWHILE*) 
        ELSE
            WHILE i > index DO
                WITH typtablep^ [i] DO
                    BEGIN
                    IF  tyindi = vtyp
                    THEN
                        IF  (tysize = vsize) AND (typtr = 0)
                        THEN
                            index := i;
                        (*ENDIF*) 
                    (*ENDIF*) 
                    i := i - 1;
                    END;
                (*ENDWITH*) 
            (*ENDWHILE*) 
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p19ptrindex (VAR apc: tpc_globals;
            vtyp: tsp00_Int2;
            typar1: tsp00_Int4;
            typar2: tsp00_Int2;
            typar3: tsp00_Int2;
            VAR index: tsp00_Int2);
 
VAR
      i: tsp00_Int2;
 
BEGIN
WITH apc, pcsymtab DO
    BEGIN
    index := 0;
    CASE vtyp OF
        cpr_varray:
            BEGIN
            END;
        cpr_vstruct:
            BEGIN
            i := typcnt;
            WHILE i > index DO
                WITH typtablep^ [i] DO
                    BEGIN
                    IF  (typtr = 1) AND (tyindi = vtyp)
                    THEN
                        IF  tycmpix = typar2
                        THEN
                            index := i;
                        (*ENDIF*) 
                    (*ENDIF*) 
                    i := i - 1;
                    END;
                (*ENDWITH*) 
            (*ENDWHILE*) 
            END;
        cpr_vdecimal:
            BEGIN
            i := typcnt;
            WHILE i > index DO
                WITH typtablep^ [i] DO
                    BEGIN
                    IF  (typtr = 1) AND (tyindi = vtyp)
                    THEN
                        IF  (tydigit = typar2) AND (tyfrac = typar3)
                        THEN
                            index := i;
                        (*ENDIF*) 
                    (*ENDIF*) 
                    i := i - 1;
                    END;
                (*ENDWITH*) 
            (*ENDWHILE*) 
            END;
        OTHERWISE:
            BEGIN
            i := typcnt;
            WHILE i > index DO
                WITH typtablep^ [i] DO
                    BEGIN
                    IF  (typtr = 1) AND (tyindi = vtyp)
                    THEN
                        IF  tysize = typar1
                        THEN
                            index := i;
                        (*ENDIF*) 
                    (*ENDIF*) 
                    i := i - 1;
                    END;
                (*ENDWITH*) 
            (*ENDWHILE*) 
            END;
        END;
    (*ENDCASE*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p19datova (VAR apc: tpc_globals);
 
VAR
      z, i, typix, tfrac: tsp00_Int2;
      tindi, tdigit: tsp00_Int2;
      tsize : tsp00_Int4;
      maptype : cpr00_MapDatatype;
 
BEGIN
WITH apc, pcdclgen, sqlca, sqlxa, sqlrap^,
     sqlcxap^.xasqldap.sqldaptr^, pcsymtab DO
    BEGIN
    FOR i := 1 TO sqln DO
        WITH sqlvar [i] DO
            IF  varcnt >= mxpc_varent
            THEN
                p11precomerror (apc, cpc_too_many_type_declared)
            ELSE
                BEGIN
                varcnt := varcnt + 1;
                cmpindexp^ [cmpcnt + i] := varcnt;
                WITH vartablep^ [varcnt] DO
                    BEGIN
                    vasqlix := 0;
                    vacnt := 0;
                    vaglobl := 0;
                    s10mv (sizeof(colname), LNAME_MXSP00, @colname, 1,
                          @vaname, 1, LNAME_MXSP00);
                    vanaml := s30len (vaname, ' ', sizeof(vaname));
                    IF  ralang in [cpr_la_cobol,
                        cpr_la_cobmic, cpr_la_cob8860]
                    THEN
                        FOR z:=1 TO vanaml DO
                            IF  vaname[z]='_'
                            THEN
                                vaname[z]:='-';
                            (*ENDIF*) 
                        (*ENDFOR*) 
                    (*ENDIF*) 
		    maptype.coltype := coltype;
                    CASE maptype.datatype OF
                        dfixed,
                        dsmallint,
                        dinteger :
                            IF  ralang in [cpr_la_cobol,cpr_la_cobmic,
                                cpr_la_cob8860]
                            THEN
                                BEGIN
                                tindi := cpr_vdecimal;
                                tdigit := collength;
                                tsize := collength DIV 2 + 1;
                                tfrac := colfrac;
                                END
                            ELSE
                                BEGIN
                                IF  colfrac = 0
                                THEN
                                    BEGIN
                                    IF  collength > cpr_numblen_int2
                                    THEN
                                        BEGIN
                                        tindi := cpr_vint4;
                                        tdigit := cpr_numblen_int4;
                                        tsize := 4;
                                        END
                                    ELSE
                                        BEGIN
                                        tindi := cpr_vint2;
                                        tdigit := cpr_numblen_int2;
                                        tsize := 2;
                                        END;
                                    (*ENDIF*) 
                                    tfrac := 0;
                                    END
                                ELSE
                                    BEGIN
                                    IF  collength > cpr_numblen_r4
                                    THEN
                                        BEGIN
                                        tindi := cpr_vreal8;
                                        tdigit := cpr_numblen_r8;
                                        tsize := 8;
                                        END
                                    ELSE
                                        BEGIN
                                        tindi := cpr_vreal4;
                                        tdigit := cpr_numblen_r4;
                                        tsize := 4;
                                        END;
                                    (*ENDIF*) 
                                    tfrac := -1;
                                    END;
                                (*ENDIF*) 
                                END;
                            (*ENDIF*) 
                        dfloat, dvfloat :
                            BEGIN
                            IF  collength > cpr_numblen_r4
                            THEN
                                BEGIN
                                tindi := cpr_vreal8;
                                tdigit := cpr_numblen_r8;
                                tsize := 8;
                                END
                            ELSE
                                BEGIN
                                tindi := cpr_vreal4;
                                tdigit := cpr_numblen_r4;
                                tsize := 4;
                                END;
                            (*ENDIF*) 
                            tfrac := -1;
                            END;
                        dcha, dchb, ddate,
                        dtime,  dtimestamp, dvarcharuni,
                        dvarchara, dboolean  :
                            BEGIN
                            IF  ralang = cpr_la_c
                            THEN
                                BEGIN
                                tindi := cpr_vcharc;
                                tsize := collength + 1;
                                END
                            ELSE
                                BEGIN
                                tindi := cpr_vchar;
                                tsize := collength;
                                END;
                            (*ENDIF*) 
                            tdigit := 0;
                            tfrac := 0;
                            END;
                        dstra,
                        dstrb,
                        dlonga,
                        dlongb :
                            BEGIN
                            IF  ralang = cpr_la_c
                            THEN
                                tindi := cpr_vcharc
                            ELSE
                                tindi := cpr_vchar;
                            (*ENDIF*) 
                            tsize := csp_maxint2;
                            tdigit := 0;
                            tfrac := 0;
                            END;
                        dlongdb, dstrdb, ddbyteebcdic :
                            BEGIN
                            IF  ralang = cpr_la_c
                            THEN
                                BEGIN
                                tindi := cpr_vcharc;
                                tsize := 2 * collength + 1;
                                END
                            ELSE
                                BEGIN
                                tindi := cpr_vchar;
                                tsize := 2 * collength;
                                END;
                            (*ENDIF*) 
                            tdigit := 0;
                            tfrac := 0;
                            END;
                        OTHERWISE:
                            BEGIN
                            tindi := cpr_vnone;
                            tsize := 0;
                            tdigit := 0;
                            tfrac := 0;
                            END;
                        END;
                    (*ENDCASE*) 
                    p19typindex (apc, tindi, tsize, tdigit, tfrac, typix);
                    IF  typix = 0
                    THEN
                        IF  typcnt >= mxpc_typent
                        THEN
                            p11precomerror (apc, cpc_too_many_type_declared)
                        ELSE
                            BEGIN
                            typcnt := typcnt + 1;
                            typix := typcnt;
                            WITH typtablep^ [typix] DO
                                BEGIN
                                tyindi := tindi;
                                tysize := tsize;
                                tydigit := tdigit;
                                tyfrac := tfrac;
                                tyref := 0;
                                typtr := 0;
                                END;
                            (*ENDWITH*) 
                            END;
                        (*ENDIF*) 
                    (*ENDIF*) 
                    vatypix := typix;
                    END;
                (*ENDWITH*) 
                END;
            (*ENDIF*) 
        (*ENDWITH*) 
    (*ENDFOR*) 
    IF  indclause = cpr_is_true
    THEN
        BEGIN
        FOR i := 1 TO sqln DO
            WITH sqlvar [i] DO
                IF  varcnt >= mxpc_varent
                THEN
                    p11precomerror (apc, cpc_too_many_type_declared)
                ELSE
                    BEGIN
                    varcnt := varcnt + 1;
                    cmpindexp^ [cmpcnt + sqln + i] := varcnt;
                    WITH vartablep^ [varcnt] DO
                        BEGIN
                        vasqlix := 0;
                        vacnt := 0;
                        vaglobl := 0;
                        vaname [1] := 'I';
                        s10mv (sizeof(colname), LNAME_MXSP00, @colname, 1,
                              @vaname, 2, LNAME_MXSP00 - 1);
                        vanaml := s30len (vaname, ' ', sizeof(vaname));
                        IF  ralang in [cpr_la_cobol,
                            cpr_la_cobmic, cpr_la_cob8860]
                        THEN
                            FOR z:=1 TO vanaml DO
                                IF  vaname[z]='_'
                                THEN
                                    vaname[z]:='-';
                                (*ENDIF*) 
                            (*ENDFOR*) 
                        (*ENDIF*) 
                        p19typindex (apc, cpr_vint2, 2, cpr_numblen_int2, 0, typix);
                        IF  typix = 0
                        THEN
                            IF  typcnt >= mxpc_typent
                            THEN
                                p11precomerror (apc, cpc_too_many_type_declared)
                            ELSE
                                BEGIN
                                typcnt := typcnt + 1;
                                typix := typcnt;
                                WITH typtablep^ [typix] DO
                                    BEGIN
                                    tyref := 0;
                                    typtr := 0;
                                    tyindi := cpr_vint2;
                                    tydigit := cpr_numblen_int2;
                                    tysize := 2;
                                    tyfrac := 0;
                                    END;
                                (*ENDWITH*) 
                                END;
                            (*ENDIF*) 
                        (*ENDIF*) 
                        vatypix := typix;
                        END;
                    (*ENDWITH*) 
                    END;
                (*ENDIF*) 
            (*ENDWITH*) 
        (*ENDFOR*) 
        IF  typcnt >= mxpc_typent
        THEN
            p11precomerror (apc, cpc_too_many_type_declared)
        ELSE
            BEGIN
            typcnt := typcnt + 1;
            FOR i:= sqln + 1 TO 2 * sqln DO
                vartablep^ [cmpindexp^ [cmpcnt + i]].vastrix := typcnt;
            (*ENDFOR*) 
            WITH typtablep^ [typcnt] DO
                BEGIN
                tyref := 0;
                typtr := 0;
                tyindi := cpr_vstruct;
                tysize := 0;
                tycmpix := cmpcnt + sqln + 1;
                tycmcnt := sqln
                END;
            (*ENDWITH*) 
            END;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  typcnt >= mxpc_typent
    THEN
        p11precomerror (apc, cpc_too_many_type_declared)
    ELSE
        BEGIN
        typcnt := typcnt + 1;
        FOR i:= 1 TO sqln DO
            vartablep^ [cmpindexp^ [cmpcnt + i]].vastrix := typcnt;
        (*ENDFOR*) 
        WITH typtablep^ [typcnt] DO
            BEGIN
            tyref := 0;
            typtr := 0;
            tyindi := cpr_vstruct;
            tysize := 0;
            tycmpix := cmpcnt + 1;
            tycmcnt := sqln
            END;
        (*ENDWITH*) 
        cmpcnt := cmpcnt + sqln;
        IF  indclause = cpr_is_true
        THEN
            cmpcnt := cmpcnt + sqln;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p19dydatova (VAR apc: tpc_globals);
 
VAR
      n, z, i, typix, tfrac: tsp00_Int2;
      tmpcmpcnt, tindi, tdigit: tsp00_Int2;
      tsize : tsp00_Int4;
      maptype : cpr00_MapDatatype;
 
BEGIN
WITH apc, pcdclgen, sqlca, sqlxa, sqlrap^,
     sqlcxap^.xasqldap.sqldaptr^, pcsymtab DO
    BEGIN
    IF  indclause = cpr_is_true
    THEN
        n := 2 * sqln
    ELSE
        n := sqln ;
    (*ENDIF*) 
    tmpcmpcnt := cmpcnt ;
    WHILE tmpcmpcnt <= cmpcnt + n
          DO
        BEGIN
        p19cmpallocate (tmpcmpcnt) ;
        END;
    (*ENDWHILE*) 
    FOR i := 1 TO sqln DO
        WITH sqlvar [i] DO
            BEGIN
            p19varallocate (varcnt) ;
            cmpindexp^ [cmpcnt + i] := varcnt;
            WITH vartablep^ [varcnt] DO
                BEGIN
                vasqlix := 0;
                vacnt := 0;
                vaglobl := 0;
                s10mv (sizeof(colname), LNAME_MXSP00, @colname, 1,
                      @vaname, 1, LNAME_MXSP00);
                vanaml := s30len (vaname, ' ', sizeof(vaname));
                IF  ralang in [cpr_la_cobol,
                    cpr_la_cobmic, cpr_la_cob8860]
                THEN
                    FOR z:=1 TO vanaml DO
                        IF  vaname[z]='_'
                        THEN
                            vaname[z]:='-';
                        (*ENDIF*) 
                    (*ENDFOR*) 
                (*ENDIF*) 
		maptype.coltype := coltype;
                CASE maptype.datatype OF
                    dfixed,
                    dsmallint,
                    dinteger :
                        IF  ralang in [cpr_la_cobol,cpr_la_cobmic,
                            cpr_la_cob8860]
                        THEN
                            BEGIN
                            tindi := cpr_vdecimal;
                            tdigit := collength;
                            tsize := collength DIV 2 + 1;
                            tfrac := colfrac;
                            END
                        ELSE
                            BEGIN
                            IF  colfrac = 0
                            THEN
                                BEGIN
                                IF  collength > cpr_numblen_int2
                                THEN
                                    BEGIN
                                    tindi := cpr_vint4;
                                    tdigit := cpr_numblen_int4;
                                    tsize := 4;
                                    END
                                ELSE
                                    BEGIN
                                    tindi := cpr_vint2;
                                    tdigit := cpr_numblen_int2;
                                    tsize := 2;
                                    END;
                                (*ENDIF*) 
                                tfrac := 0;
                                END
                            ELSE
                                BEGIN
                                IF  collength > cpr_numblen_r4
                                THEN
                                    BEGIN
                                    tindi := cpr_vreal8;
                                    tdigit := cpr_numblen_r8;
                                    tsize := 8;
                                    END
                                ELSE
                                    BEGIN
                                    tindi := cpr_vreal4;
                                    tdigit := cpr_numblen_r4;
                                    tsize := 4;
                                    END;
                                (*ENDIF*) 
                                tfrac := -1;
                                END;
                            (*ENDIF*) 
                            END;
                        (*ENDIF*) 
                    dfloat, dvfloat :
                        BEGIN
                        IF  collength > cpr_numblen_r4
                        THEN
                            BEGIN
                            tindi := cpr_vreal8;
                            tdigit := cpr_numblen_r8;
                            tsize := 8;
                            END
                        ELSE
                            BEGIN
                            tindi := cpr_vreal4;
                            tdigit := cpr_numblen_r4;
                            tsize := 4;
                            END;
                        (*ENDIF*) 
                        tfrac := -1;
                        END;
                    dcha, dchb, ddate,
                    dtime,  dtimestamp, dvarcharuni,
                    dvarchara, dboolean  :
                        BEGIN
                        IF  ralang = cpr_la_c
                        THEN
                            BEGIN
                            tindi := cpr_vcharc;
                            tsize := collength + 1;
                            END
                        ELSE
                            BEGIN
                            tindi := cpr_vchar;
                            tsize := collength;
                            END;
                        (*ENDIF*) 
                        tdigit := 0;
                        tfrac := 0;
                        END;
                    dstra,
                    dstrb,
                    dlonga,
                    dlongb :
                        BEGIN
                        IF  ralang = cpr_la_c
                        THEN
                            tindi := cpr_vcharc
                        ELSE
                            tindi := cpr_vchar;
                        (*ENDIF*) 
                        tsize := csp_maxint2;
                        tdigit := 0;
                        tfrac := 0;
                        END;
                    dstrdb, dlongdb, ddbyteebcdic :
                        BEGIN
                        IF  ralang = cpr_la_c
                        THEN
                            BEGIN
                            tindi := cpr_vcharc;
                            tsize := 2 * collength + 1;
                            END
                        ELSE
                            BEGIN
                            tindi := cpr_vchar;
                            tsize := 2 * collength;
                            END;
                        (*ENDIF*) 
                        tdigit := 0;
                        tfrac := 0;
                        END;
                    OTHERWISE:
                        BEGIN
                        tindi := cpr_vnone;
                        tsize := 0;
                        tdigit := 0;
                        tfrac := 0;
                        END;
                    END;
                (*ENDCASE*) 
                p19typindex (apc, tindi, tsize, tdigit, tfrac, typix);
                IF  typix = 0
                THEN
                    IF  typcnt >= mxpc_typent
                    THEN
                        p11precomerror (apc, cpc_too_many_type_declared)
                    ELSE
                        BEGIN
                        p19typallocate (typcnt) ;
                        typix := typcnt;
                        WITH typtablep^ [typix] DO
                            BEGIN
                            tyindi := tindi;
                            tysize := tsize;
                            tydigit := tdigit;
                            tyfrac := tfrac;
                            tyref := 0;
                            typtr := 0;
                            END;
                        (*ENDWITH*) 
                        END;
                    (*ENDIF*) 
                (*ENDIF*) 
                vatypix := typix;
                END;
            (*ENDWITH*) 
            END;
        (*ENDWITH*) 
    (*ENDFOR*) 
    IF  indclause = cpr_is_true
    THEN
        BEGIN
        FOR i := 1 TO sqln DO
            WITH sqlvar [i] DO
                BEGIN
                p19varallocate (varcnt) ;
                cmpindexp^ [cmpcnt + sqln + i] := varcnt;
                WITH vartablep^ [varcnt] DO
                    BEGIN
                    vasqlix := 0;
                    vacnt := 0;
                    vaglobl := 0;
                    vaname [1] := 'I';
                    s10mv (sizeof(colname), LNAME_MXSP00, @colname, 1,
                          @vaname, 2, LNAME_MXSP00 - 1);
                    vanaml := s30len (vaname, ' ', sizeof(vaname));
                    IF  ralang in [cpr_la_cobol,
                        cpr_la_cobmic, cpr_la_cob8860]
                    THEN
                        FOR z:=1 TO vanaml DO
                            IF  vaname[z]='_'
                            THEN
                                vaname[z]:='-';
                            (*ENDIF*) 
                        (*ENDFOR*) 
                    (*ENDIF*) 
                    p19typindex (apc, cpr_vint2, 2, cpr_numblen_int2, 0, typix);
                    IF  typix = 0
                    THEN
                        IF  typcnt >= mxpc_typent
                        THEN
                            p11precomerror (apc, cpc_too_many_type_declared)
                        ELSE
                            BEGIN
                            p19typallocate (typcnt) ;
                            typix := typcnt;
                            WITH typtablep^ [typix] DO
                                BEGIN
                                tyref := 0;
                                typtr := 0;
                                tyindi := cpr_vint2;
                                tydigit := cpr_numblen_int2;
                                tysize := 2;
                                tyfrac := 0;
                                END;
                            (*ENDWITH*) 
                            END;
                        (*ENDIF*) 
                    (*ENDIF*) 
                    vatypix := typix;
                    END;
                (*ENDWITH*) 
                END;
            (*ENDWITH*) 
        (*ENDFOR*) 
        BEGIN
        p19typallocate (typcnt) ;
        FOR i:= sqln + 1 TO 2 * sqln DO
            vartablep^ [cmpindexp^ [cmpcnt + i]].vastrix := typcnt;
        (*ENDFOR*) 
        WITH typtablep^ [typcnt] DO
            BEGIN
            tyref := 0;
            typtr := 0;
            tyindi := cpr_vstruct;
            tysize := 0;
            tycmpix := cmpcnt + sqln + 1;
            tycmcnt := sqln
            END;
        (*ENDWITH*) 
        END;
        END;
    (*ENDIF*) 
    p19typallocate (typcnt) ;
    FOR i:= 1 TO sqln DO
        vartablep^ [cmpindexp^ [cmpcnt + i]].vastrix := typcnt;
    (*ENDFOR*) 
    WITH typtablep^ [typcnt] DO
        BEGIN
        tyref := 0;
        typtr := 0;
        tyindi := cpr_vstruct;
        tysize := 0;
        tycmpix := cmpcnt + 1;
        tycmcnt := sqln
        END;
    (*ENDWITH*) 
    cmpcnt := cmpcnt + n;
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      p19needvinit  (VAR apc : tpc_globals ;
            va1index : tsp00_Int2) : boolean;
 
VAR
      j : integer;
      found : boolean;
 
BEGIN
WITH apc, sqlxa DO
    BEGIN
    found := false;
    j := 1;
    WHILE (NOT found) AND (j <= pcpa)
          DO
        WITH sqlpap^[j] DO
            BEGIN
&           ifdef TRACE
            m90int2 (pc, '==va1index==', va1index);
            m90int2 (pc, '==index ====', j);
            m90int2 (pc, 'pavarno =   ', pavarno);
            m90int2 (pc, 'paindno =   ', paindno);
&           endif
            IF  (va1index = pavarno)
                OR (va1index = paindno)
            THEN
                BEGIN
                found := true ;
&               ifdef TRACE
                m90int2 (pc, '==va1index==', va1index);
&               endif
                END;
            (*ENDIF*) 
            j := j + 1 ;
            END;
        (*ENDWITH*) 
    (*ENDWHILE*) 
    p19needvinit := found ;
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      p19need2vinit  (VAR apc : tpc_globals ;
            va2index : tsp00_Int2) : boolean;
 
VAR
      j : integer;
      found : boolean;
 
BEGIN
WITH apc, sqlxa, pcsqlva DO
    BEGIN
    found := false;
    j := 1;
    WHILE (NOT found) AND (j <= va1cnt)
          DO
        BEGIN
        IF  p19needvinit (apc, j)
        THEN
            WITH sqlv1p^[j] DO
                IF  (va1indva2_sc = va2index)
                THEN
                    found := true ;
                (*ENDIF*) 
            (*ENDWITH*) 
        (*ENDIF*) 
        j := j + 1 ;
        END;
    (*ENDWHILE*) 
    p19need2vinit := found ;
    END;
(*ENDWITH*) 
END;
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
*-PRETTY-*  statements    :        625
*-PRETTY-*  lines of code :       1757        PRETTY  3.09 
*-PRETTY-*  lines in file :       2600         1992-11-23 
.PA 
