.CM *ID* VCT02    VDN      changed on 1992-08-13-12.21.14 by CARSTEN   *
.ad 8
.bm 8
.fm 4
.bt $Copyright by   Software AG, 1999$$Page %$
.tm 12
.hm 6
.hs 3
.tt 1 $SQL$Project Distributed Database System$VCT02$
.tt 2 $$$
.tt 3 $C. Nemack$String_utilities$1995-05-02$
***********************************************************
.nf


    ========== licence begin LGPL
    Copyright (C) 2002 SAP AG

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

    This library 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
    Lesser General Public License for more details.

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

.fo
.nf
.sp
Module  : String_utilities
=========
.sp
Purpose : This module defines some procedures and functions
          for string- and filename-processing.
.CM *-END-* purpose -------------------------------------
.sp
.cp 3
Define  :
 
        VAR
              c02oline     : tct_line;
              c02outf      : tsp_int4;
              c02delimiter : tct_delim;
              c02uplo      : integer;
              c02lbracket  : tsp_c2;
              c02rbracket  : tsp_c2;
 
        PROCEDURE
              c02init;
 
        PROCEDURE
              c02linelength_init ( l : integer );
 
        PROCEDURE
              c02fncat (
                    VAR s      : tsp_vfilename;
                    VAR s1     : tsp_line;
                    VAR start1 : tsp_int4;
                    VAR n      : tsp_name;
                    nlen       : tsp_int4);
 
        PROCEDURE
              c02vncat (
                    VAR s      : tsp_vfilename;
                    VAR s1     : tsp_name;
                    VAR start1 : tsp_int4;
                    VAR n      : tsp_name;
                    nlen       : tsp_int4);
 
        FUNCTION
              c02getline (
                    infileno : tsp_int4;
                    VAR ln   : tct_line) : tsp_vf_return;
 
        FUNCTION
              c02findstr (
                    VAR ln  : tct_line;
                    VAR beg : integer;
                    nstr    : tsp_name) : tsp_int4;
 
        FUNCTION
              c02strpos (
                    VAR ln   : tct_line;
                    nstr     : tsp_name) : tsp_int4;
 
        FUNCTION
              c02chrpos (
                    VAR ln   : tct_line;
                    beg      : tsp_int4;
                    c        : char) : tsp_int2;
 
        PROCEDURE
              c02getword (
                    VAR ln   : tct_line;
                    VAR beg  : tsp_int2;
                    VAR word : tsp_name);
 
        PROCEDURE
              c02getidentifier (
                    VAR ln   : tct_line;
                    VAR beg  : tsp_int2;
                    VAR word : tsp_knl_identifier);
 
        PROCEDURE
              c02vfwrite (
                    fno      : tsp_int4;
                    VAR line : tct_line);
 
        PROCEDURE
              c02int4to_line (
                    int       : tsp_int4;
                    with_zero : boolean;
                    int_len   : integer;
                    ln_pos    : integer;
                    VAR ln    : tsp_line);
 
        FUNCTION
              c02isend_section ( VAR ln : tct_line ) : boolean;
 
        FUNCTION
              c02vcsymb_get (
                    VAR ln : tct_line;
                    beg    : integer) : tct_vcsymb;
 
        FUNCTION
              c02isblankline ( VAR ln : tct_line ) : boolean;
 
        FUNCTION
              c02toupper ( c : char ) : char;
 
        FUNCTION
              c02tolower ( c : char ) : char;
 
        PROCEDURE
              c02putname (
                    VAR ln  : tct_line;
                    pos     : integer;
                    nam     : tsp_name);
 
        PROCEDURE
              c02putidentifier (
                    VAR ln  : tct_line;
                    pos     : integer;
                    nam     : tsp_knl_identifier);
 
        PROCEDURE
              c02putchar (
                    VAR ln  : tct_line;
                    c       : char);
 
        PROCEDURE
              c02blankline ( VAR ln : tct_line );
 
        PROCEDURE
              c02print_com ( com : tsp_name );
 
        PROCEDURE
              c02trimint4_to_line (
                    int        : tsp_int4;
                    VAR ln_len : integer;
                    VAR ln     : tsp_line);
 
        PROCEDURE
              c02change_date (
                    VAR date   : tsp_c8;
                    VAR u_date : tsp_c8);
 
        FUNCTION
              c02equal_string (
                    VAR nam1 : tsp_name;
                    VAR nam2 : tsp_name) : boolean;
 
        FUNCTION
              c02process_state_ok (
                    process   : tct_do;
                    errfileno : tsp_int4) : boolean;
 
        PROCEDURE
              c02zwrite ( ln : tct_line );
 
.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :
 
        FROM
              RTE_driver : VEN102;
 
        PROCEDURE
              sqlinit (
                    VAR component  : tsp_compname;
                    canceladdr     : tsp_booladdr);
 
        PROCEDURE
              sqlfinit (buffer_pool_size : tsp_int2;
                    VAR poolptr        : tsp_int4;
                    VAR ok             : boolean);
 
        PROCEDURE
              sqlfread (VAR hostfileno : tsp_int4;
                    buf              : tsp_vf_bufaddr;
                    VAR length       : tsp_int4;
                    VAR error        : tsp_vf_return;
                    VAR errtext      : tsp_errtext);
 
        PROCEDURE
              sqlfwrite (VAR hostfileno : tsp_int4;
                    buf               : tct_lineaddr;
                    length            : tsp_int4;
                    VAR error         : tsp_vf_return;
                    VAR errtext       : tsp_errtext);
 
      ------------------------------ 
 
        FROM
              RTE-Extension-10 : VSP10;
 
        PROCEDURE
              s10mv (
                    size1    : tsp_int4;
                    size2    : tsp_int4;
                    VAR val1 : tsp_c64;
                    p1       : tsp_int4;
                    VAR val2 : tsp_line;
                    p2       : tsp_int4;
                    cnt      : tsp_int4);
 
        PROCEDURE
              s10mv2 (
                    size1    : tsp_int4;
                    size2    : tsp_int4;
                    VAR val1 : tsp_line;
                    p1       : tsp_int4;
                    VAR val2 : tsp_line;
                    p2       : tsp_int4;
                    cnt      : tsp_int4);
 
        PROCEDURE
              s10mv3 (
                    size1    : tsp_int4;
                    size2    : tsp_int4;
                    VAR val1 : tsp_c40;
                    p1       : tsp_int4;
                    VAR val2 : tsp_line;
                    p2       : tsp_int4;
                    cnt      : tsp_int4);
 
        PROCEDURE
              s10mv4 (
                    size1    : tsp_int4;
                    size2    : tsp_int4;
                    VAR val1 : tsp_name;
                    p1       : tsp_int4;
                    VAR val2 : tsp_line;
                    p2       : tsp_int4;
                    cnt      : tsp_int4);
 
        PROCEDURE
              s10mv5 (
                    size1    : tsp_int4;
                    size2    : tsp_int4;
                    VAR val1 : tsp_buf;
                    p1       : tsp_int4;
                    VAR val2 : tsp_line;
                    p2       : tsp_int4;
                    cnt      : tsp_int4);
 
        PROCEDURE
              s10mv6 (
                    size1    : tsp_int4;
                    size2    : tsp_int4;
                    VAR val1 : tsp_knl_identifier;
                    p1       : tsp_int4;
                    VAR val2 : tsp_line;
                    p2       : tsp_int4;
                    cnt      : tsp_int4);
 
        PROCEDURE
              s10fil (
                    size     : tsp_int4;
                    VAR m    : tsp_line;
                    pos      : tsp_int4;
                    len      : tsp_int4;
                    fillchar : char);
 
      ------------------------------ 
 
        FROM
              RTE-Extension-30 : VSP30;
 
        FUNCTION
              s30lnr (
                    VAR nam : tsp_name;
                    val     : char;
                    start   : tsp_int4;
                    cnt     : tsp_int4) : tsp_int4;
 
.CM *-END-* use -----------------------------------------
.sp;.cp 3
Synonym :
 
        PROCEDURE
              s10mv;
 
              tsp_moveobj tsp_c64
              tsp_moveobj tsp_line
 
        PROCEDURE
              s10mv2;
 
              tsp_moveobj tsp_line
              tsp_moveobj tsp_line
 
        PROCEDURE
              s10mv3;
 
              tsp_moveobj tsp_c40
              tsp_moveobj tsp_line
 
        PROCEDURE
              s10mv4;
 
              tsp_moveobj tsp_name
              tsp_moveobj tsp_line
 
        PROCEDURE
              s10mv5;
 
              tsp_moveobj tsp_buf
              tsp_moveobj tsp_line
 
        PROCEDURE
              s10mv6;
 
              tsp_moveobj tsp_knl_identifier
              tsp_moveobj tsp_line
 
        PROCEDURE
              sqlfwrite;
 
              tsp_vf_bufaddr tct_lineaddr
 
        FUNCTION
              s30lnr;
 
              tsp_moveobj tsp_name
 
.CM *-END-* synonym -------------------------------------
Author  : C. Nemack
.sp
.cp 3
Created : 1988-07-18
.sp
.cp 3
Version : 1999-09-06
.sp
.cp 3
Release :  6.1.1         Date : 1995-05-02
.sp
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Specification:
 
.CM *-END-* specification -------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Description:
.sp 2
PROCEDURE c02init:
.sp
Special initialisation for vct-modules. The length of the outputline
c02oline will be initialized by 1.
.sp 2
PROCEDURE c02fncat:
.sp
This procedure builds a filename for the Virtual-File. The first part
of the name is specified by the line 's1' and the position 'start1'.
The search will start at 'start1' and all blanks from 'start1' to the
first non-blank character are suppressed.
The second part of filename is given by line 's2' and the length 'len2'.
The filename will be returned in the first parameter of the procedure
's'. Start1 points to the next word on line 's1'.
.sp 2
PROCEDURE c02vncat:
.sp
This procedure build a filename for the Virtual-File. The first part
of the name is specified by the line 's1' and the position 'start1'.
The second part of filename is given by line 's2' and the length 'len2'.
The filename will be returned in the first parameter of the procedure
's'. Start1 points to the next word on line 's1'.
.sp 2
FUNCTION c02getline:
.sp
The function c02getline gets a line from the virtual-file, which
is specified by the 'infileno'. The errorcode will be returned as
function-result.
.sp
.nf
NOTE: The maximum linelength of c02getline is defined as
      'c02_lnlength' and the returned length of line is
      defined by 'maxlinelength' in procedure INIT. If a
      line is longer as maxlinelength, it will be truncated
      to maxlinelength.
 
      For using an other linelength see procedure
      C02_LINELENGTH_INIT.
.fo
.sp 2
FUNCTION c02findstr:
.sp
This function returns the position of line where the name 'nstr'
was found. If the line doesn't contain the char, the function returns
zero. The parameter 'beg' is set to the position behind 'nstr' if
the name was fouynd, else it will be set to zero. If 'beq' is equal
to zero, then there is no name 'nstr' on the line.
.sp 2
FUNCTION c02strpos:
.sp
This function returns the position of line where the name 'nstr'
was found. If the line doesn't contain the nstr, the function returns
zero.
.sp 2
FUNCTION c02chrpos:
.sp
This function returns the position of line where the char 'c'
was found. If the line doesn't contain the char, the function returns
zero.
.sp 2
PROCEDURE c02getword:
.sp
This procedure copies the 'word' from line 'ln.l' beginning at
position 'beg' and ending when maxnamelength is reached or a delimiter
on line is found. The position of next word will be returned in 'beg'
also if the word is longer than maxnamelength.
.sp 2
PROCEDURE c02vfwrite:
.sp
This procedure writes a line into the virtual-file specified by 'fno'.
The length of the line is set to 1.
.sp 2
PROCEDURE c02int4to_line:
.sp
The integer 'int' is dumped as printable characters on line 'ln'. The
parameter 'ln_pos' specifies the position of starting the dump on line.
'int_len' specifies the number of bytes which shall be used for the
output of the integer. Leading zeros can be generated by setting
'with_zeros = true'.
.sp 2
FUNCTION c02isend_section:
.sp
This function will be true, if the keywords for sectionend are on given
line.
.sp 2
FUNCTION c02vcsymb_get:
.sp
This function returns the vcs_symbol found on given line starting at
position beg. If no vcs_symbol was found, it returns 'vcs_emty'.
.sp 2
FUNCTION c02isblankline:
.sp
This funtion checks the given line. If all characters on line are equal
blank it returns true, else false.
.sp 2
FUNCTION c02toupper:
.sp
The given character will be transformed to s60uppcase. If the character
is equal to underline, it will be transformed to 'x'.
.sp 2
FUNCTION c02tolower:
.sp
The given character will be transformed to s60lowercase. If the character
is equal to underline, it will be transformed to 'x'.
.sp 2
PROCEDURE c02putname:
.sp
The name 'nam' will be inserted in line 'ln' at position 'pos'.
.sp 2
PROCEDURE c02putchar:
.sp
The character 'c' will be added at the end of the line 'ln'.
.sp 2
PROCEDURE c02blankline:
.sp
The given line will be filled with blanks. The length of line is set
to one.
.sp 2
PROCEDURE c02print_com:
.sp
The given name 'com' will be transformed to a special outputformat.
.sp 2
PROCEDURE c02trimint4_to_line:
.sp
The integer int will be dump 'int' as printable characters on line 'ln'.
The starting position is given by 'ln_len'. The filled length of ln
is returned in ln_len.
.sp 2
PROCEDURE c02change_date:
.sp
This procedure transforms the date from format (nam1) 'YYYYMMDD' to
the format (nam2) 'DD:MM:YY'.
.sp 2
FUNCTION c02equal_string:
.sp
This function compares two names without making differents between
upper and lower letters. If the names are equal to each other, the
function returns true, else false.
.sp 2
.sp2
FUNCTION c02process_state_ok:
.sp
This function checks the given process-state. It should be called at the
end of the main-procedure of programs, which processes the module_frame.
If the given process-state
equal to 'do_workend', then the work is done correctly. In other cases,
The function generates an errormessage which specifies the
missing key-words in the module-frame. The errormessage is genearted by
the procedure 'put_errormsg'.
.sp 2
PROCEDURE put_errormsg:
.sp
This procedure build an errormessage and writes it to the specified
errorfile.
.cm
.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    :
 
 
VAR
      c02lnlength   : integer;
      c02iline      : tct_line;
      c02hline      : tct_line;
 
 
(*------------------------------*) 
 
PROCEDURE
      c02zwrite (
            ln : tct_line);
 
VAR
      i : integer;
 
BEGIN
write (ln.len:2, '>');
FOR i := 1 TO ln.len DO
    write (ln.l [ i ] );
(*ENDFOR*) 
writeln ('<');
END; (* c02zwrite *)
 
(*------------------------------*) 
 
PROCEDURE
      c02init;
 
VAR
      dummy_ptr  : tsp_int4;
      ok         : boolean;
      component  : tsp_compname;
      dummy_addr : tsp_booladdr;
 
BEGIN
component := bsp_c64;
dummy_addr := NIL;
sqlinit (component, dummy_addr);
sqlfinit (0, dummy_ptr, ok);
c02delimiter := [  cct_l_parenth, cct_r_parenth, cct_komma,
      cct_colon, cct_dollar, cct_asterisk, bsp_c1,
      cct_equal, cct_semicolon, cct_plus, cct_hyphen  ] ;
c02oline.len := 1;
c02linelength_init (mxct_line); (* max. pascal linelength *)
c02uplo      := abs(ord('A') - ord('a'));
c02hline.adr := @c02hline.l;
c02iline.adr := @c02iline.l;
c02oline.adr := @c02oline.l;
(* Die in Pascal gueltigen 'eckigen' Klammern (runde Klammer + Punkt) *)
(* wurden leider immer bei der Portierung umgewandelt. *)
c02lbracket [  1  ] := cct_l_parenth;
c02lbracket [  2  ] := cct_period;
c02rbracket [  2  ] := cct_r_parenth;
c02rbracket [  1  ] := cct_period;
END; (* c02init *)
 
(*------------------------------*) 
 
PROCEDURE
      c02linelength_init (
            l : integer);
 
BEGIN
c02lnlength := l;
END; (* c02linelength_init *)
 
(*------------------------------*) 
 
PROCEDURE
      c02fncat (
            VAR s      : tsp_vfilename;
            VAR s1     : tsp_line;
            VAR start1 : tsp_int4;
            VAR n      : tsp_name;
            nlen       : tsp_int4);
 
VAR
      i                : tsp_int4;
      j                : tsp_int4;
      begpos           : tsp_int4;
      hname            : tsp_vfilename;
 
BEGIN
&IFDEF DEBUG
writeln('c02_fn_c s1      >', s1, '<');
writeln('                 >123456789-123456789-');
writeln('         start1 = ', start1);
&ENDIF
s := bsp_c64;
j := mxsp_line;
(* get last non_blank character-position *)
WHILE ( (s1 [ j ]  = bsp_c1) AND (j > start1) ) DO
    j := pred(j);
(*ENDWHILE*) 
i := start1;
(* skip leading blanks, beginning at 'start1' *)
WHILE ( (s1 [ i ]  = bsp_c1) AND (j > i) ) DO
    i := succ(i);
(*ENDWHILE*) 
begpos := i;
&IFDEF DEBUG
writeln('         j      = ', j);
writeln('         begpos = ', begpos);
&ENDIF
(* move the filename from s1() to s() *)
WHILE (   (s1 [ begpos  ] <> bsp_c1)
      AND (begpos-start1 <= mxsp_vfilename)
      AND (begpos <= j) ) DO
    BEGIN
    s [ begpos  ] := s1 [ begpos ] ;
    begpos      := succ(begpos);
    END;
(*ENDWHILE*) 
i      := begpos;
j      := 1;
start1 := succ(begpos);  (* first possible pos of next word in s1 *)
(* append  n() to s() *)
&IFDEF DEBUG
writeln('         i      = ', i);
&ENDIF
WHILE ((i < mxsp_vfilename) AND (j <= nlen)) DO
    BEGIN
    s [ i ]  := n [ j ] ;
    i      := succ(i);
    j      := succ(j);
    END;
(*ENDWHILE*) 
&IF $OS = UNIX
FOR i := 1 TO mxsp_vfilename
      DO
    s[ i ] := c02tolower(s[ i ]);
(*ENDFOR*) 
&ELSE
j := 1;
FOR i := 1 TO mxsp_vfilename DO
    BEGIN
    IF  (j <= mxsp_vfilename)
    THEN
        BEGIN
        IF  (s [i] = '\\')
        THEN
            BEGIN
            hname [j] := '\\';
            j := j + 1;
            END;
        (*ENDIF*) 
        hname [ j ] := s [ i ];
        j := j + 1;
        END;
    (*ENDIF*) 
    END;
(*ENDFOR*) 
s := hname;
&ENDIF
&IFDEF UDEBUG
writeln('c02fncat :', s);
&ENDIF
END; (* c02fncat *)
 
(*------------------------------*) 
 
PROCEDURE
      c02vncat (
            VAR s      : tsp_vfilename;
            VAR s1     : tsp_name;
            VAR start1 : tsp_int4;
            VAR n      : tsp_name;
            nlen       : tsp_int4);
 
VAR
      i                 : tsp_int4;
      j                 : tsp_int4;
 
BEGIN
WHILE ((start1 < mxsp_name) AND (s1 [ start1  ] <> bsp_c1)) DO
    BEGIN
&   IF $OS = UNIX
    s[ start1 ] := c02tolower(s1[ start1 ]);
&   ELSE
    s[ start1 ] := s1 [ start1 ] ;
&   ENDIF
    start1      := succ(start1);
    END;
(*ENDWHILE*) 
i      := start1;
j      := 1;
start1 := succ(start1);  (* next word *)
WHILE ((i < mxsp_name) AND (j <= nlen)) DO
    BEGIN
    s[ i ] := n [ j ] ;
    i      := succ(i);
    j      := succ(j);
    END;
(*ENDWHILE*) 
FOR j := i TO mxsp_vfilename DO
    BEGIN
    s [ j ]  := bsp_c1;
    END;
(*ENDFOR*) 
&IFDEF UDEBUG
writeln('c02vncat :', s);
&ENDIF
END; (* c02vncat *)
 
(*------------------------------*) 
 
FUNCTION
      c02getline (
            infileno : tsp_int4;
            VAR ln   : tct_line) : tsp_vf_return;
 
VAR
      start_pos   : integer;
      fbuflen     : tsp_int4;
      fbuf        : tsp_buf;
      ferr        : tsp_vf_return;
      ferr_txt    : tsp_errtext;
 
BEGIN
(* h.b. 6.9.1999
      Achtung! Kann zu Abstuerzen fuehren, da die LZU bis zu 64K liefert  *)
sqlfread (infileno, @fbuf, fbuflen, ferr, ferr_txt);
(* correction for length (file was created with fixed length) *)
WHILE ((fbuflen > 1) AND (fbuf [ fbuflen  ] = bsp_c1)) DO
    fbuflen := fbuflen - 1;
(*ENDWHILE*) 
IF  (fbuflen <= c02lnlength)
THEN
    BEGIN
    ln.len    := fbuflen;
    start_pos := 1;
    END
ELSE
    BEGIN
    ln.len    := c02lnlength;
    start_pos := fbuflen - c02lnlength + 1;
    ferr      := vf_notok; 
    END;
(*ENDIF*) 
s10mv5 (sizeof(fbuf), mxsp_line, fbuf, start_pos, ln.l, 1, ln.len);
&IFDEF DEBUG
write('c02_getl : ');
c02zwrite(ln);
&ENDIF
c02getline := ferr; 
END; (* c02getline *)
 
(*------------------------------*) 
 
FUNCTION
      c02findstr (
            VAR ln  : tct_line;
            VAR beg : integer;
            nstr    : tsp_name) : tsp_int4;
 
VAR
      i       : tsp_int4;
      j       : tsp_int4;
      r       : tsp_int4;
      namlen  : tsp_int4;
      equal   : boolean;
 
BEGIN
&IFDEF DEBUG
write ('02_find_str ');
zwrite (ln);
writeln ('>', nstr, '<     begin = ', beg:3);
&ENDIF
i      := beg;
j      := 1;
namlen := mxsp_name;
WHILE ((namlen > 1) AND (nstr [ namlen  ] = bsp_c1)) DO
    namlen := namlen - 1;
(*ENDWHILE*) 
IF  (ln.len >= namlen)
THEN
    REPEAT
        BEGIN
        r     := abs(ord(nstr [ 1 ] ) - ord(ln.l [ i ] ));
        i     := succ(i);
        j     := 1;
        equal := ((r = 0) OR (r = c02uplo));
&       IFDEF DEBUG
        writeln ;
&       ENDIF
        WHILE (equal AND (i <= ln.len) AND (j < namlen)) DO
            BEGIN
            j := succ(j);
            r := abs(ord(nstr [ j ] ) - ord(ln.l [ i ] ));
            i := succ(i);
            equal := ((r = 0) OR (r = c02uplo));
&           IFDEF DEBUG
            write (ord(equal):1, '  r = ', r:3, ' ');
&           ENDIF
            END;
        (*ENDWHILE*) 
        END;
    UNTIL
        ((i > ln.len) OR (equal AND (j = namlen)));
    (*ENDREPEAT*) 
&IFDEF DEBUG
(*ENDIF*) 
write ('i = ', i:3, '  j = ', j:3, '  equal = ', ord(equal):1);
writeln ('namlen = ', namlen:3);
&ENDIF
IF  (equal AND ((i > ln.len) OR (ln.l [ i ]  in c02delimiter)))
THEN
    BEGIN
    beg          := i;
    c02findstr := i - j;
    END
ELSE
    BEGIN
    beg          := 0;
    c02findstr := 0;
    END
(*ENDIF*) 
END; (* c02findstr *)
 
(*------------------------------*) 
 
FUNCTION
      c02strpos (
            VAR ln : tct_line;
            nstr   : tsp_name) : tsp_int4;
 
VAR
      i       : tsp_int4;
      j       : tsp_int4;
      r       : tsp_int4;
      namlen  : tsp_int4;
      equal   : boolean;
 
BEGIN
&IFDEF DEBUG
write ('02strpos ');
zwrite (ln);
writeln ('>', nstr, '<');
&ENDIF
i      := 1;
j      := 1;
equal  := false;
namlen := mxsp_name;
WHILE ((namlen > 1) AND (nstr [ namlen  ] = bsp_c1)) DO
    namlen := namlen - 1;
(*ENDWHILE*) 
IF  (ln.len >= namlen)
THEN
    REPEAT
        BEGIN
        r     := abs(ord(nstr [ 1 ] ) - ord(ln.l [ i ] ));
        i     := succ(i);
        j     := 1;
        equal := ((r = 0) OR (r = c02uplo));
&       IFDEF DEBUG
        writeln ;
&       ENDIF
        WHILE (equal AND (i <= ln.len) AND (j < namlen)) DO
            BEGIN
            j := succ(j);
            r := abs(ord(nstr [ j ] ) - ord(ln.l [ i ] ));
            i := succ(i);
            equal := ((r = 0) OR (r = c02uplo));
&           IFDEF DEBUG
            write (ord(equal):1, '  r = ', r:3, ' ');
&           ENDIF
            END;
        (*ENDWHILE*) 
        END;
    UNTIL
        ((i > ln.len) OR (equal AND (j = namlen)));
    (*ENDREPEAT*) 
&IFDEF DEBUG
(*ENDIF*) 
write ('i = ', i:3, '  j = ', j:3, '  equal = ', ord(equal):1);
writeln ('namlen = ', namlen:3);
&ENDIF
IF  (equal AND ((i > ln.len) OR (ln.l [ i ]  in c02delimiter)))
THEN
    c02strpos := i - j
ELSE
    c02strpos := 0;
(*ENDIF*) 
END; (* c02strpos *)
 
(*------------------------------*) 
 
FUNCTION
      c02chrpos (
            VAR ln : tct_line;
            beg    : tsp_int4;
            c      : char) : tsp_int2;
 
VAR
      i       : tsp_int4;
      pos     : tsp_int2;
 
BEGIN
i   := beg;
pos := 0;
WHILE (i <= ln.len) DO
    BEGIN
    IF  (ln.l [ i ]  = c)
    THEN
        BEGIN
        pos := i;
        i   := ln.len + 1;   (* exit while *)
        END
    ELSE
        i := succ(i);
    (*ENDIF*) 
    END;
(*ENDWHILE*) 
c02chrpos := pos;
END; (* c02chrpos *)
 
(*------------------------------*) 
 
PROCEDURE
      c02getword (
            VAR ln   : tct_line;
            VAR beg  : tsp_int2;
            VAR word : tsp_name);
 
VAR
      i                       : integer;
      delim_end               : boolean;
 
BEGIN
i         := 0;
word      := bsp_name;
delim_end := false;
WHILE ((beg < ln.len) AND (ln.l [ beg  ] = bsp_c1)) DO
    beg := succ(beg);
(*ENDWHILE*) 
WHILE ((beg <= ln.len) AND (i < mxsp_name)) DO
    IF  (ln.l [ beg  ] IN c02delimiter)
    THEN
        BEGIN
        delim_end := true;
        i         := mxsp_name;  (* exit while *)
        END
    ELSE
        BEGIN
        i         := succ(i);
        word [ i ]  := ln.l [ beg ] ;
        beg       := succ(beg);
        END;
    (*ENDIF*) 
(*ENDWHILE*) 
WHILE ((beg <= ln.len) AND NOT delim_end) DO
    IF  (ln.l [ beg  ] IN c02delimiter)
    THEN
        delim_end := true
    ELSE
        beg := succ(beg);
    (*ENDIF*) 
(*ENDWHILE*) 
END; (* c02getword *)
 
        PROCEDURE
              c02getidentifier (
                    VAR ln   : tct_line;
                    VAR beg  : tsp_int2;
                    VAR word : tsp_knl_identifier);
 VAR
      i                       : integer;
      delim_end               : boolean;
 
BEGIN
i         := 0;
word      := bsp_knl_identifier;
delim_end := false;
WHILE ((beg < ln.len) AND (ln.l [ beg  ] = bsp_c1)) DO
    beg := succ(beg);
(*ENDWHILE*) 
WHILE ((beg <= ln.len) AND (i < sizeof(tsp_knl_identifier))) DO
    IF  (ln.l [ beg  ] IN c02delimiter)
    THEN
        BEGIN
        delim_end := true;
        i         := sizeof(tsp_knl_identifier);  (* exit while *)
        END
    ELSE
        BEGIN
        i         := succ(i);
        word [ i ]  := ln.l [ beg ] ;
        beg       := succ(beg);
        END;
    (*ENDIF*) 
(*ENDWHILE*) 
WHILE ((beg <= ln.len) AND NOT delim_end) DO
    IF  (ln.l [ beg  ] IN c02delimiter)
    THEN
        delim_end := true
    ELSE
        beg := succ(beg);
    (*ENDIF*) 
(*ENDWHILE*) 
END; (* c02getidentifier *)

(*------------------------------*) 
 
PROCEDURE
      c02vfwrite (
            fno      : tsp_int4;
            VAR line : tct_line);
 
VAR
      ferr        : tsp_vf_return;
      ferr_txt    : tsp_errtext;
 
BEGIN
&IFDEF DEBUG
writeln ('02_vf_write ', line.len:2, '>', line.l:line.len, '<');
&ENDIF
sqlfwrite (fno, line.adr, line.len, ferr, ferr_txt);
line.len := 1;
END; (* c02vfwrite *)
 
(*------------------------------*) 
 
PROCEDURE
      c02int4to_line (
            int       : tsp_int4;
            with_zero : boolean;
            int_len   : integer;
            ln_pos    : integer;
            VAR ln    : tsp_line);
 
VAR
      rem : tsp_int4;
      i   : integer;
 
BEGIN
IF  int < 0
THEN
    rem := -int
ELSE
    rem := int;
(*ENDIF*) 
FOR i := int_len DOWNTO 1 DO
    BEGIN
    ln [ ln_pos + i - 1  ] := chr((rem MOD 10) + ord('0'));
    rem := rem DIV 10
    END;
(*ENDFOR*) 
IF  with_zero
THEN
    i := ln_pos
ELSE
    BEGIN
    i := ln_pos;
    WHILE (i < ln_pos + int_len - 1) AND (ln [ i ]  = '0') DO
        BEGIN
        ln [ i ]  := bsp_c1;
        i := i + 1
        END;
    (*ENDWHILE*) 
    IF  i > ln_pos
    THEN
        i := i - 1
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  int < 0
THEN
    ln [ i ]  := cct_hyphen
(*ENDIF*) 
END; (* c02int4to_line *)
 
(*------------------------------*) 
 
FUNCTION
      c02isend_section (
            VAR ln : tct_line) : boolean;
 
VAR
      end_found : boolean;
 
BEGIN
end_found := false;
IF  (c02strpos (ln, cct_n_cm) = 1)
THEN
    IF  (c02strpos (ln, cct_n_endpart) <> 0)
    THEN
        end_found := true;
    (*ENDIF*) 
(*ENDIF*) 
c02isend_section := end_found;
END; (* c02isend_section *)
 
(*------------------------------*) 
 
FUNCTION
      c02vcsymb_get (
            VAR ln : tct_line;
            beg    : integer) : tct_vcsymb;
 
VAR
      symb : tct_vcsymb;
 
BEGIN
symb := vcs_empty;
IF  ((ln.len = beg + 8) AND (c02strpos (ln, cct_n_procedure) = beg))
THEN
    symb := vcs_pr
ELSE
    IF  ((ln.len = beg + 7) AND (c02strpos (ln, cct_n_function) = beg))
    THEN
        symb := vcs_fu
    ELSE
        IF  c02strpos (ln, cct_n_type ) = beg
        THEN
            symb := vcs_ty
        ELSE
            IF  c02strpos (ln, cct_n_const) = beg
            THEN
                symb := vcs_co
            ELSE
                IF  c02strpos (ln, cct_n_var) = beg
                THEN
                    symb := vcs_va
                ELSE
                    IF  c02strpos (ln, cct_n_from) = beg
                    THEN
                        symb := vcs_fr
                    ELSE
                        IF  c02strpos (ln, cct_n_begin) = beg
                        THEN
                            symb := vcs_be
                        ELSE
                            IF  (c02strpos(ln,
                                'END               ') = beg) AND
                                (c02chrpos(ln, beg, cct_semicolon) <> 0)
                            THEN
                                symb := vcs_en
                            ELSE
                                IF  ((ln.len = beg + 6) AND
                                    (c02strpos (ln, cct_n_program) = beg))
                                THEN
                                    symb := vcs_main;
                                (*ENDIF*) 
                            (*ENDIF*) 
                        (*ENDIF*) 
                    (*ENDIF*) 
                (*ENDIF*) 
            (*ENDIF*) 
        (*ENDIF*) 
    (*ENDIF*) 
(*ENDIF*) 
c02vcsymb_get := symb;
END; (* c02vcsymb_get *)
 
(*------------------------------*) 
 
FUNCTION
      c02isblankline (
            VAR ln : tct_line) : boolean;
 
VAR
      i     : integer;
 
BEGIN
i := ln.len;
WHILE (i >= 1) AND (ln.l [ i ]  = bsp_c1) DO
    i := i - 1;
(*ENDWHILE*) 
IF  (i < 1)
THEN
    c02isblankline := true
ELSE
    c02isblankline := false;
(*ENDIF*) 
END; (* c02isblankline *)
 
(*------------------------------*) 
 
FUNCTION
      c02toupper (
            c : char) : char;
 
CONST
      underline = '_';
 
BEGIN
IF  (c IN [  'a'..'i', 'j'..'r', 's'..'z' ] )
THEN
    c := chr(ord(c) + ord ('A') - ord ('a'))
ELSE
    IF  (c = underline)
    THEN
        c := 'x';
    (*ENDIF*) 
(*ENDIF*) 
c02toupper := c
END; (* c02toupper *)
 
(*------------------------------*) 
 
FUNCTION
      c02tolower (
            c : char) : char;
 
CONST
      underline = '_';
 
BEGIN
IF  (c IN [  'A'..'I', 'J'..'R', 'S'..'Z' ] )
THEN
    c := chr(ord(c) + ord ('a') - ord ('A'))
ELSE
    IF  (c = underline)
    THEN
        c := 'x';
    (*ENDIF*) 
(*ENDIF*) 
c02tolower := c
END; (* c02tolower *)
 
(*------------------------------*) 
 
PROCEDURE
      c02putname (
            VAR ln : tct_line;
            pos    : integer;
            nam    : tsp_name);
 
VAR
      i : integer;
      n : integer;
 
BEGIN
n := mxsp_name;
WHILE (n > 0) AND (nam [ n ]  = bsp_c1) DO
    n := n - 1;
(*ENDWHILE*) 
WITH ln DO
    BEGIN
    IF  pos = 0
    THEN
        IF  len > 1
        THEN
            pos      := len + 1
        ELSE
            pos := 1;
        (*ENDIF*) 
    (*ENDIF*) 
    s10mv4 (mxsp_name, mxsp_line, nam, 1, l, pos, n);
    len := pos + n;
    END
(*ENDWITH*) 
END; (* c02putname *)
 
(*------------------------------*) 
        PROCEDURE
              c02putidentifier (
                    VAR ln  : tct_line;
                    pos     : integer;
                    nam     : tsp_knl_identifier);
 
VAR
      i : integer;
      n : integer;
 
BEGIN
n := sizeof(tsp_knl_identifier);
WHILE (n > 0) AND (nam [ n ]  = bsp_c1) DO
    n := n - 1;
(*ENDWHILE*) 
WITH ln DO
    BEGIN
    IF  pos = 0
    THEN
        IF  len > 1
        THEN
            pos      := len + 1
        ELSE
            pos := 1;
        (*ENDIF*) 
    (*ENDIF*) 
    s10mv6 (sizeof(nam), mxsp_line, nam, 1, l, pos, n);
    len := pos + n;
    END
(*ENDWITH*) 
END; (* c02putidentifier *)
 
 
PROCEDURE
      c02putchar (
            VAR ln : tct_line;
            c      : char);
 
BEGIN
WITH ln DO
    BEGIN
    len      := len + 1;
    l [ len  ] := c
    END
(*ENDWITH*) 
END; (* c02putchar *)
 
(*------------------------------*) 
 
PROCEDURE
      c02blankline (
            VAR ln : tct_line);
 
VAR
      i : integer;
 
BEGIN
FOR i := 1 TO mxsp_line DO
    ln.l [ i ]  := bsp_c1;
(*ENDFOR*) 
ln.len := 1;
END; (* c02blankline *)
 
(*------------------------------*) 
 
PROCEDURE
      c02print_com (
            com : tsp_name);
 
VAR
      out : tct_line;
 
BEGIN
c02blankline (out);
c02putname (out, 0, cct_n_combeg);
c02putname (out, 0, com);
c02putname (out, 0, cct_n_u_line);
c02putname (out, 0, cct_n_comend);
s10mv2 (mxsp_line, mxsp_line, out.l, 1, c02oline.l,
      c02oline.len, out.len);
c02oline.len := c02oline.len + out.len - 1;
c02vfwrite (c02outf, c02oline);
END; (* c02print_com *)
 
(*------------------------------*) 
 
PROCEDURE
      c02trimint4_to_line (
            int        : tsp_int4;
            VAR ln_len : integer;
            VAR ln     : tsp_line);
 
VAR
      rem   : tsp_int4;
      i     : integer;
      len   : integer;
 
BEGIN
IF  int < 0
THEN
    BEGIN
    ln_len := ln_len + 1;
    ln [ ln_len  ] := cct_hyphen;
    rem := -int
    END
ELSE
    rem := int;
(*ENDIF*) 
len := 1;
WHILE rem >= 10 DO
    BEGIN
    len := len + 1;
    rem := rem DIV 10
    END;
(*ENDWHILE*) 
IF  int < 0
THEN
    rem := -int
ELSE
    rem := int;
(*ENDIF*) 
FOR i := len DOWNTO 1 DO
    BEGIN
    ln [ ln_len+i  ] := chr((rem MOD 10) + ord('0'));
    rem := rem DIV 10
    END;
(*ENDFOR*) 
ln_len := ln_len + len
END; (* c02trimint4_to_line *)
 
(*------------------------------*) 
 
PROCEDURE
      c02change_date (
            VAR date   : tsp_c8;
            VAR u_date : tsp_c8);
 
BEGIN
u_date [ 1 ]  := date [ 7 ] ;
u_date [ 2 ]  := date [ 8 ] ;
u_date [ 3 ]  := cct_colon;
u_date [ 4 ]  := date [ 5 ] ;
u_date [ 5 ]  := date [ 6 ] ;
u_date [ 6 ]  := cct_colon;
u_date [ 7 ]  := date [ 3 ] ;
u_date [ 8 ]  := date [ 4 ] ;
END; (* c02change_date *)
 
(*------------------------------*) 
 
FUNCTION
      c02equal_string (
            VAR nam1 : tsp_name;
            VAR nam2 : tsp_name) : boolean;
 
VAR
      i       : tsp_int4;
      r       : tsp_int4;
      namlen1 : tsp_int4;
      namlen2 : tsp_int4;
 
BEGIN
i       := 1;
namlen1 := mxsp_name;
WHILE ((namlen1 > 1) AND (nam1 [ namlen1  ] = bsp_c1)) DO
    namlen1 := namlen1 - 1;
(*ENDWHILE*) 
namlen2 := mxsp_name;
WHILE ((namlen2 > 1) AND (nam2 [ namlen2  ] = bsp_c1)) DO
    namlen2 := namlen2 - 1;
(*ENDWHILE*) 
IF  (namlen1 <> namlen2)
THEN
    c02equal_string := false
ELSE
    BEGIN
    r := abs(ord(nam2 [ i ] ) - ord(nam1 [ i ] ));
    WHILE (((r = 0) OR (r = c02uplo)) AND (i < namlen1)) DO
        BEGIN
        i := succ(i);
        r := abs(ord(nam2 [ i ] ) - ord(nam1 [ i ] ));
        END;
    (*ENDWHILE*) 
    END;
(*ENDIF*) 
IF  ((r = 0) OR (r = c02uplo))
THEN
    c02equal_string := true
ELSE
    c02equal_string := false;
(*ENDIF*) 
END; (* c02equal_string *)
 
(*------------------------------*) 
 
PROCEDURE
      put_errormsg (
            errfileno : tsp_int4;
            process   : tsp_name;
            name1     : tsp_name;
            name2     : tsp_name);
 
CONST
      c_nxt_symb = '< AND >           ';
 
VAR
      l    : integer;
      i    : integer;
      nam  : tsp_name;
      hc64 : tsp_c64;
 
BEGIN
hc64 :=
      'ERROR Missing keyword(s) in moduleframe : >                     ';
s10mv (mxsp_c64, mxsp_line, hc64, 1, c02hline.l, 1, 43);
c02hline.len  := 43;
l := s30lnr (name1, bsp_c1, 1, mxsp_name);
s10mv4 (mxsp_name, mxsp_line, name1, 1,
      c02hline.l, c02hline.len + 1, l);
c02hline.len  := c02hline.len + l;
l := s30lnr (name2, bsp_c1, 1, mxsp_name);
IF  (l > 0)
THEN
    BEGIN
    nam := c_nxt_symb;
    i   := s30lnr (nam, bsp_c1, 1, mxsp_name);
    s10mv4 (mxsp_name, mxsp_line, nam, 1,
          c02hline.l, c02hline.len + 1, i);
    c02hline.len  := c02hline.len + i;
    s10mv4 (mxsp_name, mxsp_line, name2, 1,
          c02hline.l, c02hline.len + 1, l);
    c02hline.len  := c02hline.len + l;
    END;
(*ENDIF*) 
c02hline.len  := c02hline.len + 1;
c02hline.l [ c02hline.len  ] := '<';
c02vfwrite (errfileno, c02hline);
hc64 :=
      '      current process state : >                                 ';
s10mv (mxsp_c64, mxsp_line, hc64, 1, c02hline.l, 1, 30);
c02hline.len  := 30;
l   := s30lnr (process, bsp_c1, 1, mxsp_name);
s10mv4 (mxsp_name, mxsp_line, process, 1,
      c02hline.l, c02hline.len + 1, l);
c02hline.len  := c02hline.len + l + 1;
c02hline.l [ c02hline.len  ] := '<';
c02vfwrite (errfileno, c02hline);
END; (* put_errormsg *)
 
(*------------------------------*) 
 
FUNCTION
      c02process_state_ok (
            process   : tct_do;
            errfileno : tsp_int4) : boolean;
 
VAR
      ok      : boolean;
      hc40    : tsp_c40;
 
BEGIN
ok := false;
CASE process OF
    do_searchvdn    :
        put_errormsg (errfileno, 'search vdn        ', cct_n_tt1,
              '$$$               ');
    do_searchdate   :
        put_errormsg (errfileno, 'search date       ', cct_n_tt3,
              '$$$               ');
    do_searchmod    :
        put_errormsg (errfileno, 'search mod        ', cct_n_module,
              ':                 ');
    do_searchdef    :
        put_errormsg (errfileno, 'search def        ', cct_n_define, bsp_name);
    do_workdef      :
        put_errormsg (errfileno, 'work def          ', cct_n_cm, cct_n_endpart);
    do_searchuse    :
        put_errormsg (errfileno, 'search use        ', cct_n_use, bsp_name);
    do_workuse      :
        put_errormsg (errfileno, 'work use          ', cct_n_cm, cct_n_endpart);
    do_searchcode   :
        put_errormsg (errfileno, 'search code       ', cct_n_cm, cct_n_code);
    do_workcode     :
        put_errormsg (errfileno, 'work code         ', cct_n_cm, cct_n_endpart);
    do_searchsyn    :
        put_errormsg (errfileno, 'search syn        ', cct_n_synonym, bsp_name);
    do_worksyn      :
        put_errormsg (errfileno, 'work syn          ', cct_n_cm, cct_n_endpart);
    do_prettyresult :
        put_errormsg (errfileno, 'pretty result     ', cct_n_cm, cct_n_endpart);
    do_searchstruct :
        put_errormsg (errfileno, 'search struct     ', cct_n_cm,
              cct_n_struct_lc);
    do_searchversion :
        put_errormsg (errfileno, 'search version    ', cct_n_version, bsp_name);
    do_workend      :
        (* program worked correctly *)
        ok := true;
    OTHERWISE
        BEGIN
        hc40     := 'Invalid process state                   ';
        s10mv3 (mxsp_c40, mxsp_line, hc40, 1, c02hline.l, 1, 30);
        c02hline.len := 22;
        c02vfwrite (errfileno, c02hline);
        END;
    END;
(*ENDCASE*) 
c02process_state_ok := ok;
END; (* c02process_state_ok *)
 
&IFDEF DEBUG
(*------------------------------*) 
 
PROCEDURE
      zwrite (
            ln : tct_line);
 
VAR
      i : integer;
 
BEGIN
write (ln.len:2, '>');
FOR i := 1 TO ln.len DO
    write (ln.l [ i ] );
(*ENDFOR*) 
writeln ('<');
END; (* zwrite *)
 
&ENDIF
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
*-PRETTY-*  statements    :        337
*-PRETTY-*  lines of code :       1011        PRETTYX 3.10 
*-PRETTY-*  lines in file :       1525         1997-12-10 
.PA 
