.CM *ID* VCT14    VDN      changed on 1992-11-23-16.57.44 by CARSTEN   *
.CM
.bm  6
.fm  3
.fs  1
.ad  5
.tm 10
.hm  4
.hs  3
.bt $Copyright by   Software AG, 1999$$Page %$
.tt 1 $SQL$Project Distributed Database System$VCT14$
.tt 2 $$$$
.tt 3 $C. Segieth$PRETTYX$1996-12-10$
***********************************************************
.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  : PRETTYX
=========
.sp
Purpose : Modules written in the module frame are structured
          with blanks in nested statements and lines between
          functions and procedures  to be read easier and to
          get one layout for all modules.
 
          This version handles identifiers containing uppercase
          letters.
 
.CM *-END-* purpose -------------------------------------
.sp
.cp 3
Define  :
 
        PROGRAM
              VCT14;
 
.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :
 
        FROM
              String_utilities : VCT02;
 
        VAR
              c02outf         : tsp_int4;
              c02uplo        : integer;
 
        PROCEDURE
              c02init;
 
        PROCEDURE
              c02linelength_init (l : integer);
 
        PROCEDURE
              c02fncat (
                    VAR s      : tsp_vfilename;
                    VAR s1     : tsp_line;
                    VAR start1 : tsp_int4;
                    VAR s2     : tsp_name;
                    s60len2       : tsp_int4);
 
        FUNCTION
              c02getline (
                    infileno   : tsp_int4;
                    VAR ln     : tct_line) : tsp_vf_return;
 
        FUNCTION
              c02process_state_ok (
                    process    : tct_do;
                    errfileno  : tsp_int4) : boolean;
 
        FUNCTION
              c02strpos (
                    VAR ln     : tct_line;
                    nstr       : tsp_name) : tsp_int4;
 
        PROCEDURE
              c02vfwrite (
                    fno        : tsp_int4;
                    VAR buf    : tct_line);
 
        PROCEDURE
              c02int4to_line (
                    int        : tsp_int4;
                    with_zero  : boolean;
                    int_len    : integer;
                    ln_pos     : integer;
                    VAR ln     : tsp_line);
 
        PROCEDURE
              c02putname (
                    VAR ln     : tct_line;
                    pos        : integer;
                    nam        : tsp_name);
 
        PROCEDURE
              c02blankline (VAR ln : tct_line);
 
        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);
 
        FUNCTION
              c02equal_string (
                    VAR nam1 : tsp_name;
                    VAR nam2 : tsp_name) : boolean;
 
      ------------------------------ 
 
        FROM
              RTE_driver : VEN102;
 
&       if $OS = WIN32
        VAR
              WinArgc : tsp_int4;
              __argc  : tsp_int4;
              WinArgv : tsp_moveobj_ptr;
              __argv  : tsp_moveobj_ptr;
&       endif
 
        PROCEDURE
              sqlargl (VAR args    : tsp_line);
 
        PROCEDURE
              sqlresult (result : tsp_int1);
 
        PROCEDURE
              sqldattime (
                    VAR d      : tsp_date;
                    VAR t      : tsp_time);
 
        PROCEDURE
              sqlfinish (terminate : boolean);
 
        PROCEDURE
              sqlfopen (VAR hostfile : tsp_vfilename;
                    direction      : tsp_opcodes;
                    resource       : tsp_vf_resource;
                    VAR hostfileno : tsp_int4;
                    VAR format     : tsp_vf_format;
                    VAR rec_len    : tsp_int4;
                    poolptr        : tsp_int4;
                    buf_count      : tsp_int2;
                    VAR block      : tct_lineaddr;
                    VAR error      : tsp_vf_return;
                    VAR errtext    : tsp_errtext);
 
        PROCEDURE
              sqlfclose (VAR hostfileno : tsp_int4;
                    erase             : boolean;
                    poolptr           : tsp_int4;
                    buf_count         : tsp_int2;
                    block             : tct_lineaddr;
                    VAR error         : tsp_vf_return;
                    VAR errtext       : tsp_errtext);
 
      ------------------------------ 
 
        FROM
              RTE-Extension-10 : VSP10;
 
        PROCEDURE
              s10fil (
                    size       : tsp_int4;
                    VAR m      : tsp_line;
                    pos        : tsp_int4;
                    len        : tsp_int4;
                    fillchar   : char);
 
        PROCEDURE
              s10mv1 (
                    size1      : namepositions;
                    size2      : tsp_int4;
                    VAR val1   : tsp_name;
                    p1         : tsp_int4;
                    VAR val2   : tsp_line;
                    p2         : tsp_int4;
                    anz        : tsp_int4 );
 
        PROCEDURE
              s10mv2 (
                    size1      : tsp_int4;
                    size2      : tsp_int4;
                    VAR val1   : tsp_line;
                    p1         : tsp_int4;
                    VAR val2   : tsp_lname;
                    p2         : tsp_int4;
                    anz        : tsp_int4 );
 
      ------------------------------ 
 
        FROM
              RTE-Extension-30: VSP30;
 
        FUNCTION
              s30klen (   VAR str  : tsp_line;
                    val      : char;
                    cnt      : integer) : integer;
&       if $COMP=PTOC
&       else
 
        FUNCTION
              s30gad (VAR b : tsp_line) : tct_lineaddr;
&       endif
 
.CM *-END-* use -----------------------------------------
.sp;.cp 3
Synonym :
 
        PROCEDURE
              s30klen;
 
              tsp_moveobj       tsp_line
 
        PROCEDURE
              s10fil;
 
              tsp_moveobj       tsp_line
 
        PROCEDURE
              s10mv1;
 
              tsp_moveobj       tsp_name
              tsp_int4          namepositions
              tsp_moveobj       tsp_line
 
        PROCEDURE
              s10mv2;
 
              tsp_moveobj       tsp_line
              tsp_moveobj       tsp_lname
&             if $COMP=PTOC
&             else
 
        FUNCTION
              s30gad;
 
              tsp_moveobj tsp_line
              tsp_addr tct_lineaddr
&             endif
 
        PROCEDURE
              sqlfopen;
 
              tsp_vf_bufaddr tct_lineaddr
 
        PROCEDURE
              sqlfclose;
 
              tsp_vf_bufaddr tct_lineaddr
 
.CM *-END-* synonym -------------------------------------
.sp;.cp 8
Author  : C.Segieth                  (Origin: E.Zabach)
.sp
Created : 1988-07-12
.sp
Version : 1999-09-17
.sp
Release :  6.2   Date : 1996-12-10
.sp
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Specification:
.CM *-END-* specification -------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Description:
.CM *-END-* description ---------------------------------
***********************************************************
.sp
.cp 10
.nf
.oc _/1
Structure:
 
.CM *-END-* structure -----------------------------------
.sp 2
**********************************************************
.sp
.cp 10
.nf
.oc _/1
.CM -lll-
Code    :
 
 
CONST
      (*   version - number, put to the bottom of the processed module *)
      n_vct_version   = 'PRETTYX 3.10      ';
      n_vct_date      = ' 1997-12-10       ';
      c_dist_prettvers = 8;     (* right distance from 'lines_of_code' *)
&     if $OS = VMSP
      (* 'sqlfinish' in VM/SP can't leave recursive-procedures from   *)
      (* the bottom of the hierarchic levels. so we have to jump to   *)
      (* the end of the code to the last statements of the main-part. *)
 
LABEL
      9999;
&     endif
 
CONST
&     if $OS = VMSP
      n_ftm_error      = ' ERROR A          ';
      l_ftm_error      =   8;
      n_ftm_pretty     = ' PRETTY A         ';
      l_ftm_pretty     =   9;
      n_ftm_source     = ' VDN *            ';
      l_ftm_source     =   6;
      x_cr             = '\0d';
&     else
      (*  UNIX, ... *)
      n_ftm_error      = '.err              ';
      l_ftm_error      =   4;
      n_ftm_pretty     = '.pre              ';
      l_ftm_pretty     =   4;
      n_ftm_source     = '                  ';
      l_ftm_source     =   0;
      x_cr             = '\0d';
&     endif
      (* old pretty values :     -- *)
      in_begin         =  0;  (*  0 *)
      in_case          =  4;  (*    *)
      in_casepoint     =  4;  (*    *)
      in_co_if         =  4;  (*  5 *)
      in_co_while      =  6;  (*    *)
      in_co_with       =  5;  (*    *)
      in_continue      =  6;  (* 12 *)
      in_ctv           =  6;  (*  6 *)
      in_for           =  4;  (*  4 *)
      in_proc          =  6;  (*  6 *)
      in_record        =  6;  (*  6 *)
      in_repeat        =  4;  (*  7 *)
      in_then          =  4;  (*  4 *)
      in_until         =  4;  (*  6 *)
      in_usedef        =  8;  (*  8 *)
      in_while         =  4;  (*  6 *)
      in_with          =  4;  (*  5 *)
      len_words        = 35;
      max_offset       = 50;
      max_push_depth   = 40; (* war bis PRETTY 3.07 auf 30 *)
      maxpascallinelen = 100;(* JA 1998-01-21 *)
      n_and            = 'AND               ';
      n_array          = 'ARRAY             ';
      n_bt             = '.bt               ';
      n_case           = 'CASE              ';
      n_code_w         = 'code              ';
      n_com_end        = '(*END             ';
      n_com_error      = '(*+++ERROR        ';
      n_dash           = '---------------   ';
      n_det_errors     = 'detected errors : ';
      n_div            = 'DIV               ';
      n_do             = 'DO                ';
      n_downto         = 'DOWNTO            ';
      n_e_blank        = '                  ';
      n_e_longline     = 'line is too long  ';
      n_e_maxpush1     = 'maximum depth (30)';
      n_e_maxpush2     = 'for intend reached';
      n_e_missdo       = '"DO" missing      ';
      n_e_missend      = '"END" missing     ';
      n_e_missendcase  = '"ENDCASE" missing ';
      n_e_missendspec  = '".cm ende missing"';
      n_e_missuntil    = '"UNTIL" missing   ';
      n_e_notallowhere = 'not allowed here  ';
      n_e_routinend    = 'end of routine    ';
      n_e_unbalanced   = 'unbalanced "END"  ';
      n_else           = 'ELSE              ';
      n_endif          = 'ENDIF             ';
      n_endwhile       = 'ENDWHILE          ';
      n_endfor         = 'ENDFOR            ';
      n_endrepeat      = 'ENDREPEAT         ';
      n_endwith        = 'ENDWITH           ';
      n_endcase        = 'ENDCASE           ';
      n_false          = 'FALSE             ';
      n_for            = 'FOR               ';
      n_if             = 'IF                ';
      n_in             = 'IN                ';
      n_init_error     = 'line_____msg______';
      n_label          = 'LABEL             ';
      n_main           = 'MAIN              ';
      n_mod            = 'MOD               ';
      n_nil            = 'NIL               ';
      n_not            = 'NOT               ';
      n_of             = 'OF                ';
      n_opt_noblank    = 'NOBLANK           '; (* option for &ifdef *)
      n_or             = 'OR                ';
      n_otherwise      = 'OTHERWISE         ';
      n_packed         = 'PACKED            ';
      n_page           = '$$Page %$         ';
      n_pretty         = 'PRETTY            ';
      n_record         = 'RECORD            ';
      n_repeat         = 'REPEAT            ';
      n_script_cp      = '(*SCRIPT*.cp 20 *)';
      n_semicolon      = ';                 ';
      n_set            = 'SET               ';
      n_then           = 'THEN              ';
      n_to             = 'TO                ';
      n_true           = 'TRUE              ';
      n_type           = 'TYPE              ';
      n_until          = 'UNTIL             ';
      n_while          = 'WHILE             ';
      n_with           = 'WITH              ';
      x_ampersand      = '&';
      x_asterisk       = '*';
      x_colon          = ':';
      x_dollar         = '$';
      x_equal          = '=';
      x_hyphen         = '-';
      x_komma          = ',';
      x_parenth_cl     = ')';
      x_parenth_op     = '(';
      x_curve_cl       = '}';
      x_curve_op       = '{';
      x_period         = '.';
      x_quote          = '''';
      x_semicolon      = ';';
      x_slash          = '/';
      x_underln        = '_';
 
TYPE
      namepositions = 0..mxsp_name;
 
      tp_c14_record    = RECORD
            r_offsets         : ARRAY [ 0..max_push_depth ] OF tsp_int2;
            r_keywords        : ARRAY [ 1..len_words ] OF tsp_name;
            r_end_of_process  : boolean;
            r_infile_is_open  : boolean;
            r_in_proc_ctv     : boolean;
            r_intend_continue : boolean;
            r_intend_cclines  : boolean;
            r_is_comment      : boolean;
            r_is_keyword      : boolean;
            r_its_a_case      : boolean;
            r_its_frompart    : boolean;
            r_its_prog        : boolean;
            r_take_it         : boolean;
            r_new_tags_found  : boolean;
            r_act_date        : tsp_date;
            r_act_time        : tsp_time;
            r_vdn_modul_name  : tct_vdn_name;
            r_ferr_text       : tsp_errtext;
            r_line_number     : tsp_int2;
            r_begpos_in_actln : tsp_int2;
            r_clcount         : tsp_int2;
            r_cond_output     : tsp_int2;
            r_count           : tsp_int2;
            r_detected_errors : tsp_int2;
            r_endpos_in_actln : tsp_int2;
            r_firstchar       : tsp_int2;
            r_offset          : tsp_int2;
            r_push_depth      : tsp_int2;
            r_stcount         : tsp_int2;
            r_process_state   : tct_do;
            r_ferr            : tsp_vf_return;
            r_infile          : tsp_int4;
            r_outfile         : tsp_int4;
            r_blankline       : tsp_line;
            r_name_line       : tsp_name;
            r_little_digit_ul : SET OF char;
            r_identchars      : SET OF char;
            r_signs           : SET OF CHAR;
            c14fill2        : tsp_int2;
            r_hline           : tct_line;
            r_actln           : tct_line;
            r_outln           : tct_line;
            r_bufadr          : tct_lineaddr;
            r_check_linelength: boolean;
            r_sizecheck_cnt   : integer;
      END;
 
 
VAR
      c14_cnt      : integer;
      c14_digits   : SET OF char;
      c14_capitals : SET OF char;
      c14_littles  : SET OF char;
      c14_glob     : tp_c14_record;
 
 
(*------------------------------*) 
 
FUNCTION
      c14_compare  (
            cline : tsp_line;
            cname : tsp_name
            ) : boolean ;
 
VAR
      is_equal : boolean;
      i        : integer;
 
BEGIN
i        := 1;
is_equal := true;
WHILE ((is_equal) AND (i <= mxsp_name)) DO
    BEGIN
    is_equal := ( cline [ i ]  =  cname[ i ] );
    i        := succ (i);
    END;
(*ENDWHILE*) 
c14_compare := is_equal;
END;
 
(*------------------------------*) 
 
FUNCTION
      c14_eq_resp_case  (
            first    : tsp_name;
            second   : tsp_name;
            startpos : integer;
            len      : integer
            ) : boolean ;
 
VAR
      is_equal : boolean;
      i        : integer;
      act_pos  : integer;
 
BEGIN
WITH c14_glob DO
    BEGIN
    i := 1;
    act_pos := startpos-1;
    is_equal := true;
    WHILE ((is_equal) AND (i <= len)) DO
        BEGIN
        is_equal := ( first [ act_pos+i ]  =  second [ i ] );
        i := succ (i);
        END;
    (*ENDWHILE*) 
    c14_eq_resp_case := is_equal;
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      c14_eq_ign_case (
            ln    : tct_line;
            nstr  : tsp_name;
            start : integer
            ) : boolean;
 
VAR
      pos_1       : integer;
      j       : integer;
      r       : integer;
      namlen  : integer;
 
BEGIN
WITH c14_glob DO
    BEGIN
    pos_1     := start;
    namlen := mxsp_name;
    WHILE ((namlen > 1) AND (nstr[ namlen ] = bsp_c1)) DO
        namlen := namlen - 1;
    (*ENDWHILE*) 
    j := 1;
    r := abs(ord(nstr [ 1 ]) - ord(ln.l[ pos_1 ]));
    WHILE (((r = 0) OR (r = c02uplo)) AND
          (pos_1 <= ln.len) AND (j < namlen)) DO
        BEGIN
        j     := succ (j);
        pos_1 := succ (pos_1);
        r     := abs(ord(nstr[ j ]) - ord(ln.l[ pos_1 ]));
        END;
    (*ENDWHILE*) 
    IF  (((r = 0) OR (r = c02uplo)) AND (j = namlen))
    THEN
        c14_eq_ign_case := true
    ELSE
        c14_eq_ign_case := false
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct14_push (shift_right : integer);
 
BEGIN
WITH c14_glob DO
    BEGIN
    r_offsets [ r_push_depth ] := r_offset;
    r_push_depth := succ (r_push_depth);
    IF  r_push_depth > max_push_depth
    THEN
        BEGIN
        ct14_write_errmsg (n_e_maxpush1, 18);
        ct14_write_errmsg (n_e_maxpush2, 18);
        END
    ELSE
        IF  ((shift_right > 0) AND (r_offset >= max_offset))
        THEN
            (* the line is full ... *)
            IF  shift_right = in_continue
            THEN
                r_offset := r_offset+3
            ELSE
                r_offset := succ (r_offset)
            (*ENDIF*) 
        ELSE
            r_offset := r_offset + shift_right;
        (*ENDIF*) 
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct14_skipbl (VAR begpos, endpos : tsp_int2);
 
BEGIN
WITH c14_glob DO
    BEGIN
    begpos := endpos;
    WHILE ((begpos <= r_actln.len) AND (r_actln.l[ begpos ] = bsp_c1)) DO
        begpos := begpos+1;
    (*ENDWHILE*) 
    IF  endpos = 1
    THEN
        r_firstchar := begpos;
    (*ENDIF*) 
    endpos := begpos;
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct14_read_one_line;
 
VAR
      i : integer;
 
BEGIN
WITH c14_glob DO
    BEGIN
    c02blankline (r_actln);
    r_ferr := c02getline (r_infile, r_actln);
    r_actln.l [ r_actln.len + 1 ] := x_cr;
    IF   r_ferr <> vf_ok
    THEN
        r_end_of_process := true;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct14_give_identifier  (
            VAR startpos   : tsp_linepositions;
            endpos         : integer;
            VAR len_result : tsp_linepositions;
            VAR result     : tsp_line);
 
VAR
      pos_in_line : integer;
 
BEGIN
WITH c14_glob DO
    BEGIN
    WHILE ((startpos <= endpos) AND
          (NOT (r_actln.l[ startpos ] IN r_identchars))) DO
        startpos := startpos+1;
    (*ENDWHILE*) 
    pos_in_line := startpos;
    len_result := 0;
&   ifdef garbage
    IF  ((startpos > 1) AND (startpos <= endpos))
    THEN
        IF  r_actln.l [ startpos - 1 ] IN c14_capitals
        THEN
            BEGIN
            result [ 1 ] := r_actln.l [ startpos - 1 ];
            startpos := startpos-1;
            len_result := 1
            END;
&       endif
        (*ENDIF*) 
    (*ENDIF*) 
    WHILE ((pos_in_line <= endpos) AND
          (r_actln.l[ pos_in_line ] IN r_identchars) AND
          (len_result < mxsp_line)) DO
        BEGIN
        len_result := len_result+1;
        result[ len_result ] := r_actln.l[ pos_in_line ];
        pos_in_line := pos_in_line+1
        END;
    (*ENDWHILE*) 
    s10fil (mxsp_line, result, len_result+1, mxsp_line-len_result, bsp_c1);
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      c14_is_keyword (
            nextword : tsp_objaddr;
            length   : integer) : boolean;
 
VAR
      start_array : integer;
      end_array,k : integer;
      found       : boolean;
      lowname     : tsp_name;
      i           : integer;
 
BEGIN
(*writeln (nextword^:18, '(', length, ')');*)
found := false;
CASE length OF
    2 :
        BEGIN
        start_array := 1;
        end_array   := 5
        END;
    3 :
        BEGIN
        start_array := 6;
        end_array   := 14
        END;
    4 :
        BEGIN
        start_array := 15;
        end_array   := 21
        END;
    5 :
        BEGIN
        start_array := 22;
        end_array   := 27
        END;
    6 :
        BEGIN
        start_array := 28;
        end_array   := 31
        END;
    7, 8, 9 :
        BEGIN
        start_array := 32;
        end_array   := 35
        END;
    OTHERWISE:
        BEGIN
        start_array := 1;
        end_array   := 0;
        END;
    END;
(*ENDCASE*) 
found := false;
IF  start_array <= end_array
THEN
    BEGIN
    lowname := bsp_name;
    FOR i := 1 TO length DO
        BEGIN
        IF  nextword^ [i] in c14_capitals
        THEN
            lowname [i] := chr (ord (nextword^ [i]) + ord ('a') - ord ('A'))
        ELSE
            lowname [i] := nextword^ [i];
        (*ENDIF*) 
        END;
    (*ENDFOR*) 
    WHILE ((start_array <= end_array) AND NOT (found)) DO
        BEGIN
        IF  c14_eq_resp_case (c14_glob.r_keywords[ start_array ],
            lowname, 1, length)
        THEN
            BEGIN
            found := true;
            END;
        (*ENDIF*) 
        start_array := succ (start_array)
        END;
    (*ENDWHILE*) 
    END;
(*writeln ('result -> ', found);*)
(*ENDIF*) 
c14_is_keyword := found;
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct14_uppcase (startpos, endpos : integer);
 
VAR
      start_array, end_array,k  : integer;
      ident      : tsp_dataline;
      short_str  : tsp_name;
      found      : boolean;
 
BEGIN
WITH c14_glob, ident DO
    BEGIN
    pos := startpos;
    ct14_give_identifier (pos, endpos, length, text);
    WHILE length > 0 DO
        BEGIN
        IF  ( (length > 1)
            AND (length < 10) )
        THEN
            BEGIN
            FOR k := 1 TO 10 DO
                short_str [ k ] := text [ k ];
            (*ENDFOR*) 
            CASE length OF
                2 :
                    BEGIN
                    start_array := 1;
                    end_array   := 5
                    END;
                3 :
                    BEGIN
                    start_array := 6;
                    end_array   := 14
                    END;
                4 :
                    BEGIN
                    start_array := 15;
                    end_array   := 21
                    END;
                5 :
                    BEGIN
                    start_array := 22;
                    end_array   := 27
                    END;
                6 :
                    BEGIN
                    start_array := 28;
                    end_array   := 31
                    END;
                7, 8, 9 :
                    BEGIN
                    start_array := 32;
                    end_array   := 35
                    END
                END;
            (*ENDCASE*) 
            found := false;
            WHILE ((start_array <= end_array) AND
                  NOT (found)) DO
                BEGIN
                IF  c14_eq_resp_case (r_keywords[ start_array ], short_str, 1, length)
                THEN
                    BEGIN
                    found := true;
                    FOR k := pos TO pos + length - 1 DO
                        r_actln.l [ k ] := chr (ord(r_actln.l[ k ])
                              + ord ('A') - ord ('a'))
                    (*ENDFOR*) 
                    END;
                (*ENDIF*) 
                start_array := succ (start_array)
                END
            (*ENDWHILE*) 
            END;
        (*ENDIF*) 
        pos := pos + length;
        ct14_give_identifier (pos, endpos, length, text)
        END;
    (*ENDWHILE*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct14_keyw_upc (startpos : integer);
 
VAR
      position, endposition : integer;
 
BEGIN
WITH c14_glob DO
    BEGIN
    position := startpos;
    IF  NOT r_is_comment
    THEN
        BEGIN
        WHILE ((r_actln.l[ position ] = bsp_c1) AND
              (r_actln.l[ position ] <> x_cr)) DO
            position := position+1;
        (*ENDWHILE*) 
        endposition := position;
        WHILE ((r_actln.l[ endposition ] <> x_parenth_op) AND
              (r_actln.l[ endposition ] <> x_curve_op) AND
              (r_actln.l[ endposition ] <> x_quote) AND
              (r_actln.l[ endposition ] <> x_cr)) DO
            endposition := endposition+1;
        (*ENDWHILE*) 
        IF  r_actln.l[ endposition ] = x_cr
        THEN
            BEGIN
            IF  endposition - position > 1
            THEN
                ct14_uppcase (position, endposition - 1)
            (*ENDIF*) 
            END
        ELSE
            IF  r_actln.l[ endposition ] = x_quote
            THEN
                BEGIN
                IF  endposition - position > 1
                THEN
                    ct14_uppcase (position, endposition - 1);
                (*ENDIF*) 
                position := endposition+1;
                WHILE ((r_actln.l[ position ] <> x_cr) AND
                      (r_actln.l[ position ] <> x_quote)) DO
                    position := position+1;
                (*ENDWHILE*) 
                IF  r_actln.l[ position ] = x_quote
                THEN
                    BEGIN
                    position := position+1;
                    WHILE ((r_actln.l[ position ] <> x_cr) AND
                          (r_actln.l[ position ] = bsp_c1)) DO
                        position := position+1;
                    (*ENDWHILE*) 
                    IF  r_actln.l[ position ] <> x_cr
                    THEN
                        ct14_keyw_upc (position)
                    (*ENDIF*) 
                    END
                (*ENDIF*) 
                END
            ELSE
                BEGIN
                IF  endposition - position > 1
                THEN
                    ct14_uppcase (position, endposition - 1);
                (*ENDIF*) 
                IF  r_actln.l[ endposition+1 ] = x_asterisk
                THEN
                    BEGIN
                    r_is_comment := true;
                    ct14_keyw_upc (endposition + 2)
                    END
                ELSE
                    IF  r_actln.l[ endposition ] = x_curve_op
                    THEN
                        BEGIN
                        r_is_comment := true;
                        ct14_keyw_upc (endposition + 1)
                        END
                    ELSE
                        ct14_keyw_upc (endposition + 1)
                    (*ENDIF*) 
                (*ENDIF*) 
                END
            (*ENDIF*) 
        (*ENDIF*) 
        END
    ELSE
        BEGIN
        WHILE (((r_actln.l[ position ] <> x_asterisk) OR
              (r_actln.l[ position+1 ] <> x_parenth_cl)) AND
              (r_actln.l[ position ] <> x_curve_cl) AND
              (r_actln.l[ position ] <> x_cr)) DO
            position := position+1;
        (*ENDWHILE*) 
        IF  r_actln.l[ position ] <> x_cr
        THEN
            BEGIN
            r_is_comment := false;
            IF  r_actln.l[ position ] = x_curve_cl
            THEN
                ct14_keyw_upc (position+1)
            ELSE
                ct14_keyw_upc (position+2)
            (*ENDIF*) 
            END
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct14_catch_identifier (
            VAR result          : tsp_line;
            VAR begpos, endpos : tsp_int2);
 
VAR
      index : integer;
 
BEGIN
WITH c14_glob DO
    BEGIN
    ct14_skipbl (begpos, endpos);
    IF  begpos > r_actln.len
    THEN
        BEGIN
        ct14_read_text;
        END;
    (*ENDIF*) 
    WHILE ((r_actln.l[ begpos ] = x_parenth_op) AND
          (r_actln.l[ begpos+1 ] = x_asterisk)) OR
          (r_actln.l[ begpos ] = x_curve_op) DO
        BEGIN
        ct14_output_of_text (begpos, -1);
        ct14_skipbl (begpos, endpos)
        END;
    (*ENDWHILE*) 
    WHILE ((begpos = 1) AND (r_actln.l[ 1 ] = x_ampersand)) DO
        BEGIN
        ct14_output_of_text (begpos, 0);
        ct14_skipbl (begpos, endpos)
        END;
    (*ENDWHILE*) 
    WHILE ((r_actln.l[ begpos ] = x_parenth_op) AND
          (r_actln.l[ begpos+1 ] = x_asterisk)) OR
          (r_actln.l[ begpos ] = x_curve_op) DO
        BEGIN
        ct14_output_of_text (begpos, -1);
        ct14_skipbl (begpos, endpos)
        END;
    (*ENDWHILE*) 
    index := 1;
    IF  r_actln.l [ begpos ] = x_quote
    THEN
        BEGIN
        endpos := begpos+1;
        result [ 1 ] := x_quote;
        index := 2;
        WHILE ((index <= mxsp_line) AND
              (endpos <= r_actln.len) AND
              (r_actln.l[ endpos ] <> x_quote)) DO
            BEGIN
            result [ index ] := r_actln.l [ endpos ];
            endpos := endpos+1;
            index := index+1
            END;
        (*ENDWHILE*) 
        IF  ((r_actln.l[ endpos ] = x_quote) AND
            (index <= mxsp_line))
        THEN
            BEGIN
            result [ index ] := x_quote;
            index := index+1;
            endpos := endpos+1
            END
        (*ENDIF*) 
        END
    ELSE
        BEGIN
        WHILE ((r_actln.l[ endpos ] IN r_signs) AND
              (index <= mxsp_line)) DO
            BEGIN
            result [ index ] := r_actln.l [ endpos ];
            endpos := endpos+1;
            index := index+1
            END
        (*ENDWHILE*) 
        END;
    (*ENDIF*) 
    WHILE index <= mxsp_line DO
        BEGIN
        result [ index ] := bsp_c1;
        index := index+1
        END         ;
    (*ENDWHILE*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct14_give_upcase_word (
            VAR upc_word : tsp_name;
            endpos       : integer;
            VAR length   : tsp_int2);
 
VAR
      ind : integer;
      wordchars : SET OF CHAR;
 
BEGIN
WITH c14_glob DO
    BEGIN
    length := 0;
    ind := endpos;
    wordchars := c14_capitals + ['_'];
    WHILE ((length < mxsp_name) AND
          (r_actln.l[ ind ] IN wordchars)) DO
        BEGIN
        length := length+1;
        upc_word [ length ] := r_actln.l [ ind ];
        ind := ind+1
        END;
    (*ENDWHILE*) 
    FOR ind := length+1 TO mxsp_name DO
        upc_word[ ind ] := bsp_c1;
    (*ENDFOR*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct14_st_begin (VAR next_word : tsp_line);
 
BEGIN
WITH c14_glob DO
    BEGIN
    ct14_push (in_begin);
    ct14_output_of_text (r_begpos_in_actln, 5);
    WHILE NOT r_is_keyword DO
        ct14_sprocess_statement;
    (*ENDWHILE*) 
    ct14_catch_identifier (next_word, r_begpos_in_actln, r_endpos_in_actln);
    IF  NOT (c14_compare (next_word, cct_n_end))
    THEN
        BEGIN
        ct14_write_errmsg (n_e_missend, 13);
        r_endpos_in_actln := r_begpos_in_actln;
        IF  NOT (c14_compare (next_word, n_until))
        THEN
            r_is_keyword := false
        (*ENDIF*) 
        END
    ELSE
        BEGIN
        r_is_keyword := false;
        WHILE ((r_actln.l[ r_endpos_in_actln ] = bsp_c1) AND
              (r_endpos_in_actln <= r_actln.len)) DO
            r_endpos_in_actln := r_endpos_in_actln+1;
        (*ENDWHILE*) 
        IF  ((r_endpos_in_actln = r_actln.len+1) OR
            (r_actln.l[ r_endpos_in_actln ] <> x_semicolon))
        THEN
            ct14_output_of_text (r_begpos_in_actln, 3)
        ELSE
            ct14_output_of_text (r_begpos_in_actln, r_endpos_in_actln-
                  r_begpos_in_actln+1)
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    ct14_pop;
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct14_st_if (VAR next_word : tsp_line);
 
VAR
      len_line   : integer;
      i          : integer;
      k          : integer;
      first_line : boolean;
      its_found  : boolean;
      search_beg : integer;
 
BEGIN
WITH c14_glob DO
    BEGIN
    i := 0;
    len_line := r_actln.len;
    (* shift if-condition to right *)
    WHILE i <= in_co_if - 3 DO
        BEGIN
        IF  r_actln.l[ r_endpos_in_actln+i ] <> bsp_c1
        THEN
            BEGIN
            k := succ(r_actln.len);
            WHILE k >= r_endpos_in_actln+i DO
                BEGIN
                r_actln.l[ succ(k) ] := r_actln.l[ k ];
                k := pred(k)
                END;
            (*ENDWHILE*) 
            r_actln.l[ succ(k) ] := bsp_c1;
            r_actln.len := succ(r_actln.len)
            END;
        (*ENDIF*) 
        i := succ(i)
        END;
    (*ENDWHILE*) 
    first_line      := true;
    its_found       := false;
    r_endpos_in_actln := r_endpos_in_actln+r_actln.len-len_line;
    WHILE NOT its_found DO
        BEGIN
        search_beg := r_endpos_in_actln;
        ct14_search_word_in_line (n_then, 4, its_found,
              search_beg, r_endpos_in_actln);
        IF  its_found
        THEN
            BEGIN
            IF  r_endpos_in_actln - in_then > r_begpos_in_actln
            THEN
                ct14_output_of_text (r_begpos_in_actln, r_endpos_in_actln-5-
                      r_begpos_in_actln)
            (*ENDIF*) 
            END
        ELSE
            IF  r_endpos_in_actln > r_begpos_in_actln
            THEN
                ct14_output_of_text (r_begpos_in_actln, r_endpos_in_actln-
                      r_begpos_in_actln);
            (*ENDIF*) 
        (*ENDIF*) 
        IF  first_line
        THEN
            BEGIN
            ct14_push (in_co_if);
            first_line := false
            END
        (*ENDIF*) 
        END;
    (*ENDWHILE*) 
    (* keyword 'then' found *)
    ct14_pop;
    ct14_output_of_text (r_begpos_in_actln, 4);
    ct14_push (in_then);
    ct14_sprocess_statement;
    ct14_pop;
    ct14_catch_identifier (next_word, r_begpos_in_actln, r_endpos_in_actln);
    r_endpos_in_actln := r_begpos_in_actln;
    IF  c14_compare (next_word, n_else )
    THEN
        BEGIN
        r_is_keyword := false;
        ct14_output_of_text (r_begpos_in_actln, 4);
        ct14_push (in_then);
        ct14_sprocess_statement;
        ct14_pop
        END;
    (*ENDIF*) 
    ct14_write_end_com (n_endif);
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct14_st_while_with (VAR next_word : tsp_line);
 
VAR
      do_found   : boolean;
      do_error   : boolean;
      first_line : boolean;
      search_beg : integer;
      old_search : integer;
      old_endpos : integer;
 
BEGIN
WITH c14_glob DO
    BEGIN
    do_found   := false;
    first_line := true;
    WHILE NOT do_found DO
        BEGIN
        search_beg := r_endpos_in_actln;
        ct14_search_word_in_line (n_do, 2, do_found, search_beg,
              r_endpos_in_actln);
        IF  NOT do_found
        THEN
            BEGIN
            old_search := search_beg;
            old_endpos := r_endpos_in_actln;
            do_error   := false;
            ct14_search_word_in_line (cct_n_begin, 5, do_error, search_beg,
                  r_endpos_in_actln);
            IF  NOT do_error
            THEN
                BEGIN
                r_endpos_in_actln := old_endpos;
                search_beg      := old_search;
                ct14_search_word_in_line (n_semicolon, 1, do_error, search_beg,
                      r_endpos_in_actln);
                END;
            (*ENDIF*) 
            IF  do_error
            THEN
                BEGIN
                ct14_write_errmsg(n_e_missdo, 12);
                (* if 'BEGIN' or ';' is found, we assume, that the 'DO' has *)
                (* been forgotten. so *)
                (* set 'do_found' to 'true' to leave the processing of the *)
                (* while/with - condition. pretty should go on correctly.  *)
                do_found := true;
                END;
            (*ENDIF*) 
            r_endpos_in_actln := old_endpos;
            search_beg      := old_search;
            END;
        (*ENDIF*) 
        IF  r_endpos_in_actln > r_begpos_in_actln
        THEN
            ct14_output_of_text (r_begpos_in_actln, r_endpos_in_actln-
                  r_begpos_in_actln);
        (*ENDIF*) 
        IF  first_line
        THEN
            BEGIN
            IF  c14_compare (next_word, n_while )
            THEN
                ct14_push (in_co_while)
            ELSE
                ct14_push (in_co_with);
            (*ENDIF*) 
            first_line := false
            END;
        (*ENDIF*) 
        END;
    (*ENDWHILE*) 
    ct14_pop;
    IF  c14_compare (next_word, n_while )
    THEN
        ct14_push (in_while)
    ELSE
        ct14_push (in_with);
    (*ENDIF*) 
    ct14_sprocess_statement;
    ct14_pop;
    IF  c14_compare (next_word, n_while )
    THEN
        ct14_write_end_com (n_endwhile)
    ELSE
        ct14_write_end_com (n_endwith);
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct14_st_for (VAR next_word : tsp_line);
 
VAR
      _first_line : boolean;
      _its_found  : boolean;
      _search_beg : integer;
 
BEGIN
WITH c14_glob DO
    BEGIN
    _its_found  := false;
    _first_line := true;
    WHILE NOT _its_found DO
        BEGIN
        _search_beg := r_endpos_in_actln;
        ct14_search_word_in_line (n_do, 2, _its_found, _search_beg,
              r_endpos_in_actln);
        IF  _its_found
        THEN
            BEGIN
            IF  r_actln.l[ r_endpos_in_actln ] = 'W'
            THEN
                _its_found := false
            ELSE
                IF  r_endpos_in_actln > r_begpos_in_actln
                THEN
                    ct14_output_of_text (r_begpos_in_actln, r_endpos_in_actln-
                          r_begpos_in_actln)
                (*ENDIF*) 
            (*ENDIF*) 
            END
        ELSE
            IF  r_endpos_in_actln > r_begpos_in_actln
            THEN
                ct14_output_of_text (r_begpos_in_actln, r_endpos_in_actln-
                      r_begpos_in_actln);
            (*ENDIF*) 
        (*ENDIF*) 
        IF  (_first_line AND
            (r_begpos_in_actln = r_endpos_in_actln))
        THEN
            BEGIN
            ct14_push (in_continue);
            _first_line := false
            END
        (*ENDIF*) 
        END;
    (*ENDWHILE*) 
    ct14_pop;
    ct14_push (in_for);
    ct14_sprocess_statement;
    ct14_pop;
    ct14_write_end_com (n_endfor);
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct14_st_repeat (VAR next_word : tsp_line);
 
BEGIN
WITH c14_glob DO
    BEGIN
    ct14_output_of_text (r_begpos_in_actln, 6);
    ct14_push (in_repeat);
    WHILE NOT r_is_keyword DO
        ct14_sprocess_statement;
    (*ENDWHILE*) 
    ct14_pop;
    ct14_catch_identifier (next_word, r_begpos_in_actln, r_endpos_in_actln);
    IF  NOT (c14_compare (next_word, n_until ))
    THEN
        BEGIN
        ct14_write_errmsg(n_e_missuntil, 15);
        r_endpos_in_actln := r_begpos_in_actln;
        IF  NOT (c14_compare (next_word, cct_n_end ))
        THEN
            r_is_keyword := false
        (*ENDIF*) 
        END
    ELSE
        BEGIN
        r_is_keyword      := false;
        ct14_output_of_text (r_begpos_in_actln, 5);
        ct14_push (in_until);
        r_stcount         := r_stcount-1;
        r_intend_continue := false;
        ct14_sprocess_statement;
        r_intend_continue := true;
        ct14_pop
        END;
    (*ENDIF*) 
    ct14_write_end_com (n_endrepeat);
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct14_st_case (VAR next_word : tsp_line);
 
VAR
      _go_on       : boolean;
      _first_line  : boolean;
      _its_found   : boolean;
      _its_reached : boolean;
      _i           : integer;
      _search_beg  : integer;
 
BEGIN
WITH c14_glob DO
    BEGIN
    _its_found  := false;
    _first_line := true;
    WHILE NOT _its_found DO
        BEGIN
        _search_beg := r_endpos_in_actln;
        ct14_search_word_in_line (n_of, 2, _its_found, _search_beg,
              r_endpos_in_actln);
        IF  r_endpos_in_actln > r_begpos_in_actln
        THEN
            ct14_output_of_text (r_begpos_in_actln, r_endpos_in_actln-
                  r_begpos_in_actln);
        (*ENDIF*) 
        IF  _first_line
        THEN
            BEGIN
            ct14_push (in_continue);
            _first_line := false
            END
        (*ENDIF*) 
        END;
    (*ENDWHILE*) 
    ct14_pop;
    ct14_push (in_case);
    _its_found := false;
    WHILE NOT _its_found DO
        BEGIN
        r_begpos_in_actln := r_endpos_in_actln;
        ct14_catch_identifier (next_word, r_begpos_in_actln, r_endpos_in_actln);
        IF  c14_compare (next_word, cct_n_end )
        THEN
            BEGIN
            r_is_keyword := false;
            _its_found  := true
            END
        ELSE
            IF  c14_compare (next_word, n_otherwise )
            THEN
                BEGIN
                r_is_keyword := false;
                WHILE ((r_endpos_in_actln <= r_actln.len) AND
                      (r_actln.l[ r_endpos_in_actln ] = bsp_c1 )) DO
                    r_endpos_in_actln := r_endpos_in_actln + 1;
                (*ENDWHILE*) 
                IF  r_actln.l[ r_endpos_in_actln ] = x_colon
                THEN
                    ct14_output_of_text (r_begpos_in_actln, r_endpos_in_actln + 1
                          - r_begpos_in_actln)
                ELSE
                    ct14_output_of_text (r_begpos_in_actln, 9);
                (*ENDIF*) 
                ct14_push (in_casepoint);
                ct14_sprocess_statement;
                ct14_pop
                END
            ELSE
                BEGIN
                _its_reached := false;
                WHILE NOT _its_reached DO
                    BEGIN
                    WHILE ((r_endpos_in_actln <= r_actln.len) AND
                          (r_actln.l[ r_endpos_in_actln ] <> x_colon)) DO
                        r_endpos_in_actln := r_endpos_in_actln+1;
                    (*ENDWHILE*) 
                    IF  r_actln.l[ r_endpos_in_actln ] = x_colon
                    THEN
                        IF  r_actln.l[ r_endpos_in_actln+1 ] <> x_equal
                        THEN
                            IF  r_its_a_case
                            THEN
                                BEGIN
                                ct14_output_of_text (r_begpos_in_actln, r_endpos_in_actln -
                                      r_begpos_in_actln + 1);
                                ct14_push (in_casepoint);
                                _i := r_endpos_in_actln;
                                WHILE ((_i < r_actln.len) AND (r_actln.l[ _i ] = bsp_c1)) DO
                                    _i := _i + 1;
                                (*ENDWHILE*) 
                                IF  r_actln.l[ _i ] = x_parenth_op
                                THEN
                                    BEGIN
                                    _go_on := true;
                                    WHILE _go_on DO
                                        BEGIN
                                        _i := r_begpos_in_actln;
                                        IF  _i = 1
                                        THEN
                                            IF  r_actln.l[ _i ] = x_parenth_cl
                                            THEN
                                                _go_on := false
                                            ELSE
                                                _i := succ(_i);
                                            (*ENDIF*) 
                                        (*ENDIF*) 
                                        WHILE (_go_on AND (_i <= r_actln.len)) DO
                                            BEGIN
                                            IF  ((r_actln.l[ _i ] = x_parenth_cl) AND
                                                NOT (r_actln.l[ _i-1 ] IN [ x_asterisk, x_period ]))
                                            THEN
                                                _go_on := false;
                                            (*ENDIF*) 
                                            _i := succ(_i)
                                            END;
                                        (*ENDWHILE*) 
                                        ct14_sprocess_statement;
                                        END;
                                    (*ENDWHILE*) 
                                    _its_reached := true
                                    END
                                ELSE
                                    BEGIN
                                    r_endpos_in_actln := r_begpos_in_actln;
                                    ct14_sprocess_statement;
                                    _its_reached     := true
                                    END;
                                (*ENDIF*) 
                                ct14_pop;
                                END
                            ELSE
                                BEGIN
                                ct14_output_of_text (r_begpos_in_actln, r_endpos_in_actln-
                                      r_begpos_in_actln+1);
                                ct14_push (in_casepoint);
                                ct14_sprocess_statement;
                                ct14_pop;
                                _its_reached := true
                                END
                            (*ENDIF*) 
                        ELSE
                            BEGIN
                            ct14_write_errmsg(n_e_missendcase, 17);
                            r_endpos_in_actln := r_begpos_in_actln;
                            _its_reached     := true;
                            _its_found       := true
                            END
                        (*ENDIF*) 
                    ELSE
                        ct14_output_of_text (r_begpos_in_actln, 0);
                    (*ENDIF*) 
                    END;
                (*ENDWHILE*) 
                END
            (*ENDIF*) 
        (*ENDIF*) 
        END;
    (*ENDWHILE*) 
    IF  c14_compare (next_word, cct_n_end )
    THEN
        ct14_output_of_text (r_begpos_in_actln, 3);
    (*ENDIF*) 
    ct14_pop;
    ct14_write_end_com (n_endcase);
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      ct14_g10found (VAR next_word : tsp_line) : boolean;
 
VAR
      _iword : tsp_lname;
 
BEGIN
(* check from bottom to top because of name-equality in *)
(* local values and parts of global defined types (vak73 for example) *)
_iword := '                                ';
s10mv2 (mxsp_line, mxsp_lname, next_word, 1, _iword, 1, 5);
IF  (_iword = 'g10mv                           ')
    OR (_iword = 'g10fi                           ')
THEN
    ct14_g10found := true
ELSE
    ct14_g10found := false
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct14_st_normal (VAR next_word : tsp_line);
 
VAR
      _first_line   : boolean;
      _its_reached  : boolean;
      _i            : integer;
      _len_line     : tsp_int2;
      _capital_word : tsp_name;
 
BEGIN
WITH c14_glob DO
    BEGIN
    IF  (c14_is_keyword (@next_word, r_endpos_in_actln - r_begpos_in_actln)
        AND NOT (c14_compare (next_word, n_not))
        AND NOT (c14_compare (next_word, cct_n_from))
        AND r_take_it )
    THEN
        BEGIN
        ct14_write_errmsg(n_e_blank, 2);
        r_is_keyword      := true;
        r_endpos_in_actln := r_begpos_in_actln
        END
    ELSE
        BEGIN
        IF  ct14_g10found (next_word)
        THEN
            BEGIN
            WHILE r_actln.l[ r_endpos_in_actln ] = ' ' DO
                r_endpos_in_actln := succ(r_endpos_in_actln);
            (*ENDWHILE*) 
            r_endpos_in_actln := succ(r_endpos_in_actln);
            _capital_word := '        ,    ,    ';
            _capital_word[ 1 ] := x_quote;
            FOR _i := 1 TO 6 DO
                _capital_word[ 1+_i ] := r_vdn_modul_name[ _i ];
            (*ENDFOR*) 
            _capital_word[ 8 ] := x_quote;
            r_sizecheck_cnt := succ(r_sizecheck_cnt);
            _i := r_sizecheck_cnt;
            IF  r_sizecheck_cnt > 99
            THEN
                BEGIN
                _capital_word[ 11 ] := chr(r_sizecheck_cnt DIV 100 + ord('0'));
                _i := _i MOD 100;
                END;
            (*ENDIF*) 
            IF  r_sizecheck_cnt > 9
            THEN
                BEGIN
                _capital_word[ 12 ] := chr(_i DIV 10 + ord('0'));
                _i := _i MOD 10
                END;
            (*ENDIF*) 
            _capital_word[ 13 ] := chr(_i + ord('0'));
            s10mv1(mxsp_name, mxsp_line, _capital_word, 1,
                  r_actln.l, r_endpos_in_actln, mxsp_name);
            r_actln.len := r_endpos_in_actln + mxsp_name - 1;
            r_endpos_in_actln := pred(r_endpos_in_actln);
            END;
        (*ENDIF*) 
        _first_line  := true;
        _its_reached := false;
        WHILE (   NOT (r_is_keyword)
              AND NOT (_its_reached) ) DO
            BEGIN
            IF  r_actln.l[ 1 ] <> x_ampersand
            THEN
                WHILE (   NOT (r_is_keyword)
                      AND (r_endpos_in_actln <= r_actln.len)
                      AND (r_actln.l[ r_endpos_in_actln ] <> x_semicolon)) DO
                    BEGIN
                    WHILE (   r_endpos_in_actln <= r_actln.len)
                          AND (NOT ( r_actln.l[ r_endpos_in_actln ] IN
                          (c14_capitals +
                          [ x_quote, x_parenth_op, x_semicolon,
                          x_curve_op ]) ) )
                          DO
                        r_endpos_in_actln := r_endpos_in_actln+1;
                    (*ENDWHILE*) 
                    IF  (   (r_endpos_in_actln <= r_actln.len)
                        AND (r_actln.l[ r_endpos_in_actln ] <> x_semicolon))
                    THEN
                        CASE r_actln.l[ r_endpos_in_actln ] OF
                            x_parenth_op :
                                IF  r_actln.l[ r_endpos_in_actln+1 ] = x_asterisk
                                THEN
                                    IF  r_is_comment
                                    THEN
                                        r_endpos_in_actln := r_actln.len+1
                                    ELSE
                                        BEGIN
                                        WHILE (   (r_endpos_in_actln < r_actln.len)
                                              AND ((r_actln.l[ r_endpos_in_actln ] <> x_asterisk) OR
                                              (r_actln.l[ r_endpos_in_actln+1 ] <> x_parenth_cl))) DO
                                            r_endpos_in_actln := r_endpos_in_actln+1;
                                        (*ENDWHILE*) 
                                        r_endpos_in_actln := r_endpos_in_actln+2
                                        END
                                    (*ENDIF*) 
                                ELSE
                                    r_endpos_in_actln := r_endpos_in_actln+1;
                                (*ENDIF*) 
                            x_curve_op :
                                IF  r_is_comment
                                THEN
                                    r_endpos_in_actln := r_actln.len+1
                                ELSE
                                    BEGIN
                                    WHILE (   (r_endpos_in_actln < r_actln.len)
                                          AND (r_actln.l[ r_endpos_in_actln+1 ] <> x_curve_cl)) DO
                                        r_endpos_in_actln := r_endpos_in_actln+1;
                                    (*ENDWHILE*) 
                                    r_endpos_in_actln := r_endpos_in_actln+1
                                    END;
                                (*ENDIF*) 
                            x_quote :
                                BEGIN
                                r_endpos_in_actln := r_endpos_in_actln+1;
                                WHILE (   (r_endpos_in_actln <= r_actln.len)
                                      AND (r_actln.l[ r_endpos_in_actln ] <> x_quote))
                                      DO
                                    r_endpos_in_actln := r_endpos_in_actln+1;
                                (*ENDWHILE*) 
                                r_endpos_in_actln := r_endpos_in_actln+1
                                END;
                            OTHERWISE
                                BEGIN
                                ct14_give_upcase_word (_capital_word, r_endpos_in_actln, _len_line);
                                IF  r_take_it
                                THEN
                                    IF  (  (_capital_word = n_and)
                                        OR (_capital_word = n_div)
                                        OR (_capital_word = n_false)
                                        OR (_capital_word = cct_n_from)
                                        OR (_capital_word = n_in)
                                        OR (_capital_word = n_mod)
                                        OR (_capital_word = n_nil)
                                        OR (_capital_word = n_not)
                                        OR (_capital_word = n_or)
                                        OR (_capital_word = n_true)
                                        OR (_len_line = 1))
                                    THEN
                                        r_endpos_in_actln := r_endpos_in_actln+_len_line
                                    ELSE
                                        BEGIN
                                        r_is_keyword := c14_is_keyword (
                                              @_capital_word, _len_line);
                                        IF  NOT r_is_keyword
                                        THEN
                                            r_endpos_in_actln :=
                                                  r_endpos_in_actln+_len_line;
                                        (*ENDIF*) 
                                        END
                                    (*ENDIF*) 
                                ELSE
                                    IF  (   (_capital_word <> cct_n_end  )
                                        AND (_capital_word <> n_record    ))
                                    THEN
                                        r_endpos_in_actln := r_endpos_in_actln+_len_line
                                    ELSE
                                        r_is_keyword := true;
                                    (*ENDIF*) 
                                (*ENDIF*) 
                                END;
                            END
                        (*ENDCASE*) 
                    (*ENDIF*) 
                    END;
                (*ENDWHILE*) 
            (*ENDIF*) 
            IF  r_is_keyword
            THEN
                BEGIN
                IF  r_endpos_in_actln > r_begpos_in_actln
                THEN
                    IF  _capital_word <> n_record
                    THEN
                        ct14_output_of_text (r_begpos_in_actln,
                              r_endpos_in_actln-r_begpos_in_actln)
                    (*ENDIF*) 
                (*ENDIF*) 
                END
            ELSE
                IF  r_actln.l[ r_endpos_in_actln ] = x_semicolon
                THEN
                    BEGIN
                    _its_reached := true;
                    ct14_output_of_text (r_begpos_in_actln, r_endpos_in_actln-
                          r_begpos_in_actln+1)
                    END
                ELSE
                    ct14_output_of_text (r_begpos_in_actln, 0);
                (*ENDIF*) 
            (*ENDIF*) 
            IF  _first_line
            THEN
                IF  r_intend_continue
                THEN
                    BEGIN
                    ct14_push (in_continue);
                    _first_line := false
                    END
                ELSE
                    BEGIN
                    ct14_push ( 0 );
                    _first_line := false
                    END
                (*ENDIF*) 
            (*ENDIF*) 
            END;
        (*ENDWHILE*) 
        ct14_pop
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct14_sprocess_statement;
 
VAR
      _next_word   : tsp_line;
      _case_select : integer;
 
BEGIN
WITH c14_glob DO
    BEGIN
    ct14_catch_identifier (_next_word, r_begpos_in_actln, r_endpos_in_actln);
    IF  c14_compare (_next_word, cct_n_begin )
    THEN
        _case_select := 1
    ELSE
        IF  c14_compare (_next_word, n_if )
        THEN
            _case_select := 2
        ELSE
            IF  (  c14_compare (_next_word, n_while)
                OR c14_compare (_next_word, n_with ) )
            THEN
                _case_select := 3
            ELSE
                IF  c14_compare (_next_word, n_for )
                THEN
                    _case_select := 4
                ELSE
                    IF  c14_compare (_next_word, n_repeat )
                    THEN
                        _case_select := 5
                    ELSE
                        IF  c14_compare (_next_word, n_case )
                        THEN
                            _case_select := 6
                        ELSE
                            IF  (  c14_compare (_next_word, cct_n_end )
                                OR c14_compare (_next_word, n_until ))
                            THEN
                                _case_select := 7
                            ELSE
                                _case_select := 8;
                            (*ENDIF*) 
                        (*ENDIF*) 
                    (*ENDIF*) 
                (*ENDIF*) 
            (*ENDIF*) 
        (*ENDIF*) 
    (*ENDIF*) 
    IF  ((_case_select > 1) AND (_case_select <> 7))
    THEN
        r_stcount := r_stcount+r_count;
    (*ENDIF*) 
    CASE _case_select OF
        1 :
            ct14_st_begin (_next_word);
        2 :
            ct14_st_if (_next_word);
        3 :
            ct14_st_while_with (_next_word);
        4 :
            ct14_st_for (_next_word);
        5 :
            ct14_st_repeat (_next_word);
        6 :
            ct14_st_case (_next_word);
        7 :
            BEGIN
            r_is_keyword      := true;
            r_endpos_in_actln := r_begpos_in_actln
            END;
        OTHERWISE
            ct14_st_normal (_next_word)
        END;
    (*ENDCASE*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct14_search_word_in_line (
            srch_word       : tsp_name;
            len_line        : integer;
            VAR   its_found : boolean;
            begpos          : integer;
            VAR   r_endpos_in_actln : tsp_int2
            );
 
VAR
      _word_index  : integer;
      _beg_comment : integer;
      _end_comment : integer;
 
BEGIN
WITH c14_glob DO
    BEGIN
    its_found    := false;
    _word_index  := ct14_pos_resp_case (srch_word, begpos, len_line);
    _beg_comment := ct14_pos_resp_case (cct_n_combeg, begpos, 2);
    IF  (   ((_beg_comment = 0) OR (_beg_comment > _word_index))
        AND (_word_index > 0))
    THEN
        IF  _word_index > 1
        THEN
            IF  r_actln.l[ _word_index-1 ] <> x_quote
            THEN
                BEGIN
                its_found       := true;
                r_endpos_in_actln := _word_index+len_line
                END
            ELSE
                ct14_search_word_in_line (srch_word, len_line, its_found,
                      _word_index+len_line, r_endpos_in_actln)
            (*ENDIF*) 
        ELSE
            BEGIN
            its_found       := true;
            r_endpos_in_actln := _word_index+len_line
            END
        (*ENDIF*) 
    ELSE
        IF  _beg_comment > 0
        THEN
            BEGIN
            _end_comment := ct14_pos_ign_case (cct_n_comend, _beg_comment+2, 2);
            IF  (   (_end_comment <> 0)
                AND (_end_comment < _word_index))
            THEN
                BEGIN
                its_found       := true;
                r_endpos_in_actln := _word_index+len_line
                END
            ELSE
                IF  _end_comment = 0
                THEN
                    BEGIN
                    r_endpos_in_actln := _beg_comment;
                    IF  (   (_beg_comment = begpos)
                        AND (r_begpos_in_actln = begpos))
                    THEN
                        ct14_output_of_text (_beg_comment, -1)
                    (*ENDIF*) 
                    END
                ELSE
                    r_endpos_in_actln := _end_comment+2
                (*ENDIF*) 
            (*ENDIF*) 
            END
        ELSE
            r_endpos_in_actln := r_actln.len+1;
        (*ENDIF*) 
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct14_pop;
 
BEGIN
WITH c14_glob DO
    BEGIN
    r_push_depth := r_push_depth-1;
    IF  r_push_depth = 0
    THEN
        BEGIN
        r_offset     := 1;
        r_push_depth := 1
        END
    ELSE
        r_offset := r_offsets [ r_push_depth ];
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      ct14_equal_resp (first    : tsp_line;
            second   : tsp_name;
            startpos : integer;
            len      : integer) : boolean ;
 
VAR
      _is_equal : boolean;
      _i        : integer;
      _act_pos  : integer;
 
BEGIN
WITH c14_glob DO
    BEGIN
    _i        := 1;
    _act_pos  := startpos-1;
    _is_equal := true;
    WHILE ((_is_equal) AND (_i <= len)) DO
        BEGIN
        _is_equal := ( first[ _act_pos+_i ] = second[ _i ] );
        _i := succ(_i);
        END;
    (*ENDWHILE*) 
    ct14_equal_resp := _is_equal;
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      ct14_pos_ign_case (
            target          : tsp_name;
            startpos, length : integer) : integer;
 
VAR
      _position : integer;
      _found : boolean;
 
BEGIN
WITH c14_glob DO
    BEGIN
    _found := false;
    _position := startpos-1;
    WHILE ((_position <= r_actln.len-length) AND NOT (_found)) DO
        BEGIN
        _position := succ(_position);
        _found := c14_eq_ign_case (r_actln, target, _position)
        END;
    (*ENDWHILE*) 
    IF  NOT _found
    THEN
        BEGIN
        ct14_pos_ign_case := 0;
        END
    ELSE
        BEGIN
        ct14_pos_ign_case := _position;
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      ct14_pos_resp_case (
            target          : tsp_name;
            startpos, length : integer) : integer;
 
VAR
      _position : integer;
      _found : boolean;
 
BEGIN
WITH c14_glob DO
    BEGIN
    _found    := false;
    _position := startpos-1;
    WHILE ((_position <= r_actln.len-length) AND NOT (_found)) DO
        BEGIN
        _position := succ(_position);
        _found    := ct14_equal_resp(r_actln.l, target, _position, length)
        END;
    (*ENDWHILE*) 
    IF  NOT _found
    THEN
        BEGIN
        ct14_pos_resp_case := 0;
        END
    ELSE
        BEGIN
        ct14_pos_resp_case := _position;
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct14_check_offset;
 
BEGIN
WITH c14_glob DO
    BEGIN
    IF  (r_offset <> 1) AND (NOT (r_in_proc_ctv))
        AND (
        (   r_process_state = do_searchcode)    (* work_in_struct *)
        OR (r_process_state = do_prettyresult)  (* work_in_code *)
        )
    THEN
        BEGIN
        ct14_write_errmsg(n_e_missend, 13);
        r_push_depth := 1;
        r_offset     := 1;
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct14_read_text;
 
VAR
      _line_found : boolean;
      _int_l     : integer;
 
BEGIN
WITH c14_glob DO
    BEGIN
    r_actln.l[ 1 ] := x_period;
    WHILE (   (NOT (r_ferr = vf_eof))
          AND (r_actln.l[ 1 ] = x_period)
          AND (NOT r_end_of_process)) DO
        BEGIN
        _line_found := false;
        WHILE (   (NOT (r_ferr = vf_eof))
              AND (NOT r_end_of_process)
              AND (NOT _line_found) ) DO
            BEGIN
            _line_found := true;
            ct14_read_one_line;
            IF  r_actln.len = 0
            THEN
                _line_found := false
            ELSE
                BEGIN
                FOR _int_l := 1 TO r_actln.len DO
                    IF  ord(r_actln.l[ _int_l ]) = 9
                    THEN
                        r_actln.l[ _int_l ] := bsp_c1;
                    (*ENDIF*) 
                (*ENDFOR*) 
                IF  (   c14_eq_ign_case ( r_actln, n_dash, 8)
                    AND (r_actln.len > mxsp_name+6))
                    (* some 'special' lines should be ignored by PRETTY *)
                THEN
                    _line_found := false
                ELSE
                    BEGIN
                    r_endpos_in_actln := 1;
                    ct14_skipbl (r_begpos_in_actln, r_endpos_in_actln);
                    IF  (  (r_begpos_in_actln = r_actln.len+1)
                        OR ct14_equal_resp(r_actln.l, n_com_end,    r_begpos_in_actln,  5)
                        OR ct14_equal_resp(r_actln.l, n_com_error,  r_begpos_in_actln, 10)
                        OR ct14_equal_resp(r_actln.l, n_script_cp,  r_begpos_in_actln, 10)
                        )
                    THEN
                        _line_found := false
                    (*ENDIF*) 
                    END
                (*ENDIF*) 
                END
            (*ENDIF*) 
            END;
        (*ENDWHILE*) 
        IF  c14_eq_ign_case ( r_actln, cct_n_cm, 1)
        THEN
            IF  ct14_pos_ign_case (cct_n_endpart, 5, 7) <> 0
            THEN
                BEGIN
                (* the end of a specific section is reached *)
                ct14_write_linend;
                IF  ct14_pos_ign_case (n_code_w, 11, 4) <> 0
                THEN
                    BEGIN (* end of code-part reached - stop processing *)
                    (* action of label 10 *)
                    IF  (r_offset <> 1) AND NOT (r_in_proc_ctv)
                    THEN
                        BEGIN
                        ct14_write_errmsg(n_e_missend, 13);
                        r_push_depth := 1;
                        r_offset     := 1;
                        END;
                    (*ENDIF*) 
                    IF  r_actln.len <> 0
                    THEN
                        ct14_write_actline;
                    (*ENDIF*) 
                    ct14_sequential_program;
                    IF  NOT c02process_state_ok (r_process_state, c02outf)
                    THEN
                        r_detected_errors := succ(r_detected_errors);
                    (*ENDIF*) 
                    IF  r_detected_errors <> 0
                    THEN
                        BEGIN
                        r_hline.l[ 1 ] := bsp_c1;
                        r_hline.len    := 1;
                        c02vfwrite (c02outf, r_hline);
                        r_name_line   := cct_n_prettyspec;
                        s10mv1 ( mxsp_name, mxsp_line, r_name_line, 1, r_hline.l, 1, 10);
                        r_hline.l[ 11 ] := bsp_c1;
                        r_hline.l[ 12 ] := bsp_c1;
                        r_name_line := n_det_errors;
                        s10mv1 ( mxsp_name, mxsp_line, r_name_line, 1, r_hline.l, 13, 18);
                        c02int4to_line ( r_detected_errors, false, 6, 31, r_hline.l);
                        r_hline.len := 36;
                        c02vfwrite (c02outf, r_hline);
                        END;
                    (*ENDIF*) 
                    END
                ELSE
                    BEGIN
                    (* end of any other than code-part reached *)
                    (* action of label 20 *)
                    ct14_check_offset;
                    ct14_write_actline;
                    ct14_sequential_program;
                    END
                (*ENDIF*) 
                END
            (*ENDIF*) 
        (*ENDIF*) 
        END;
    (*ENDWHILE*) 
    IF  (r_ferr = vf_eof)  OR  r_end_of_process
    THEN
        BEGIN
&       if $OS = VMSP
        (* see comment at the label-definition at top of code *)
        goto 9999;
&       else
        (* action of label 9999 *)
        ct14_close_files;
        sqlfinish(true);
&       endif
        END
    ELSE
        BEGIN
        IF  c14_eq_ign_case ( r_actln, cct_n_author, 1)
        THEN
            BEGIN
            ct14_write_errmsg(n_e_missendspec, 18);
            (* action of label 20 *)
            ct14_write_actline;
            ct14_sequential_program;
            END;
        (*ENDIF*) 
        IF  r_actln.l[ r_begpos_in_actln ] <> x_ampersand
        THEN
            IF  NOT r_its_frompart
            THEN
                ct14_keyw_upc (r_begpos_in_actln)
            ELSE
                BEGIN
                _int_l := r_begpos_in_actln;
                WHILE (   (r_actln.l[ _int_l ] <> x_cr)
                      AND (r_actln.l[ _int_l ] <> x_semicolon)) DO
                    _int_l := succ(_int_l);
                (*ENDWHILE*) 
                ct14_keyw_upc (_int_l)
                END
            (*ENDIF*) 
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct14_print_text (from_pos, pos_cnt : integer);
 
VAR
      _prt_txt_cnt, _prt_pos, _i : integer;
 
BEGIN
WITH c14_glob DO
    BEGIN
    r_clcount := r_clcount+1;
    _prt_pos := pos_cnt;
    IF  _prt_pos = 0
    THEN
        _prt_pos := r_actln.len-from_pos+1;
    (*ENDIF*) 
    IF  _prt_pos = 0
    THEN
        ct14_write_linend
    ELSE
        BEGIN
        _prt_txt_cnt := r_offset;
        IF  (   (r_offset+_prt_pos > mxsp_line)
            AND (_prt_pos < mxsp_line))
        THEN
            r_offset := mxsp_line-_prt_pos;
        (*ENDIF*) 
        IF  r_actln.l[ from_pos ] <> x_ampersand
        THEN
            BEGIN
            FOR _i := 1 TO r_offset-1 DO
                ct14_write_char (bsp_c1);
            (*ENDFOR*) 
            FOR _i := 0 TO _prt_pos-1 DO
                ct14_write_char (r_actln.l[ from_pos+_i ]);
            (*ENDFOR*) 
            END
        ELSE
            BEGIN
            (* print a 'conditional-compiling-control-line' *)
            ct14_write_char (r_actln.l[ from_pos ]);
            IF  r_intend_cclines
            THEN
                (* suppress the blanks - if wanted by option *)
                IF  r_cond_output = 0
                THEN
                    FOR _i := 1 TO r_offset-2 DO
                        ct14_write_char (bsp_c1)
                    (*ENDFOR*) 
                ELSE
                    FOR _i := 1 TO r_cond_output DO
                        ct14_write_char (bsp_c1);
                    (*ENDFOR*) 
                (*ENDIF*) 
            (*ENDIF*) 
            _i := from_pos+1;
            WHILE (   (_i <= from_pos+_prt_pos-1)
                  AND (r_actln.l[ _i ] = bsp_c1)) DO
                _i := succ(_i);
            (*ENDWHILE*) 
            WHILE _i <= from_pos+_prt_pos-1 DO
                BEGIN
                ct14_write_char (r_actln.l[ _i ]);
                _i := succ(_i)
                END
            (*ENDWHILE*) 
            END;
        (*ENDIF*) 
        ct14_write_linend;
        r_offset := _prt_txt_cnt
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct14_output_of_text (
            from_pos : integer;
            apos     : integer);
 
VAR
      _chr_count    : integer;
      _from_ptr     : integer;
      _pos_cnt      : integer;
      _found        : boolean;
      _its_intended : boolean;
 
BEGIN
WITH c14_glob DO
    BEGIN
    _from_ptr     := from_pos;
    _pos_cnt      := apos;
    _its_intended := false;
    IF  (  (_pos_cnt = 0)
        OR (r_actln.len <= _pos_cnt+from_pos-1))
    THEN
        BEGIN
        IF  (   (from_pos = r_firstchar)
            AND (r_offset   = r_firstchar)
            AND (r_actln.l[ from_pos ] <> x_ampersand))
        THEN
            BEGIN
            ct14_write_actline;
            r_clcount := r_clcount+1
            END
        ELSE
            ct14_print_text (from_pos, 0);
        (*ENDIF*) 
        ct14_read_text;
        END
    ELSE
        BEGIN
        IF  _pos_cnt = -1
        THEN
            r_endpos_in_actln := from_pos
        ELSE
            r_endpos_in_actln := from_pos+_pos_cnt;
        (*ENDIF*) 
        ct14_skipbl (r_begpos_in_actln, r_endpos_in_actln);
        IF  (   (r_actln.l[ r_endpos_in_actln ] = x_parenth_op)
            AND (r_actln.l[ r_endpos_in_actln+1 ]  = x_asterisk))OR
            (    r_actln.l[ r_endpos_in_actln ]  = x_curve_op)
        THEN
            BEGIN
            IF  r_actln.l[ r_endpos_in_actln ] <> x_curve_op
            THEN
                r_endpos_in_actln := r_endpos_in_actln+2;
            (*ENDIF*) 
            _found := false;
            WHILE NOT _found DO
                BEGIN
                IF  r_is_comment
                THEN
                    BEGIN
                    ct14_print_text ( _from_ptr , r_actln.len+1- _from_ptr );
                    ct14_read_text;
                    IF  r_offset - r_offsets[ r_push_depth-1 ] < in_continue
                    THEN
                        BEGIN
                        _its_intended := true;
                        ct14_push (in_continue)
                        END;
                    (*ENDIF*) 
                    _from_ptr := r_endpos_in_actln
                    END
                ELSE
                    BEGIN
                    REPEAT
                        r_endpos_in_actln := r_endpos_in_actln+1
                    UNTIL
                        (   ((r_actln.l[ r_endpos_in_actln-1 ] = x_asterisk)
                        AND  (r_actln.l[ r_endpos_in_actln ] = x_parenth_cl))
                        OR   (r_actln.l[ r_endpos_in_actln ] = x_curve_cl)
                        OR (r_endpos_in_actln > r_actln.len));
                    (*ENDREPEAT*) 
                    _chr_count       := r_endpos_in_actln- _from_ptr +1;
                    r_endpos_in_actln := r_endpos_in_actln+1;
                    _found           := true;
                    ct14_skipbl (r_begpos_in_actln, r_endpos_in_actln);
                    IF  r_endpos_in_actln > r_actln.len
                    THEN
                        BEGIN
                        ct14_print_text ( _from_ptr , _chr_count);
                        BEGIN
                        ct14_read_text;
                        END;
                        END
                    ELSE
                        BEGIN
                        ct14_print_text ( _from_ptr , _chr_count);
                        r_begpos_in_actln := r_endpos_in_actln
                        END
                    (*ENDIF*) 
                    END
                (*ENDIF*) 
                END;
            (*ENDWHILE*) 
            IF  _its_intended
            THEN
                ct14_pop
            (*ENDIF*) 
            END
        ELSE
            IF  (   (r_actln.l[ r_endpos_in_actln ]  = x_semicolon)
                AND (r_actln.l[ from_pos+_pos_cnt-1 ]  <> x_semicolon))
            THEN
                BEGIN
                ct14_print_text (from_pos, r_endpos_in_actln-from_pos+1);
                IF  r_endpos_in_actln = r_actln.len
                THEN
                    BEGIN
                    ct14_read_text;
                    END
                ELSE
                    BEGIN
                    r_endpos_in_actln := r_endpos_in_actln+1;
                    r_begpos_in_actln := r_endpos_in_actln
                    END
                (*ENDIF*) 
                END
            ELSE
                BEGIN
                ct14_print_text (from_pos, _pos_cnt);
                IF  r_endpos_in_actln = r_actln.len+1
                THEN
                    BEGIN
                    ct14_read_text;
                    END;
                (*ENDIF*) 
                r_begpos_in_actln := r_endpos_in_actln
                END
            (*ENDIF*) 
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    (*     IF  r_actln.l[ r_begpos_in_actln ] = x_ampersand *)
    (*     THEN *)
    (*         ct14_output_of_text (r_begpos_in_actln, 0); *)
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct14_write_end_com (comment : tsp_name);
 
BEGIN
WITH c14_glob DO
    BEGIN
    r_clcount := r_clcount+1;
    s10fil(mxsp_line, r_outln.l, 1, r_offset-1, bsp_c1);
    c02putname(r_outln, r_offset,    cct_n_combeg);
    c02putname(r_outln, r_outln.len, comment);
    c02putname(r_outln, r_outln.len, cct_n_comend);
    ct14_write_linend;
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct14_init;
 
VAR
      _k          : integer;
      _l          : integer;
      _ddd        : tsp_date;
      _ttt        : tsp_time;
      _ord_little : integer;
 
BEGIN
WITH c14_glob DO
    BEGIN
    c02init;
&   if $COMP=PTOC
    r_actln.adr := @r_actln.l;
    r_outln.adr := @r_outln.l;
    r_hline.adr := @r_hline.l;
&   else
    r_actln.adr := s30gad (r_actln.l);
    r_outln.adr := s30gad (r_outln.l);
    r_hline.adr := s30gad (r_hline.l);
&   endif
    c02linelength_init(mxsp_line);
    sqldattime ( _ddd, _ttt ) ;
    r_act_date        := _ddd ;
    r_act_time        := _ttt ;
    FOR _l := 1 TO mxsp_line DO
        r_blankline[ _l ] := bsp_c1;
    (*ENDFOR*) 
    r_outln.l         := r_blankline;
    r_outln.len       := 0;
    r_begpos_in_actln := 1;
    r_endpos_in_actln := 1;
    r_line_number     := 0;
    r_offsets[ 0 ]    := 1;
    r_its_a_case      := false;
    r_end_of_process  := false;
    r_in_proc_ctv     := false;
    r_intend_continue := true;
    r_is_comment      := false;
    r_clcount         := 0;
    _ord_little      := ord('a')-ord('A');
    c14_digits      := [ '0'..'9' ] ;
    c14_capitals    := [ 'A'..'I', 'J'..'R', 'S'..'Z' ] ;
    c14_littles     := [ 'a'..'i', 'j'..'r', 's'..'z' ] ;
    r_little_digit_ul := c14_littles + c14_digits + [ x_underln ] ;
    r_identchars      := c14_capitals + c14_littles + c14_digits + [ x_underln ] ;
    r_signs           := c14_capitals + r_little_digit_ul + [ x_quote ];
    r_count           := 0;
    r_detected_errors := 0;
    r_infile_is_open  := false;
    r_its_frompart    := false;
    r_take_it         := true;
    r_new_tags_found  := false;
    r_offset          := 1;
    r_process_state   := do_searchvdn;
    r_is_keyword      := false;
    r_stcount         := 0;
    r_push_depth      := 1;
    r_keywords[ 1 ]   := n_if;
    r_keywords[ 2 ]   := n_do;
    r_keywords[ 3 ]   := n_or;
    r_keywords[ 4 ]   := n_to;
    r_keywords[ 5 ]   := n_of;
    r_keywords[ 6 ]   := cct_n_end;
    r_keywords[ 7 ]   := n_for;
    r_keywords[ 8 ]   := cct_n_var;
    r_keywords[ 9 ]   := n_not;
    r_keywords[ 10 ]  := n_set;
    r_keywords[ 11 ]  := n_and;
    r_keywords[ 12 ]  := n_mod;
    r_keywords[ 13 ]  := n_div;
    r_keywords[ 14 ]  := n_nil;
    r_keywords[ 15 ]  := n_then;
    r_keywords[ 16 ]  := n_else;
    r_keywords[ 17 ]  := n_case;
    r_keywords[ 18 ]  := n_type;
    r_keywords[ 19 ]  := cct_n_from;
    r_keywords[ 20 ]  := n_with;
    r_keywords[ 21 ]  := n_main;
    r_keywords[ 22 ]  := cct_n_begin;
    r_keywords[ 23 ]  := n_while;
    r_keywords[ 24 ]  := cct_n_const;
    r_keywords[ 25 ]  := n_until;
    r_keywords[ 26 ]  := n_array;
    r_keywords[ 27 ]  := n_label;
    r_keywords[ 28 ]  := n_repeat;
    r_keywords[ 29 ]  := n_record;
    r_keywords[ 30 ]  := n_downto;
    r_keywords[ 31 ]  := n_packed;
    r_keywords[ 32 ]  := cct_n_program;
    r_keywords[ 33 ]  := cct_n_function;
    r_keywords[ 34 ]  := cct_n_procedure;
    r_keywords[ 35 ]  := n_otherwise;
    FOR _k := 1 TO 35 DO
        FOR _l := 1 TO mxsp_name DO
            IF  r_keywords[ _k, _l ]  <> bsp_c1
            THEN
                r_keywords[ _k, _l ] := chr(ord(r_keywords[ _k, _l ] )+
                      _ord_little);
            (*ENDIF*) 
        (*ENDFOR*) 
    (*ENDFOR*) 
    sqlresult(0); (* set the default - value *)
    r_sizecheck_cnt := 0;
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct14_bprocess_block;
 
VAR
      _next_word : tsp_line;
 
BEGIN
WITH c14_glob DO
    BEGIN
    r_push_depth := 1;
    r_offset     := 1;
    ct14_catch_identifier (_next_word, r_begpos_in_actln, r_endpos_in_actln);
    IF  (  c14_compare (_next_word, cct_n_procedure )
        OR c14_compare (_next_word, cct_n_function ))
    THEN
        BEGIN
        c02putname(r_outln, 0, cct_n_combeg);
        c02putname(r_outln, r_outln.len, n_dash);
        c02putname(r_outln, r_outln.len, n_dash);
        c02putname(r_outln, r_outln.len, cct_n_comend);
        ct14_write_linend;
&       ifdef SCRIPT
        c02putname(r_outln, 0, n_script_cp);
        ct14_write_linend;
&       endif
        ct14_write_linend;
        r_clcount := r_clcount+2;
        IF  c14_compare (_next_word, cct_n_procedure )
        THEN
            ct14_output_of_text (r_begpos_in_actln, 9)
        ELSE
            ct14_output_of_text (r_begpos_in_actln, 8);
        (*ENDIF*) 
        ct14_header(false);
        ct14_ctv;
        ct14_catch_identifier (_next_word, r_begpos_in_actln, r_endpos_in_actln);
        IF  c14_compare (_next_word, cct_n_begin )
        THEN
            BEGIN
            r_count           := 1;
            r_endpos_in_actln := r_begpos_in_actln;
            ct14_sprocess_statement;
            r_count           := 0
            END
        ELSE
            ct14_write_errmsg(n_e_blank, 2)
        (*ENDIF*) 
        END
    ELSE
        IF  c14_compare (_next_word, cct_n_program )
        THEN
            ct14_extra (true)
        ELSE
            IF  (   c14_compare (_next_word, cct_n_begin )
                AND (r_its_prog = true))
            THEN
                ct14_extra (false)
            ELSE
                BEGIN
                r_endpos_in_actln := r_begpos_in_actln;
                IF  (  c14_compare (_next_word, cct_n_const )
                    OR c14_compare (_next_word, n_type )
                    OR c14_compare (_next_word, n_label )
                    OR c14_compare (_next_word, cct_n_var ))
                THEN
                    ct14_ctv
                ELSE
                    BEGIN
                    r_is_keyword := false;
                    ct14_write_errmsg(n_e_unbalanced, 16);
                    WHILE
                          (   NOT (c14_compare (_next_word, cct_n_procedure))
                          AND NOT (c14_compare (_next_word, cct_n_function))
                          AND NOT (c14_compare (_next_word, cct_n_program))
                          AND NOT (c14_compare (_next_word, cct_n_const))
                          AND NOT (c14_compare (_next_word, n_label))
                          AND NOT (c14_compare (_next_word, n_type))
                          AND NOT (c14_compare (_next_word, cct_n_var))
                          AND NOT (c14_compare (_next_word, cct_n_begin ) AND (r_its_prog = true))
                          ) DO
                        BEGIN
                        ct14_output_of_text (r_begpos_in_actln, 0);
                        ct14_catch_identifier (_next_word, r_begpos_in_actln, r_endpos_in_actln)
                        END;
                    (*ENDWHILE*) 
                    r_endpos_in_actln := r_begpos_in_actln
                    END
                (*ENDIF*) 
                END;
            (*ENDIF*) 
        (*ENDIF*) 
    (*ENDIF*) 
    ct14_write_linend;
    r_clcount := r_clcount+1;
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct14_header (may_main : boolean);
 
VAR
      _first_line : boolean;
      _found_cnt  : tsp_int2;
      _next_word  : tsp_line;
 
BEGIN
WITH c14_glob DO
    BEGIN
    ct14_push (in_proc);
    _found_cnt  := 0;
    _first_line := true;
    WHILE _found_cnt = 0 DO
        BEGIN
        ct14_bracket_begin (_found_cnt);
        IF  _found_cnt = 2
        THEN (* x_parenth_op found*)
            BEGIN
            _found_cnt       := 0;
            r_endpos_in_actln := r_endpos_in_actln+1;
            WHILE _found_cnt <= 1 DO
                BEGIN
                ct14_bracket_end (_found_cnt);
                ct14_output_of_text (r_begpos_in_actln, r_endpos_in_actln-
                      r_begpos_in_actln);
                IF  _first_line
                THEN
                    BEGIN
                    ct14_push (in_continue);
                    _first_line := false
                    END;
                (*ENDIF*) 
                IF  _found_cnt = 3
                THEN
                    BEGIN
                    ct14_write_errmsg(n_e_blank, 2);
                    _found_cnt       := 0;
                    r_endpos_in_actln := r_endpos_in_actln+1
                    END
                (*ENDIF*) 
                END
            (*ENDWHILE*) 
            END
        ELSE
            ct14_output_of_text (r_begpos_in_actln, r_endpos_in_actln-
                  r_begpos_in_actln);
        (*ENDIF*) 
        IF  _first_line
        THEN
            BEGIN
            ct14_push (in_continue);
            _first_line := false
            END
        (*ENDIF*) 
        END;
    (*ENDWHILE*) 
    ct14_pop;
    ct14_catch_identifier (_next_word, r_begpos_in_actln, r_endpos_in_actln);
    r_endpos_in_actln := r_begpos_in_actln;
    IF  (c14_compare (_next_word, n_main )  AND  may_main)
    THEN
        ct14_output_of_text (r_begpos_in_actln, 0);
    (*ENDIF*) 
    ct14_pop;
    ct14_write_linend;
    r_clcount := r_clcount+1;
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct14_bracket_begin (VAR found_cnt : tsp_int2);
 
VAR
      _its_the_end : boolean;
 
BEGIN
WITH c14_glob DO
    BEGIN
    _its_the_end     := false;
    r_endpos_in_actln := r_endpos_in_actln-1;
    WHILE ((found_cnt = 0) AND  NOT _its_the_end  AND
          (r_endpos_in_actln <= r_actln.len)) DO
        BEGIN
        r_endpos_in_actln := r_endpos_in_actln+1;
        IF  r_actln.l[ r_endpos_in_actln ] = x_parenth_op
        THEN
            IF  r_actln.l[ r_endpos_in_actln+1 ] = x_asterisk
            THEN
                BEGIN
                _its_the_end := true;
                IF  r_begpos_in_actln = r_endpos_in_actln
                THEN
                    r_endpos_in_actln := r_endpos_in_actln-1
                (*ENDIF*) 
                END
            ELSE
                found_cnt := 2
            (*ENDIF*) 
        ELSE
            IF  r_actln.l[ r_endpos_in_actln ] = x_curve_op
            THEN
                found_cnt := 2
            ELSE
                IF  r_actln.l[ r_endpos_in_actln ] = x_semicolon
                THEN
                    BEGIN
                    found_cnt       := 1;
                    r_endpos_in_actln := r_endpos_in_actln+1
                    END
                (*ENDIF*) 
            (*ENDIF*) 
        (*ENDIF*) 
        END;
    (*ENDWHILE*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct14_bracket_end (VAR found_cnt : tsp_int2);
 
VAR
      _index : integer;
 
BEGIN
WITH c14_glob DO
    BEGIN
    _index := r_endpos_in_actln;
    WHILE ((found_cnt <= 0) AND (_index <= r_actln.len)) DO
        BEGIN
        IF  r_actln.l[ _index ] = x_parenth_cl
        THEN
            IF  _index > 1
            THEN
                BEGIN
                IF  r_actln.l[ _index-1 ] <> x_asterisk
                THEN
                    found_cnt := succ(found_cnt)
                (*ENDIF*) 
                END
            ELSE
                found_cnt := succ(found_cnt)
            (*ENDIF*) 
        ELSE
            IF  (r_actln.l[ _index ] = x_curve_cl)
                OR (r_actln.l[ _index ] = x_curve_op)
            THEN
                BEGIN
                END
            ELSE
                IF  r_actln.l[ _index ] = x_parenth_op
                THEN
                    IF  r_actln.l[ _index+1 ] <> x_asterisk
                    THEN
                        IF  found_cnt = 0
                        THEN
                            found_cnt := -1 (* procedure in parateter - list *)
                        ELSE
                            BEGIN
                            _index     := _index-2;
                            found_cnt := 3
                            END;
                        (*ENDIF*) 
                    (*ENDIF*) 
                (*ENDIF*) 
            (*ENDIF*) 
        (*ENDIF*) 
        _index := _index+1
        END;
    (*ENDWHILE*) 
    r_endpos_in_actln := _index;
    WHILE ((found_cnt = 1) AND (_index <= r_actln.len)) DO
        BEGIN
        IF  r_actln.l[ _index ] = x_semicolon
        THEN
            BEGIN
            found_cnt       := 2;
            r_endpos_in_actln := _index+1
            END;
        (*ENDIF*) 
        _index := _index+1
        END;
    (*ENDWHILE*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct14_v_p_f (
            must_semi : boolean;
            may_from  : boolean;
            may_main  : boolean);
      (* 3rd parameter may be deleted later *)
      (* it seems to be unused in ct14_v_p_f     *)
 
VAR
      _next_word : tsp_line;
      _its_found : boolean;
 
BEGIN
WITH c14_glob DO
    BEGIN
    ct14_catch_identifier (_next_word, r_begpos_in_actln, r_endpos_in_actln);
    r_endpos_in_actln := r_begpos_in_actln;
    IF  (   NOT (c14_compare (_next_word, cct_n_var))
        AND NOT (c14_compare (_next_word, cct_n_procedure))
        AND NOT (c14_compare (_next_word, cct_n_function))
        AND NOT (c14_compare (_next_word, cct_n_program))
        AND NOT (c14_compare (_next_word, cct_n_from ) AND may_from)
        )
    THEN
        BEGIN
        ct14_write_errmsg(n_e_notallowhere, 16);
        WHILE (   NOT (c14_compare (_next_word, cct_n_var))
              AND NOT (c14_compare (_next_word, cct_n_procedure))
              AND NOT (c14_compare (_next_word, cct_n_function))
              AND NOT (c14_compare (_next_word, cct_n_program)) ) DO
            BEGIN
            ct14_output_of_text (1, r_actln.len);
            ct14_catch_identifier (_next_word, r_begpos_in_actln, r_endpos_in_actln);
            END;
        (*ENDWHILE*) 
        r_endpos_in_actln := r_begpos_in_actln
        END;
    (*ENDIF*) 
    IF  c14_compare (_next_word, cct_n_program )
    THEN
        BEGIN
        ct14_extra (true);
        ct14_catch_identifier (_next_word, r_begpos_in_actln, r_endpos_in_actln);
        r_endpos_in_actln := r_begpos_in_actln
        END;
    (*ENDIF*) 
    IF  c14_compare (_next_word, cct_n_var )
    THEN
        ct14_ctv;
    (*ENDIF*) 
    ct14_catch_identifier (_next_word, r_begpos_in_actln, r_endpos_in_actln);
    WHILE (  c14_compare (_next_word, cct_n_procedure )
          OR c14_compare (_next_word, cct_n_function )) DO
        BEGIN
        ct14_output_of_text (r_begpos_in_actln, 9);
        IF  NOT must_semi
        THEN
            ct14_header(true)
        ELSE
            BEGIN
            _its_found       := false;
            ct14_push (in_proc);
            r_endpos_in_actln := r_endpos_in_actln-1;
            WHILE ((NOT _its_found) AND (r_endpos_in_actln < r_actln.len)) DO
                BEGIN
                r_endpos_in_actln := r_endpos_in_actln+1;
                IF  r_actln.l[ r_endpos_in_actln ] = x_semicolon
                THEN
                    _its_found := true
                (*ENDIF*) 
                END;
            (*ENDWHILE*) 
            IF  NOT _its_found
            THEN
                BEGIN
                r_endpos_in_actln            := r_endpos_in_actln+1;
                r_actln.len                  := r_actln.len+1;
                r_actln.l[ r_endpos_in_actln ] := x_semicolon
                END;
            (*ENDIF*) 
            ct14_output_of_text (r_begpos_in_actln, r_endpos_in_actln -
                  r_begpos_in_actln + 1);
            ct14_pop;
            ct14_write_linend;
            r_clcount := r_clcount+1
            END;
        (*ENDIF*) 
        ct14_catch_identifier (_next_word, r_begpos_in_actln, r_endpos_in_actln);
        END;
    (*ENDWHILE*) 
    r_endpos_in_actln := r_begpos_in_actln;
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct14_ctv;
 
VAR
      _next_word    : tsp_line;
      _old_word     : tsp_line;
      _int_record   : integer;
      _its_a_record : boolean;
 
BEGIN
WITH c14_glob DO
    BEGIN
    r_in_proc_ctv := true;
    ct14_catch_identifier (_next_word, r_begpos_in_actln, r_endpos_in_actln);
    WHILE (  c14_compare (_next_word, cct_n_const )
          OR c14_compare (_next_word, n_type )
          OR c14_compare (_next_word, n_label )
          OR c14_compare (_next_word, cct_n_var )
          ) DO
        BEGIN
        _its_a_record := false;
        IF  (  c14_compare (_next_word, cct_n_const )
            OR c14_compare (_next_word, n_label ) )
        THEN
            ct14_output_of_text (r_begpos_in_actln, 5)
        ELSE
            ct14_output_of_text (r_begpos_in_actln, 4);
        (*ENDIF*) 
        ct14_push (in_ctv);
        _old_word := _next_word;
        ct14_catch_identifier (_next_word, r_begpos_in_actln, r_endpos_in_actln);
        WHILE ( NOT c14_is_keyword (@_next_word, r_endpos_in_actln - r_begpos_in_actln))
              OR _its_a_record DO
            BEGIN
            r_its_a_case  := false;
            IF  c14_compare (_old_word, cct_n_const)
            THEN
                _int_record := 0
            ELSE
                BEGIN
                (*_int_record := ct14_pos_resp_case (n_record, r_endpos_in_actln, 6);*)
                _int_record := ct14_pos_resp_case (' RECORD           ',
                      r_endpos_in_actln, 7);
                END;
            (*ENDIF*) 
            IF  _int_record > 0
            THEN
                BEGIN
                IF  r_push_depth = 2
                THEN
                    ct14_write_linend;
                (*ENDIF*) 
                ct14_output_of_text (r_begpos_in_actln, _int_record-r_begpos_in_actln+7);
                _its_a_record := true;
                ct14_catch_identifier (_next_word, r_begpos_in_actln, r_endpos_in_actln);
                ct14_push (in_record)
                END;
            (*ENDIF*) 
            IF  c14_compare (_next_word, n_case )
            THEN
                r_its_a_case := true;
            (*ENDIF*) 
            r_take_it         := false;
            r_endpos_in_actln := r_begpos_in_actln;
            ct14_sprocess_statement;
            r_take_it         := true;
            ct14_catch_identifier (_next_word, r_begpos_in_actln, r_endpos_in_actln);
            IF  _its_a_record
            THEN
                IF  r_its_a_case
                THEN
                    BEGIN
                    r_its_a_case   := false;
                    _its_a_record := false;
                    ct14_pop;
                    ct14_write_linend
                    END
                ELSE
                    WHILE c14_compare (_next_word, cct_n_end) DO
                        BEGIN
                        ct14_pop;
                        r_is_keyword := false;
                        IF  r_actln.l[ r_endpos_in_actln ] = x_semicolon
                        THEN
                            r_endpos_in_actln := r_endpos_in_actln+1;
                        (*ENDIF*) 
                        ct14_output_of_text (r_begpos_in_actln, r_endpos_in_actln-
                              r_begpos_in_actln);
                        IF  ((r_push_depth = 2) OR (r_push_depth = 3))
                        THEN
                            BEGIN
                            _its_a_record := false;
                            ct14_write_linend
                            END;
                        (*ENDIF*) 
                        ct14_catch_identifier (_next_word, r_begpos_in_actln, r_endpos_in_actln)
                        END
                    (*ENDWHILE*) 
                (*ENDIF*) 
            (*ENDIF*) 
            END;
        (*ENDWHILE*) 
        IF  _its_a_record
        THEN
            BEGIN
            ct14_pop;
            ct14_write_errmsg(n_e_missend, 13)
            END
        ELSE
            IF  ((NOT _its_a_record) AND c14_compare (_next_word, cct_n_end ))
            THEN
                BEGIN
                IF  r_actln.l[ r_endpos_in_actln ] = x_semicolon
                THEN
                    r_endpos_in_actln := r_endpos_in_actln+1;
                (*ENDIF*) 
                ct14_output_of_text (r_begpos_in_actln, r_endpos_in_actln-
                      r_begpos_in_actln);
                ct14_write_errmsg(n_e_missend, 13);
                ct14_catch_identifier (_next_word, r_begpos_in_actln, r_endpos_in_actln)
                END;
            (*ENDIF*) 
        (*ENDIF*) 
        ct14_pop;
        ct14_write_linend;
        r_clcount := r_clcount+1
        END;
    (*ENDWHILE*) 
    r_endpos_in_actln := r_begpos_in_actln;
    r_in_proc_ctv     := false;
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct14_fprocess_from_part;
 
VAR
      _next_word : tsp_line;
 
BEGIN
WITH c14_glob DO
    BEGIN
    ct14_catch_identifier (_next_word, r_begpos_in_actln, r_endpos_in_actln);
    IF  c14_compare (_next_word, cct_n_from )
    THEN
        BEGIN
        r_its_frompart := true;
        ct14_output_of_text (r_begpos_in_actln, 4);
        r_its_frompart := false;
        ct14_push (in_ctv);
        r_take_it      := false;
        ct14_sprocess_statement;
        ct14_pop;
        r_take_it      := true;
        ct14_write_linend
        END
    ELSE
        BEGIN
        ct14_write_errmsg(n_e_blank, 2);
        ct14_output_of_text (r_begpos_in_actln, r_endpos_in_actln-
              r_begpos_in_actln)
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct14_extra (bool_parameter : boolean);
 
BEGIN
WITH c14_glob DO
    BEGIN
    IF  bool_parameter
    THEN
        BEGIN
        r_its_prog := true;
        ct14_output_of_text (r_begpos_in_actln, 7);
        ct14_header(false)
        END
    ELSE
        BEGIN
        r_endpos_in_actln := r_begpos_in_actln;
        r_count := 1;
        c02putname(r_outln, 0, cct_n_combeg);
        c02putname(r_outln, r_outln.len, n_dash);
        c02putname(r_outln, r_outln.len, n_dash);
        c02putname(r_outln, r_outln.len, cct_n_comend);
        ct14_write_linend;
&       ifdef SCRIPT
        c02putname(r_outln, 0, n_script_cp);
        ct14_write_linend;
&       endif
        ct14_write_linend;
        r_clcount := r_clcount+2;
        ct14_sprocess_statement;
        r_count   := 0;
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      ct14_catch_vdn_name : boolean;
 
VAR
      _func_result : boolean;
      _i           : integer;
      _j           : integer;
 
BEGIN
WITH c14_glob DO
    BEGIN
    _func_result := false;
    (* look for the line WITH the module-name  '.tt 1$...$VCT11$'  *)
    IF  (c14_eq_ign_case ( r_actln, cct_n_tt1, 1) OR
        c14_eq_ign_case ( r_actln, cct_n_modulename, 1))
    THEN
        BEGIN
        IF  c14_eq_ign_case( r_actln, cct_n_modulename, 1)
        THEN
            r_new_tags_found := true;
        (*ENDIF*) 
        r_vdn_modul_name := bsp_c8;
        _func_result    := true;
        _i              := 1;
        _j              := 0;
        IF  r_new_tags_found
        THEN
            BEGIN
            (* position to ':' *)
            WHILE (_i <= r_actln.len) AND (r_actln.l[_i] <> x_colon) DO
                _i := succ(_i);
            (*ENDWHILE*) 
            _i := succ(_i);
            (* position to module name *)
            WHILE (_i <= r_actln.len)   AND
                  ((r_actln.l[_i] = ' ') OR (r_actln.l[_i] = '\t')) DO
                _i := succ(_i);
            (*ENDWHILE*) 
            END
        ELSE
            REPEAT
                IF  r_actln.l[ _i ] = x_dollar
                THEN
                    _j := succ(_j);
                (*ENDIF*) 
                _i := succ(_i);
                (* the module-name is the third param OF .tt *)
            UNTIL
                (_j = 3) OR (_i > r_actln.len);
            (*ENDREPEAT*) 
        (*ENDIF*) 
        _j := 1;
        WHILE  (r_actln.l[ _i ] <> x_dollar) AND 
               ((r_actln.l[ _i ] <> ' ') AND (r_actln.l[ _i ] <> '\t'))
               AND (_i <= r_actln.len) DO
            BEGIN
            r_vdn_modul_name[ _j ] := r_actln.l[ _i ];
            _i                   := succ(_i);
            _j                   := succ(_j);
            END;
        (*ENDWHILE*) 
        END
    ELSE
        BEGIN
        (* look for the line with '.bt $Copyright...$$' *)
        (* Die 'Copyright'-Zeile wird jetzt nicht mehr von SCRIPT in   *)
        (* die Datei geschrieben, da wir jetzt zwei verschiedene Ver-  *)
        (* sionen fuer Release 2.4 und 3.0 haben (SAG + SQL) / (SAG).  *)
        (* Der Copyright-Vermerk wird vom XEDIT-Macro TT3 geschrieben. *)
        (* Erkennungszeichen in der Zeile ist das ',' vor der Jahresz. *)
        IF  c14_eq_ign_case (r_actln, n_bt, 1)
        THEN
            WITH r_actln DO
                BEGIN
                _i := 1;
                WHILE  (r_actln.l[ _i ] <> x_komma) AND (_i <= r_actln.len) DO
                    _i := succ(_i);
                (*ENDWHILE*) 
                len           := _i;
                l [ len + 1 ] := bsp_c1;
                l [ len + 2 ] := r_act_date [ 1 ];
                l [ len + 3 ] := r_act_date [ 2 ];
                l [ len + 4 ] := r_act_date [ 3 ];
                l [ len + 5 ] := r_act_date [ 4 ];
                len           := len + 5;
                c02putname (r_actln, 0, n_page);
                l [ len ]     := bsp_c1;
                len           := pred (len);
&               ifdef debug
                writeln ('r_actln.len = ', r_actln.len);
                writeln ('r_actln.l   =>', r_actln.l, '<');
                write   ('r_actln.l   =>');
                FOR _i := 1 TO r_actln.len DO
                    write('+');
                (*ENDFOR*) 
                writeln ('<');
&               endif
                END;
            (*ENDWITH*) 
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    ct14_catch_vdn_name := _func_result
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct14_write_line_count;
 
BEGIN
WITH c14_glob DO
    BEGIN
    c02putname (r_outln, 0, cct_n_sp2);
    ct14_write_linend;
    r_actln.len      := 59;
    s10fil(mxsp_line, r_actln.l, 1, r_actln.len, '*');
    ct14_write_actline;
    (*           statements  *)
    (*
    r_actln.l        := r_blankline;
    c02putname( r_actln, 1, cct_n_prettyspec);
    r_actln.len      := 12;
    c02putname( r_actln, 0, cct_n_statements);
    c02int4to_line(r_stcount, false, 10, succ(r_actln.len), r_actln.l);
    r_actln.len      := r_actln.len + 10;
    ct14_write_actline;
    *)
    (*           lines_of_code  *)
    (*
    r_actln.l        := r_blankline;
    r_actln.len      := 0;
    c02putname( r_actln, 0, cct_n_prettyspec);
    r_actln.len      := 12;
    c02putname( r_actln, 0, cct_n_lines_of_code);
    c02int4to_line(r_clcount, false, 10, succ(r_actln.len), r_actln.l);
    r_actln.len      := r_actln.len + 10 + c_dist_prettvers;
    c02putname(r_actln, 0, n_vct_version);
    ct14_write_actline;
    *)
    (* --------- lines_in_file  *)
    (*
    r_actln.l        := r_blankline;
    c02putname( r_actln, 1, cct_n_prettyspec);
    r_actln.len      := 12;
    c02putname( r_actln, 0, cct_n_lines_in_file);
    c02int4to_line(r_line_number+2, false, 10, r_actln.len+1, r_actln.l);
    r_actln.len      := r_actln.len + 10 + c_dist_prettvers;
    c02putname(r_actln, 0, n_vct_date);
    ct14_write_actline;
    *)
    (* --------- .pa  *)
    c02putname (r_outln, 0, cct_n_pa);
    ct14_write_linend;
    r_stcount        := 0;
    r_clcount        := 0;
    r_end_of_process := true;
    r_process_state  := do_workend;
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct14_write_actline;
 
BEGIN
WITH c14_glob DO
    BEGIN
    r_outln.l   := r_actln.l;
    r_outln.len := r_actln.len;
    r_actln.len := 0;
    ct14_write_linend;
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct14_write_char (character : CHAR);
 
BEGIN
WITH c14_glob, r_outln DO
    BEGIN
    len      := succ(len);
    l[ len ] := character;
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct14_write_linend;
 
VAR
      _b_len : integer;
      _first : integer;
      _i     : integer;
      _line_ok : boolean;
 
BEGIN
WITH c14_glob, r_outln DO
    BEGIN
    r_line_number := succ(r_line_number);
    _line_ok     := true;
    IF  len = 0
    THEN
        BEGIN
        len    := 1;
        l[ 1 ] := bsp_c1;
        END
    (*==========*)
    ELSE
        BEGIN
        (*           ** check the non_null line ** *)
        IF  r_check_linelength AND (len > maxpascallinelen)
        THEN
            BEGIN
            _first := 0;
            _b_len := len - maxpascallinelen;
            FOR _i := 1 TO _b_len + 1 DO
                IF  ((l[ _i ] <> bsp_c1) AND (_first = 0))
                THEN
                    _first := _i;
                (*ENDIF*) 
            (*ENDFOR*) 
            IF  (_first <> 0) AND (_first <= _b_len)
            THEN
                _line_ok := false;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        END
    (*ENDIF*) 
    (*==========*)
    ;
    c02vfwrite(r_outfile, r_outln);
    IF  NOT(_line_ok)
    THEN
        ct14_write_errmsg(n_e_longline, 17);
    (*ENDIF*) 
    len := 0;
    l   := r_blankline;
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct14_close_files;
 
VAR
      _dummy : boolean;
 
BEGIN
WITH c14_glob DO
    BEGIN
    (* IF not do_workend THEN write error into the error_file *)
    IF  NOT (c02process_state_ok (r_process_state, c02outf))
    THEN
        BEGIN
        sqlresult(11);
        ct14_write_linend;
        (* ... write error to bottom of '<fn> PRETTY' *)
        _dummy := c02process_state_ok (r_process_state, r_outfile);
        END;
    (*ENDIF*) 
    sqlfclose (c02outf, (r_detected_errors = 0), 0, 0,
          r_bufadr, r_ferr, r_ferr_text);
    IF  r_infile_is_open
    THEN
        BEGIN
        sqlfclose (r_infile,  false, 0, 0, r_bufadr, r_ferr, r_ferr_text);
        sqlfclose (r_outfile, false, 0, 0, r_bufadr, r_ferr, r_ferr_text);
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct14_get_option (VAR args : tsp_line);
 
VAR
      _begpos  : tsp_int2;
      _argln   : tct_line;
      _option1 : tsp_name;
 
BEGIN
WITH  c14_glob  DO
    BEGIN
    _argln.l        := args;
    _argln.len      := s30klen(args, bsp_c1, mxsp_line);
    r_intend_cclines := true;
    (*      1.: check for a '('         *)
    _begpos         := 1;
    _begpos         := c02chrpos(_argln, _begpos, '(');
    IF  _begpos <> 0
    THEN
        BEGIN
        (*      2.: get the option 1        *)
        _begpos := succ(_begpos);
        WHILE (args[ _begpos ] = bsp_c1)
              AND (_argln.len > _begpos)
              DO
            _begpos := succ(_begpos);
        (*ENDWHILE*) 
        c02getword(_argln, _begpos, _option1);
        (* ******************************************* *)
        (*      for later use (2nd option, .. ]       *)
        (* IF  (_option1 <> blankname) THEN BEGIN *)
        (* WHILE (args[ _begpos ] = blank) *)
        (* AND (_argln.len > _begpos) DO *)
        (* _begpos := succ(_begpos); *)
        (* c02_getword(_argln, _begpos, option2) END *)
        (* ******************************************* *)
        END
    ELSE
        BEGIN
        _option1    := bsp_name;
        (* option2 := blankname; *)
        END;
    (*ENDIF*) 
    r_name_line := n_opt_noblank;
    IF  c02equal_string (_option1, r_name_line)
    THEN
        r_intend_cclines := false
    ELSE
        r_intend_cclines := true;
    (*ENDIF*) 
&   IF $OS = UNIX
    (* Differenzen zw. langsamem und schnellem System !!! *)
    (* Also gibt es erst mal keinen Unterschied !      CS *)
    r_intend_cclines := true;
&   ENDIF
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      ct14_open_files : boolean;
 
VAR
      _i           : tsp_int4;
      _argl        : tsp_line;
      _pretty_fn   : tsp_vfilename;
      _source_fn   : tsp_vfilename;
      _error_fn    : tsp_vfilename;
      _func_result : boolean;
      _reclen      : tsp_int4;
      _format      : tsp_vf_format;
 
BEGIN
WITH  c14_glob  DO
    BEGIN
    sqlargl  (_argl);
    ct14_get_option (_argl);
    _i         := 1;
    r_ferr      := vf_ok;
    _error_fn  := bsp_c64;
    r_name_line := n_ftm_error;
    c02fncat (_error_fn, _argl, _i, r_name_line, l_ftm_error);
    (* try to open the error - file *)
    _format := vf_plaintext;
    _reclen := 0;
    sqlfopen (_error_fn, voverwrite, vf_stack, c02outf, _format,
          _reclen, 0, 0, r_bufadr, r_ferr,r_ferr_text);
    IF  (r_ferr = vf_ok)
    THEN
        BEGIN
        _i         := 1;
        _reclen    := 0;
        r_name_line := n_ftm_source;
        _source_fn := bsp_c64;
        c02fncat (_source_fn, _argl, _i, r_name_line, l_ftm_source);
        (* try to open the input-file *)
        sqlfopen (_source_fn, vread, vf_stack, r_infile, _format,
              _reclen, 0, 0, r_bufadr, r_ferr,r_ferr_text);
        IF  (r_ferr = vf_ok)
        THEN
            BEGIN
            _i          := 1;
            _reclen     := 0;
            r_name_line  := n_ftm_pretty;
            _pretty_fn  := bsp_c64;
            c02fncat (_pretty_fn, _argl, _i, r_name_line, l_ftm_pretty);
            (* try to open the output-file *)
            sqlfopen (_pretty_fn, voverwrite, vf_stack, r_outfile, _format,
                  _reclen, 0, 0, r_bufadr, r_ferr,r_ferr_text);
            IF  (r_ferr = vf_ok)
            THEN
                BEGIN
                _func_result := true;
                END
            ELSE
                BEGIN
                _func_result := false;
                END
            (*ENDIF*) 
            END
        ELSE
            BEGIN
            _func_result := false;
            ct14_write_errmsg ('in_file not found.', 18);
            END;
        (*ENDIF*) 
        END
    ELSE
        BEGIN
        _func_result := false;
        END;
    (*ENDIF*) 
    ct14_open_files     := _func_result;
    r_infile_is_open := _func_result;
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct14_write_errmsg (errline : tsp_name; errlen : integer);
 
VAR
      _out          : tct_line;
 
BEGIN
WITH c14_glob, _out DO
    BEGIN
&   if $COMP=PTOC
    _out.adr := @_out.l;
&   else
    _out.adr := s30gad (_out.l);
&   endif
    IF  r_detected_errors = 0
    THEN
        BEGIN
        (* initialise the error file *)
        r_name_line  := n_init_error;
        s10mv1(mxsp_name, mxsp_line, r_name_line, 1, l, 1, 18);
        s10fil(mxsp_line, l, 19, 24, '_');
        _out.len := 42;
        c02vfwrite (c02outf, _out);
        l[ 1 ]  := bsp_c1;
        _out.len := 1;
        c02vfwrite (c02outf, _out);
        sqlresult(11);
        END;
    (*ENDIF*) 
    r_line_number    := succ(r_line_number);
    (* write the r_line_number and the err_msg into the error-file *)
    c02int4to_line ( r_line_number, false, 5, 1, l);
    l[ 6 ]         := bsp_c1;
    l[ 7 ]         := x_colon;
    l[ 8 ]         := bsp_c1;
    l[ 9 ]         := bsp_c1;
    len            := 9;
    s10mv1( mxsp_name, mxsp_line, errline, 1, l, len+1, errlen);
    len            := len+errlen;
    c02vfwrite (c02outf, _out);
    r_detected_errors := succ(r_detected_errors);
    IF  r_infile_is_open
    THEN
        BEGIN
        (* write the err_msg into the output-file *)
        r_clcount    := succ(r_clcount);
        len        := r_offset-1;
        s10fil(mxsp_line, l, 1, len, bsp_c1);
        r_name_line  := cct_n_combeg;
        s10mv1( mxsp_name, mxsp_line, r_name_line, 1, l, r_offset, 2);
        len        := len+2;
        r_name_line  := cct_n_error;
        s10mv1( mxsp_name, mxsp_line, r_name_line, 1, l, succ(len), 12);
        len        := len+12;
        s10mv1( mxsp_name, mxsp_line, errline, 1, l, succ(len), errlen);
        len        := len+errlen;
        r_name_line  := cct_n_comend;
        s10mv1( mxsp_name, mxsp_line, r_name_line, 1, l, succ(len), 2);
        len        := len+2;
        c02vfwrite (r_outfile, _out);
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct14_cpprocess_code_part;
 
VAR
      _scan_part : boolean;
 
BEGIN
WITH c14_glob DO
    BEGIN
    r_offset         := 1;
    r_push_depth     := 1;
    r_stcount        := 0;
    r_clcount        := 0;
    ct14_write_actline;
    r_is_comment     := false;
    r_take_it        := true;
    ct14_read_text;
    IF  ct14_pos_ign_case (n_pretty, 1, 6) = 0
    THEN
        BEGIN
        r_outln.len  := 0;
        ct14_write_linend;
        ct14_write_linend;
        (* process the code-part of a pascal source file *)
        (*         or the structure-part of a file *)
        WHILE true DO
            BEGIN
            ct14_bprocess_block
            END
        (*ENDWHILE*) 
        END
    ELSE
        BEGIN
        (* ======================================== *)
        (* this part must'n be processed by PRETTY  *)
        (* (i.e. the CODE-part of an ASSEMBLER file *)
        (* or a STRUCTURE-part with english words.  *)
        (* ======================================== *)
        _scan_part      := true;
        r_check_linelength := false;
        ct14_write_actline;
        WHILE (   NOT (r_ferr = vf_eof)
              AND NOT (r_end_of_process)
              AND _scan_part   ) DO
            BEGIN
            ct14_read_one_line;
            IF  c14_eq_ign_case ( r_actln, cct_n_cm, 1)
                AND (c02strpos(r_actln, cct_n_endpart) > 4)
            THEN
                BEGIN
                (* this should be the end of the structure | code-part *)
                IF  c02strpos(r_actln, n_code_w) > 12
                THEN
                    BEGIN
                    (* this is the end of the code-part *)
                    ct14_write_actline;
                    ct14_write_line_count;
                    END
                ELSE
                    BEGIN
                    (* this must be the end of the structure-part *)
                    ct14_write_actline;
                    _scan_part := false;
                    END;
                (*ENDIF*) 
                END
            ELSE
                BEGIN
                IF  c14_eq_ign_case ( r_actln, cct_n_pa, 1)
                THEN
                    BEGIN
                    ct14_write_line_count;
                    END;
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            IF  (   (NOT  ct14_equal_resp(r_actln.l, cct_n_prettyspec, 1, 10))
                AND  NOT (r_end_of_process)  AND  _scan_part )
            THEN
                BEGIN
                ct14_write_actline;
                r_stcount := succ(r_stcount);
                r_clcount := succ(r_clcount)
                END
            (*ENDIF*) 
            END;
        (*ENDWHILE*) 
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct14_sequential_program;
 
VAR
      _first_line : boolean;
      _next_word  : tsp_line;
      _reject_line: boolean;
 
BEGIN
WITH c14_glob DO
    BEGIN
    _reject_line := false;
    WHILE ((NOT (r_ferr = vf_eof)) AND (NOT r_end_of_process)) DO
        BEGIN
        IF NOT _reject_line
        THEN
            ct14_read_one_line;
        _reject_line  := false;
        r_cond_output := 0;
        r_check_linelength := false;
        CASE r_process_state OF
            do_searchvdn :
                BEGIN
                (* catch_vdn replaces the date in the '.bt Copyright'  *)
                (* the line '.bt $...$' must be in front of '.tt 1 ... *)
                IF  ct14_catch_vdn_name
                THEN
                    (*
                    IF r_new_tags_found
                    THEN
                        r_process_state := do_searchversion
                    ELSE
                    *)
                        r_process_state := do_searchdef;
                (*ENDIF*) 
                ct14_write_actline
                END;
            do_searchdef :
                IF  NOT c14_eq_ign_case (r_actln, cct_n_define, 1)
                THEN
                    BEGIN
                    IF  NOT c14_eq_ign_case ( r_actln, cct_n_prettydate, 1)
                    THEN
                        ct14_write_actline
                    ELSE
                        (* remove pretty date line *)
                        ;
                    END
                ELSE
                    BEGIN
                    r_process_state := do_searchuse;
                    r_check_linelength := true;
                    r_cond_output   := 7;
                    ct14_output_of_text (1, 9);
                    ct14_push (in_usedef );
                    ct14_write_linend;
                    IF  ((r_vdn_modul_name[ 4 ] = '0') AND (r_vdn_modul_name[ 5 ] = '0')) 
                        OR
                        ((r_vdn_modul_name[ 1 ] = 'G') OR  (r_vdn_modul_name[ 1 ] = 'g'))
                    THEN
                        ct14_ctv
                    ELSE
                        ct14_v_p_f (false, false, true);
                    (*ENDIF*) 
                    ct14_pop;
                    r_offset        := 1;
                    r_push_depth    := 1;
                    ct14_write_actline
                    END;
                (*ENDIF*) 
            do_searchuse :
                IF  NOT c14_eq_ign_case ( r_actln, cct_n_use, 1)
                THEN
                    ct14_write_actline
                ELSE
                    BEGIN
                    r_process_state := do_searchsyn;
                    r_check_linelength := true;
                    r_cond_output   := 7;
                    _first_line    := true;
                    r_offset        := 1;
                    r_push_depth    := 1;
                    ct14_output_of_text (1, 9);
                    ct14_push (in_usedef );
                    ct14_write_linend;
                    WHILE true DO
                        BEGIN
                        IF  NOT _first_line
                        THEN
                            BEGIN
                            (* write a dash-line between two different modules *)
                            s10fil(mxsp_line, r_outln.l, 1, 7, bsp_c1);
                            r_outln.len := 7;
                            c02putname(r_outln, r_outln.len, n_dash);
                            c02putname(r_outln, r_outln.len, n_dash);
                            ct14_write_linend;
                            ct14_write_linend;
                            END;
                        (*ENDIF*) 
                        _first_line := false;
                        ct14_fprocess_from_part;
                        ct14_v_p_f (false, true, false)
                        END;
                    (*ENDWHILE*) 
                    END;
                (*ENDIF*) 
            do_searchsyn :
                IF  NOT c14_eq_ign_case ( r_actln, cct_n_synonym, 1)
                THEN
                    ct14_write_actline
                ELSE
                    BEGIN
                    (*
                    IF NOT r_new_tags_found
                    THEN
                        r_process_state := do_searchversion
                    ELSE
                    *)
                        r_process_state := do_searchstruct;
                    r_check_linelength := true;
                    r_offset        := 1;
                    r_push_depth    := 1;
                    ct14_output_of_text (1, 9);
                    ct14_push (in_usedef );
                    ct14_write_linend;
                    WHILE true DO
                        BEGIN
                        ct14_v_p_f(true, false, false);
                        ct14_push (in_proc);
                        ct14_catch_identifier (_next_word, r_begpos_in_actln,
                              r_endpos_in_actln);
                        r_endpos_in_actln := r_begpos_in_actln;
                        WHILE (   NOT (c14_compare (_next_word, cct_n_procedure))
                              AND NOT (c14_compare (_next_word, cct_n_function))) DO
                            BEGIN
                            ct14_output_of_text (r_begpos_in_actln, r_actln.len);
                            ct14_catch_identifier (_next_word, r_begpos_in_actln,
                                  r_endpos_in_actln);
                            r_endpos_in_actln := r_begpos_in_actln
                            END;
                        (*ENDWHILE*) 
                        ct14_write_linend;
                        ct14_pop
                        END
                    (*ENDWHILE*) 
                    END;
                (*ENDIF*) 
            do_searchversion :
                IF  NOT 
                    (c14_eq_ign_case ( r_actln, cct_n_version, 1) OR
                     c14_eq_ign_case ( r_actln, cct_n_prettydate, 1))
                THEN
                    ct14_write_actline
                ELSE
                    BEGIN
                    (* change the date in this line to the actual date *)
                    r_actln.l[ 10 ] := bsp_c1;
                    r_actln.l[ 11 ] := r_act_date [ 1 ];
                    r_actln.l[ 12 ] := r_act_date [ 2 ];
                    r_actln.l[ 13 ] := r_act_date [ 3 ];
                    r_actln.l[ 14 ] := r_act_date [ 4 ];
                    r_actln.l[ 15 ] := x_hyphen;
                    r_actln.l[ 16 ] := r_act_date [ 5 ];
                    r_actln.l[ 17 ] := r_act_date [ 6 ];
                    r_actln.l[ 18 ] := x_hyphen;
                    r_actln.l[ 19 ] := r_act_date [ 7 ];
                    r_actln.l[ 20 ] := r_act_date [ 8 ];
                    r_actln.len     := 20;
                    ct14_write_actline;
                    IF r_new_tags_found
                    THEN
                        r_process_state := do_searchdef
                    ELSE
                        r_process_state := do_searchstruct;
                    END;
                (*ENDIF*) 
            do_searchstruct :
                IF  NOT c14_eq_ign_case ( r_actln, cct_n_structure, 1)
                THEN
                    IF c14_eq_ign_case ( r_actln, cct_n_code, 1 )
                    THEN
                        BEGIN
                        _reject_line    := true;
                        r_process_state := do_searchcode;
                        END
                    ELSE
                        BEGIN
                        IF  NOT c14_eq_ign_case ( r_actln, cct_n_version, 1)
                        THEN
                            ct14_write_actline
                        ELSE
                            (* remove pretty date line *)
                            ;
                        END
                ELSE
                    BEGIN
                    (* the structure-part should be processed like the code_part *)
                    (* because the 'pseudo-code' has to be pretty, too. *)
                    r_process_state := do_searchcode;
                    ct14_cpprocess_code_part;
                    END;
                (*ENDIF*) 
            do_searchcode :
                IF  NOT c14_eq_ign_case ( r_actln, cct_n_code, 1)
                THEN
                    ct14_write_actline
                ELSE
                    BEGIN
                    r_process_state := do_prettyresult;
                    r_check_linelength := true;
                    (* make the code-part pretty ... *)
                    ct14_cpprocess_code_part;
                    END;
                (*ENDIF*) 
            do_prettyresult :
                BEGIN
                r_process_state     := do_workend;
                ct14_write_line_count;
                END;
            do_workend :
                BEGIN
                END
            END
        (*ENDCASE*) 
        END;
    (*ENDWHILE*) 
    END;
(*ENDWITH*) 
END;
 
(*-  m a i n    p r o g r a m  -*)
(*------------------------------*) 
 
BEGIN
&if $OS = WIN32
WinArgc := __argc;
WinArgv := __argv;
&endif
ct14_init;
IF  ct14_open_files
THEN
    ct14_sequential_program
ELSE
    sqlresult(11);
(*ENDIF*) 
(*    label 20 removed *)
(*    label 10 removed *)
&if $OS = VMSP
(* see comment at the label-definition at top of code *)
9999 :;
ct14_close_files;
sqlfinish(true);
&else
(* label 9999 removed *)
&endif
END
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
*-PRETTY-*  statements    :       1402
*-PRETTY-*  lines of code :       3803        PRETTYX 3.10 
*-PRETTY-*  lines in file :       4114         1997-12-10 
.PA 
