.CM *ID* VCT01    VDN      changed on 1992-07-07-18.22.24 by CARSTEN   *
.ad 8
.bm 8
.fm 4
.bt $Copyright by   Software AG, 2000$$Page %$
.tm 12
.hm 6
.hs 3
.tt 1 $SQL$Project Distributed Database System$VCT01$
.tt 2 $$$
.tt 3 $C.Nemack$VDNTYPE_CHECK$1995-10-05$
***********************************************************
.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  : VDNTYPE_CHECK
=========
.sp
Purpose : Declaration in the use_part is checked against the
          definitions in the define-part of the exporting module.
.CM *-END-* purpose -------------------------------------
.sp
.cp 3
Define  :
 
        PROGRAM
              vct01 (input);
 
.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :
 
        FROM
              String_utilities : VCT02;
 
        VAR
              c02oline          : tct_line;
              c02delimiter      : tct_delim;
 
        PROCEDURE
              c02init;
 
        PROCEDURE
              c02linelength_init ( l : integer );
 
        PROCEDURE
              c02fncat (VAR s      : tsp_vfilename;
                    VAR s1     : tsp_line;
                    VAR start1 : tsp_int4;
                    VAR n      : tsp_name;
                    nlen       : tsp_int4);
 
        PROCEDURE
              c02vncat (VAR s      : tsp_vfilename;
                    VAR s1     : tsp_name;
                    VAR start1 : tsp_int4;
                    VAR n      : tsp_name;
                    nlen       : tsp_int4);
 
        FUNCTION
              c02strpos (VAR ln   : tct_line;
                    nstr     : tsp_name) : tsp_int4;
 
        FUNCTION
              c02chrpos (VAR ln   : tct_line;
                    beg      : tsp_int4;
                    c        : char) : tsp_int2;
 
        PROCEDURE
              c02getword (
                    VAR ln   : tct_line;
                    VAR beg  : tsp_int2;
                    VAR word : tsp_name);
 
        PROCEDURE
              c02getidentifier (
                    VAR ln   : tct_line;
                    VAR beg  : tsp_int2;
                    VAR word : tsp_knl_identifier);
 
        PROCEDURE
              c02vfwrite (fno : tsp_int4;
                    VAR line  : tct_line);
 
        PROCEDURE
              c02int4to_line (int       : tsp_int4;
                    with_zero : boolean;
                    int_len   : integer;
                    ln_pos    : integer;
                    VAR ln    : tsp_line);
 
        FUNCTION
              c02isend_section (VAR l : tct_line) : boolean;
 
        FUNCTION
              c02vcsymb_get (VAR l    : tct_line;
                    beg      : integer) : tct_vcsymb;
 
        FUNCTION
              c02isblankline (VAR l : tct_line) : boolean;
&       IF $OS = VMSP
 
        FUNCTION
              c02toupper  (c : char) : char;
&       ELSE
 
        FUNCTION
              c02tolower  (c : char) : char;
&       ENDIF
 
        PROCEDURE
              c02putname (VAR l : tct_line;
                    pos   : integer;
                    nam   : tsp_name);
 
        PROCEDURE
              c02putidentifier (
                    VAR ln  : tct_line;
                    pos     : integer;
                    nam     : tsp_knl_identifier);
 
        PROCEDURE
              c02blankline (VAR l : tct_line);
 
        PROCEDURE
              c02print_com (com : tsp_name);
 
        FUNCTION
              c02process_state_ok (process   : tct_do;
                    errfileno : tsp_int4) : boolean;
 
      ------------------------------ 
 
        FROM
              Conditional-Compiling_Utilities : VCT04;
 
        PROCEDURE
              c04cc2init (VAR argln     : tct_line;
                    VAR printrout : tsp_name;
                    VAR td_trace  : boolean;
                    errfileno     : tsp_int4);
 
        FUNCTION
              c04ccgetline (infileno : tsp_int4;
                    VAR ln    : tct_line;
                    errfileno : tsp_int4) : tsp_vf_return;
 
        PROCEDURE
              c04linelength_init ( l : integer );
 
      ------------------------------ 
 
        FROM
              GetFilePath  : VCT05c;
 
        PROCEDURE
              c05get_file_path (
                    VAR modul     : tsp_vfilename;
                    VAR modulpath : tsp_vfilename;
                    VAR ok        : integer);
 
      ------------------------------ 
 
        FROM
              RTE-Extension-10 : VSP10;
 
        PROCEDURE
              s10fil (size     : tsp_int4;
                    VAR m    : tsp_line;
                    pos      : tsp_int4;
                    len      : tsp_int4;
                    fillchar : char);
 
        PROCEDURE
              s10fil1 (size     : tsp_int4;
                    VAR m    : tsp_execline;
                    pos      : tsp_int4;
                    len      : tsp_int4;
                    fillchar : char);
 
        PROCEDURE
              s10mv1 (size1    : tsp_int4;
                    size2    : tsp_int4;
                    VAR val1 : tsp_name;
                    p1       : tsp_int4;
                    VAR val2 : tsp_line;
                    p2       : tsp_int4;
                    cnt      : tsp_int4);
 
        PROCEDURE
              s10mv2 (size1    : tsp_int4;
                    size2    : tsp_int4;
                    VAR val1 : tsp_line;
                    p1       : tsp_int4;
                    VAR val2 : tsp_line;
                    p2       : tsp_int4;
                    cnt      : tsp_int4);
 
        PROCEDURE
              s10mv3 (size1    : tsp_int4;
                    size2    : tsp_int4;
                    VAR val1 : tsp_vfilename;
                    p1       : tsp_int4;
                    VAR val2 : tsp_line;
                    p2       : tsp_int4;
                    cnt      : tsp_int4);
 
        PROCEDURE
              s10mv4 (size1    : tsp_int4;
                    size2    : tsp_int4;
                    VAR val1 : tsp_c40;
                    p1       : tsp_int4;
                    VAR val2 : tsp_line;
                    p2       : tsp_int4;
                    cnt      : tsp_int4);
 
        PROCEDURE
              s10mv6 (size1    : tsp_int4;
                    size2    : tsp_int4;
                    VAR val1 : tsp_c64;
                    p1       : tsp_int4;
                    VAR val2 : tsp_line;
                    p2       : tsp_int4;
                    cnt      : tsp_int4);
 
        PROCEDURE
              s10mv7 (size1    : tsp_int4;
                    size2    : tsp_int4;
                    VAR val1 : tsp_c40;
                    p1       : tsp_int4;
                    VAR val2 : tsp_execline;
                    p2       : tsp_int4;
                    cnt      : tsp_int4);
 
        PROCEDURE
              s10mv8 (size1    : tsp_int4;
                    size2    : tsp_int4;
                    VAR val1 : tsp_name;
                    p1       : tsp_int4;
                    VAR val2 : tsp_vfilename;
                    p2       : tsp_int4;
                    cnt      : tsp_int4);
 
        PROCEDURE
              s10mv9 (size1    : tsp_int4;
                    size2    : tsp_int4;
                    VAR val1 : tsp_line;
                    p1       : tsp_int4;
                    VAR val2 : tsp_vfilename;
                    p2       : tsp_int4;
                    cnt      : tsp_int4);
 
        PROCEDURE
              s10mv10 (size1    : tsp_int4;
                    size2    : tsp_int4;
                    VAR val1 : tsp_vfilename;
                    p1       : tsp_int4;
                    VAR val2 : tsp_execline;
                    p2       : tsp_int4;
                    cnt      : tsp_int4);
 
        PROCEDURE
              s10mv11 (size1    : tsp_int4;
                    size2    : tsp_int4;
                    VAR val1 : tsp_knl_identifier;
                    p1       : tsp_int4;
                    VAR val2 : tsp_line;
                    p2       : tsp_int4;
                    cnt      : tsp_int4);
 
      ------------------------------ 
 
        FROM
              RTE_driver : VEN102;
 
&       if $OS = WIN32
        VAR
              WinArgc : tsp_int4;
              __argc  : tsp_int4;
              WinArgv : tsp_moveobj_ptr;
              __argv  : tsp_moveobj_ptr;
&       endif
 
        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);
 
        PROCEDURE
              sqlresult (result : integer);
 
        PROCEDURE
              sqlfinish (terminate : boolean);
 
        PROCEDURE
              sqlargl (VAR args    : tsp_line);
 
        PROCEDURE
              sqlexec (
                    VAR command       : tsp_execline;
                    mode              : tsp_exec_mode;
                    VAR error         : tsp_exec_return;
                    VAR err_text      : tsp_errtext;
                    VAR commandresult : tsp_int2);
 
      ------------------------------ 
 
        FROM
              RTE-Extension-30 : VSP30;
 
        FUNCTION
              s30lnr (VAR str : tsp_line;
                    val     : char;
                    start   : tsp_int4;
                    cnt     : tsp_int4) : tsp_int4;
 
.CM *-END-* use -----------------------------------------
.sp;.cp 3
Synonym :
 
        PROCEDURE
              s10fil;
 
              tsp_moveobj tsp_line
 
        PROCEDURE
              s10fil;
 
              tsp_moveobj tsp_execline
 
        PROCEDURE
              s10mv1;
 
              tsp_moveobj tsp_name
              tsp_moveobj tsp_line
 
        PROCEDURE
              s10mv2;
 
              tsp_moveobj tsp_line
              tsp_moveobj tsp_line
 
        PROCEDURE
              s10mv3;
 
              tsp_moveobj tsp_vfilename
              tsp_moveobj tsp_line
 
        PROCEDURE
              s10mv4;
 
              tsp_moveobj tsp_c40
              tsp_moveobj tsp_line
 
        PROCEDURE
              s10mv6;
 
              tsp_moveobj tsp_c64
              tsp_moveobj tsp_line
 
        PROCEDURE
              s10mv7;
 
              tsp_moveobj tsp_c40
              tsp_moveobj tsp_execline
 
        PROCEDURE
              s10mv8;
 
              tsp_moveobj tsp_name
              tsp_moveobj tsp_vfilename
 
        PROCEDURE
              s10mv9;
 
              tsp_moveobj tsp_line
              tsp_moveobj tsp_vfilename
 
        PROCEDURE
              s10mv10;
 
              tsp_moveobj tsp_vfilename
              tsp_moveobj tsp_execline
 
        PROCEDURE
              s10mv11;
 
              tsp_moveobj tsp_knl_identifier
              tsp_moveobj tsp_line
 
        PROCEDURE
              sqlresult;
 
              tsp_int1 integer
 
        FUNCTION
              s30lnr;
 
              tsp_moveobj tsp_line
 
        PROCEDURE
              sqlfopen;
 
              tsp_vf_bufaddr tct_lineaddr
 
        PROCEDURE
              sqlfclose;
 
              tsp_vf_bufaddr tct_lineaddr
 
.CM *-END-* synonym -------------------------------------
Author  : C. Nemack
.sp
.cp 3
Created : 1988-07-01
.sp
.cp 3
Version : 2000-03-10
.sp
.cp 3
Release :  6.1.2         Date : 1995-10-05
.sp
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Specification:
 
.nf
PROGRAM    VCT01:
.sp 3
CALL    :  VCT01 fn mach
.sp
   with :  fn      Module, the declarations in the Use-part
                   are checked against the definitions in the
                   exporting module.
.sp
                   Mach specifies the machine for conditional-
                   compiling, e.g. "IBM", "T31", "T35" ...
.sp
           output  The module generates an errorfile named
                   'modulename check a'.
 
 
Used   :  vct00 const-, typedefinitions
          vct02 Subroutines for vctXX
          vct01 Mainprogram
.sp 2
.fo
This type-checker-version contains the generation of output using the
Virtual-File mechanism.
.sp3
PROCEDURE  SEQUENTIAL_PROGRAM:
.sp
This is the main procedure of the type_checker. All variables are
initialized. All modules declared in the use-part are inserted into
the from-tab. This happens in the procedure 'fill_from_tab'. The
procedure 'fprocess_from_tab' causes the storage in a tree of all used
variables, procedures and functions of the exporting module.
The key of the declarations in the tree consists of the modulename
and the kind of declaration.
The procedure 'fprocess_input_file' performs the comparison of
the declarations stored in the 'usetree' and the ones in the use-part.
.sp
.nf
.sp 4
PROCEDURE  FILL_FROM_TAB:
.sp
.fo
All module names which are declared in the usepart are stored in
'from_tab'. The module names are transformed to uppercase letters. They
are equal to the filenames.
.sp 4
PROCEDURE  FPROCESS_FROM_TAB:
.sp
All modules stored in the 'from_tab' are processed sequentially.
The definitions of the define part are stored ordered by
module name and kind of definition. The corresponding lines
are stored in the usetree as well.
.sp 4
PROCEDURE  MPROCESS_MODUL:
.sp
Each module will be processed line by line until the variables 'process'
and 'end_do' are equal.
.sp 4
PROCEDURE  LPROCESS_LINE:
.sp
This procedure processes one line. Depending on the state of the
variable 'process' it searches for special words in the line like
in the following example:
.sp
.nf
do_searchvdn  : get vdn_n from line '.tt 1'
do_searchdate : get dat_n from line '.tt 3'
do_searchmod  : get mod-n from line 'Module :'
.sp 2
 
PROCEDURE dprocess_def:
 
The definitions of the define-section are processed by the procedures
vprocess_var and rprocess_rout.
 
 
PROCEDURE sprocess_syn:
 
The declarations of the synonym-section are inserted in the 'syn_tab'.
 
 
PROCEDURE vprocess_var:
 
The type-definitons are checked and inserted into the use-tree by the
procedure enter_use_tree.
 
 
PROCEDURE rprocess_rout:
 
The name of the routine is inserted into the tree by the
procedure enter_use_tree.
 
 
PROCEDURE uprocess_use:
 
The use-definitons are checked and inserted into the list 'from_tab'.
 
 
PROCEDURE transkg:
 
The name is translated from lowercase to uppercase characters.
 
 
PROCEDURE iprocess_input_file:
 
The input file will be processed from the beginning. The processing
will be performed by the procedure pprocess_and_print_line.
 
 
PROCEDURE pprocess_and_print_line:
 
This procedure processes three states: do_searchcode, do_workuse and
do_workcode. Do_searchcode: the work will be done by the procedure
puprocess_print_use. Do_workuse will be processed by check_proc.
 
 
PROCEDURE puprocess_print_use:
 
 
PROCEDURE print_var:
 
 
PROCEDURE print_rout:
 
 
PROCEDURE enter_use_tree:
 
 
PROCEDURE search_key:
 
 
PROCEDURE print_error:
 
 
PROCEDURE write_inp_line:
 
 
PROCEDURE check_proc:
 
 
PROCEDURE check_ptab:
 
 
PROCEDURE write_param_line:
 
 
PROCEDURE fill_ptab:
 
 
FUNCTION next_delim_in_arr:
 
 
PROCEDURE write_error:
 
 
FUNCTION exist_syn:
 
 
.CM *-END-* specification -------------------------------
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Description:
 
.CM *-END-* description ---------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.nf
.oc _/1
Structure:
 
.CM *-END-* structure -----------------------------------
.sp 2
**********************************************************
.sp
.cp 10
.nf
.oc _/1
.CM -lll-
Code    :
 
 
CONST
      (*   version - number, put to the top of the result file *)
      n_vct_version   = '(TYPE-CHECK 7.2.2 ';
      n_vct_date      = '  2000-03-10)     ';
      cct01_n_var     = 
	    'VAR                                                             ';
 
TYPE
 
      c01_glob_tp      = RECORD
            error      : boolean;
            module_ok  : boolean;
            inputfile  : boolean;
            err        : boolean;
            u_key      : tct_usekey;
            u_tree     : tct_usepointer;   (* root pointer *)
            key_p      : tct_usepointer;   (* pointer: u_key = n_key *)
            num_from   : tsp_int4;
            from_tab   : tct_from_table;
            inp_vdn    : tsp_name;
            module_name: tsp_name;
            hname      : tsp_name;
            h_c64      : tsp_c64;
            h_c40      : tsp_c40;
            hline      : tct_line;
            mod_nfound : boolean;
            c01fill1   : boolean;
            vdn_n      : tsp_name;
            dat_n      : tsp_name;
            mod_n      : tsp_name;
            symb       : tct_vcsymb;
            process    : tct_do;
            first      : boolean;
            check      : boolean;
            vdn_from   : tsp_name;
            syn_rout   : tsp_knl_identifier;
            dn         : tsp_int4;
            un         : tsp_int4;
            arr_d      : tct_z_arr;
            arr_u      : tct_z_arr;
            ptd        : tct_paramtab;
            ptu        : tct_paramtab;
            syn_tab    : tct_syn_table;
            num_syn    : tsp_int4;
            bufadr     : tct_lineaddr;
            errfno     : tsp_int4;
            local_src  : boolean;
      END;
 
 
VAR
      c01_glob           : c01_glob_tp;
 
 
(*------------------------------*) 
 
PROCEDURE
      sequential_program;
 
VAR
      i             : tsp_int4;
      j             : tsp_int4;
      source_fn     : tsp_vfilename;
      errfilen      : tsp_vfilename;
      infileno      : tsp_int4;
      format        : tsp_vf_format;
      reclen        : tsp_int4;
      ferr          : tsp_vf_return;
      ferr_txt      : tsp_errtext;
      argln         : tct_line;
      dummyname     : tsp_name;
      dummybool     : boolean;
      errtext       : tsp_errtext;
      error         : boolean;
      command       : tsp_execline;
      exec_err      : tsp_exec_return;
      exec_errtext  : tsp_errtext;
      commandresult : tsp_int2;
      modul         : tsp_vfilename;
      ok            : integer;
 
BEGIN
WITH  c01_glob  DO
    BEGIN
    c02init;
    c02linelength_init (mxsp_line);
    hline.adr  := @hline.l;
    local_src  := false;
    module_ok  := true;
    mod_nfound := false;
    num_syn    := 0;
    sqlargl  (argln.l);
    argln.len  := s30lnr (argln.l, ' ', 1, mxsp_line);
    (* h.b. 29.10.97  no IVIEW call if -l option is set *)
    get_parameter (argln);
    i          := 1;
    reclen     := 0;
    ferr       := vf_ok;
    hname      := '.check            ';
    c02fncat (errfilen, argln.l, i, hname, 6);
    format     := vf_plaintext;
&   IFDEF UDEBUG
    writeln('errfilen : ', errfilen);
&   ENDIF
    sqlfopen (errfilen, voverwrite, vf_stack, errfno, format,
          reclen, 0, 0, bufadr, ferr,ferr_txt);
    c04cc2init (argln, dummyname, dummybool, errfno);
    c04linelength_init (mxsp_line);
&   if $OS in [ WIN32, OS2 ]
    IF  NOT local_src
    THEN
        BEGIN
        modul := bsp_vfilename;
        s10mv9(mxsp_line, mxsp_vfilename,
              argln.l, 1, modul, 1, argln.len);
        c05get_file_path (modul, source_fn, ok);
        END
    ELSE
        BEGIN
        i     := 1;
        hname := bsp_name;
        c02fncat (source_fn, argln.l, i, hname, 6);
        END;
    (*ENDIF*) 
&   else
    i     := 1;
    hname := bsp_name;
    c02fncat (source_fn, argln.l, i, hname, 6);
&   endif
&   IFDEF UDEBUG
    writeln('source_fn: ', source_fn);
&   ENDIF
    sqlfopen (source_fn, vread, vf_stack, infileno, format,
          reclen, 0, 0, bufadr, ferr, ferr_txt);
&   IFDEF UDEBUG
    writeln('       no:', infileno);
&   ENDIF
    IF  (ferr = vf_ok)
    THEN
        BEGIN
        fill_from_tab (infileno);
        IF  module_ok
        THEN
            BEGIN
            fprocess_from_tab;
            sqlfclose (infileno, false, 0, 0, bufadr, ferr, ferr_txt);
&           IFDEF UDEBUG
            writeln('source_fn ok: ', source_fn);
&           ENDIF
&           if $OS in [ WIN32, OS2 ]
            IF  NOT local_src
            THEN
                BEGIN
                modul := source_fn;
                c05get_file_path (modul, source_fn, ok);
                END;
&           endif
            (*ENDIF*) 
            sqlfopen (source_fn, vread, vf_stack, infileno,
                  format, reclen, 0, 0, bufadr, ferr, ferr_txt);
&           IFDEF UDEBUG
            writeln('       no:', infileno);
&           ENDIF
            IF  ((ferr = vf_ok) AND module_ok)
            THEN
                iprocess_input_file (infileno);
            (*ENDIF*) 
            sqlfclose (infileno, false, 0, 0, bufadr, ferr, ferr_txt);
            END;
        (*ENDIF*) 
        END
    ELSE
        BEGIN
        module_ok    := false;
        hline.len    := 65;
        s10fil (mxsp_line, hline.l, 1, hline.len, '=');
        c02vfwrite (errfno, hline);
        s10mv3 (mxsp_vfilename, mxsp_line, source_fn, 1,
              c02oline.l, c02oline.len, mxsp_vfilename);
        c02oline.len := c02oline.len + mxsp_name;
        h_c40        := ' *****  Module not found ****           ';
        s10mv4 (mxsp_c40, mxsp_line, h_c40, 1,
              c02oline.l, c02oline.len, 32);
        c02oline.len := c02oline.len + 31;
        c02vfwrite (errfno, c02oline);
        END;
    (*ENDIF*) 
    hline.l[ 1 ] := ' ';
    hline.len    := 1;
    c02vfwrite (errfno, hline);
    IF  module_ok
    THEN
        module_ok := c02process_state_ok (process, errfno);
    (*ENDIF*) 
    IF  module_ok
    THEN
        BEGIN
        h_c40 := ' ****  NO ERRORS DETECTED               ';
        sqlresult (0);
        END
    ELSE
        BEGIN
        h_c40 := ' ****  ERRORS ****                      ';
        sqlresult (-1);
        END;
    (*ENDIF*) 
    s10mv4 (mxsp_line, mxsp_line, h_c40, 1, c02oline.l, 1, 26);
    c02oline.len := c02oline.len + 25;
    c02vfwrite (errfno, c02oline);
    hline.l[  1 ] := ' ';
    hline.len    := 1;
    c02vfwrite (errfno, hline);
    s10fil (mxsp_line, hline.l, 1, 67, '*');
    hname := ' END OF ERRORFILE ';
    s10mv1 (mxsp_name, mxsp_line, hname, 1, hline.l, 35, 18);
    hline.len := 67;
    c02vfwrite (errfno, hline);
    sqlfclose (errfno, false, 0, 0, bufadr, ferr, ferr_txt);
    sqlfinish (true);
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      fill_from_tab (infileno    : tsp_int4);
 
VAR
      hname : tsp_name;
 
BEGIN
WITH  c01_glob  DO
    BEGIN
    num_from  := 0;
    inputfile := true;
    hname     := bsp_name;
    mprocess_module (infileno, hname, do_searchcode);
    inp_vdn   := vdn_n;
    IF  module_ok
    THEN
        module_ok := c02process_state_ok (process, errfno);
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      fprocess_from_tab;
 
VAR
      i        : tsp_int4;
      infileno : tsp_int4;
      ferr     : tsp_vf_return;
      ferr_txt : tsp_errtext;
 
BEGIN
WITH  c01_glob  DO
    BEGIN
    inputfile := false;
    u_tree    := NIL;
    FOR i := 1 TO num_from DO
        BEGIN
        mprocess_module (infileno, from_tab [ i,1 ], do_searchcode);
        IF  (infileno <> -1)
        THEN
            sqlfclose (infileno, false, 0, 0, bufadr,
                  ferr, ferr_txt);
        (*ENDIF*) 
        IF  module_ok
        THEN
            BEGIN
            module_ok := c02process_state_ok (process, errfno);
            IF  NOT module_ok
            THEN
                BEGIN
                hname := '      in module:  ';
                s10mv1 (mxsp_name, mxsp_line, hname,1,hline.l, 1, mxsp_name);
                hline.len  := 18;
                s10mv1 (mxsp_name, mxsp_line, from_tab [ i,1 ],
                      1,hline.l, hline.len, mxsp_name);
                hline.len  := hline.len + mxsp_name - 1;
                c02vfwrite (errfno, hline);
                END;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        from_tab [ i,2 ] := mod_n;
        END;
    (*ENDFOR*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      mprocess_module (VAR infileno : tsp_int4;
            VAR vdn_name : tsp_name;
            end_do       : tct_do);
 
VAR
      ln            : tct_line;
      i             : tsp_int4;
      n             : tsp_int4;
      err           : tsp_int4;
      fn            : tsp_vfilename;
      format        : tsp_vf_format;
      reclen        : tsp_int4;
      ferr          : tsp_vf_return;
      ferr_txt      : tsp_errtext;
      command       : tsp_execline;
      exec_err      : tsp_exec_return;
      exec_errtext  : tsp_errtext;
      commandresult : tsp_int2;
      modul         : tsp_vfilename;
      ok            : integer;
 
BEGIN
WITH  c01_glob  DO
    BEGIN
    ln.adr      := @ln.l;
    ferr        := vf_ok;
    module_name := vdn_name;
    IF  vdn_name <> bsp_name
    THEN
        BEGIN
&       if $OS in [ WIN32, OS2 ]
        IF  NOT local_src
        THEN
            BEGIN
            modul := bsp_vfilename;
            s10mv8(mxsp_name, mxsp_vfilename, vdn_name, 1, modul, 1, mxsp_name);
            c05get_file_path (modul, fn, ok);
            END
        ELSE
            BEGIN
            i     := 1;
            hname := '                  ';
            c02vncat (fn, vdn_name, i, hname, 1);
            END;
        (*ENDIF*) 
&       else
        i     := 1;
        hname := '                  ';
        c02vncat (fn, vdn_name, i, hname, 1);
&       ENDIF
        reclen    := 0;
        format    := vf_plaintext;
&       IFDEF UDEBUG
        writeln('source_fn mp: ', fn);
&       ENDIF
        sqlfopen (fn, vread, vf_stack, infileno, format,
              reclen, 0, 0, bufadr, ferr, ferr_txt);
        IF  ferr <> vf_ok
        THEN
            BEGIN
            module_ok := false;
            infileno  := -1;
            hname     := '**** ERROR : File ';
            s10mv1 (mxsp_line, mxsp_line, hname, 1, c02oline.l,
                  c02oline.len, 18);
            c02oline.len := c02oline.len + 18;
            s10mv1 (mxsp_name, mxsp_line, vdn_name,
                  1, c02oline.l, c02oline.len, mxsp_name);
            c02oline.len := c02oline.len + mxsp_name;
            h_c40    := ' do not exist *******                   ';
            s10mv4 (mxsp_c40, mxsp_line, h_c40, 1, c02oline.l,
                  c02oline.len, 22);
            c02oline.len := c02oline.len + 21;
            c02vfwrite (errfno, c02oline);
            END;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    mod_n := bsp_name;
    IF  (ferr = vf_ok)
    THEN
        BEGIN
        process := do_searchvdn;
        WHILE (c04ccgetline (infileno, ln, errfno) = vf_ok) AND
              (process <> end_do) DO
            BEGIN
            lprocess_line (ln);
            s10fil( mxsp_line, ln.l, 1, mxsp_line, bsp_c1 );
            END;
        (*ENDWHILE*) 
        IF  (process = end_do)
        THEN
            process := do_workend;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      lprocess_line (VAR ln : tct_line);
 
VAR
      pos   : tsp_int2;
      i     : tsp_int4;
      newtag: boolean;
 
BEGIN
WITH  c01_glob  DO
    BEGIN
    CASE process OF
        do_searchvdn :
            BEGIN
            newtag := false;
            IF  (c02strpos(ln, cct_n_tt1) = 1) OR
                (c02strpos(ln, cct_n_modulename) = 1)
            THEN
                BEGIN
                IF  (c02strpos(ln, cct_n_modulename) = 1)
                THEN
                    BEGIN
                    pos := c02chrpos(ln, 1, ':') + 1;
                    newtag := true;
&                   ifdef UDEBUG
                    writeln('new tag "modname" found');
&                   endif
                    END
                ELSE
                    BEGIN
                    pos := 1;
                    FOR i := 1 TO 3 DO
                        pos := c02chrpos (ln, pos, '$') + 1;
                    (*ENDFOR*) 
                    END;
                (*ENDIF*) 
                c02getword (ln, pos, vdn_n);
&               IF $OS = VMSP
                transkg (vdn_n);
&               ELSE
                transgk (vdn_n);
&               ENDIF
                (* fill first part of the key *)
                IF  (vdn_n <> module_name) AND
                    (module_name <> bsp_name)
                THEN
                    BEGIN
&                   ifdef UDEBUG
                    writeln('vdn_n      :', vdn_n);
                    writeln('module_name:', module_name);
&                   endif
                    IF  NOT newtag
                    THEN
                        BEGIN
                        h_c64 :=
                              '**** ERROR Modulename in line .tt 1 differs to filename         ';
                        hline.len  := 57;
                        END
                    ELSE
                        BEGIN
                        h_c64 :=
                              '**** ERROR Modulename in line "Modname" differs to filename     ';
                        hline.len  := 61;
                        END;
                    (*ENDIF*) 
                    s10mv6 (mxsp_c64, mxsp_line, h_c64, 1,
                          hline.l, 1, hline.len);
                    s10mv1 (mxsp_name, mxsp_line, module_name, 1,
                          hline.l, hline.len, mxsp_name);
                    hline.len  := hline.len + mxsp_name;
                    c02vfwrite (errfno, hline);
                    END;
                (*ENDIF*) 
                FOR i := 1 TO 7 DO
                    u_key [ i ] := vdn_n [ i ];
                (*ENDFOR*) 
                IF  inputfile
                THEN
                    BEGIN
                    s10fil (mxsp_line, hline.l, 1, 67, '=');
                    hline.len := 67;
                    c02vfwrite (errfno, hline);
                    h_c40 :=
                          'TYPE CHECK PROTOCOL                     ';
                    s10mv4 (mxsp_c40, mxsp_line, h_c40,
                          1, c02oline.l, 1, 37);
                    c02oline.len := 36;
                    c02putname (c02oline,  0, n_vct_version);
                    c02oline.len := c02oline.len - 1;
                    c02putname (c02oline,  0, n_vct_date);
                    c02oline.len := c02oline.len - 1;
                    c02vfwrite (errfno, c02oline);
                    hline.len := 67;
                    c02vfwrite (errfno, hline);
                    s10mv1 (mxsp_name, mxsp_line, vdn_n,
                          1, c02oline.l, c02oline.len, mxsp_name);
                    c02oline.len := c02oline.len + mxsp_name;
                    h_c40 := '                   module change date:  ';
                    s10mv4 (mxsp_c40, mxsp_line, h_c40,
                          1, c02oline.l, c02oline.len, 39);
                    c02oline.len := c02oline.len + 39;
                    END;
                (*ENDIF*) 
                process := do_searchdate
                END
            (*ENDIF*) 
            END;
        do_searchdate :
            BEGIN
            newtag := false;
            IF  (c02strpos(ln, cct_n_tt3) = 1) OR
                (c02strpos(ln, 'Changed           ') = 1)
            THEN
                BEGIN
                pos := 1;
                FOR i := 1 TO 3 DO
                    pos := c02chrpos (ln, pos, '$') + 1;
                (*ENDFOR*) 
                (* c02_getword (ln, pos, dat_n); *)
                s10mv2 (mxsp_line, mxsp_line, ln.l, pos, c02oline.l,
                      c02oline.len, cct_datelen);
                IF  inputfile
                THEN
                    BEGIN
                    s10mv2 (mxsp_line, mxsp_line, ln.l, pos, c02oline.l,
                          c02oline.len, cct_datelen);
                    c02oline.len := c02oline.len + cct_datelen - 1;
                    c02vfwrite (errfno, c02oline);
                    s10fil (mxsp_line, hline.l, 1, 67, '=');
                    hline.len := 67;
                    c02vfwrite (errfno, hline);
                    hline.l[ 1 ] := ' ';
                    hline.len    := 1;
                    c02vfwrite (errfno, hline);
                    END;
                (*ENDIF*) 
                process := do_searchmod
                END
            (*ENDIF*) 
            END;
        do_searchmod :
            BEGIN
            IF  (c02strpos(ln, cct_n_module) = 1)
            THEN
                BEGIN
                pos := c02chrpos (ln, 1, ':') + 1;
                c02getword (ln, pos, mod_n);
                process := do_searchdef
                END
            (*ENDIF*) 
            END;
        do_searchdef :
            BEGIN
            IF  (c02strpos(ln, cct_n_define) = 1)
            THEN
                process := do_workdef
            (*ENDIF*) 
            END;
        do_workdef :
            BEGIN
            IF  c02isend_section (ln)
            THEN
                process := do_searchuse
            ELSE
                IF  NOT inputfile
                THEN
                    dprocess_def (ln)
                (*ENDIF*) 
            (*ENDIF*) 
            END;
        do_searchuse :
            BEGIN
            IF  (c02strpos(ln, cct_n_use) = 1)
            THEN
                BEGIN
                process := do_workuse;
                first   := false
                END
            (*ENDIF*) 
            END;
        do_workuse :
            BEGIN
            IF  c02isend_section (ln)
            THEN
                process := do_searchsyn
            ELSE
                IF  inputfile
                THEN
                    uprocess_use (ln);
                (*ENDIF*) 
            (*ENDIF*) 
            END;
        do_searchsyn :
            BEGIN
            IF  (c02strpos(ln, cct_n_synonym) = 1)
            THEN
                BEGIN
                process := do_worksyn;
                first   := false
                END
            ELSE
                IF  (c02strpos(ln, cct_n_author) = 1)
                THEN
                    process := do_searchcode;
                (*ENDIF*) 
            (*ENDIF*) 
            END;
        do_worksyn :
            BEGIN
            IF  c02isend_section (ln)
            THEN
                process := do_searchcode
            ELSE
                IF  inputfile
                THEN
                    sprocess_syn (ln);
                (*ENDIF*) 
            (*ENDIF*) 
            END;
        do_searchcode :
            BEGIN
            IF  (c02strpos(ln, cct_n_code) = 1)
            THEN
                process := do_workcode
            (*ENDIF*) 
            END;
        do_workcode :
            BEGIN
            IF  c02isend_section (ln)
            THEN
                process := do_workend
            (*ENDIF*) 
            END;
        do_workend :
            BEGIN
            c02print_com (cct_n_endpart)
            END
        END;
    (*ENDCASE*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      dprocess_def (VAR ln : tct_line);
 
VAR
      sy : tct_vcsymb;
 
BEGIN
WITH  c01_glob  DO
    BEGIN
    sy := c02vcsymb_get (ln, cct_begdef);
    IF  sy <> vcs_empty
    THEN
        BEGIN
        symb  := sy;
        first := true
        END;
    (*ENDIF*) 
    CASE symb OF
        vcs_va :
            IF  first
            THEN
                first := false
            ELSE
                vprocess_var (ln);
            (*ENDIF*) 
        vcs_pr, vcs_fu :
            IF  sy = vcs_empty
            THEN
                rprocess_rout (ln);
            (*ENDIF*) 
        vcs_co, vcs_ty, vcs_be, vcs_en, vcs_fr, vcs_main, vcs_empty :
            sy := sy
        END
    (*ENDCASE*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      sprocess_syn (VAR ln : tct_line);
 
VAR
      sy  : tct_vcsymb;
      pos : tsp_int2;
      nam : tsp_knl_identifier;
 
BEGIN
WITH  c01_glob  DO
    BEGIN
    sy := c02vcsymb_get (ln, cct_begdef);
    IF  sy <> vcs_empty
    THEN
        BEGIN
        symb  := sy;
        first := true
        END;
    (*ENDIF*) 
    CASE symb OF
        vcs_pr, vcs_fu :
            IF  (sy = vcs_empty)
            THEN
                IF  (first)
                THEN
                    BEGIN
                    pos := 1;
                    c02getidentifier (ln, pos, syn_rout);
                    first := false;
                    END
                ELSE
                    BEGIN
                    pos     := 1;
                    num_syn := num_syn + 1;
                    c02getidentifier (ln, pos, nam);
                    syn_tab [ num_syn, 1 ] := nam;
                    c02getidentifier (ln, pos, nam);
                    syn_tab [ num_syn, 2 ] := nam;
                    syn_tab [ num_syn, 3 ] := syn_rout;
                    END;
                (*ENDIF*) 
            (*ENDIF*) 
        OTHERWISE
        END
    (*ENDCASE*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      vprocess_var (VAR ln : tct_line);
 
VAR
      out   : tct_line;
      pos   : tsp_int2;
      i     : tsp_int4;
      ind   : tsp_int2;
      nam   : tsp_knl_identifier;
 
BEGIN
WITH  c01_glob  DO
    BEGIN
    pos := 1;
    ind := c02chrpos (ln, 1, ':');
    IF  ind = 0
    THEN
        BEGIN
        IF  (c02strpos (ln, cct_n_u_line) = 0)
        THEN
            BEGIN
            module_ok := false;
            h_c40     := 'TYPE-Definition in VAR missing:         ';
            s10mv4 (mxsp_c40, mxsp_line, h_c40, 1,
                  c02oline.l, c02oline.len, 32);
            c02oline.len := c02oline.len + 32;
            s10mv2 (mxsp_line, mxsp_line, ln.l, 1,
                  c02oline.l, c02oline.len, ln.len);
            c02oline.len := c02oline.len + ln.len - 1;
            c02vfwrite (errfno, c02oline);
            END;
        (*ENDIF*) 
        END
    ELSE
        WHILE (pos < ind) DO
            BEGIN
            c02getidentifier (ln, pos, nam);
            u_key[ 8 ] := chr(ord(symb));
            FOR i := 1 TO sizeof(tsp_knl_identifier) DO
                u_key [ i+8 ]  := nam [ i ];
            (*ENDFOR*) 
            c02blankline (out);
            i := 1;
            WHILE (ln.l [ i ]  = bsp_c1) DO
                i := i + 1;
            (*ENDWHILE*) 
            c02putidentifier (out, i, nam);
            FOR i := ind TO ln.len DO
                out.l [ i ]  := ln.l [ i ];
            (*ENDFOR*) 
            out.len := ln.len;
            enter_use_tree (u_tree, u_key, out);
            WHILE ((ln.l [ pos ] IN c02delimiter)
                  AND (pos < ind)) DO
                pos := pos + 1
            (*ENDWHILE*) 
            END
        (*ENDWHILE*) 
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      rprocess_rout (VAR ln : tct_line);
 
VAR
      i   : tsp_int4;
      pos : tsp_int2;
      nam : tsp_knl_identifier;
 
BEGIN
WITH  c01_glob  DO
    BEGIN
    IF  first
    THEN
        BEGIN
        first := false;
        pos   := 1;
        c02getidentifier (ln, pos, nam);
        u_key[ 8 ] := chr(ord(symb));
        FOR i := 1 TO sizeof(tsp_knl_identifier) DO
            u_key [ i+8 ]  := nam [ i ]
        (*ENDFOR*) 
        END;
    (*ENDIF*) 
    enter_use_tree (u_tree, u_key, ln)
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      uprocess_use (VAR ln : tct_line);
 
VAR
      pos    : tsp_int2;
      nam    : tsp_name;
      sy     : tct_vcsymb;
      i      : tsp_int4;
      in_tab : boolean;
      hline  : tsp_line;
 
BEGIN
WITH  c01_glob  DO
    BEGIN
    sy := c02vcsymb_get (ln, cct_begdef);
    IF  sy <> vcs_empty
    THEN
        BEGIN
        symb  := sy;
        first := true
        END;
    (*ENDIF*) 
    CASE symb OF
        vcs_fr :
            IF  first AND (sy = vcs_empty)
            THEN
                BEGIN
                pos := c02chrpos(ln, 1, ':') + 1;
                c02getword (ln, pos, nam);
&               IF $OS = VMSP
                transkg (nam);
&               ELSE
                transgk (nam);
&               ENDIF
                in_tab := false;
                FOR i := 1  TO num_from DO
                    IF  from_tab [ i,1 ]  = nam
                    THEN
                        BEGIN
                        in_tab    := true;
                        module_ok := false;
                        hname     := 'Module            ';
                        s10mv1 (mxsp_name, mxsp_line, hname, 1,
                              c02oline.l, c02oline.len, 7);
                        c02oline.len := c02oline.len + 7;
                        s10mv1 (mxsp_name, mxsp_line, nam, 1,
                              c02oline.l, c02oline.len, mxsp_name);
                        c02oline.len := c02oline.len + mxsp_name;
                        h_c40 :=
                              ' was previous declared                  ';
                        s10mv4 (mxsp_c40, mxsp_line, h_c40, 1,
                              c02oline.l, c02oline.len, 22);
                        c02oline.len := c02oline.len + 21;
                        c02vfwrite (errfno, c02oline);
                        END;
                    (*ENDIF*) 
                (*ENDFOR*) 
                IF  NOT in_tab
                THEN
                    BEGIN
                    num_from := num_from + 1;
                    from_tab [ num_from,1 ]  := nam
                    END;
                (*ENDIF*) 
                first := false
                END;
            (*ENDIF*) 
        vcs_co, vcs_ty, vcs_va, vcs_pr, vcs_fu, vcs_be, vcs_en,
        vcs_main, vcs_empty :
            sy := sy
        END
    (*ENDCASE*) 
    END;
(*ENDWITH*) 
END;
 
&IF  $OS = VMSP
(*------------------------------*) 
 
PROCEDURE
      transkg (VAR nam : tsp_name);
 
VAR
      i : tsp_int4;
 
BEGIN
WITH  c01_glob  DO
    BEGIN
    FOR i := 1 TO mxsp_name DO
        IF  (nam [ i ]  <> '_')
        THEN
            nam [ i ]  := c02toupper (nam [ i ] )
        (*ENDIF*) 
    (*ENDFOR*) 
    END;
(*ENDWITH*) 
END;
 
&ELSE
(*------------------------------*) 
 
PROCEDURE
      transgk (VAR nam : tsp_name);
 
VAR
      i : tsp_int4;
 
BEGIN
WITH  c01_glob  DO
    BEGIN
    FOR i := 1 TO mxsp_name DO
        IF  (nam [ i ]  <> '_')
        THEN
            nam [ i ]  := c02tolower (nam [ i ] )
        (*ENDIF*) 
    (*ENDFOR*) 
    END;
(*ENDWITH*) 
END;
 
&ENDIF
(*------------------------------*) 
 
PROCEDURE
      iprocess_input_file (infileno : tsp_int4);
 
VAR
      ln           : tct_line;
      prev_process : tct_do;
 
BEGIN
WITH  c01_glob  DO
    BEGIN
    process      := do_searchuse;
    prev_process := do_workend;
    check   := false;
    c02blankline( ln );
    WHILE ((c04ccgetline (infileno, ln, errfno) = vf_ok) AND
          (process <> do_workend)) DO
        BEGIN
&       ifdef UDEBUG
        IF  process <> prev_process
        THEN
            BEGIN
            CASE process OF
                do_searchvdn:
                    writeln( 'do_searchvdn' );
                do_searchmod:
                    writeln( 'do_searchmod' );
                do_searchdef:
                    writeln( 'do_searchdef' );
                do_workdef:
                    writeln( 'do_workdef' );
                do_searchuse:
                    writeln( 'do_searchuse' );
                do_workuse:
                    writeln( 'do_workuse' );
                do_searchsyn:
                    writeln( 'do_searchsyn' );
                do_worksyn:
                    writeln( 'do_worksyn' );
                do_searchdate:
                    writeln( 'do_searchdate' );
                do_searchversion:
                    writeln( 'do_searchversion' );
                do_searchstruct:
                    writeln( 'do_searchstruct' );
                do_workstruct:
                    writeln( 'do_workstruct' );
                do_searchcode:
                    writeln( 'do_searchcode' );
                do_workcode:
                    writeln( 'do_workcode' );
                do_prettyresult:
                    writeln( 'do_prettyresult' );
                do_workend:
                    writeln( 'do_workend' );
                END;
            (*ENDCASE*) 
            prev_process := process;
            END;
&       endif
&       ifdef UDEBUG
        (*ENDIF*) 
        IF  process = do_workuse
        THEN
            writeln( ln.l );
&       endif
        (*ENDIF*) 
        pprocess_and_print_line (ln);
        c02blankline( ln );
        END;
    (*ENDWHILE*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      pprocess_and_print_line (VAR ln : tct_line);
 
BEGIN
WITH  c01_glob  DO
    BEGIN
    CASE process OF
        do_searchuse :
            BEGIN
            IF  (c02strpos(ln, cct_n_use) = 1)
            THEN
                BEGIN
                symb    := vcs_empty;
                process := do_workuse
                END;
            (*ENDIF*) 
            END;
        do_workuse :
            BEGIN
            IF  c02isend_section (ln)
            THEN
                BEGIN
                process := do_workcode;
                END
            ELSE
                puprocess_print_use (ln);
            (*ENDIF*) 
            END;
        do_workcode :
            BEGIN
            IF  c02isend_section (ln)
            THEN
                process := do_workend
            ELSE
                check_proc;
            (*ENDIF*) 
            END;
        END
    (*ENDCASE*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      puprocess_print_use (VAR ln : tct_line);
 
VAR
      pos    : tsp_int2;
      i      : tsp_int4;
      ind    : tsp_int2;
      nam    : tsp_name;
      ident  : tsp_knl_identifier;
      sy     : tct_vcsymb;
      modn_u : tsp_name;
      pos_u  : tsp_int2;
      pos_d  : tsp_int2;
      typn_d : tsp_knl_identifier;
      typn_u : tsp_knl_identifier;
      ok     : boolean;
 
BEGIN
WITH  c01_glob  DO
    BEGIN
    sy := c02vcsymb_get (ln, cct_begdef);
    IF  (mod_nfound AND (sy <> vcs_fr))
    THEN
        sy := vcs_empty;
    (*ENDIF*) 
    IF  sy <> vcs_empty
    THEN
        BEGIN
        symb  := sy;
        first := true
        END;
    (*ENDIF*) 
    CASE symb OF
        vcs_fr :
            BEGIN
            IF  first AND (sy = vcs_empty)
            THEN
                BEGIN
                mod_nfound := false;
                first      := false;
                error      := false;
                pos_u      := 1;
                c02getword (ln, pos_u, modn_u);
                pos   := c02chrpos (ln, 1, ':') + 1;
                c02getword (ln, pos, nam);
&               IF $OS = VMSP
                transkg (nam);
&               ELSE
                transgk (nam);
&               ENDIF
                vdn_from := nam;
                FOR i := 1 TO num_from DO
                    IF  from_tab [ i,1 ]  = nam
                    THEN
                        BEGIN
                        mod_n      := from_tab [ i,2 ];
                        IF  (mod_n = bsp_name)
                        THEN
                            mod_nfound := true;
                        (*ENDIF*) 
                        END;
                    (*ENDIF*) 
                (*ENDFOR*) 
                IF  (modn_u <> mod_n) AND NOT mod_nfound
                THEN
                    BEGIN
                    write_error (cct_n_modn_n_eq);
                    h_c40 :=
                          '          DEF: MODULENAME =             ';
                    s10mv4 (mxsp_c40, mxsp_line, h_c40, 1,
                          c02oline.l, c02oline.len, 28);
                    c02oline.len := c02oline.len + 28;
                    s10mv1 (mxsp_name, mxsp_line, mod_n, 1,
                          c02oline.l, c02oline.len, mxsp_name);
                    c02oline.len := c02oline.len + mxsp_name - 1;
                    c02vfwrite (errfno, c02oline);
                    h_c40 :=
                          '          USE: MODULENAME =             ';
                    s10mv4 (mxsp_c40, mxsp_line, h_c40, 1,
                          c02oline.l, c02oline.len, 28);
                    c02oline.len := c02oline.len + 28;
                    s10mv1 (mxsp_name, mxsp_line, modn_u, 1,
                          c02oline.l, c02oline.len, mxsp_name);
                    c02oline.len := c02oline.len + mxsp_name - 1;
                    c02vfwrite (errfno, c02oline);
                    END;
                (*ENDIF*) 
                FOR i := 1 TO 7 DO
                    u_key [ i ]  := nam [ i ]
                (*ENDFOR*) 
                END
            ELSE
                check_proc;
            (*ENDIF*) 
            END;
        vcs_va :
            BEGIN
            IF  first
            THEN
                BEGIN
                first := false;
                END
            ELSE
                IF  c02strpos (ln, cct_n_u_line) = 0
                THEN
                    BEGIN
                    ind := c02chrpos (ln, 1, ':');
                    IF  ind = 0
                    THEN
                        ind := ln.len;
                    (*ENDIF*) 
                    pos := 1;
                    WHILE (pos < ind) DO
                        BEGIN
                        c02getidentifier (ln, pos, ident);
                        u_key[ 8 ] := chr(ord(symb));
                        FOR i := 1 TO sizeof(ident)  DO
                            u_key [ i+8 ]  := ident [ i ];
                        (*ENDFOR*) 
                        print_var (u_key, ln, ok);
                        IF  ok
                        THEN
                            BEGIN
                            arr_u[ 1 ] := ln;
                            pos_d    := c02chrpos (arr_d[ 1 ], 1, ':') + 1;
                            c02getidentifier (arr_d[ 1 ], pos_d, typn_d);
                            pos_u    := c02chrpos (ln, 1, ':') + 1;
                            c02getidentifier (ln, pos_u, typn_u);
                            IF  typn_d <> typn_u
                            THEN
                                BEGIN
                                module_ok := false;
                                write_error (cct_n_typn_n_eq);
                                hname := '          DEF:    ';
                                s10mv1 (mxsp_name, mxsp_line, hname,
                                      1, c02oline.l,
                                      c02oline.len, 15);
                                c02oline.len := c02oline.len + 15;
                                s10mv2 (mxsp_line, mxsp_line,
                                      arr_d[ 1 ].l, 1, c02oline.l,
                                      c02oline.len, arr_d[ 1 ].len);
                                c02oline.len := c02oline.len +
                                      arr_d[ 1 ].len - 1;
                                c02vfwrite (errfno, c02oline);
                                hname := '          USE:    ';
                                s10mv1 (mxsp_name, mxsp_line,
                                      hname, 1, c02oline.l,c02oline.len,15);
                                c02oline.len := c02oline.len + 15;
                                s10mv2 (mxsp_line, mxsp_line,
                                      ln.l, 1, c02oline.l,
                                      c02oline.len, ln.len);
                                c02oline.len := c02oline.len + ln.len -1;
                                c02vfwrite (errfno, c02oline);
                                END
                            (*ENDIF*) 
                            END;
                        (*ENDIF*) 
                        WHILE ((ln.l [ pos ]  in c02delimiter) AND
                              (pos < ind)) DO
                            pos := pos + 1
                        (*ENDWHILE*) 
                        END
                    (*ENDWHILE*) 
                    END
                (*ENDIF*) 
            (*ENDIF*) 
            END;
        vcs_pr, vcs_fu :
            BEGIN
            IF  first AND (sy = vcs_empty)
            THEN
                BEGIN
                first := false;
                pos   := 1;
                c02getidentifier (ln, pos, ident);
                u_key[ 8 ] := chr(ord(symb));
                FOR i := 1 TO sizeof(ident)  DO
                    u_key [ i+8 ]  := ident [ i ];
                (*ENDFOR*) 
                arr_u[ 1 ] := ln;
                un         := 1;
                print_rout (u_key, ln);
                END
            ELSE
                IF  first
                THEN
                    check_proc
                ELSE
                    IF  c02strpos (ln, cct_n_u_line) =  0
                    THEN
                        BEGIN
                        un          := un + 1;
                        arr_u[ un ] := ln;
                        END
                    (*ENDIF*) 
                (*ENDIF*) 
            (*ENDIF*) 
            END;
        OTHERWISE
        END
    (*ENDCASE*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      print_var (VAR u_key : tct_usekey;
            VAR l     : tct_line;
            VAR ok    : boolean);
 
VAR
      pointer : tct_usepointer;
 
BEGIN
WITH  c01_glob  DO
    BEGIN
    ok      := false;
    pointer := u_tree;
    search_key (u_key, pointer);
    IF  key_p = NIL
    THEN
        print_error (l)
    ELSE
        BEGIN
        arr_d[ 1 ] := key_p^.line_p^.d_line;
        ok         := true;
        END
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      print_rout (VAR u_key : tct_usekey;
            VAR l     : tct_line);
 
VAR
      pointer : tct_usepointer;
      p       : tct_linepointer;
 
BEGIN
WITH  c01_glob  DO
    BEGIN
    pointer := u_tree;
    search_key (u_key, pointer);
    dn := 0;
    IF  key_p = NIL
    THEN
        BEGIN
        print_error (l);
        err   := true
        END
    ELSE
        BEGIN
        err   := false;
        check := true;
        p     := key_p^.line_p;
        WHILE (p <> NIL) DO
            BEGIN
            dn          := dn + 1;
            arr_d[ dn ] := p^.d_line;
            p           := p^.next
            END;
        (*ENDWHILE*) 
        END
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      enter_use_tree (VAR tree : tct_usepointer;
            VAR key  : tct_usekey;
            VAR ln   : tct_line);
 
VAR
      z_p  : tct_linepointer;
      last : tct_linepointer;
 
BEGIN
WITH  c01_glob  DO
    BEGIN
    IF  tree = NIL
    THEN
        BEGIN
        new (tree);
        WITH tree^ DO
            BEGIN
            left  := NIL;
            right := NIL;
            n_key := key;
            new(line_p);
            WITH line_p^ DO
                BEGIN
                d_line := ln;
                next   := NIL
                END
            (*ENDWITH*) 
            END
        (*ENDWITH*) 
        END
    ELSE
        WITH tree^ DO
            IF  n_key = key
            THEN
                BEGIN
                z_p := line_p;
                WHILE (z_p <> NIL) DO
                    BEGIN
                    last := z_p;
                    z_p  := z_p^.next
                    END;
                (*ENDWHILE*) 
                new (last^.next);
                WITH last^.next^ DO
                    BEGIN
                    d_line := ln;
                    next   := NIL
                    END
                (*ENDWITH*) 
                END
            ELSE
                IF  key < n_key
                THEN
                    enter_use_tree (left, key, ln)
                ELSE
                    enter_use_tree (right, key, ln)
                (*ENDIF*) 
            (*ENDIF*) 
        (*ENDWITH*) 
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      search_key (u_key     : tct_usekey;
            VAR tree  : tct_usepointer);
 
BEGIN
WITH  c01_glob  DO
    BEGIN
    key_p := NIL;
    IF  tree <> NIL
    THEN
        WITH  tree^ DO
            BEGIN
            IF  n_key <> u_key
            THEN
                IF  u_key < n_key
                THEN
                    search_key (u_key, left)
                ELSE
                    search_key (u_key, right)
                (*ENDIF*) 
            ELSE
                key_p := tree
            (*ENDIF*) 
            END;
        (*ENDWITH*) 
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      print_error (VAR l : tct_line);
 
BEGIN
WITH  c01_glob  DO
    BEGIN
    write_error ('NAME NOT FOUND    ');
    write_inp_line (l);
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      write_inp_line (VAR l : tct_line);
 
BEGIN
WITH  c01_glob  DO
    BEGIN
    hname := '          USE:    ';
    s10mv1 (mxsp_name, mxsp_line, hname, 1,c02oline.l,
          c02oline.len,15);
    c02oline.len := c02oline.len + 15;
    s10mv2 (mxsp_line, mxsp_line, l.l, 1, c02oline.l,
          c02oline.len, l.len);
    c02oline.len := c02oline.len + l.len - 1;
    c02vfwrite (errfno, c02oline);
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      check_proc;
 
BEGIN
WITH  c01_glob  DO
    BEGIN
    IF  check
    THEN
        BEGIN
        fill_ptab (arr_d, dn, ptd);
        fill_ptab (arr_u, un, ptu);
        check_ptab (ptd, ptu);
        check := false;
        END
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      check_ptab (VAR ptd : tct_paramtab;
            VAR ptu : tct_paramtab);
 
VAR
      ok    : boolean;
      num   : tsp_int4;
      i     : tsp_int4;
      dr    : boolean;
 
BEGIN
WITH  c01_glob  DO
    BEGIN
    ok := true;
    IF  ptd.numt <> ptu.numt
    THEN
        BEGIN
        write_error (cct_n_param_n_eq);
        h_c40 := '          DEF: NUM PARAMETER =          ';
        s10mv4 (mxsp_c40, mxsp_line, h_c40, 1,c02oline.l, c02oline.len, 31);
        c02oline.len := c02oline.len + 31;
        c02int4to_line (ptd.numt - 1, false, 4, c02oline.len, c02oline.l);
        c02oline.len := c02oline.len + 3;
        c02vfwrite (errfno, c02oline);
        h_c40 := '          USE: NUM PARAMETER =          ';
        s10mv4 (mxsp_c40, mxsp_line, h_c40, 1,c02oline.l, c02oline.len, 31);
        c02oline.len := c02oline.len + 31;
        c02int4to_line (ptu.numt - 1, false, 4, c02oline.len, c02oline.l);
        c02oline.len := c02oline.len + 3;
        c02vfwrite (errfno, c02oline);
        IF  ptd.numt < ptu.numt
        THEN
            num := ptd.numt
        ELSE
            num := ptu.numt;
        (*ENDIF*) 
        write_param_line (ptd, true, 1);
        END
    ELSE
        BEGIN
        num := ptd.numt;
        i   := 1;
        WHILE (i <= num) DO
            IF  (ptd.pt[ i ].va = ptu.pt[ i ].va)
                AND (ptd.pt[ i ].ty = ptu.pt[ i ].ty)
            THEN
                i := i + 1
            ELSE
                BEGIN
                ptu.pt[ i ].ok := false;
                i              := i + 1;
                ok             := false;
                END;
            (*ENDIF*) 
        (*ENDWHILE*) 
        IF  NOT ok
        THEN
            BEGIN
            dr := true;
            (* print parameter def use *)
            FOR i := 2 TO num DO
                IF  NOT (ptu.pt[ i ].ok)
                THEN
                    IF  NOT exist_syn (ptd.pt[ i ].ty, ptu.pt[ i ].ty,
                        ptu.pt[ 1 ].n)
                        OR  ( ptu.pt[ i ].va <> ptd.pt[ i ].va )
                    THEN
                        BEGIN
                        IF  dr
                        THEN
                            BEGIN
                            write_error (cct_n_typpar_n_eq);
                            write_param_line (ptd, true, 1);
                            dr := false;
                            END;
                        (*ENDIF*) 
                        write_param_line (ptd, true, i);
                        write_param_line (ptu, false, i);
                        END;
                    (*ENDIF*) 
                (*ENDIF*) 
            (*ENDFOR*) 
            END
        (*ENDIF*) 
        END
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      write_param_line (VAR p : tct_paramtab;
            vdef  : boolean;
            i     : tsp_int4);
 
BEGIN
WITH  c01_glob  DO
    BEGIN
    IF  i = 1
    THEN
        hname := '          NAM:    '
    ELSE
        IF  vdef
        THEN
            hname := '          DEF:    '
        ELSE
            hname := '          USE:    ';
        (*ENDIF*) 
    (*ENDIF*) 
    s10mv1 (mxsp_name, mxsp_line, hname, 1,c02oline.l, c02oline.len,15);
    c02oline.len := c02oline.len + 15;
    IF  p.pt[ i ].va
    THEN
        hname := 'VAR               '
    ELSE
        hname := '                  ';
    (*ENDIF*) 
    s10mv1 (mxsp_name, mxsp_line, hname, 1,c02oline.l, c02oline.len, 4);
    c02oline.len := c02oline.len + 4;
    s10mv11 (sizeof(tsp_knl_identifier), mxsp_line, p.pt[ i ].n, 1, c02oline.l,
          c02oline.len, sizeof(tsp_knl_identifier));
    c02oline.len := c02oline.len + sizeof(tsp_knl_identifier);
    IF  p.pt[ i ].ty <> bsp_knl_identifier
    THEN
        BEGIN
        c02oline.len := c02oline.len - 1;
        c02vfwrite (errfno, c02oline);
        hname := '                  ';
        s10mv1 (mxsp_name, mxsp_line, hname, 1, c02oline.l, c02oline.len, mxsp_name);
        c02oline.len := c02oline.len + mxsp_name;
        hname := '        :         ';
        s10mv1 (mxsp_name, mxsp_line, hname, 1, c02oline.l, c02oline.len, 10);
        c02oline.len := c02oline.len + 10;
        s10mv11 (sizeof(tsp_knl_identifier), mxsp_line, p.pt[ i ].ty, 1, c02oline.l,
              c02oline.len, sizeof(tsp_knl_identifier));
        c02oline.len := c02oline.len + sizeof(tsp_knl_identifier);
        END;
    (*ENDIF*) 
    c02oline.len := c02oline.len - 1;
    c02vfwrite (errfno, c02oline);
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      fill_ptab (VAR arr  : tct_z_arr;
            n        : tsp_int4;
            VAR ptab : tct_paramtab);
 
VAR
      i      : tsp_int4;
      j      : tsp_int4;
      t      : tsp_int4;
      pos    : tsp_int2;
      nam    : tsp_knl_identifier;
      c      : char;
      go_on  : boolean;
      last_t : tsp_int4;
      last_va: boolean;
      stop   : boolean;
 
BEGIN
WITH  c01_glob  DO
    BEGIN
    WITH ptab DO
        BEGIN
        pos := 1;
        t   := 1;
        i   := 1;
        (* get routinenname *)
        c02getidentifier (arr[ i ], pos, pt[ t ].n);
        pt[ t ].ok := true;
        pt[ t ].va := false;
        pt[ t ].ty := bsp_knl_identifier;
        go_on   := false;
        last_t   := t + 1;
        last_va  := false;
        stop     := false;
        REPEAT
            c := next_delim_in_arr (arr, i, pos);
            CASE c OF
                ')' :
                    go_on := false;
                ',' :
                    BEGIN
                    (* next variablename *)
                    t := t + 1;
                    c02getidentifier (arr[ i ], pos, nam);
                    pt[ t ].ok := true;
                    pt[ t ].va := last_va;
                    pt[ t ].n  := nam
                    END;
                ':' :
                    BEGIN
                    c02getidentifier (arr[ i ], pos, nam);
                    IF  NOT go_on
                    THEN
                        BEGIN
                        (* functionstype *)
                        t := t + 1;
                        pt[ t ].ok := true;
                        pt[ t ].va := false;
                        pt[ t ].n  := bsp_knl_identifier;
                        pt[ t ].ty := nam;
                        END
                    ELSE
                        (* parametertype *)
                        FOR j := last_t TO t DO
                            pt[ j ].ty := nam;
                        (*ENDFOR*) 
                    (*ENDIF*) 
                    last_t := t + 1;
                    END;
                '(', ';' :
                    BEGIN
                    IF  c = '('
                    THEN
                        go_on := true;
                    (*ENDIF*) 
                    IF  NOT go_on
                    THEN
                        stop := true
                    ELSE
                        BEGIN
                        t := t + 1;
                        c02getidentifier (arr[ i ], pos, nam);
                        IF  nam = cct01_n_var
                        THEN
                            BEGIN
                            last_va := true;
                            REPEAT
                                IF  pos >= arr[ i ].len
                                THEN
                                    BEGIN
                                    i := i + 1;
                                    pos := 1;
                                    END;
                                (*ENDIF*) 
                                pos := pos + 1;
                            UNTIL
                                (arr[ i ].l[ pos ] <> bsp_c1);
                            (*ENDREPEAT*) 
                            pos := pos - 1;
                            c02getidentifier (arr[ i ], pos, nam);
                            END
                        ELSE
                            last_va := false;
                        (*ENDIF*) 
                        pt[ t ].ok := true;
                        pt[ t ].va := last_va;
                        pt[ t ].n  := nam;
                        END
                    (*ENDIF*) 
                    END
                END;
            (*ENDCASE*) 
        UNTIL
            (stop);
        (*ENDREPEAT*) 
        numt := t;
        END
    (*ENDWITH*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      next_delim_in_arr (VAR arr : tct_z_arr;
            VAR i   : tsp_int4;
            VAR pos : tsp_int2) : char;
 
VAR
      j   : tsp_int2;
      c   : char;
      d   : char;
      com : boolean;
 
BEGIN
WITH  c01_glob  DO
    BEGIN
    j   := pos;
    com := false;
    REPEAT
        IF  (pos > arr[ i ].len)
        THEN
            BEGIN
            i   := i + 1;
            pos := 1;
            END;
        (*ENDIF*) 
        c := arr[ i ].l[ pos ];
        IF  (c = '(')
        THEN
            IF  (arr[ i ].l[ pos+1 ] = '*')
            THEN
                BEGIN
                com := true;
                END;
            (*ENDIF*) 
        (*ENDIF*) 
        IF  (c = ')')
        THEN
            IF  (arr[ i ].l[ pos-1 ] = '*')
            THEN
                BEGIN
                com := false;
                c := ' '; (* so UNTIL doesn't see ')' *)
                END;
            (*ENDIF*) 
        (*ENDIF*) 
        pos := pos + 1;
    UNTIL
        (c IN [ ',', ';', ':', '(', ')' ]) AND (NOT com);
    (*ENDREPEAT*) 
    d := bsp_c1;
    REPEAT
        IF  (d = ')')
        THEN
            IF  (arr[ i ].l[ pos-2 ] = '*')
            THEN
                com := false;
            (*ENDIF*) 
        (*ENDIF*) 
        IF  (pos > arr[ i ].len)
        THEN
            BEGIN
            i   := i + 1;
            pos := 1;
            END;
        (*ENDIF*) 
        d := arr[ i ].l[ pos ];
        IF  (d = '(')
        THEN
            IF  (arr[ i ].l[ pos+1 ] = '*')
            THEN
                com := true;
            (*ENDIF*) 
        (*ENDIF*) 
        pos := pos + 1;
    UNTIL
        (d <> bsp_c1) AND (NOT com);
    (*ENDREPEAT*) 
    pos := pos - 1;
    next_delim_in_arr := c
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      write_error (f_art : tsp_name);
 
BEGIN
WITH  c01_glob  DO
    BEGIN
    IF  NOT error
    THEN
        BEGIN
        hline.l[ 1 ] := ' ';
        hline.len    := 1;
        c02vfwrite (errfno, hline);
        h_c40 := '**** ERROR IN : FROM                    ';
        s10mv4 (mxsp_c40, mxsp_line, h_c40, 1,c02oline.l, c02oline.len, 21);
        c02oline.len := c02oline.len + 21;
        s10mv1 (mxsp_name, mxsp_line, vdn_from, 1, c02oline.l,
              c02oline.len, mxsp_name);
        c02oline.len := c02oline.len + mxsp_name;
        hname := ' *******          ';
        s10mv1 (mxsp_name, mxsp_line, hname, 1,c02oline.l, c02oline.len, 8);
        c02oline.len := c02oline.len + 7;
        c02vfwrite (errfno, c02oline);
        module_ok := false;
        error     := true;
        END;
    (*ENDIF*) 
    hname := '     ****         ';
    s10mv1 (mxsp_name, mxsp_line, hname, 1,c02oline.l, c02oline.len, 10);
    c02oline.len := c02oline.len + 10;
    s10mv1 (mxsp_name, mxsp_line, f_art, 1, c02oline.l,
          c02oline.len, mxsp_name);
    c02oline.len := c02oline.len + mxsp_name - 1;
    c02vfwrite (errfno, c02oline);
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      exist_syn (VAR tyd : tsp_knl_identifier;
            VAR tyu : tsp_knl_identifier;
            VAR nu  : tsp_knl_identifier) : boolean;
 
VAR
      f_ok : boolean;
      i    : tsp_int4;
 
BEGIN
WITH  c01_glob  DO
    BEGIN
    f_ok := false;
    i    := 1;
    WHILE (i <= num_syn) AND (NOT f_ok) DO
        BEGIN
        IF  syn_tab[ i,1 ] = tyd
        THEN
            IF  syn_tab[ i,2 ] = tyu
            THEN
                IF  syn_tab[ i,3 ] = nu
                THEN
                    f_ok := true;
                (*ENDIF*) 
            (*ENDIF*) 
        (*ENDIF*) 
        i := i + 1;
        END;
    (*ENDWHILE*) 
    exist_syn := f_ok;
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      get_parameter (VAR argln     : tct_line);
 
CONST
      c_param_char  = '-';
      c_local       = 'l';
 
VAR
      i           : integer;
      j           : integer;
 
BEGIN
WITH  c01_glob  DO
    BEGIN
    i := 1;
    WHILE (i < argln.len) DO
        BEGIN
        WHILE ((argln.l[ i ] = bsp_c1) AND (i < argln.len)) DO
            i := i + 1;
        (*ENDWHILE*) 
        IF  (argln.l[ i ] = c_param_char)
        THEN
            BEGIN
            j := i + 1;
            i := i + 2;
            WHILE ((argln.l[ i ] = bsp_c1) AND (i < argln.len)) DO
                i := i + 1;
            (*ENDWHILE*) 
            CASE argln.l[ j ] OF
                c_local    :
                    local_src := true;
                OTHERWISE
                END;
            (*ENDCASE*) 
            END
        ELSE
            i := i + 1;
        (*ENDIF*) 
        END;
    (*ENDWHILE*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
BEGIN
&if $OS = WIN32
WinArgc := __argc;
WinArgv := __argv;
&endif
sequential_program
END
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
*-PRETTY-*  statements    :        744
*-PRETTY-*  lines of code :       1983        PRETTYX 3.10 
*-PRETTY-*  lines in file :       2623         1997-12-10 
.PA 
