.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$VPC10$
.tt 2 $$$
.TT 3 $$Syntax Recognition by precompiler$2000-09-05$
***********************************************************
.nf
 
.nf
 
.nf
 
    ========== licence begin  GPL
    Copyright (c) 2000-2005 SAP AG
 
    This program is free software; you can redistribute it and/or
    modify it under the terms of the GNU General Public License
    as published by the Free Software Foundation; either version 2
    of the License, or (at your option) any later version.
 
    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.
 
    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
    ========== licence end
.fo
 
 
.fo
 
 
.fo
.nf
.sp
MODULE  : Precompiler_Syntax_Erkennung
=========
.sp
Purpose : Syntax recognition by the precompiler.
          Sprachen unabh?angig.
.CM *-END-* purpose -------------------------------------
.sp
.cp 3
Define  :
 
        VAR
              p10kw : tpc_keywords;
              p10ki : tpc_keywordindex;
 
        PROCEDURE
              p10initprecomvariable (VAR apc : tpc_globals);
 
        PROCEDURE
              p10ipass2variable (VAR apc : tpc_globals);
 
        PROCEDURE
              p10getaddrrest  (VAR apc : tpc_globals;
                    VAR sqlda : sqldatype);
 
        PROCEDURE
              p10stringliteralget (VAR apc : tpc_globals;
                    VAR buf : tpc_partbuffer);
 
        PROCEDURE
              p10getkeyword (VAR apc : tpc_globals;
                    VAR buf : tpc_partbuffer;
                    VAR index : integer);
 
        PROCEDURE
              p101getkeyword (VAR apc : tpc_globals;
                    VAR buf : tpc_partbuffer;
                    VAR index : integer);
 
        PROCEDURE
              p10inttochr12 (int : integer;
                    VAR chr12 : tsp00_C12;
                    lnumb     : integer);
 
        PROCEDURE
              p10minttochr (int : integer;
                    VAR chr12 : tsp00_C12;
                    VAR lnumb     : integer);
 
        PROCEDURE
              p10up1casebuf (VAR buf : tsp00_Buf;
                    lwb : integer;
                    upb : integer);
 
        PROCEDURE
              p10up2casebuf (VAR buf : tsp00_Buf;
                    lwb : integer;
                    upb : integer);
 
        PROCEDURE
              p10c6toint2 (VAR apc : tpc_globals;
                    VAR buf : tsp00_Buf;
                    pos  : integer;
                    VAR int : tsp00_Int2);
 
        PROCEDURE
              p10int2unsignedget (VAR apc : tpc_globals;
                    VAR buf : tsp00_Buf;
                    VAR int : tsp00_Int2);
 
        PROCEDURE
              p10xint2unsignedget (VAR apc : tpc_globals;
                    VAR buf : tsp00_Buf;
                    VAR int : tsp00_Int2);
 
        PROCEDURE
              p10int4unsignedget (VAR apc : tpc_globals;
                    VAR buf : tsp00_Buf;
                    VAR int : tsp00_Int4);
 
        PROCEDURE
              p10unixmsdospathname(VAR apc : tpc_globals;
                    VAR args : tsp4_argline;
                    VAR napos, nalen : integer;
                    path_delimiter : char);
 
        PROCEDURE
              p10rmspace (VAR buf : tpc_partbuffer;
                    cpr_quotsym, escsym : char;
                    ind, inplen : tsp00_Int4;
                    VAR  maxbuf, outlen : tsp00_Int4);
 
        PROCEDURE
              p10rm1space (VAR buf : tpc_partbuffer;
                    cpr_quotsym, escsym : char;
                    ind, inplen : tsp00_Int4;
                    VAR  maxbuf, outlen : tsp00_Int4);
&       ifdef TRACE
 
        PROCEDURE
              p10areaprint  (VAR apc : tpc_globals);
&       endif
 
.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :
 
        FROM
              Kommunikation mit Ein-Ausgabeger?ate   : VPC11;
 
        PROCEDURE
              p11precomerror (VAR apc : tpc_globals;
                    error : tpc_pre_errors);
 
      ------------------------------ 
 
        FROM
              RTE-Extension-30    : VSP30;
 
        FUNCTION
              s30gad4 (VAR b : sqldatype) : sqldapointer;
 
      ------------------------------ 
 
        FROM
              C-Type-Checker-Module  : VPR102;
 
        PROCEDURE
              p03gaxuserinit (sqlga : sqlgapointer;
                    errmsg : sqlempointer);
&       ifdef TRACE
 
        PROCEDURE
              m90sname (layer : tsp00_ToolLayer;
                    nam : tsp00_Sname);
 
        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
              m90buf2  (layer : tsp00_ToolLayer;
                    VAR buf :  tpr_intaddr;
                    pos_anf : integer;
                    pos_end : integer);
 
        PROCEDURE
              m90lname (layer : tsp00_ToolLayer;
                    nam : tsp00_Lname);
&       endif
 
      ------------------------------ 
 
        FROM
              Kernel_move_and_fill   : VGG101;
 
        PROCEDURE
              SAPDB_PascalForcedFill (
                    size        : tsp00_Int4;
                    m           : tsp00_MoveObjPtr;
                    pos         : tsp00_Int4;
                    len         : tsp00_Int4;
                    fillchar    : char);
 
        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);
 
.CM *-END-* use -----------------------------------------
.sp;.cp 3
Synonym :
 
        FUNCTION
              s30gad4;
 
              tsp00_Addr          sqldapointer
              tsp00_MoveObj   sqldatype
              tsp00_Int4         sqldapointer
 
        PROCEDURE
              m90buf2;
 
              tsp00_Buf           tpr_intaddr
 
.CM *-END-* synonym -------------------------------------
.sp;.cp 3
Author  :
.sp
.cp 3
Created : 1986-04-02
.sp
.cp 3
.sp
.cp 3
Release :      Date : 2000-09-05
.sp
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Specification:
.sp 2
PROCEDURE  P10_INIT_PRECOM_VARIABLE:
.sp 2
All precompiler variables in apc are initialized.
The option variables pcopts are placed according to
language. The file variables pcvf are preinitialized.
.sp 4
PROCEDURE  P10_GETADDR_REST:
.sp
In the SQLXA area assigns the pointers for the
sqldi, sqlna, sqlop and sqlda areas.
.sp 4
.cp 4
PROCEDURE  P10_NEXT_SYMBOL:
.br;  and  P10_1NEXT_SYBOL:
.sp 2
Searches for the next tpr_symbol in the buffer buf with
the maximum occupancy length buflen. The search is controlled
via the variable pcscan in apc.
.nf
   pcscan :
      scanner type = RECORD
            syposacc : integer;  (* current pos from which to analyze *)
            sypos    : integer;  (* tpr_symbol position *)
            sylen    : integer;  (* tpr_symbol length    *)
            symb     : tpr_symbol;   (* recognized tpr_symbol *)
            symblast : tpr_symbol;   (* if p19_s_exec.string_literal quote*)
                                 (* string constant *)
      END;
.sp;.nf
Input :  syposacc ::  current position from which the search for
                      the next tpr_symbol is run.
Output:  syposacc ::  position of the character from where the search
                      for the next tpr_symbol is to be run.
         sypos    ::  position of the found tpr_symbol
         sylen    ::  length of the found tpr_symbol
         symb     ::  recognized tpr_symbol
.sp 2;.fo
The following symbols are recognized:
.hi 8
 cpr_s_unknown : an unknown tpr_symbol, is recognized in the case of
certain special characters.
.sp
s_begin_comment :
In the case of cpr_la_c, cpr_la_pascal and la_pl1  with string  /*
or (*.
.sp
s_byte_string : recognized if the string begins with the
character x'.
.sp
 cpr_s_colon :  recognized in the course of analysis in the
declare section at the character ':'.
.sp
 cpr_s_comma : ',' character is recognized.
.sp
s_comment : recognized in the case of cpr_la_cobol if the character  '*'
or '/' stands at position 8.
.sp
 cpr_s_divide : '/' character is recognized.
.sp
s_end_comment : in the case of cpr_la_c, cpr_la_pascal and la_pl1
the string */ or *) is recognized.
.sp
 cpr_s_eof :  the cpr_pc_endsign = '!' has been recognized.
.sp
 cpr_s_bufeof : buffer buf has been checked up to buflen.
.sp
 cpr_s_equal : the '=' character is recognized.
.sp
 cpr_s_fixed_point_literal : a fixed number is recognized;
the number contains a '.' or ',' depending on the assignment
of pcopts.opdecpoint.
.sp
*** inactivated ******************************************
* cpr_s_floating_point_literal : a floating-point number is  *
* recognized; the number contains an exponent entry      *
**********************************************************
.sp
s_greater : the '>' character is recognized.
.sp
s_greater_or_eq : the characters '>=' are recognized.
.sp
 cpr_s_identifier : an identifier (name) is recognized.
.sp
 cpr_s_leftindpar : the characters ' [' are recognized.
.sp
 cpr_s_leftpar : the '(' character is recognized.
.sp
s_less : the '<' character is recognized.
.sp
s_less_or_eq : the characters '<=' are recognized.
.sp
 cpr_s_macro : the characters '%xxx' are recognized, where
xxx = a number.
.sp
 cpr_s_minus : the '-' character is recognized.
.sp
 cpr_s_parameter_name : when SQL statements are checked
(pcan.ancomtyp <> cpr_com_empty) ':identifier' is
recognized.
.sp
 cpc_s_period : the characters '..' are recognized.
.sp
 cpr_s_plus : the '+' character is recognized.
.sp
 cpr_s_point : the '.' character is recognized.
 
 cpr_s_rightindpar : the characters '] ' are recognized.
.sp
 cpr_s_rightpar : the ')' character is recognized.
.sp
 cpr_s_semicolon : the ';' character is recognized.
.sp
s_stern : the '*' character is recognized.
.sp
 cpr_s_string_literal : a character string enclosed
in quotes, depending on the assignment of pcopts.opquote,
is recognized. The enclosing quotes are not included
in calculating sypos and sylen.
.br
attention : dobble qoutes in the string will be set to
one. Buffer is changed.
.sp
s_unequal : the characters '<>' are recognized.
.sp
 cpr_s_unsigned_integer : an unsigned number is recognized.
.hi
.sp 4
.cp 4
PROCEDURE  P10_GET_KEYWORD:
.br; and   P10_1GET_KEYWORD:
.sp 2
Uses the information in pcscan. In the case of an cpr_s_identifier
 tpr_symbol, a search is run in the keyword list  p10kw to see whether
this identifier exists, and if it does, the key index is sent back
to the list. If no keyword is found, the index = 0.
.sp 4
.cp 4
PROCEDURE  P10_FGET_KEYWORD:
.sp 2
FORTRAN - Version of P10_GET_KEYWORD.
.sp 4
.cp 4
FUNCTION  P10_KEYWORD_INDEX:
.sp 2
Performs binary search
in the keyword list for the name snam
and sends back the index when found; if it is not found,
index = 0.
.sp
For unix, vms and msdos operating systems,
the search is sequential.
.sp 4
.cp 4
FUNCTION  P10_FKEYWORD_INDEX:
.sp 2
FORTRAN - Version of P10_KEYWORD_INDEX.
.br
A keyword is recognized without the delimiter that follows it
( without the following blank ). The pointer syposacc is set
to the subsequent character after recognition of a keyword;
sylen receives the length of the keyword.
.sp 4
.cp 4
PROCEDURE  P10_0INIT_KEYWORD_TAB:
.br; and   P10_1INIT_KEYWORD_TAB:
.br; and   P10_2INIT_KEYWORD_TAB:
.br; and   P10_3INIT_KEYWORD_TAB:
.sp
The keyword list in general and Fortran is initialized.
.sp 4
.cp 4
PROCEDURE  P10_INT_TO_CHR12:
.sp 2
The procedure converts an integer int into characters.
The converted number is stored right-justified in chr12
in the left part with the length lnumb.
.sp 4
.cp 4
PROCEDURE  P10_UPPERCASE_BUF:
.br; and   P10_1UPPERCASE_BUF:
.sp 2
All lower-case letters outside of string information are
converted to upper-case letters in the buffer buf from the
position lwb to the position upb inclusive.
.sp 4
.cp 4
PROCEDURE  P10_INT2_UNSIGNED_GET:
.sp 2
A number is converted by the buffer buf at the position
of the pcscan information sypos to an integer of the
length 2 int2.
.sp 4
.cp 4
PROCEDURE  P10_INT4_UNSIGNED_GET:
.sp 2
A number is converted by the buffer buf at the position
of the pcscan information sypos to an integer of the
length 4 int4.
.sp 4
.cp 4
PROCEDURE P10_NONBLASTR :
.sp 2
Searches for the next character string in the buffer BUF that contains
no blanks. After it is called, SYPOS points to the start of the string
and SYPOSACC to the next blank. If nothing but blanks were found,
SYPOS = BUFLEN + 1, and if no more blanks were found,
SYPOSACC = BUFLEN + 1.
.sp 4
PROCEDURE P10_UNIXMSDOS_PATHNAME :
.sp 2
Analysis of a UNIX or MSDOS path name and isolation of the file name.
The postfix initiated by the last '.' (file type) is stripped.
.sp 4
.cp 8
PROCEDURE
        p10rmspace (VAR buf : tpc_partbuffer;
                     cpr_quotsym, escsym : char;
                     ind, inplen : int4;
                     VAR  maxbuf, outlen : int4);
.br; and  p10rm1space:
.sp 2
Removes redundant blanks from a text. Leading blanks and blanks
following the text are removed. Character strings are not modified.
In all other cases strings of blanks are each replaced by
one blank.
.br
Parameters:
.br
.nf
buf       : contains the text.
 cpr_quotsym   : delimiter of character strings within the text.
            The start of the text is considered as being outside a
            character string. The text may end inside a character string;
            following blanks are then not removed.
escsym    : "Escape" tpr_symbol, by means of which the delimiters of strings
            are masked within the string. They may also both be the
            same, for example: \" or ''.
ind       : start index of the text in buf.
inplen    : length of the input text.
            The search is run within the limits ind .. ind + inplen - 1 only.
maxbuf    : length of the text buffer buf. When blanks are removed the
            entired buffer buf [1..maxbuf] is always compressed and then
            maxbuf is decremented by the amount shifted.
outlen    : length of the reduced text.
.sp 2
***********************************************************
.sp 2
 
PROCEDURE  P10_INIT_PRECOM_VARIABLE:
.sp 2
Alle Precompiler Variablen in apc werden initalisiert.
Die Optionsvariablen pcopts werden Sprachen abh?angig
gelegt. Die Filevariablen pcvf werden vor initalisiert.
.sp 4
PROCEDURE  P10_GETADDR_REST:
.sp
Belegt in der SQLXA-Area die Pointer f?ur die
sqldi- sqlna- sqlop- und sqlda-Area.
.sp 4
.cp 4
PROCEDURE  P10_NEXT_SYMBOL:
.br;  sowie P10_1NEXT_SYBOL:
.sp 2
Sucht in dem Puffer buf mit der maximalen Belegungsl?ange
buflen das n?achste Symbol. Die Suche wird ?uber die
Variable pcscan in apc gesteuert.
.nf
   pcscan :
      tpr_scannertype = RECORD
            syposacc : integer;  (* aktuelle pos ab der analys. wird *)
            sypos    : integer;  (* tpr_symbol position *)
            sylen    : integer;  (* tpr_symbol l?ange    *)
            symb     : tpr_symbol;   (* erkanntes tpr_symbol *)
      END;
.sp;.nf
Input :  syposacc ::  actuelle Position ab der das n?achste
                      Symbol gesucht wird.
Output:  syposacc ::  Position des Zeichens, ab dem das n?achste
                      Symbol gesucht werden soll.
         sypos    ::  Position des gefundenen Symbols
         sylen    ::  L?ange des gefundenen Symbols
         symb     ::  erkanntes Symbol
.sp 2;.fo
Folgende Symbole werden erkannt :
.hi 8
 cpr_s_unknown : ein Unbekanntes Symbol, wird erkannt bei
bestimmten Sonderzeichen
.sp
s_begin_comment :
Bei cpr_la_c, cpr_la_pascal und la_pl1  bei String  /*
oder (*.
.sp
s_byte_string : wird erkannt, wenn String mit Zeichen
x' beginnt.
.sp
 cpr_s_colon :  wird bei der Analyse in den Declaresection
erkannt beim Zeichen ':'.
.sp
 cpr_s_comma : Zeichen ',' wird erkannt.
.sp
s_comment : wird bei cpr_la_cobol erkannt wenn an Position
8 das Zeichen '*' oder '/' steht.
.sp
 cpr_s_divide : Zeichen '/' wird erkannt.
.sp
s_end_comment : bei cpr_la_c, cpr_la_pascal und la_pl1 wird
der String */ oder *) erkannt.
.sp
 cpr_s_eof :  das cpr_pc_endsign = '!' wurde erkannt.
.sp
 cpr_s_bufeof : Puffer buf wurde bis buflen untersucht.
.sp
 cpr_s_equal : das Zeichen '=' wird erkannt.
.sp
 cpr_s_fixed_point_literal : eine Fixedzahl wird erkannt,
die Zahl enth?alt einen '.' oder ',' je nach Belegung
von pcopts.opdecpoint.
.sp
*** wurde inaktiviert ************************************
* cpr_s_floating_point_literal : eine Floatzahl wird erkannt,*
* die Zahl enth?alt eine Exponentenangabe.               *
**********************************************************
.sp
s_greater : das Zeichen '>' wird erkannt.
.sp
s_greater_or_eq : die Zeichen '>=' werden erkannt.
.sp
 cpr_s_identifier : ein Identifier (Name) wird erkannt.
.sp
 cpr_s_leftindpar : die Zeichen ' [' werden erkannt.
.sp
 cpr_s_leftpar : das Zeichen '(' wird erkannt.
.sp
s_less : das Zeichen '<' wird erkannt.
.sp
s_less_or_eq : die Zeichen '<=' werden erkannt.
.sp
 cpr_s_macro : die Zeichen '%xxx' werden erkannt, mit
xxx = eine Zahl.
.sp
 cpr_s_minus : das Zeichen '-' wird erkannt.
.sp
 cpr_s_parameter_name : bei Untersuchung von SQL-Statements
(pcan.ancomtyp <> cpr_com_empty) wird ':identifier'
erkannt.
.sp
 cpc_s_period : die Zeichen '..' werden erkannt.
.sp
 cpr_s_plus : das Zeichen '+' wird erkannt.
.sp
 cpr_s_point : das Zeichen '.' wird erkannt.
.sp
 cpr_s_rightindpar : die Zeichen '] ' werden erkannt.
.sp
 cpr_s_rightpar : das Zeichen ')' wird erkannt.
.sp
 cpr_s_semicolon : das Zeichen ';' wird erkannt.
.sp
s_stern : das Zeichen '*' wird erkannt.
.sp
 cpr_s_string_literal : Eine Zeichenkette eingeschlossen
in Hochkomma, je nach Belegung von pcopts.opquote
wird erkannt. Die einschlie?zenden Hochkommas werden
bei sypos und sylen nicht mit gerechnet.
.br
achtung : doppelte Hochkomma innerhalb des Strings werden in
einfache umgesetzt. Puffer ?Anderung.
.sp
s_unequal : die Zeichen '<>' werden erkannt.
.sp
 cpr_s_unsigned_integer : eine Vorzeichenlose Zahl wird erkannt.
.hi
.sp 4
.cp 4
PROCEDURE  P10_GET_KEYWORD:
.br; sowie P10_1GET_KEYWORD:
.sp 2
Benutzt die Angaben in pcscan. Bei Einem Symbol cpr_s_identifier
wird in der Keywordlist  p10kw nachgesehen, ob dieser Identifier
existiert und bei ja, wird der Keyindex in der Liste zur?uckgegeben.
Wird kein Keyword gefunden ist der Index = 0.
.sp 4
.cp 4
PROCEDURE  P10_FGET_KEYWORD:
.sp 2
FORTRAN - Version von P10_GET_KEYWORD.
.sp 4
.cp 4
FUNCTION  P10_KEYWORD_INDEX:
.sp 2
Sucht bin?ar
in der keywordlist nach dem Namen snam
und liefert den gefunden Index zur?uck, bei nicht gefunden
ist Index = 0.
.sp
F?ur BS-System os_unix, os_vms und os_msdos wird
sequentiell gesucht.
.sp 4
.cp 4
FUNCTION  P10_FKEYWORD_INDEX:
.sp 2
FORTRAN - Version von P10_KEYWORD_INDEX.
.br
Ein Schl?usselwort wird ohne folgenden Begrenzer ( ohne folgendes Leer-
zeichen ) erkannt. Der Zeiger syposacc wird nach Erkennung eines Schl?us-
selwortes auf das Folgezeichen gesetzt, sylen erh?alt die L?ange des
Schl?usselwortes.
.sp 4
.cp 4
PROCEDURE  P10_0INIT_KEYWORD_TAB:
.br; sowie P10_1INIT_KEYWORD_TAB:
.br; sowie   P10_2INIT_KEYWORD_TAB:
.br; sowie   P10_3INIT_KEYWORD_TAB:
.sp
Die Keywordliste allgemein und Fortran wird initialisiert.
.sp 4
.cp 4
PROCEDURE  P10_INT_TO_CHR12:
.sp 2
Die Procedure wandelt einen Integer int in Charakterzeichen um.
Die umgewandelte Zahl wird in chr12 im linken Teil der L?ange
lnumb Rechtsb?undig abgelegt.
.sp 4
.cp 4
PROCEDURE  P10_UPPERCASE_BUF:
.br; sowie P10_1UPPERCASE_BUF:
.sp 2
Alle Kleinbuchstaben au?zerhalb von Stringangaben werden in
Gro?zbuchstaben im Puffer buf ab der Position lwb bis
zur Position upb einschlie?zlich umgewandelt.
.sp 4
.cp 4
PROCEDURE  P10_INT2_UNSIGNED_GET:
.sp 2
Eine Zahl wird vom Puffer buf an der Position der
 pcscan Angaben sypos in einen Integer der L?ange 2 int2
umgewandelt.
.sp 4
.cp 4
PROCEDURE  P10_INT4_UNSIGNED_GET:
.sp 2
Eine Zahl wird vom Puffer buf an der Position der
 pcscan Angaben sypos in einen Integer der L?ange 4 int4
umgewandelt.
.sp 4
.cp 4
PROCEDURE P10_NONBLASTR :
.sp 2
Suchen der naechsten Zeichenfolge im Puffer BUF, die kein Leerzeichen
enth?alt.Nach dem Aufruf zeigt SYPOS auf den Anfang dieser Folge,
SYPOSACC auf das naechste Leerzeichen. Wurden nur noch Leerzeichen
gefunden, ist SYPOS = BUFLEN + 1, wurde kein Leerzeichen mehr gefunden,
ist SYPOSACC = BUFLEN + 1.
.sp 4
PROCEDURE P10_UNIXMSDOS_PATHNAME :
.sp 2
Analyse eines UNIX- MSDOS- pathname und Isolieren des filename. Der durch
das letzte '.' eingeleitete Postfix (filetype) wird gestrippt.
.sp 4
.cp 8
PROCEDURE
        p10rmspace (VAR buf : tpc_partbuffer;
                     cpr_quotsym, escsym : char;
                     ind, inplen : int4;
                     VAR  maxbuf, outlen : int4);
.br; sowie p10rm1space:
.sp 2
Entfernen redundanter Leerzeichen aus einem Text: F?uhrende und dem Text
folgende Leerzeichen werden entfernt. Zeichenketten werden nicht ver?andert.
In allen anderen F?allen werden Folgen von Leerzeichen durch jeweils ein
Leerzeichen ersetzt.
.br
Parameter:
.br
.nf
buf       : enth?alt den Text.
 cpr_quotsym   : Begrenzer von Zeichenketten innerhalb des Textes.
            Der Textanfang wird als au?zerhalb einer Zeichenkette stehend
            betrachtet. Der Text darf innerhalb einer Zeichenkette enden,
            folgende Leerzeichen werden dann nicht entfernt.
escsym    : "Escape"-Zeichen, mit dem innerhalb von Zeichenketten deren
            Begrenzer maskiert wird. Beide k?onnen auch gleich sein.
            Beispiele: \" oder ''.
ind       : Anfangsindex des Textes in buf.
inplen    : L?ange des Eingabetextes.
            Nur innerhalb der Grenzen ind .. ind + inplen - 1 wird gesucht.
maxbuf    : L?ange des Textpuffers buf. Beim Entfernen von Leerzeichen wird
            stets der gesamte Puffer buf [1..maxbuf] komprimiert und danach
            maxbuf um den Verschiebungsbetrag vermindert.
outlen    : L?ange des reduzierten Textes.
.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    :
 
 
CONST
      (* ------drucker konstanten----------- *)
      p10_linepropage       = 55;
      p10_charproline       = 130;
 
 
(*------------------------------*) 
 
PROCEDURE
      p10shift (VAR buf : tpc_partbuffer;
            ind, shift : tsp00_Int4;
            VAR maxind : tsp00_Int4);
 
VAR
      i : integer;
 
BEGIN
IF   shift > 0
THEN
    IF   ind+shift <= maxind
    THEN
        BEGIN
        FOR i:= ind+shift TO maxind DO
            buf [i-shift] := buf [i] ;
        (*ENDFOR*) 
        maxind := maxind-shift
        END
    ELSE
        maxind := ind-1
    (*ENDIF*) 
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      p10keyword_index  (VAR apc : tpc_globals;
            VAR snam  : tsp00_Sname) : integer;
 
CONST
      interval1 = 35;
      interval2 = 70;
      interval3 = 120;
 
VAR
      index : integer;
      i : integer;
      j : integer;
      k : integer;
      ok : boolean;
      c  : char;
 
BEGIN
WITH apc, pcscan DO
    BEGIN
    index  := 0;
    ok     := false;
    i      := 1;
    j      := mxpc_keyword;
    CASE sqlca.sqlrap^.rasqlos OF
        os_unix , os_os2, os_win32,
        os_vms, os_windows :
            BEGIN
            (* sequentielles suchen *)
            c := snam [1] ;
            IF   c >  p10kw [interval1,1 ]
            THEN
                i := interval1;
            (*ENDIF*) 
            IF   c >  p10kw [interval2,1 ]
            THEN
                i := interval2;
            (*ENDIF*) 
            IF   c >  p10kw [interval3,1 ]
            THEN
                i := interval3;
            (*ENDIF*) 
            WHILE (i <= mxpc_keyword) AND (c >=  p10kw [i,1] )
                  AND (index = 0) DO
                BEGIN
                IF   snam =  p10kw [i]
                THEN
                    index := i;
                (*ENDIF*) 
                i := i + 1;
                END;
            (*ENDWHILE*) 
            END;
        OTHERWISE:
            BEGIN
            (* bin?ares suchen *)
            REPEAT
                k := (i+j) DIV 2;
                IF   ( p10kw [k]   = snam)
                THEN
                    ok := true
                ELSE
                    IF   ( p10kw [k]  <  snam)
                    THEN
                        i := k + 1
                    ELSE
                        j := k - 1;
                    (*ENDIF*) 
                (*ENDIF*) 
&               ifdef TRACE
                m90int (pc, 'binaere such', k);
&               endif
            UNTIL
                (i > j) OR (ok);
            (*ENDREPEAT*) 
            IF   ok
            THEN
                index := k;
            (*ENDIF*) 
            END;
        END;
    (*ENDCASE*) 
    END;
(*ENDWITH*) 
&ifdef TRACE
(* t15int (pc, ' p10kw.index', index);*)
&endif
      p10keyword_index:=  p10ki [index] ;
END;
 
(*------------------------------*) 
 
PROCEDURE
      p100init_keyword_tab (VAR apc : tpc_globals;
            VAR index : integer);
 
VAR
      i : integer;
 
BEGIN
WITH apc DO
    (* sortiert f?ur bin?ares suchen *)
    p10ki [0] := 0;
(*ENDWITH*) 
i := 1;
p10ki [i] :=  cpc_i_abort     ;
p10kw [i] := 'ABORT       ';
i := i + 1;
p10ki [i] :=  cpc_i_adabas    ;
p10kw [i] := 'ADABAS      ';
i := i + 1;
p10ki [i] :=  cpc_i_alter     ;
p10kw [i] := 'ALTER       ';
i := i + 1;
p10ki [i] :=  cpc_i_any       ;
p10kw [i] := 'ANY         ';
i := i + 1;
p10ki [i] :=  cpc_i_array     ;
p10kw [i] := 'ARRAY       ';
i := i + 1;
p10ki [i] :=  cpc_i_as        ;
p10kw [i] := 'AS          ';
i := i + 1;
p10ki [i] :=  cpc_i_async     ;
p10kw [i] := 'ASYNC       ';
i := i + 1;
p10ki [i] :=  cpc_i_at        ;
p10kw [i] := 'AT          ';
i := i + 1;
p10ki [i] :=  cpc_i_begin     ;
p10kw [i] := 'BEGIN       ';
i := i + 1;
p10ki [i] :=  cpc_i_bind      ;
p10kw [i] := 'BIND        ';
i := i + 1;
p10ki [i] :=  cpc_i_bnddsc    ;
p10kw [i] := 'BNDDSC      ';
i := i + 1;
p10ki [i] :=  cpc_i_call      ;
p10kw [i] := 'CALL        ';
i := i + 1;
p10ki [i] :=  cpc_i_cancel    ;
p10kw [i] := 'CANCEL      ';
i := i + 1;
p10ki [i] :=  cpc_i_char      ;
p10kw [i] := 'CHAR        ';
i := i + 1;
p10ki [i] :=  cpc_i_character ;
p10kw [i] := 'CHARACTER   ';
i := i + 1;
p10ki [i] :=  cpc_i_charz     ;
p10kw [i] := 'CHARZ       ';
i := i + 1;
p10ki [i] :=  cpc_i_cics      ;
p10kw [i] := 'CICS        ';
i := i + 1;
p10ki [i] :=  cpc_i_close     ;
p10kw [i] := 'CLOSE       ';
i := i + 1;
p10ki [i] :=  cpc_i_column   ;
p10kw [i] := 'COLUMN      ';
i := i + 1;
p10ki [i] :=  cpc_i_command   ;
p10kw [i] := 'COMMAND     ';
i := i + 1;
p10ki [i] :=  cpc_i_connect   ;
p10kw [i] := 'CONNECT     ';
i := i + 1;
p10ki [i] :=  cpc_i_const     ;
p10kw [i] := 'CONST       ';
i := i + 1;
p10ki [i] :=  cpc_i_continue  ;
p10kw [i] := 'CONTINUE    ';
i := i + 1;
p10ki [i] :=  cpc_i_conversation;
p10kw [i] := 'CONVERSATION';
i := i + 1;
p10ki [i] :=  cpc_i_create    ;
p10kw [i] := 'CREATE      ';
i := i + 1;
p10ki [i] :=  cpc_i_current   ;
p10kw [i] := 'CURRENT     ';
i := i + 1;
p10ki [i] :=  cpc_i_cursor    ;
p10kw [i] := 'CURSOR      ';
i := i + 1;
p10ki [i] :=  cpc_i_database  ;
p10kw [i] := 'DATABASE    ';
i := i + 1;
p10ki [i] :=  cpc_i_datafile  ;
p10kw [i] := 'DATAFILE    ';
i := i + 1;
p10ki [i] :=  cpc_i_date      ;
p10kw [i] := 'DATE        ';
i := i + 1;
p10ki [i] :=  cpc_i_dbname    ;
p10kw [i] := 'DBNAME      ';
i := i + 1;
p10ki [i] :=  cpc_i_dbproc    ;
p10kw [i] := 'DBPROC      ';
i := i + 1;
p10ki [i] :=  cpc_i_decimal   ;
p10kw [i] := 'DECIMAL     ';
i := i + 1;
p10ki [i] :=  cpc_i_declare   ;
p10kw [i] := 'DECLARE     ';
i := i + 1;
p10ki [i] :=  cpc_i_describe  ;
p10kw [i] := 'DESCRIBE    ';
i := i + 1;
p10ki [i] :=  cpc_i_descriptor;
p10kw [i] := 'DESCRIPTOR  ';
i := i + 1;
p10ki [i] :=  cpc_i_display   ;
p10kw [i] := 'DISPLAY     ';
i := i + 1;
p10ki [i] :=  cpc_i_do        ;
p10kw [i] := 'DO          ';
i := i + 1;
p10ki [i] :=  cpc_i_double    ;
p10kw [i] := 'DOUBLE      ';
i := i + 1;
p10ki [i] :=  cpc_i_end       ;
p10kw [i] := 'END         ';
i := i + 1;
p10ki [i] :=  cpc_i_exec      ;
p10kw [i] := 'EXEC        ';
i := i + 1;
p10ki [i] :=  cpc_i_execute   ;
p10kw [i] := 'EXECUTE     ';
i := i + 1;
index := i;
END;
 
(*------------------------------*) 
 
PROCEDURE
      p101init_keyword_tab (VAR apc : tpc_globals;
            VAR index : integer);
 
VAR
      i : integer;
 
BEGIN
WITH apc DO
    i := index;
(*ENDWITH*) 
p10ki [i] :=  cpc_i_false     ;
p10kw [i] := 'FALSE       ';
i := i + 1;
p10ki [i] :=  cpc_i_fetch     ;
p10kw [i] := 'FETCH       ';
i := i + 1;
p10ki [i] :=  cpc_i_first     ;
p10kw [i] := 'FIRST       ';
i := i + 1;
p10ki [i] :=  cpc_i_float     ;
p10kw [i] := 'FLOAT       ';
i := i + 1;
p10ki [i] :=  cpc_i_for       ;
p10kw [i] := 'FOR         ';
i := i + 1;
p10ki [i] :=  cpc_i_found     ;
p10kw [i] := 'FOUND       ';
i := i + 1;
p10ki [i] :=  cpc_i_from      ;
p10kw [i] := 'FROM        ';
i := i + 1;
p10ki [i] :=  cpc_i_getval    ;
p10kw [i] := 'GETVAL      ';
i := i + 1;
p10ki [i] :=  cpc_i_go        ;
p10kw [i] := 'GO          ';
i := i + 1;
p10ki [i] :=  cpc_i_goto      ;
p10kw [i] := 'GOTO        ';
i := i + 1;
p10ki [i] :=  cpc_i_hold      ;
p10kw [i] := 'HOLD        ';
i := i + 1;
p10ki [i] :=  cpc_i_immediate ;
p10kw [i] := 'IMMEDIATE   ';
i := i + 1;
p10ki [i] :=  cpc_i_include   ;
p10kw [i] := 'INCLUDE     ';
i := i + 1;
p10ki [i] :=  cpc_i_ind       ;
p10kw [i] := 'IND         ';
i := i + 1;
p10ki [i] :=  cpc_i_index     ;
p10kw [i] := 'INDEX       ';
i := i + 1;
p10ki [i] :=  cpc_i_indicator ;
p10kw [i] := 'INDICATOR   ';
i := i + 1;
p10ki [i] :=  cpc_i_integer   ;
p10kw [i] := 'INTEGER     ';
i := i + 1;
p10ki [i] :=  cpc_i_internal  ;
p10kw [i] := 'INTERNAL    ';
i := i + 1;
p10ki [i] :=  cpc_i_into      ;
p10kw [i] := 'INTO        ';
i := i + 1;
p10ki [i] :=  cpc_i_is        ;
p10kw [i] := 'IS          ';
i := i + 1;
p10ki [i] :=  cpc_i_keep      ;
p10kw [i] := 'KEEP        ';
i := i + 1;
p10ki [i] :=  cpc_i_keeputm   ;
p10kw [i] := 'KEEPUTM     ';
i := i + 1;
p10ki [i] :=  cpc_i_labels    ;
p10kw [i] := 'LABELS      ';
i := i + 1;
p10ki [i] :=  cpc_i_last    ;
p10kw [i] := 'LAST        ';
i := i + 1;
p10ki [i] :=  cpc_i_line      ;
p10kw [i] := 'LINE        ';
i := i + 1;
p10ki [i] :=  cpc_i_link      ;
p10kw [i] := 'LINK        ';
i := i + 1;
p10ki [i] :=  cpc_i_list      ;
p10kw [i] := 'LIST        ';
i := i + 1;
p10ki [i] :=  cpc_i_long      ;
p10kw [i] := 'LONG        ';
i := i + 1;
p10ki [i] :=  cpc_i_longint   ;
p10kw [i] := 'LONGINT     ';
i := i + 1;
p10ki [i] :=  cpc_i_macro     ;
p10kw [i] := 'MACRO       ';
i := i + 1;
p10ki [i] :=  cpc_i_mlslabel  ;
p10kw [i] := 'MLSLABEL    ';
i := i + 1;
index := i;
END;
 
(*------------------------------*) 
 
PROCEDURE
      p102init_keyword_tab (VAR apc : tpc_globals;
            VAR index : integer);
 
VAR
      i : integer;
 
BEGIN
WITH apc DO
    (* sortier f?ur bin?ares suchen *)
    i := index;
(*ENDWITH*) 
p10ki [i] :=  cpc_i_names     ;
p10kw [i] := 'NAMES       ';
i := i + 1;
p10ki [i] :=  cpc_i_newsync   ;
p10kw [i] := 'NEWSYNC     ';
i := i + 1;
p10ki [i] :=  cpc_i_next   ;
p10kw [i] := 'NEXT        ';
i := i + 1;
p10ki [i] :=  cpc_i_nolog     ;
p10kw [i] := 'NOLOG       ';
i := i + 1;
p10ki [i] :=  cpc_i_not       ;
p10kw [i] := 'NOT         ';
i := i + 1;
p10ki [i] :=  cpc_i_notfound  ;
p10kw [i] := 'NOTFOUND    ';
i := i + 1;
p10ki [i] :=  cpc_i_number    ;
p10kw [i] := 'NUMBER      ';
i := i + 1;
p10ki [i] :=  cpc_i_of        ;
p10kw [i] := 'OF          ';
i := i + 1;
p10ki [i] :=  cpc_i_off       ;
p10kw [i] := 'OFF         ';
i := i + 1;
p10ki [i] :=  cpc_i_on        ;
p10kw [i] := 'ON          ';
i := i + 1;
p10ki [i] :=  cpc_i_open      ;
p10kw [i] := 'OPEN        ';
i := i + 1;
p10ki [i] :=  cpc_i_option     ;
p10kw [i] := 'OPTION      ';
i := i + 1;
p10ki [i] :=  cpc_i_oraca     ;
p10kw [i] := 'ORACA       ';
i := i + 1;
p10ki [i] :=  cpc_i_oracle    ;
p10kw [i] := 'ORACLE      ';
i := i + 1;
p10ki [i] :=  cpc_i_packed    ;
p10kw [i] := 'PACKED      ';
i := i + 1;
p10ki [i] :=  cpc_i_perform   ;
p10kw [i] := 'PERFORM     ';
i := i + 1;
p10ki [i] :=  cpc_i_pos       ;
p10kw [i] := 'POS         ';
i := i + 1;
p10ki [i] :=  cpc_i_prepare   ;
p10kw [i] := 'PREPARE     ';
i := i + 1;
p10ki [i] :=  cpc_i_prev   ;
p10kw [i] := 'PREV        ';
i := i + 1;
p10ki [i] :=  cpc_i_printer   ;
p10kw [i] := 'PRINTER     ';
i := i + 1;
p10ki [i] :=  cpc_i_putval    ;
p10kw [i] := 'PUTVAL      ';
i := i + 1;
p10ki [i] :=  cpc_i_raw       ;
p10kw [i] := 'RAW         ';
i := i + 1;
p10ki [i] :=  cpc_i_real      ;
p10kw [i] := 'REAL        ';
i := i + 1;
p10ki [i] :=  cpc_i_reconnect ;
p10kw [i] := 'RECONNECT   ';
i := i + 1;
p10ki [i] :=  cpc_i_record    ;
p10kw [i] := 'RECORD      ';
i := i + 1;
p10ki [i] :=  cpc_i_result    ;
p10kw [i] := 'RESULT      ';
i := i + 1;
p10ki [i] :=  cpc_i_return    ;
p10kw [i] := 'RETURN      ';
i := i + 1;
p10ki [i] :=  cpc_i_rowid     ;
p10kw [i] := 'ROWID       ';
i := i + 1;
p10ki [i] :=  cpc_i_same      ;
p10kw [i] := 'SAME        ';
i := i + 1;
p10ki [i] :=  cpc_i_section   ;
p10kw [i] := 'SECTION     ';
i := i + 1;
p10ki [i] :=  cpc_i_seldsc    ;
p10kw [i] := 'SELDSC      ';
i := i + 1;
p10ki [i] :=  cpc_i_select    ;
p10kw [i] := 'SELECT      ';
i := i + 1;
p10ki [i] :=  cpc_i_serverdb  ;
p10kw [i] := 'SERVERDB    ';
i := i + 1;
p10ki [i] :=  cpc_i_session   ;
p10kw [i] := 'SESSION     ';
i := i + 1;
p10ki [i] :=  cpc_i_set       ;
p10kw [i] := 'SET         ';
i := i + 1;
p10ki [i] :=  cpc_i_shortint  ;
p10kw [i] := 'SHORTINT    ';
i := i + 1;
p10ki [i] :=  cpc_i_shortreal ;
p10kw [i] := 'SHORTREAL   ';
i := i + 1;
p10ki [i] :=  cpc_i_sql       ;
p10kw [i] := 'SQL         ';
i := i + 1;
p10ki [i] :=  cpc_i_sqlbegin  ;
p10kw [i] := 'SQLBEGIN    ';
i := i + 1;
p10ki [i] :=  cpc_i_sqlca     ;
p10kw [i] := 'SQLCA       ';
i := i + 1;
p10ki [i] :=  cpc_i_sqlconst  ;
p10kw [i] := 'SQLCONST    ';
i := i + 1;
p10ki [i] :=  cpc_i_sqlda     ;
p10kw [i] := 'SQLDA       ';
i := i + 1;
p10ki [i] :=  cpc_i_sqldb     ;
p10kw [i] := 'SQLDB       ';
i := i + 1;
p10ki [i] :=  cpc_i_sqldec    ;
p10kw [i] := 'SQLDEC      ';
i := i + 1;
p10ki [i] :=  cpc_i_sqlerror  ;
p10kw [i] := 'SQLERROR    ';
i := i + 1;
p10ki [i] :=  cpc_i_sqlend    ;
p10kw [i] := 'SQLEND      ';
i := i + 1;
p10ki [i] :=  cpc_i_sqlexception;
p10kw [i] := 'SQLEXCEPTION';
i := i + 1;
p10ki [i] :=  cpc_i_sqlproc   ;
p10kw [i] := 'SQLPROC     ';
i := i + 1;
p10ki [i] :=  cpc_i_sqltype   ;
p10kw [i] := 'SQLTYPE     ';
i := i + 1;
p10ki [i] :=  cpc_i_sqlucs2   ;
p10kw [i] := 'SQLUCS2     ';
i := i + 1;
p10ki [i] :=  cpc_i_sqlutf16  ;
p10kw [i] := 'SQLUTF16    ';
i := i + 1;
p10ki [i] :=  cpc_i_sqlwarning;
p10kw [i] := 'SQLWARNING  ';
i := i + 1;
p10ki [i] :=  cpc_i_sql_trace ;
p10kw [i] := 'SQL_TRACE   ';
i := i + 1;
p10ki [i] :=  cpc_i_start     ;
p10kw [i] := 'START       ';
i := i + 1;
p10ki [i] :=  cpc_i_statement ;
p10kw [i] := 'STATEMENT   ';
i := i + 1;
p10ki [i] :=  cpc_i_stop      ;
p10kw [i] := 'STOP        ';
i := i + 1;
p10ki [i] :=  cpc_i_string    ;
p10kw [i] := 'STRING      ';
i := i + 1;
p10ki [i] :=  cpc_i_struct    ;
p10kw [i] := 'STRUCT      ';
i := i + 1;
p10ki [i] :=  cpc_i_sync      ;
p10kw [i] := 'SYNC        ';
i := i + 1;
index := i;
END;
 
(*------------------------------*) 
 
PROCEDURE
      p103init_keyword_tab (VAR apc : tpc_globals;
            VAR index : integer);
 
VAR
      i : integer;
&     ifdef TRACE
      j : integer;
      l : integer;
&     endif
 
BEGIN
WITH apc DO
    (* sortier f?ur bin?ares suchen *)
    i := index;
(*ENDWITH*) 
p10ki [i] :=  cpc_i_table     ;
p10kw [i] := 'TABLE       ';
i := i + 1;
p10ki [i] :=  cpc_i_to        ;
p10kw [i] := 'TO          ';
i := i + 1;
p10ki [i] :=  cpc_i_tptst     ;
p10kw [i] := 'TPTST       ';
i := i + 1;
p10ki [i] :=  cpc_i_trace     ;
p10kw [i] := 'TRACE       ';
i := i + 1;
p10ki [i] :=  cpc_i_transid   ;
p10kw [i] := 'TRANSID     ';
i := i + 1;
p10ki [i] :=  cpc_i_true      ;
p10kw [i] := 'TRUE        ';
i := i + 1;
p10ki [i] :=  cpc_i_type      ;
p10kw [i] := 'TYPE        ';
i := i + 1;
p10ki [i] :=  cpc_i_unique    ;
p10kw [i] := 'UNIQUE      ';
i := i + 1;
p10ki [i] :=  cpc_i_unsigned  ;
p10kw [i] := 'UNSIGNED    ';
i := i + 1;
p10ki [i] :=  cpc_i_using     ;
p10kw [i] := 'USING       ';
i := i + 1;
p10ki [i] :=  cpc_i_var       ;
p10kw [i] := 'VAR         ';
i := i + 1;
p10ki [i] :=  cpc_i_varchar   ;
p10kw [i] := 'VARCHAR     ';
i := i + 1;
p10ki [i] :=  cpc_i_varchar2  ;
p10kw [i] := 'VARCHAR2    ';
i := i + 1;
p10ki [i] :=  cpc_i_variables ;
p10kw [i] := 'VARIABLES   ';
i := i + 1;
p10ki [i] :=  cpc_i_varnum    ;
p10kw [i] := 'VARNUM      ';
i := i + 1;
p10ki [i] :=  cpc_i_varraw    ;
p10kw [i] := 'VARRAW      ';
i := i + 1;
p10ki [i] :=  cpc_i_version   ;
p10kw [i] := 'VERSION     ';
i := i + 1;
p10ki [i] :=  cpc_i_when      ;
p10kw [i] := 'WHEN        ';
i := i + 1;
p10ki [i] :=  cpc_i_whenever  ;
p10kw [i] := 'WHENEVER    ';
i := i + 1;
p10ki [i] :=  cpc_i_with      ;
p10kw [i] := 'WITH        ';
i := i + 1;
p10ki [i] :=  cpc_i_xctl      ;
p10kw [i] := 'XCTL        ';
&ifdef TRACE
m90int (pc, ' p10ki(i)max', i);
m90int (pc, 'mxpc_keyword', mxpc_keyword);
IF   i <> mxpc_keyword
THEN
    p11precomerror (apc, cpc_init_keyword_wrong)
ELSE
    FOR i := 1 TO mxpc_keyword DO
        BEGIN
        j :=  p10ki [i] ;
        FOR l := i+1 TO mxpc_keyword DO
            IF    p10ki [l] = j
            THEN
                BEGIN
                m90int (pc, 'j           ', j);
                m90int (pc, 'l           ', l);
                m90int (pc, ' p10ki(l)   ', p10ki [l] );
                p11precomerror (apc, cpc_init_keyword_wrong);
                END;
            (*ENDIF*) 
        (*ENDFOR*) 
        END;
    (*ENDFOR*) 
(*ENDIF*) 
&endif
END;
 
(*------------------------------*) 
 
PROCEDURE
      p10initprecomvariable (VAR apc : tpc_globals);
 
VAR
      i : integer;
      index : integer;
 
BEGIN
WITH apc, pcopts  DO
    BEGIN
    WITH pcscan DO
        BEGIN
        sypos := 0;
        sylen := 0;
        END;
    (*ENDWITH*) 
    WITH pccmdpart DO
        BEGIN
        part1len := 0;
        part2len := 0;
        partmaxlen := 0;
        partsizlen := 0;
        partbufp := NIL;
        END;
    (*ENDWITH*) 
    pcinpeof := false;
    pcerror := cpc_pre_ok;
    pcerrcnt := 0;
    pcwrncnt := 0;
    pccmcnt  := 0;
    IF  NOT (sqlca.sqlrap^.ralang IN [cpr_la_cobol, cpr_la_cobmic,
        cpr_la_cob8860])
    THEN
        pcexecsql := 0;
    (*ENDIF*) 
    pcpa    := 0;
    pcsa    := 0;
    pcka    := 0;
    pcpr    := 0;
    pcst    := 0;
    pcfa    := 0;
    pcstmax := 0;
    pcststm := 0;
    pcdi    := 0;
    pcop    := 0;
    pcda    := 0;
    pcna    := 0;
    pcat    := 0;
    pccu    := 0;
    pcfn    := 0;   (*3.11.93*)
    pcatgacnt:= 0;
    sqlca.sqlrap^.rasqltap^.tatrout:=cpr_trace_off;
    pcwhe [1] .whlen := 0;
    pcwhe [2] .whlen := 0;
    pcwhe [3] .whlen := 0;
    pcwhe [4] .whlen := 0;
    pcwhe [5] .whlen := 0;
    pcwhe [6] .whlen := 0;
    pcwheset := cpr_is_true;
    pcwheno  := 0;
    pcan.ansection := cpc_se_off;
    FOR i := 1 TO mxpr_sqlga DO
        pcan.anusage [i]  := false;
    (*ENDFOR*) 
    pcan.anbegin   := false;
    pccse.ccnt  := 0;
    pccse.cbot  := 0;
    pclno.lnoinp := cpr_is_false;
    pclno.lnoout := cpr_is_false;
    opt_mode  := cpc_ch_all;
    opt_precom:= false;
    opt_list  := false;
    opt_lib   := false;
    opt_comment:= false;
    opt_extern := cpr_is_false;
    opt_comp   := 1;
    opt_cansi  :=cpc_oc_empty;
    opt_quote  := true;
    opt_decpoint := true;
    opt_quo[1]   := '''';
    opt_point[1] := '.';
    opt_prof     := 1 ;
    opt_progname  := bsp_knl_identifier;
    opt_modulename:= bsp_knl_identifier;
    opt_prognamel := 0;
    opt_modulenamel:= 0;
    opt_trace    := cpr_trace_empty;
    SAPDB_PascalForcedFill(sizeof(opt_tracefile), @opt_tracefile, 1, sizeof(opt_tracefile), bsp_c1);
    opt_nowarn   := false;
    opt_silent   := false;
    opt_tpmon    := cpc_notp;
    opt_tpmonid  := bsp_name;
    opt_dyn      := cpc_static_link;
    sqlca.sqldbmode    := 0;
    sqlca.sqldatetime  := cpr_dt_normal;
    opt_tabformat:= false;
    pcerrcnt  := 0;
    pccodeind  := cpc_work1file;
    pcinpind   := cpc_inputfile;
    pclineperpage:= p10_linepropage;
    pccharperline:= p10_charproline;
    sqlca.sqlcode := 0;
    sqlca.sqldbmode  := cpr_kind_internal;
    sqlca.sqldatetime:= cpr_dt_normal;
    sqlca.sqlrap^.raactsession := cpr_se_empty;
    sqlca.sqlrap^.rasqlansi    := cpr_kind_empty;
    sqlca.sqlrap^.ramodeswitch := cpr_kind_empty;
    sqlca.sqlrap^.raopprof     := cpr_is_false;
    WITH sqlca, sqlgap^, 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;
        END;
    (*ENDWITH*) 
    p03gaxuserinit (sqlca.sqlgap, sqlca.sqlemp);
    sqlca.sqlrap^.raactsession := cpr_se_primary;
    sqlca.sqlmap^.maversion := csp_maxint4;
    FOR i := 1 TO mxpr_sqlma DO
        sqlca.sqlmap^.maentry [i] .malen := 0;
    (*ENDFOR*) 
    FOR i := 1 TO mxpc_vffiles DO
        WITH pcvf.vffn [i]  DO
            BEGIN
            vffileno := 0;
            IF   i = cpc_lnoinput
            THEN
                vffilemode  := sp5vf_read
            ELSE
                vffilemode  := sp5vf_write;
            (*ENDIF*) 
            vfbinary := false;
            vfreclen2 := 0;
            vfreclen4 := 0;
            SAPDB_PascalForcedFill(sizeof(vffilen), @vffilen, 1, sizeof(vffilen), bsp_c1);
            vfcnt     := 0;
            vfbufcount:= 0;
            END;
        (*ENDWITH*) 
    (*ENDFOR*) 
&   ifdef TRACE
    m90int (pc, ' p10init   2', i);
&   endif
    IF   (sqlca.sqlrap^.ralang = cpr_la_pascal)
        OR (sqlca.sqlrap^.ralang = cpr_la_pascal31)
        OR   (sqlca.sqlrap^.ralang = cpr_la_pascalvax)
        OR   (sqlca.sqlrap^.ralang = cpr_la_pascallpi)
    THEN
        BEGIN
        (* pascal default *)
        pcfilen := bsp_knl_identifier;
        pcfilet := ' PASPC            ';
        pcfilem := ' *                ';
        opt_begmar  := 1;
        opt_endmar  := 100;
        IF   sqlca.sqlrap^.rasqlos = os_vms
        THEN
            opt_endmar   := 132;
&       ifdef TRACE
        (*ENDIF*) 
        m90int (pc, ' p10init   3', i);
&       endif
        pcendsymlen:= 1;
        pcendsym   := ';           ';
        pcendcmd  [1]  := ';';
        pcendcmd  [2]  := bsp_c1;
        WITH pcendse DO
            BEGIN
            ecnt := 5;
            eend [1] .ename := ' EXEC       ';
            eend [2] .ename := ' END        ';
            eend [3] .ename := ' END;       ';
            eend [4] .ename := ' ELSE       ';
            eend [5] .ename := ' UNTIL      ';
            eend [1] .enaml := 6;
            eend [2] .enaml := 5;
            eend [3] .enaml := 5;
            eend [4] .enaml := 6;
            eend [5] .enaml := 6;
            END;
        (*ENDWITH*) 
        END;
    (*ENDIF*) 
    IF   sqlca.sqlrap^.ralang = cpr_la_c
    THEN
        BEGIN
        (* c      default *)
        pcfilen := bsp_knl_identifier;
        pcfilet := ' CPC              ';
        pcfilem := ' *                ';
        opt_begmar := 1;
        opt_endmar := mxpr_preline;
        IF   sqlca.sqlrap^.rasqlos = os_vms
        THEN
            opt_endmar  := 132;
        (*ENDIF*) 
        opt_quo[1]   := '"';
        opt_quote    := false;
        pcendsymlen:= 1;
        pcendsym   := ';           ';
        pcendcmd  [1]  := ';';
        pcendcmd  [2]  := bsp_c1;
        WITH pcendse DO
            BEGIN
            ecnt := 2;
            eend [1] .ename := 'exec        ';
            eend [1] .enaml := 5;
            eend [2] .ename := 'EXEC        ';
            eend [2] .enaml := 5;
            END;
        (*ENDWITH*) 
        END;
&   ifdef TRACE
    (*ENDIF*) 
    m90int (pc, ' p10init   4', i);
&   endif
    IF   sqlca.sqlrap^.ralang in
        [ cpr_la_cobol,cpr_la_cobmic,cpr_la_cob8860 ]
    THEN
        BEGIN
        pcfilen := bsp_knl_identifier;
        pcfilet := ' COBPC            ';
        pcfilem := ' *                ';
        IF  pcopts.opt_tabformat
        THEN
            BEGIN
            opt_begmar := 1;
            opt_endmar   := 72;
            END
        ELSE
            BEGIN
            opt_begmar := 7;
            opt_endmar   := 72;
            END;
        (*ENDIF*) 
        pcendsymlen:= 8;
        pcendsym   := 'END-EXEC    ';
        pcendcmd  [1]  := '.';
        pcendcmd  [2]  := bsp_c1;
        WITH pcendse DO
            BEGIN
            ecnt := 1;
            eend [1] .ename := ' EXEC       ';
            eend [1] .enaml := 6;
            END;
        (*ENDWITH*) 
        END;
    (*ENDIF*) 
    sqlxa.xaprogn := opt_progname ;
    sqlxa.xaprogc := opt_prognamel ;
    sqlxa.xamodn := opt_modulename ;
    sqlxa.xamodc := opt_modulenamel ;
    sqlxa.xaatcount := 1;
    sqlxa.xaatmax := 0;
    apc.pckaatind := 0;
    apc.pckacuind := 0;
    p100init_keyword_tab (apc, index);
    p101init_keyword_tab (apc, index);
    p102init_keyword_tab (apc, index);
    p103init_keyword_tab (apc, index);
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p10ipass2variable (VAR apc : tpc_globals);
 
BEGIN
(* dummy parameter siehe vpc40 vpc42, vpc60 *)
WITH apc, pcopts  DO
    BEGIN
    pcerror:= cpc_pre_ok;
    pcerrcnt := 0;
    pcwrncnt := 0;
    pccmcnt  := 0;
    IF  NOT (sqlca.sqlrap^.ralang IN [cpr_la_cobol, cpr_la_cobmic,
        cpr_la_cob8860])
    THEN
        pcexecsql := 0;
    (*ENDIF*) 
    pcpa    := 0;
    pcsa    := 0;
    pcka    := 0;
    pcpr    := 0;
    pcst    := 0;
    pcfa    := 0;
    pcstmax := 0;
    pcststm := 0;
    pcdi    := 0;
    pcop    := 0;
    pcda    := 0;
    pcna    := 0;
    pcat    := 0;
    pccu    := 0;
    pcfn    := 0;   (*3.11.93*)
    pcatgacnt:= 0;
    pcwhe [1] .whlen := 0;
    pcwhe [2] .whlen := 0;
    pcwhe [3] .whlen := 0;
    pcwhe [4] .whlen := 0;
    pcwhe [5] .whlen := 0;
    pcwhe [6] .whlen := 0;
    pcwheset := cpr_is_true;
    pcwheno  := 0;
    pcan.ansection := cpc_se_off;
    pcan.anbegin   := false;
    pccse.ccnt  := 0;
    pccse.cbot  := 0;
    pcerrcnt  := 0;
    pccodeind  := cpc_work1file;
    pcinpind   := cpc_inputfile;
    pclineperpage:= p10_linepropage;
    pccharperline:= p10_charproline;
    sqlca.sqlcode := 0;
    sqlca.sqlmap^.maversion := csp_maxint4;
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p10getaddrrest  (VAR apc : tpc_globals;
            VAR sqlda : sqldatype);
 
BEGIN
WITH apc, sqlxa, sqlca.sqlcxap^ DO
    BEGIN
    xasqldap.sqldaptr := s30gad4 (sqlda);
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p10stringliteralget (VAR apc : tpc_globals;
            VAR buf : tpc_partbuffer);
 
VAR
      stringend : boolean;
      j         : integer;
      pos       : integer;
      poslen    : integer;
      dif       : integer;
      quoch     : char;
 
BEGIN
WITH apc, pcopts, pcscan DO
    IF  (buf [sypos] = '''')
        OR   (buf [sypos] = '"')
    THEN
        BEGIN
        stringend := false;
        quoch := buf [sypos] ;
        pos := sypos + 1;
        poslen  := sypos + sylen;
        j         := pos;
        REPEAT
            WHILE (buf [ pos ] <> quoch) AND
                  (pos < poslen) DO
                BEGIN
                buf [j]  := buf [pos] ;
                j  := j + 1;
                pos := pos + 1;
                END;
            (*ENDWHILE*) 
            IF   pos >= poslen
            THEN
                BEGIN
                stringend := true;
                IF   buf [pos ] <> quoch
                THEN
                    symb   := cpr_s_bufeof;
                (*ENDIF*) 
                END
            ELSE
                IF   sqlca.sqlrap^.ralang = cpr_la_c
                THEN
                    BEGIN
                    stringend := true;
                    IF   buf [ pos-1 ] = cpr_backslash
                    THEN
                        BEGIN
                        buf [j-1 ] := buf [pos] ;
                        stringend := false
                        END;
                    (*ENDIF*) 
                    pos := pos + 1;
                    END
                ELSE
                    BEGIN
                    stringend := true;
                    pos := pos + 1;
                    IF   buf [ pos ] = quoch
                    THEN
                        BEGIN
                        buf [j]  := buf [pos] ;
                        j  := j + 1;
                        pos := pos + 1;
                        stringend := false
                        END
                    (*ENDIF*) 
                    END
                (*ENDIF*) 
            (*ENDIF*) 
        UNTIL
            stringend;
        (*ENDREPEAT*) 
        dif := pos - j;
        sylen := sylen - dif - 1;
        sypos := sypos + 1;
        END;
    (*ENDIF*) 
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p101getkeyword (VAR apc : tpc_globals;
            VAR buf : tpc_partbuffer;
            VAR index : integer);
 
BEGIN
p10getkeyword (apc, buf, index);
END;
 
(*------------------------------*) 
 
PROCEDURE
      p10getkeyword (VAR apc : tpc_globals;
            VAR buf : tpc_partbuffer;
            VAR index : integer);
 
VAR
      word : tsp00_Sname;
      i    : integer;
      j    : integer;
 
BEGIN
WITH apc, pcscan DO
    BEGIN
    index  := 0;
    IF   (symb = cpr_s_identifier) AND (sylen >= 1)
        AND (sylen <= SNAME_MXSP00)
    THEN
        BEGIN
        word := bsp_c12;
        FOR i := 1 TO sylen DO
            BEGIN
            j := i + sypos -1;
            IF   (buf [j]  in [ 'a'..'i', 'j'..'r',  's'..'z'] )
            THEN
                word  [i]  := chr(ord(buf [j] ) + ord('A') - ord('a'))
            ELSE
                word  [i]  := buf [j] ;
            (*ENDIF*) 
            END;
        (*ENDFOR*) 
        index :=   p10keyword_index (apc, word);
        END;
&   ifdef TRACE
    (*ENDIF*) 
    m90sname (pc, word);
    m90int (pc, ' p10kw.index', index);
&   endif
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p10inttochr12 (int : integer;
            VAR chr12 : tsp00_C12;
            lnumb     : integer);
 
VAR
      a : integer;
      b : integer;
      i : integer;
      j : integer;
      neg : boolean;
      str : tsp00_C12;
 
BEGIN
neg := false;
str := bsp_c12;
b   := int;
IF   b < 0
THEN
    BEGIN
    neg := true;
    b   := abs(b);
    END;
(*ENDIF*) 
i := 12;
REPEAT
    a := (b MOD 10) + ord ('0');
    str [i]  := chr (a);
    i := i - 1;
    b := b DIV 10;
UNTIL
    (b = 0);
(*ENDREPEAT*) 
IF   neg
THEN
    BEGIN
    str  [i]  := '-';
    i := i - 1;
    END;
(*ENDIF*) 
i := 12;
chr12 := bsp_c12;
FOR j := lnumb DOWNTO 1 DO
    BEGIN
    chr12  [j]  := str [i] ;
    i := i - 1;
    END;
(*ENDFOR*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p10minttochr (int : integer;
            VAR chr12 : tsp00_C12;
            VAR lnumb     : integer);
 
VAR
      str12 : tsp00_C12;
      a : integer;
      b : integer;
      i : integer;
      j : integer;
      neg : boolean;
 
BEGIN
neg := false;
str12 := bsp_c12;
b := int;
IF   b < 0
THEN
    BEGIN
    neg := true;
    b   := abs(b);
    END;
(*ENDIF*) 
i := 12;
REPEAT
    a := (b MOD 10) + ord ('0');
    str12 [i]  := chr (a);
    i := i - 1;
    b := b DIV 10;
UNTIL
    (b = 0);
(*ENDREPEAT*) 
IF   neg
THEN
    BEGIN
    str12 [i]  := '-';
    i := i - 1;
    END;
(*ENDIF*) 
IF  lnumb < 12 - i
THEN
    lnumb := 12 - i;
(*ENDIF*) 
i := 12;
chr12 := bsp_c12;
FOR j := lnumb DOWNTO 1 DO
    BEGIN
    chr12  [j]  := str12 [i] ;
    i := i - 1;
    END;
(*ENDFOR*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p10up2casebuf (VAR buf : tsp00_Buf;
            lwb : integer;
            upb : integer);
 
BEGIN
p10up1casebuf (buf, lwb, upb);
END;
 
(*------------------------------*) 
 
PROCEDURE
      p10up1casebuf (VAR buf : tsp00_Buf;
            lwb : integer;
            upb : integer);
 
VAR
      i         : integer;
      is_string : boolean;
 
BEGIN
is_string := false;
FOR i := lwb TO upb DO
    BEGIN
    IF   buf [i]  = ''''
    THEN
        is_string := NOT is_string;
    (*ENDIF*) 
    IF   (buf [i]  in [ 'a'..'i', 'j'..'r',  's'..'z'] )
        AND NOT is_string
    THEN
        buf [i]  := chr(ord(buf [i] ) + ord('A') - ord('a'))
    (*ENDIF*) 
    END
(*ENDFOR*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p10xint2unsignedget (VAR apc : tpc_globals;
            VAR buf : tsp00_Buf;
            VAR int : tsp00_Int2);
 
BEGIN
p10int2unsignedget (apc, buf, int);
END;
 
(*------------------------------*) 
 
PROCEDURE
      p10c6toint2 (VAR apc : tpc_globals;
            VAR buf : tsp00_Buf;
            pos  : integer;
            VAR int : tsp00_Int2);
 
CONST
      int2limit = 3275;  (* (maxint2 - 9) div 10 *)
      limitmax  = 7;
      maxintl   = 5;
      c6l       = 6;
 
VAR
      i : integer;
      n : integer;
      p : integer;
 
BEGIN
WITH apc, pcscan DO
    BEGIN
    int := 0;
    p   := pos;
    WHILE (buf [p]  = '0')OR (buf [p]  = bsp_c1) DO
        p := p + 1;
    (*ENDWHILE*) 
    IF   c6l - (p - pos) > maxintl
    THEN
        p11precomerror (apc, cpc_invalid_unsignedinteger)
    ELSE
        BEGIN
        FOR i := 0 TO c6l - 1  - (p - pos)  DO
            BEGIN
            n := ord (buf [p+i] ) - ord ('0');
            IF   int <= int2limit
            THEN
                int := int * 10 + n
            ELSE
                IF   (int = int2limit + 1) AND (n <= limitmax)
                THEN
                    int := int * 10 + n
                ELSE
                    p11precomerror (apc, cpc_invalid_unsignedinteger)
                (*ENDIF*) 
            (*ENDIF*) 
            END;
        (*ENDFOR*) 
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p10int2unsignedget (VAR apc : tpc_globals;
            VAR buf : tsp00_Buf;
            VAR int : tsp00_Int2);
 
CONST
      int2limit = 3275;  (* (maxint2 - 9) div 10 *)
      limitmax  = 7;
      maxintl   = 5;
 
VAR
      i : integer;
      n : integer;
      p : integer;
 
BEGIN
WITH apc, pcscan DO
    BEGIN
    int := 0;
    p   := sypos;
    WHILE (buf [p]  = '0') DO
        p := p + 1;
    (*ENDWHILE*) 
    IF   sylen - (p - sypos) > maxintl
    THEN
        p11precomerror (apc, cpc_invalid_unsignedinteger)
    ELSE
        BEGIN
        FOR i := 0 TO sylen-1-(p-sypos) DO
            BEGIN
            n := ord (buf [p+i] ) - ord ('0');
            IF   int <= int2limit
            THEN
                int := int * 10 + n
            ELSE
                IF   (int = int2limit + 1) AND (n <= limitmax)
                THEN
                    int := int * 10 + n
                ELSE
                    p11precomerror (apc, cpc_invalid_unsignedinteger)
                (*ENDIF*) 
            (*ENDIF*) 
            END;
        (*ENDFOR*) 
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p10int4unsignedget (VAR apc : tpc_globals;
            VAR buf : tsp00_Buf;
            VAR int : tsp00_Int4);
 
CONST
      int4limit = 214748159;  (* (maxint4 - 9) div 10 *)
      limitmax  = 9;
      maxintl   = 10;
 
VAR
      i : integer;
      n : integer;
      p : integer;
 
BEGIN
WITH apc, pcscan DO
    BEGIN
    int := 0;
    p   := sypos;
    WHILE (buf [p]  = '0') DO
        p := p + 1;
    (*ENDWHILE*) 
    IF   sylen-(p-sypos) > maxintl
    THEN
        p11precomerror (apc, cpc_invalid_unsignedinteger)
    ELSE
        BEGIN
        FOR i := 0 TO sylen-1-(p-sypos) DO
            BEGIN
            n := ord (buf [p+i] ) - ord ('0');
            IF   int <= int4limit
            THEN
                int := int * 10 + n
            ELSE
                IF   (int = int4limit) AND (n <= limitmax)
                THEN
                    int := int * 10 + n
                ELSE
                    p11precomerror (apc, cpc_invalid_unsignedinteger);
                (*ENDIF*) 
            (*ENDIF*) 
            END;
        (*ENDFOR*) 
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
&ifdef REL62
(*------------------------------*) 
 
PROCEDURE
      p10nonblastr (VAR apc  : tpc_globals;
            VAR buf    : tsp_varpart;
            buflen : integer);
 
BEGIN
WITH apc,pcscan DO
    BEGIN
    WHILE (buf [syposacc] = bsp_c1) AND (syposacc < buflen) DO
        syposacc := syposacc+1;
    (*ENDWHILE*) 
    IF   buf [syposacc] = bsp_c1
    THEN
        sypos := syposacc+1
    ELSE
        sypos := syposacc;
    (*ENDIF*) 
    WHILE (buf [syposacc] <> bsp_c1) AND (syposacc < buflen) DO
        syposacc := syposacc+1;
    (*ENDWHILE*) 
    IF   buf [syposacc] <> bsp_c1
    THEN
        syposacc := syposacc+1
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
&endif
(*------------------------------*) 
 
PROCEDURE
      p10unixmsdospathname (VAR apc : tpc_globals;
            VAR args : tsp4_argline;
            VAR napos, nalen : integer;
            path_delimiter : char);
 
CONST
      dot = '.';
 
VAR
      actpos, epos : integer;
      first : boolean;
 
BEGIN
WITH apc, pcscan DO
    BEGIN
    first  := true;
    actpos := napos+nalen;
    epos := actpos;
    REPEAT
        actpos := actpos-1;
        IF   args [actpos] = dot
        THEN
            BEGIN
            IF   first
            THEN
                epos := actpos;
            (*ENDIF*) 
            first := false;
            END
        ELSE
            IF  (args [actpos] = path_delimiter)
                OR  (args [actpos] = ':')      (* 24.2.92 Collogia korr *)
            THEN
                napos := actpos+1
            (*ENDIF*) 
        (*ENDIF*) 
    UNTIL
        actpos <= napos;
    (*ENDREPEAT*) 
    nalen := epos-napos
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      p10rmspace (VAR buf : tpc_partbuffer;
            cpr_quotsym, escsym : char;
            ind, inplen : tsp00_Int4;
            VAR  maxbuf, outlen : tsp00_Int4);
 
VAR
      i,j,k,shift : tsp00_Int4;
      state : (leading, quoted, dquoted, spac, sw_normal);
 
BEGIN
state := leading;
i:= ind;
k:= ind;
j := i+inplen;
IF   j > maxbuf
THEN
    j := maxbuf;
(*ENDIF*) 
WHILE i < j DO
    BEGIN
    shift := 0;
    CASE state OF
        leading, spac:
            IF   buf [i] <> ' '
            THEN
                BEGIN
                IF   buf [i] = cpr_quotsym
                THEN
                    state := quoted
                ELSE
                    IF   buf [i] = cpr_dquosym
                    THEN
                        state := dquoted
                    ELSE
                        state := sw_normal;
                    (*ENDIF*) 
                (*ENDIF*) 
                shift := i-k;
                p10shift(buf,k,shift,maxbuf);
                j := j-shift
                END;
            (*ENDIF*) 
        quoted:
            IF   (i < j-1) AND (buf [i] = escsym) AND (buf [i+1] = cpr_quotsym)
            THEN
                i:= i+1
            ELSE
                IF   buf [i] = cpr_quotsym
                THEN
                    state := sw_normal;
                (*ENDIF*) 
            (*ENDIF*) 
        dquoted:
            IF   (i < j-1) AND (buf [i] = escsym) AND
                (buf [i+1] = cpr_dquosym)
            THEN
                i:= i+1
            ELSE
                IF   buf [i] = cpr_dquosym
                THEN
                    state := sw_normal;
                (*ENDIF*) 
            (*ENDIF*) 
        sw_normal:
            IF   buf [i] = cpr_quotsym
            THEN
                state := quoted
            ELSE
                IF   buf [i] = cpr_dquosym
                THEN
                    state := dquoted
                ELSE
                    IF   buf [i] = ' '
                    THEN
                        BEGIN
                        state := spac;
                        k := i+1
                        END
                    (*ENDIF*) 
                (*ENDIF*) 
            (*ENDIF*) 
        END;
    (*ENDCASE*) 
    i := i-shift+1
    END;
(*ENDWHILE*) 
CASE state OF
    leading:
        BEGIN
        p10shift(buf,ind,inplen,maxbuf);
        j := ind
        END;
    spac:
        BEGIN
        shift := i-k+1;
        p10shift(buf,k-1,shift,maxbuf);
        j := j-shift
        END;
    OTHERWISE:
    END;
(*ENDCASE*) 
outlen := j-ind;
END;
 
(*------------------------------*) 
 
PROCEDURE
      p10rm1space (VAR buf : tpc_partbuffer;
            cpr_quotsym, escsym : char;
            ind, inplen : tsp00_Int4;
            VAR  maxbuf, outlen : tsp00_Int4);
 
BEGIN
p10rmspace(buf,cpr_quotsym,escsym,ind,inplen,maxbuf,outlen)
END;
 
&ifdef TRACE
(*------------------------------*) 
 
PROCEDURE
      p10areaprint  (VAR apc : tpc_globals);
 
VAR
      i : integer;
 
BEGIN
WITH apc , pcsqlva, sqlxa DO
    BEGIN
    m90int  (pc, 'SQLPAR******', pcpa );
    FOR i := 1 TO pcpa DO
        WITH sqlpap^ [i] DO
            BEGIN
            m90int  (pc, 'partab i****', i );
            CASE pakindlo  OF
                sqlparlo :
                    BEGIN
                    m90int  (pc, 'pakindlo    ', pakindlo  );
                    m90int2 (pc, 'pava1index  ', pava1index);
                    m90int2 (pc, 'paloopcnt   ', paloopcnt);
                    m90int2 (pc, 'paloopmin   ', paloopmin);
                    END;
                sqlparst :
                    BEGIN
                    m90int  (pc, 'pakindst    ', pakindst  );
                    m90int2 (pc, 'pavarst     ', pavarst);
                    m90int2 (pc, 'paindst     ', paindst);
                    m90int2 (pc, 'paelcnt     ', paelcnt);
                    END;
                sqlparel :
                    BEGIN
                    m90int  (pc, 'pakindel    ', pakindel  );
                    m90int2 (pc, 'pavarno     ', pavarno  );
                    m90int2 (pc, 'paindno     ', paindno);
                    END;
                END;
            (*ENDCASE*) 
            m90int  (pc, '------------', 0 );
            END;
        (*ENDWITH*) 
    (*ENDFOR*) 
    m90int  (pc, 'SQLVA1******', 0 );
    m90int  (pc, 'va1cnt******', va1cnt);
    FOR i := 1 TO va1cnt DO
        WITH sqlv1p^ [i] DO
            BEGIN
            m90int  (pc, 'va1tab i****', i );
            CASE va1indi_sc OF
                sqlvasc :
                    BEGIN
                    m90int  (pc, 'va1indi_sc  ', va1indi_sc );
                    m90int2 (pc, 'va1indva2_sc', va1indva2_sc);
                    m90int2 (pc, 'va1indva3_sc', va1indva3_sc);
                    END;
                sqlvacm :
                    BEGIN
                    m90int  (pc, 'va1indi_cm  ', va1indi_cm );
                    m90int2 (pc, 'vacmindva2  ', va1indva2_cm);
                    m90int2 (pc, 'vacmindva3  ', va1indva3_cm);
                    END;
                sqlvast :
                    BEGIN
                    m90int  (pc, 'va1indi_st  ', va1indi_st );
                    m90int2 (pc, 'vacmpcnt    ', va1cmpcnt_st);
                    m90int2 (pc, 'va1ix_st    ', va1ix_st );
                    END;
                sqlvapt :
                    BEGIN
                    m90int  (pc, 'va1indi_pt  ', va1indi_pt );
                    m90int  (pc, 'va1ix_pt    ', va1ix_pt   );
                    END;
                END;
            (*ENDCASE*) 
            m90int  (pc, '------------', 0 );
            END;
        (*ENDWITH*) 
    (*ENDFOR*) 
    m90int  (pc, 'SQLVA2******', 0 );
    FOR i := 1 TO va2cnt DO
        WITH sqlv2p^ [i] DO
            BEGIN
            m90int  (pc, 'va2tab i****', i );
            m90int2 (pc, 'va2typ      ', va2typ);
            m90int2 (pc, 'va2digit    ', va2digit );
            m90int4 (pc, 'va2size     ', va2size  );
            m90int2 (pc, 'va2frac     ', va2frac  );
            m90int2 (pc, 'va2const    ', va2const );
            m90int  (pc, '------------', 0 );
            END;
        (*ENDWITH*) 
    (*ENDFOR*) 
    m90int  (pc, 'SQLVA3******', 0 );
    FOR i := 1 TO va3cnt DO
        WITH sqlv3p^ [i] DO
            BEGIN
            m90int  (pc, 'va3tab i**  ', i );
            m90int2 (pc, 'va3naml     ', va3naml);
            m90lname (pc, va3name);
            m90int  (pc, '------------', 0 );
            END;
        (*ENDWITH*) 
    (*ENDFOR*) 
    m90int  (pc, 'SQLND*******', 0 );
    FOR i := 1 TO ndmax DO
        WITH ndtabp^ [i] DO
            BEGIN
            m90int  (pc, 'ndcnt  i**  ', i );
            m90int2 (pc, ' ndvarmainix',  ndvarmainix);
            m90int2 (pc, ' ndvararrix ',  ndvararrix);
            m90int2 (pc, ' ndvarentix ',  ndvarentix);
            m90int2 (pc, ' ndtypentix ',  ndtypentix);
            m90int2 (pc, ' ndmaintyind',  ndmaintyindi);
            m90int2 (pc, ' ndcompexpan',  ndcompexpan );
            m90int2 (pc, ' ndarraycnt ',  ndarraycnt );
            m90int2 (pc, ' ndarray 1  ',  ndarrayix [1] );
            m90int2 (pc, ' ndarray 2  ',  ndarrayix [2] );
            m90int2 (pc, ' ndarray 3  ',  ndarrayix [3] );
            m90int2 (pc, ' ndarray 4  ',  ndarrayix [4] );
            m90int2 (pc, ' ndsqlva1st ',  ndsqlva1st );
            m90int2 (pc, ' ndsqlva1ix ',  ndsqlva1ix);
            m90int2 (pc, ' ndsqlva1cnt',  ndsqlva1cnt);
            m90int2 (pc, 'ndBlockId   ', ndBlockId);
            m90int2 (pc, 'ndkano      ', ndkano   );
            m90int2 (pc, 'ndLoopPar   ', ndLoopPar);
            m90int2 (pc, 'ndCompIx    ', ndCompIx );
            m90int2 (pc, 'ndExpanlen  ', ndExpanlen);
            m90int2 (pc, 'ndNamelen   ', ndNamelen);
            IF  ndNamelen > 0
            THEN
                m90buf2 (pc, ndNamePtr^, 1, ndNamelen);
            (*ENDIF*) 
            m90int  (pc, '------------', 0 );
            END;
        (*ENDWITH*) 
    (*ENDFOR*) 
    END;
(*ENDWITH*) 
END;
 
&endif
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
.PA 
