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


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

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

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

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

.fo
.sp
Module  : VDNCALL
=========
.sp
.fo
.of 12
Purpose : Determines the constants, types, variables and routines
of the given moduls and the procedures or functions, in
which they are used.
.CM *-END-* purpose -------------------------------------
.sp
.cp 3
.nf
Define  :
 
        PROGRAM
              VCT21 ;
 
        VAR
              c21res        : tct_result;
              c21count_list : integer;
              c21maxcode   : integer;
              c21codetab   : tct_tablepointer;
 
        PROCEDURE
              c21print_res;
 
        PROCEDURE
              c21getcall_rout (line_nb : integer);
 
.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :
 
        FROM
              CT_cross_reference   : VCT03;
 
        VAR
              c03namlist : ARRAY  [ 1..cct_maxlistelement ]  OF tsp_name;
              c03found   : ARRAY  [ 1..cct_maxlistelement ]  OF tsp_name;
 
        PROCEDURE
              c03cross_ref;
 
        PROCEDURE
              c03process_cross_tree;
 
      ------------------------------ 
 
        FROM
              String_utilities : VCT02;
 
        VAR
              c02oline          : tct_line;
              c02outf           : tsp_int4;
              c02delimiter      : tct_delim;
 
        PROCEDURE
              c02init;
 
        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 l   : tct_line;
                    VAR beg  : tsp_int2;
                    VAR word : tsp_name);
 
        PROCEDURE
              c02vfwrite (fno : tsp_int4;
                    VAR buf : tct_line);
 
        PROCEDURE
              c02trimint4_to_line (int  : tsp_int4;
                    VAR ln_len     : integer;
                    VAR ln         : tsp_line);
 
        FUNCTION
              c02isend_section (VAR l : tct_line) : boolean;
 
        FUNCTION
              c02tolower (c : char) : char;
 
        FUNCTION
              c02vcsymb_get (VAR l    : tct_line;
                    beg      : integer) : tct_vcsymb;
 
        FUNCTION
              c02equal_string (VAR nam1  : tsp_name;
                    VAR nam2 : tsp_name) : boolean;
 
        PROCEDURE
              c02putname (VAR l : tct_line;
                    pos  : integer;
                    nam  : tsp_name);
 
        PROCEDURE
              c02blankline (VAR l : tct_line);
 
        FUNCTION
              c02process_state_ok
                    (act_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;
 
      ------------------------------ 
 
        FROM
              RTE-Extension-10 : VSP10;
 
        PROCEDURE
              s10mv (size1   : tsp_int4;
                    size2    : tsp_int4;
                    VAR val1 : tsp_name;
                    p1       : tsp_int4;
                    VAR val2 : tsp_vfilename;
                    p2       : tsp_int4;
                    cnt      : tsp_int4);
 
        PROCEDURE
              s10mv1 (size1    : tsp_int4;
                    size2    : tsp_int4;
                    VAR val1 : tsp_c40;
                    p1       : tsp_int4;
                    VAR val2 : tsp_line;
                    p2       : tsp_int4;
                    cnt      : tsp_int4);
 
        PROCEDURE
              s10mv2 (size1    : tsp_int4;
                    size2    : tsp_int4;
                    VAR val1 : tsp_c50;
                    p1       : tsp_int4;
                    VAR val2 : tsp_line;
                    p2       : tsp_int4;
                    cnt      : tsp_int4);
 
        PROCEDURE
              s10mv3 (size1    : tsp_int4;
                    size2    : tsp_int4;
                    VAR val1 : tsp_name;
                    p1       : tsp_int4;
                    VAR val2 : tsp_line;
                    p2       : tsp_int4;
                    cnt      : tsp_int4);
 
        PROCEDURE
              s10mv4 (size1    : tsp_int4;
                    size2    : tsp_int4;
                    VAR val1 : tsp_vfilename;
                    p1       : tsp_int4;
                    VAR val2 : tsp_line;
                    p2       : tsp_int4;
                    cnt      : tsp_int4);
 
      ------------------------------ 
 
        FROM
              RTE_driver : VEN102;
 
        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 : tsp_int1);
 
        PROCEDURE
              sqlfinish (terminate : boolean);
 
        PROCEDURE
              sqlargl (VAR args    : tsp_line);
 
      ------------------------------ 
 
        FROM
              RTE-Extension-30 : VSP30;
 
        FUNCTION
              s30lnr (VAR str : tsp_line;
                    val     : char;
                    start   : tsp_int4;
                    cnt     : tsp_int4) : tsp_int4;
&       if $COMP=PTOC
&       else
 
        FUNCTION
              s30gad (VAR b : tsp_line) : tct_lineaddr;
&       endif
 
.CM *-END-* use -----------------------------------------
.sp;.cp 3
Synonym :
 
        PROCEDURE
              s10mv;
 
              tsp_moveobj tsp_name
              tsp_moveobj tsp_vfilename
 
        PROCEDURE
              s10mv1;
 
              tsp_moveobj tsp_c40
              tsp_moveobj tsp_line
 
        PROCEDURE
              s10mv2;
 
              tsp_moveobj tsp_c50
              tsp_moveobj tsp_line
 
        PROCEDURE
              s10mv3;
 
              tsp_moveobj  tsp_name
              tsp_moveobj  tsp_line
 
        PROCEDURE
              s10mv4;
 
              tsp_moveobj  tsp_vfilename
              tsp_moveobj  tsp_line
 
        FUNCTION
              s30lnr;
 
              tsp_moveobj  tsp_line
&             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
 
        FUNCTION
              c04ccgetline;
 
              tct_line tct_line
 
        FUNCTION
              c02strpos;
 
              tct_line tct_line
 
        FUNCTION
              c02chrpos;
 
              tct_line tct_line
 
        PROCEDURE
              c02getword;
 
              tct_line tct_line
 
        FUNCTION
              c02isend_section;
 
              tct_line tct_line
 
        FUNCTION
              c02vcsymb_get;
 
              tct_line tct_line
 
        PROCEDURE
              c02putname;
 
              tct_line tct_line
 
.CM *-END-* synonym -------------------------------------
.sp;.cp 3
Author  : N.Zimmer
.sp
.cp 3
Created : 1981-07-03
.sp
.cp 3
Version : 1995-05-02
.sp
.cp 3
Release :  6.1.1 	 Date : 1995-05-02
.sp
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Specification:
 
PROGRAMM  VCT21  :
.sp
Call :  VCT21   Parameter
.sp
Parameter :
.sp
.in 6
.of 12
const::          Constants are analysed
.sp
.of 12
type::      Typs are analysed
.sp
.of 12
var::       Global Variables are analysed
.sp
.of 12
routinen::  Functions and Procedures are analysed
.sp
.of 12
liste::     Only the names, listed in file 'list inp * ' and
seperated by delimiter ( notice lower-s60uppcase letters ) are analysed.
.sp
.of 12
input::     Only the moduls given in the argumentline are analysed.
The use_part is not used to visit other moduls.
.sp
.of 12
cross::     A file CROSS LOAD A is created, which contains all
found name, the corresponding vdn_name and a entry, whether it is found
in any modul or not. This can be helpfull to find all unused names.
.oc _/1
.of 12
ATTENTION:
In some cases this options generates a file larger than
your disk, so be carefull.
.sp
.of 12
modulname:: Name of the moduls to analyse, other needed moduls
are consulted by the Use-Part.
.sp 2
.in 0
With parameter const and/or type all moduls with name Vxx00 must be given
additional to determine the values, which are analysed.
  for example:    vct21 const type vgg00 vbd00 vbd01
.sp 2
With parameter LISTE a file 'list inp *' must exist, in which
the names, seperated by delimiter ( notice lower-s60uppcase letters ),
are included, which should be analysed additional ( s60maximal line-
length = 72 ).
In this case the resultpart e_art ist bound to '_____' and the vdn_name
e_vdn to 'LIST'.
.sp 4;.nf
RESULT FILES :
.sp
CALL LOAD A : Routine calls ....
.sp
       | vdn_name | routinenname | art | art_vdn | art_name |
sort : |          | 1.sortfield  | 2.sf|         | 3.sortf. |
.sp 2
ISCALL LOAD A : const,type,var,routine is called ....
.sp
       | art | art_vdn | art_name | vdn_name | routinenname |
sort : |1.sf.|         | 2.sortf. |          | 3.sortfield  |
.sp 2
TEMPORARY FILES :
.sp
.fo
.of 20
1.HDCALL.OUT.A:    Header for call result after sorting
.sp
.of 20
2.HDISCAll.OUT.A:  Header for iscall result after sorting ( plus HDCALL
part one )
.sp
.of 20
3.CROSS.OUT.A:     All names, which are used in any modul.
.sp
.of 20
4.CALL.OUT.A:      Unsorted version of CALL VDN A, all names, which are
referenced by any procedure in any analysed modul.
.sp
.of 20
5.ISCALL.OUT.A:    Unsorted version of ISCALL VDN A, all names, which
are referenced by any procedure in any analysed modul.
.sp 4
USED MODULS :
.sp
.nf
          VSP00  : common types and constants
          VCT00  : common types and constants for VCTxx moduls
          VCT02  : String_utilities
          VCT03  : Cross_ref subprogram
          VEN13  : RTE_Batch_Environment
          VEN10  : RTE_Extension_Application_programs
          VEN80A : Virtuell file system
          VSP10  : RTE_Extension_10
          VSP30  : RTE_Extension_30
.CM *-END-* specification -------------------------------
.sp 4
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Description:
 
PROCEDURE  CT21_SEQUENTIAL_PROGRAM:
.sp
The program makes 5 big steps :
.sp
.oc _/1
1. INITIALISATION:
.sp
In c02init : some runtime_environment initialisation
Binding some global vars ( c21count_list,count_exec, cur_exec, max_list)
Open the output files ( HDCALL, HDISCALL, CALL, ISCALL, CROSS, ERROR )
Get the input parameters ( specified option and moduls and bind the
the boolean variables (c_con, c_typ, ... ) and/or fill the table
tab_exec with given modulnames )
If option LISTE is specified, fill the list c03namlist
with the given names ( from file liste inp * ).
.sp
.oc _/1
2. GET_CODE :
.sp
Reads all files, listed in glob. var. tab_exec and fills the tables
c03namlist, symbol_list, rout_tab and c21codetab.
.sp
.oc _/1
3. CROSS_REF:
.sp
Makes a cross_reference about the table c21codetab and searches for the
names, which are given in c03namlist. The resulting name are inserted
in cross_tree.
.sp
.oc _/1
4. PROCESS_CROSS_TREE:
.sp
The linenumbers given by cross_tree are translated to names of routines,
with use of rout_tab, c03namlist and symbol_list. The single result, glob.
var c21res, are written to the outputfiles (in c21print_res).
.sp
.oc _/1
5. LAST OUTPUT and FILECLOSE
.sp
The number of included moduls is written to the temporary output and
after this the open files are closed. Without any error the program will
terminate with returncode 0, otherwise with returncode 1.
.sp 3
.oc _/1
DESCIPTION OF THE USED TABLES :
.sp
.of 16
tab_exec=      array  [ 1..100 ]  of name, containes all inputfilenames
.sp
.of 16
count_exec:    number of existing inputfiles
.sp 2
.of 16
c03namlist=  array  [ 1..4000 ]  of name, containes all names, which
must be analysed in procedure cross_ref.
.sp 2
.nf
symbol_list=   array  [ 1..4000 ]  of art_sym
                with art_sym = record
                         sym : tp_vcsymb;
                         vdn : name
                end;
.fo
.in 16
contains to every name of c03namlist the corresponding
symbol and vdn_modulname.
.in 0
.sp
.of 16
anz_list:     number of existing entries in the two lists.
.sp 2
.nf
.cp 3
rout_tab =      array  [ 1..maxrout ]  of routine
                with routine = record
                      r_name : name;
                      r_vdn  : name;
                      r_beg  : integer;
                      r_end  : integer
                end;
.fo
.in 16
containts for every found routine in the codepart the
beginning
linenumber ( r_beg ), the ending linenumber ( r_end ), the routinename
( r_name ) and the containing modulname ( r_vdn ).
.in 0
.sp 2
.of 16
c21codetab=  array [ 1..6000 ] of tp_line,
containts every line of a inputfile, which represents a codeline.
.sp
.of 16
l_nb:          Counter for the number of line in c21codetab. This
number will be used for computing the corresponding routinename in
process_cross_tree ( with the procedure c21getcall_rout ).
.sp 4
.oc _/1
DESCRIPTION OF THE DEFINED PROCEDURE AND FUNCTIONS :
.sp
.oc _/1
PROCEDURE  OPEN_OUTPUT_FILE :
.sp
.fo
This procedure opens the temporary outputfiles : HDCALL , CALL , ISCALL
CROSS and ERROR. The result_header ( control_statement for load )
will be written in HDISCALL.
.sp 4
.oc _/1
PROCEDURE  GET_INP_PARAMETER
.sp
.fo
Gets the specified options and bound the corresponding glob.var. c_con,
c_typ,c_var,c_rout, c_ross and c_list if the special option is given.
Otherwise
a modulname is specified and the name is inserted in glob.var. tab_exec.
.sp 4
.oc _/1
PROCEDURE  FILL_LIST :
.sp
.fo
Is there a file 'list inp *', which contains special name to analyse,
this file is open and the given names are inserted in table c03namlist.
The corresponding entries in table symbol_list are bound to : vdn = 'LIST'
and sym = '_____'.
.sp 4
.oc _/1
PROCEDURE  GET_CODE :
.sp
Reads all files, given in table tab_exec, fills, in case of c_con, c_typ
c_var and c_rou the tables nam_list, symbol_list, rout_tab and c21codetab.
.sp 4
.oc _/1
PROCEDURE  MPROCESS_MODUL_UNTIL
.sp
The current modul is processed until 'until : process'.
.sp 4
.oc _/1
PROCEDURE  LPROCESS_LINE:
.sp
One line will be processed in case of the glob.var process :
.hi 18
do_searchvdn:    get from line beginning with '.tt 1'    : vdn_n
.sp
do_searchdate:   get from line beginning with '.tt 3'    : dat_n
.sp
do_searchmod:    get from line beginning with 'Module :' : mod_n
.sp
do_searchdef:    searches for the beginning of the DEFINE-part.
.sp
do_workdef:      until line '.cm hier ende define' the procedure
dprocessdef is called for each line.
.sp
do_searchuse:    searches for the beginning of the USE-part.
.sp
do_workuse:      until line '.cm hier ende use' the procedure
uprocessuse is called for each line.
.sp
do_searchcode:   searches for line '.cm hier input spascal_code'
.sp
do_workcode:     until line '.cm hier ende program' the procedure
cprocesscode is called.
.sp
do_workend:      skips the last inputlines, because there is no more
interesting input.
.hi 0
.sp 4
.oc _/1
PROCEDURE  DPROCESSDEF :
.sp
In case of symbol :
.of 18
vcs_co,vcs_ty:   the procedure ctvprocess is called with '=' as
specified char.
.sp;.of 18
vcs_va:          if the char ':' is found in the current line, the
procedure ctvprocess is called with char ':', otherwise with char ','.
.sp;.of 18
otherwise:       a empty sequence BEGIN   END is inserted in c21codetab
.sp 4
.oc _/1
PROCEDURE  UPROCESSUSE :
.sp
In case of symbol :
.of 18
vcs_co,vcs_ty:   the procedure ctvprocess is called with '=' as
specified char.
.sp;.of 18
vcs_va:          if the char ':' is found in the current line, the
procedure ctvprocess is called with char ':', otherwise with char ','.
.sp;.of 18
otherwise:       a empty sequence BEGIN   END is inserted in c21codetab
.sp 4
.oc _/1
PROCEDURE  CTVPROCESS :
.sp
In case of parameter z ( char ) not in comment and glob.var. in_rou =
false and symbol :
.sp;.of 12
vcs_co:    if c_con, then insert the name in c03namlist, symbol_list
and the current line in c21codetab.
.sp;.of 12
vcs_ty:    if c_typ, then insert the name in c03namlist, symbol_list
and the current line in c21codetab.
.sp;.of 12
vcs_va:    if c_var, then insert the name in c03namlist, symbol_list
and the current line in c21codetab.
.sp 4
.oc _/1
PROCEDURE  CPROCESSCODE :
.sp
In case of symbol :
.sp
.of 17
vcs_co,vcs_ty:  call of ctvprocess with char '='.
.sp
.of 17
vcs_va:         in case of existing ':' in the current line call of
ctvprocess with char ':', otherwise with char ','.
.sp
.of 17
vcs_pr,vcs_fu:  call of rprocessrout.
.sp
.of17
vcs_en:         call of endrout.
.sp
.of17
otherwise:      insert line in c21codetab.
.sp 4
.oc _/1
PROCEDURE  RPROCESSROUT :
.sp
If it is the first line, the name is inserted in rout_tab, if c_rout
the name is inserted in c03namlist and symbol_list, the current line is
put in c21codetab and the glob.var. in_rou is bound to true.
.sp 4
.cp 4
.oc _/1
PROCEDURE  ENDROUT:
.sp
Record part r_end in table rout_tab is bound to l_nb, glob.var in_rou
to false and the line is inserted in c21codetab.
.sp 4
.cp 4
.oc _/1
PROCEDURE  PUT_VA_IN_LIST:
.sp
All names, standing in front of ':', seperated by ',', are inserted in
c03namlist and symbol_list.
.sp 4
.oc _/1
PROCEDURE  PUT_IN_LIST:
.sp
The first name of the current line is inserted in c03namlist and
symbol_list.
.sp 4
.oc _/1
PROCEDURE  PUT_LIST:
.sp
The given name is inserted in c03namlist and symbol_list, if it not
already exists.
.sp 4
.oc _/1
PROCEDURE  PR_LINE:
.sp
The current line in inserted in c21codetab and the glob.var. l_nb
is incremented.
.sp 4
.oc _/1
PROCEDURE  PUT_IN_TAB:
.sp
Glob.var. count_rout ist incremented and the table rout_tab gets a
new entry.
.sp 4
.oc _/1
PROCEDURE  PRINT_CROSS :
.sp
If c_cross = true,
the entries of c03namlist, symbol_list and c03found are put in a
line and
this line is written to the outputfile CROSS. This file is not needed
during program execution, but it is helpfull to get an overview about the
names, which are are declared but not used in any visited modul.
.sp 4
.oc _/1
PROCEDURE  SORT_TAB_EXEC_PRINT :
.sp
The given and computed modulnames from table tab_exec are sorted and
written to the file CALL COUNT A.
.sp 4
.oc _/1
PROCEDURE  PRINT_RES:
.sp
The result c21res is copied into a line and written to the temporary
outputfiles CALL and ISCALL.
.sp
.nf
CALL:
      | vdn_name | routine_name  | art | art_vdn | art_name |
 pos: |1         |15             |29   |43       |57        |
.sp
ISCALL
      | art | art_vdn | art_name | vdn_name | routine_name  |
 pos: |1    |15       |29        |43        |57             |
.sp 4
.fo
.oc _/1
PROCEDURE  C21_GET_CALL_ROUT:
.sp
The table rout_tab is searched for the passed line_number and the name
is inserted in c21res.
.sp 4
.oc _/1
PROCEDURE  ERROR :
.sp
This procedure is called, if an attempt to open a file does not succeed.
The glob.var. modul_ok is set to false and an error_diagnostic is written
to the file ERROR.
.sp 4
.oc _/1
PROCEDURE CLOSE_OUTPUT_FILE :
.sp
All files, which are opened and not close during execution are closed.
.sp 4
.oc _/1
Changes made to VCT21:
.sp
.nf
1.12  1989-10-13  * some traces added (-d test)
.sp
.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
      n_vct_version    = 'CALL    3.04      ';
      n_vct_date       = ' 1992-08-13       ';
      maxrout          =   2000;
      maxexec          =    800;
      n_input          = 'INPUT             ';
      n_comment        = '/**               ';
      n_list           = 'LIST              ';
      n_cross          = 'CROSS             ';
&     if $OS = VMSP
      n_fid_count      = 'CALL COUNT A      ';
      n_fid_error      = 'CALL ERROR A      ';
      n_fid_hea_call   = 'HDCALL OUT A      ';
      n_fid_hea_cross  = 'HDCROSS OUT A     ';
      n_fid_hea_iscall = 'HDISCALL OUT A    ';
      n_fid_list       = 'LIST INP *        ';
      n_fid_out_call   = 'CALL OUT A        ';
      n_fid_out_cross  = 'CROSS OUT A       ';
      n_fid_out_iscall = 'ISCALL OUT A      ';
      n_fid_warn       = 'CALL WARN A       ';
&     ELSE
      n_fid_count      = 'call.cnt          ';
      n_fid_error      = 'call.err          ';
      n_fid_hea_call   = 'hdcall.out        ';
      n_fid_hea_cross  = 'hdcross.out       ';
      n_fid_hea_iscall = 'hdiscall.out      ';
      n_fid_list       = 'list.inp          ';
      n_fid_out_call   = 'call.out          ';
      n_fid_out_cross  = 'cross.out         ';
      n_fid_out_iscall = 'iscall.out        ';
      n_fid_warn       = 'call.wrn          ';
&     ENDIF
 
TYPE
      table_exec =  ARRAY  [ 1..maxexec ]  OF tsp_name;
 
      kind_sym = RECORD
            sym   : tct_vcsymb;
            kfill : boolean;
            vdn   : tsp_name
      END;
 
      list_sym = ARRAY  [ 1..cct_maxlistelement ]  OF kind_sym;
 
      routine =  RECORD
            r_name : tsp_name;
            r_beg  : tsp_int2;
            r_vdn  : tsp_name;
            r_end  : tsp_int2
      END;
 
      table_rout = ARRAY  [ 1..maxrout ]  OF routine;
 
      c21_type = RECORD
            call         : tsp_int4;
            iscall       : tsp_int4;
            cross        : tsp_int4;
            errorno      : tsp_int4;
            warn_no      : tsp_int4;
            infileno     : tsp_int4;
            vdn_n        : tsp_name;
            count_exec   : tsp_int2;
            vdn_ret      : tsp_name;
            cur_exec     : tsp_int2;
            dat_n        : tsp_name;
            count_rout   : tsp_int2;
            mod_n        : tsp_name;
            max_list     : tsp_int2;
            vdn          : tsp_name;
            l_nb         : tsp_int2;
            parmpointer  : tsp_int2;
            c21fill      : tsp_int2;
            tab_exec     : table_exec;
            symbol_list  : list_sym;
            rout_tab     : table_rout;
            ret_res      : tct_result;
            c_con        : boolean;
            c_typ        : boolean;
            c_var        : boolean;
            c_rou        : boolean;
            c_list       : boolean;
            c_inp        : boolean;
            c_cross      : boolean;
            modul_ok     : boolean;
            first        : boolean;
            in_rou       : boolean;
            recursiv     : boolean;
            in_nullnull  : boolean;
            all_ok       : boolean;
            var_typ      : boolean;
            symb         : tct_vcsymb;
            process      : tct_do;
            bufadr       : tct_lineaddr;
            format       : tsp_vf_format;
      END; (* record *)
 
 
VAR
      c21_glob : c21_type;
 
 
(*------------------------------*) 
 
PROCEDURE
      ct21_sequential_program;
 
VAR
      i          : integer;
      tmp_nam    : tsp_c50;
      one_mod_ok : boolean;
 
BEGIN
WITH  c21_glob  DO
    BEGIN
    c02init;
&   if $COMP=PTOC
    c02oline.adr  := @c02oline.l;
&   else
    c02oline.adr  := s30gad (c02oline.l);
&   endif
    all_ok        := true;
    modul_ok      := true;
    one_mod_ok    := true;
    c21count_list := 0;
    count_exec    := 0;
    cur_exec      := 1;
    max_list      := 0;
    in_nullnull   := false;
    new (c21codetab);
    open_output_file;
    get_inp_parameter;
    IF  c_list
    THEN
        fill_list;
    (*ENDIF*) 
    IF  (c_con) OR (c_typ)
    THEN
        BEGIN
        in_nullnull := true;
        WHILE (   (tab_exec[ cur_exec, 4 ] = '0')
              AND (tab_exec[ cur_exec, 5 ] = '0'))
              AND all_ok DO
            BEGIN
            get_code (tab_exec[ cur_exec ]);
            c21maxcode := l_nb - 1;
            c03cross_ref;
            cur_exec   := cur_exec + 1;
            END;
        (*ENDWHILE*) 
        in_nullnull := false;
        END;
    (*ENDIF*) 
    max_list := c21count_list;
    IF  c_con OR c_typ OR c_var OR c_rou OR
        (c_list AND (c21count_list <>0))
    THEN
        BEGIN
        WHILE (count_exec + 1  >  cur_exec) AND all_ok DO
            BEGIN
            c21count_list := max_list;
            get_code (tab_exec[ cur_exec ]);
            c21maxcode := l_nb - 1;
            c03cross_ref;
            WITH ret_res DO
                BEGIN
                e_nam  := bsp_name;
                e_vdn  := bsp_name;
                e_artn := bsp_name;
                e_artv := bsp_name;
                e_art  := bsp_name
                END;
            (*ENDWITH*) 
            c03process_cross_tree;
            print_cross (1);
            IF  NOT ( c02process_state_ok( process, warn_no))
            THEN
                BEGIN
                one_mod_ok := false;
                tmp_nam    :=
                      ' The error above occurs in module :               ';
                s10mv2 (mxsp_c50, mxsp_line, tmp_nam, 1, c02oline.l, 1, 36);
                s10mv3 (mxsp_name, mxsp_line, tab_exec[ cur_exec ], 1,
                      c02oline.l, 37, mxsp_name);
                c02oline.len := 50;
                c02vfwrite (warn_no, c02oline);
                END;
            (*ENDIF*) 
            cur_exec := cur_exec + 1;
            END;
        (*ENDWHILE*) 
        print_cross (2);
        sort_tab_exec_print;
        END
    ELSE
        BEGIN
        modul_ok := false;
        tmp_nam  := ' Input exec wrong: no moduls processed !          ';
        s10mv2 (mxsp_c50, mxsp_line, tmp_nam, 1, c02oline.l, 1, 50);
        c02oline.len := 50;
        c02vfwrite (errorno, c02oline);
        END;
    (*ENDIF*) 
    close_output_file;
    IF  modul_ok AND one_mod_ok AND all_ok
    THEN
        sqlresult (0)
    ELSE
        sqlresult (1);
    (*ENDIF*) 
    sqlfinish (true);
    END;
(*ENDWITH*) 
dispose (c21codetab);
END;
 
(*------------------------------*) 
 
PROCEDURE
      get_inp_parameter;
 
VAR
      args       : tct_line;
      parm       : tsp_name;
      nam        : tsp_name;
      i          : integer;
      dummy_nam  : tsp_name;
      dummy_bool : boolean;
      errtext     : tsp_errtext;
      error       : boolean;
 
BEGIN
WITH  c21_glob  DO
    BEGIN
    parmpointer := 1;
    c_con   := false;
    c_typ   := false;
    c_var   := false;
    c_rou   := false;
    c_list  := false;
    c_inp   := false;
    c_cross := false;
    sqlargl (args.l);
    args.len := s30lnr (args.l, ' ', 1, mxsp_line);
    c04cc2init ( args, dummy_nam, dummy_bool, errorno );
    WHILE ( parmpointer <= args.len ) DO
        BEGIN
        c02getword (args, parmpointer, nam);
        IF  nam = cct_n_const
        THEN
            c_con := true
        ELSE
            IF  nam = n_cross
            THEN
                c_cross := true
            ELSE
                IF  nam = cct_n_type
                THEN
                    c_typ := true
                ELSE
                    IF  nam = cct_n_var
                    THEN
                        c_var := true
                    ELSE
                        IF  nam = cct_n_routine
                        THEN
                            c_rou := true
                        ELSE
                            IF  nam = n_list
                            THEN
                                c_list := true
                            ELSE
                                IF  nam = n_input
                                THEN
                                    c_inp := true
                                ELSE
                                    BEGIN
                                    count_exec := count_exec + 1;
                                    tab_exec [ count_exec ] := nam;
                                    END;
                                (*ENDIF*) 
                            (*ENDIF*) 
                        (*ENDIF*) 
                    (*ENDIF*) 
                (*ENDIF*) 
            (*ENDIF*) 
        (*ENDIF*) 
        END;
    (*ENDWHILE*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      fill_list;
 
VAR
      pos     : integer;
      list_fn : tsp_vfilename;
      list_no : tsp_int4;
      ln      : tct_line;
      nam     : tsp_name;
      reclen  : tsp_int4;
      ferr    : tsp_vf_return;
      ferr_txt: tsp_errtext;
      tmp_nam : tsp_name;
 
BEGIN
WITH  c21_glob  DO
    BEGIN
    list_fn := bsp_c64;
    tmp_nam := n_fid_list;
    format  := vf_plaintext;
    reclen  := 0;
    s10mv (mxsp_name, mxsp_vfilename, tmp_nam, 1, list_fn, 1, 10);
    sqlfopen (list_fn, vread, vf_stack, list_no, format,
          reclen, 0, 0, bufadr, ferr,ferr_txt);
&   IFDEF TEST
    writeln ( 'fill_lis: vfopen ', list_no:6,  ': ', list_fn );
&   ENDIF
    IF  ferr <> vf_ok
    THEN
        error (list_fn, errorno, list_no);
    (*ENDIF*) 
    vdn_n := n_list ;
    symb  := vcs_empty;
    WHILE (c04ccgetline(list_no, ln, errorno) = vf_ok ) DO
        in_list  (ln);
    (*ENDWHILE*) 
    writeln ('Liste fertig');
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      in_list  (VAR ln : tct_line);
 
VAR
      nam   : tsp_name;
      pos   : tsp_int2;
      i     : integer;
      sy    : tct_vcsymb;
      exist : boolean;
 
BEGIN
WITH  c21_glob  DO
    BEGIN
    pos := 1;
    c02getword (ln, pos, nam);
    i := c21count_list;
    exist := false;
    WHILE ((i > 0) AND (NOT exist)) DO
        BEGIN
        exist := (c03namlist[ i ] = nam);
        i := i - 1
        END;
    (*ENDWHILE*) 
    IF  ( NOT exist ) AND ( nam <> bsp_name )
    THEN
        BEGIN
        c21count_list := c21count_list + 1;
        c03namlist [ c21count_list ] := nam;
        c02getword (ln, pos, nam);
        symbol_list [ c21count_list ].vdn := nam;
        c02getword (ln, pos, nam);
        CASE nam [ 1 ] OF
            '0' :
                sy := vcs_co;
            '1' :
                sy := vcs_ty;
            '2' :
                sy := vcs_va;
            '3' :
                sy := vcs_pr;
            '4' :
                sy := vcs_fu;
            OTHERWISE
                sy := vcs_empty
            END;
        (*ENDCASE*) 
        symbol_list [ c21count_list ].sym := sy
        END
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      get_code (VAR vdn_exec : tsp_name);
 
VAR
      i  : integer;
      hp : tct_do;
 
BEGIN
WITH  c21_glob  DO
    BEGIN
    count_rout := 0;
    symb       := vcs_empty;
    l_nb       := 1;
    first      := false;
    in_rou     := false;
    hp         := do_workend;
    mprocess_modul_until (vdn_exec , hp);
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      mprocess_modul_until (VAR vdn_name : tsp_name;
            VAR do_until : tct_do);
 
VAR
      ln       : tct_line;
      i        : integer;
      ft       : tsp_name;
      inp_file : tsp_vfilename;
      reclen   : tsp_int4;
      ferr     : tsp_vf_return;
      ferr_txt : tsp_errtext;
 
BEGIN
WITH  c21_glob  DO
    BEGIN
    inp_file := bsp_c64;
    IF  vdn_name <> bsp_name
    THEN
        BEGIN
        s10mv (mxsp_name, mxsp_vfilename, vdn_name, 1, inp_file, 1, 8);
&       IF $OS = VMSP
        ft      := ' VDN *            ';
        s10mv (mxsp_name, mxsp_vfilename, ft, 1, inp_file, 9, 6);
&       ELSE
        i := 1;
        WHILE inp_file[ i ] <> bsp_c1 DO
            BEGIN
            inp_file[ i ] := c02tolower(inp_file[ i ]);
            i := succ(i);
            END;
        (*ENDWHILE*) 
&       ENDIF
        format  := vf_plaintext;
        reclen  := 0;
        sqlfopen (inp_file, vread, vf_stack, infileno, format,
              reclen, 0, 0, bufadr, ferr, ferr_txt);
&       IFDEF TEST
        writeln ( 'mprocess: vfopen ', infileno:6, ': ', inp_file );
&       ENDIF
        writeln (inp_file, ' err= ', ord(ferr));
        END;
    (*ENDIF*) 
    IF  ferr <> vf_ok
    THEN
        BEGIN
        IF  count_exec > 1
        THEN
            error ( inp_file, warn_no, infileno)
        ELSE
            error ( inp_file, errorno, infileno)
        (*ENDIF*) 
        END
    ELSE
        BEGIN
        process := do_searchvdn;
        WHILE (c04ccgetline(infileno, ln, errorno) = vf_ok)
              AND (process <> do_until) DO
            lprocess_line (ln);
        (*ENDWHILE*) 
        sqlfclose (infileno, false, 0, 0, bufadr, ferr, ferr_txt);
        END
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      lprocess_line (VAR ln : tct_line);
 
VAR
      pos : tsp_int2;
      i   : integer;
 
BEGIN
WITH  c21_glob  DO
    BEGIN
    CASE process OF
        do_searchvdn :
            BEGIN
            IF  (c02strpos(ln, cct_n_tt1) = 1)
            THEN
                BEGIN
                pos := 1;
                FOR i := 1 TO 3 DO
                    pos := c02chrpos (ln, pos, '$') + 1;
                (*ENDFOR*) 
                c02getword (ln, pos, vdn_n);
                process := do_searchdate
                END
            (*ENDIF*) 
            END;
        do_searchdate :
            BEGIN
            IF  (c02strpos (ln, cct_n_tt3) = 1)
            THEN
                BEGIN
                pos := 1;
                FOR i := 1 TO 3 DO
                    pos := c02chrpos (ln, pos, '$') + 1;
                (*ENDFOR*) 
                c02getword (ln, pos, dat_n);
                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
                BEGIN
                process := do_workdef;
                first := false;
                var_typ := false;
                END
            (*ENDIF*) 
            END;
        do_workdef :
            BEGIN
            IF  c02isend_section (ln)
            THEN
                process := do_searchuse
            ELSE
                dprocessdef (ln)
            (*ENDIF*) 
            END;
        do_searchuse :
            BEGIN
            IF  (c02strpos(ln, cct_n_use) = 1)
            THEN
                BEGIN
                process := do_workuse;
                vdn_ret := vdn_n;
                first := false
                END
            (*ENDIF*) 
            END;
        do_workuse :
            BEGIN
            IF  c02isend_section (ln)
            THEN
                BEGIN
                vdn_n := vdn_ret;
                process := do_searchcode
                END
            ELSE
                uprocessuse (ln)
            (*ENDIF*) 
            END;
        do_searchcode :
            BEGIN
            IF  (c02strpos (ln, cct_n_code) = 1 )
            THEN
                BEGIN
                process := do_workcode;
                first := false
                END
            (*ENDIF*) 
            END;
        do_workcode :
            BEGIN
            IF  c02isend_section (ln)
            THEN
                process := do_workend
            ELSE
                cprocesscode (ln)
            (*ENDIF*) 
            END;
        do_workend :
            BEGIN
            END
        END
    (*ENDCASE*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      dprocessdef (VAR ln : tct_line);
 
VAR
      sy : tct_vcsymb;
      l  : tct_line;
 
BEGIN
WITH  c21_glob  DO
    BEGIN
    sy := c02vcsymb_get (ln, cct_begdef);
    IF  sy <> vcs_empty
    THEN
        BEGIN
        first := true;
        symb := sy;
        END;
    (*ENDIF*) 
    CASE symb OF
        vcs_co, vcs_ty :
            ctvprocess (ln, '=');
        vcs_va     :
            BEGIN
            IF  first AND c_typ
            THEN
                BEGIN
                count_rout := count_rout + 1;
                WITH rout_tab [ count_rout ] DO
                    BEGIN
                    r_name := vdn_n;
                    r_vdn  := vdn_n;
                    r_beg  := l_nb + 1;
                    r_end  := l_nb + 2;
                    END;
                (*ENDWITH*) 
                c02blankline (l);
                c02putname (l, 1, cct_n_procedure);
                pr_line (l);
                c02blankline (l);
                c02putname (l, 1, vdn_n);
                pr_line (l);
                var_typ := true;
                first   := false;
                END;
            (*ENDIF*) 
            IF  c02chrpos (ln, 1, ':') <> 0
            THEN
                ctvprocess (ln, ':')
            ELSE
                ctvprocess (ln, ',');
            (*ENDIF*) 
            END;
        vcs_main, vcs_pr, vcs_fu, vcs_be, vcs_en, vcs_fr, vcs_empty :
            BEGIN
            IF  c_typ AND var_typ
            THEN
                BEGIN
                c02blankline (l);
                c02putname (l, 1, cct_n_begin);
                pr_line (l);
                c02blankline (l);
                c02putname (l, 1, cct_n_end);
                pr_line (l);
                rout_tab [ count_rout ].r_end := l_nb - 1;
                END;
            (*ENDIF*) 
            END
        END
    (*ENDCASE*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ctvprocess (VAR ln : tct_line; z : char);
 
VAR
      beg_com, end_com : integer;
      ind, i           : integer;
      pos              : tsp_int2;
 
BEGIN
WITH  c21_glob  DO
    BEGIN
    beg_com := c02strpos (ln, cct_n_combeg);
    end_com := c02strpos (ln, cct_n_comend);
    ind := c02chrpos (ln, 1, z);
    IF  (ind <> 0) AND
        NOT ((beg_com < ind) AND (ind < end_com))
    THEN
        BEGIN
        IF  NOT in_rou
        THEN
            CASE symb OF
                vcs_co :
                    IF  c_con
                    THEN
                        BEGIN
                        put_in_list (ln, pos);
                        IF  in_nullnull
                        THEN
                            FOR i := 1 TO pos DO
                                ln.l [ i ] := bsp_c1;
                            (*ENDFOR*) 
                        (*ENDIF*) 
                        pr_line (ln)
                        END;
                    (*ENDIF*) 
                vcs_ty :
                    IF  c_typ
                    THEN
                        BEGIN
                        put_in_list (ln, pos);
                        IF  in_nullnull
                        THEN
                            FOR i := 1 TO pos DO
                                ln.l [ i ] := bsp_c1;
                            (*ENDFOR*) 
                        (*ENDIF*) 
                        pr_line (ln)
                        END;
                    (*ENDIF*) 
                vcs_va :
                    IF  c_var OR c_typ
                    THEN
                        BEGIN
                        IF  c_var
                        THEN
                            put_va_in_list (ln, pos);
                        (*ENDIF*) 
                        IF  in_nullnull
                        THEN
                            FOR i := 1 TO pos DO
                                ln.l [ i ] := bsp_c1;
                            (*ENDFOR*) 
                        (*ENDIF*) 
                        pr_line (ln)
                        END
                    (*ENDIF*) 
                END
            (*ENDCASE*) 
        (*ENDIF*) 
        END
    ELSE
        pr_line (ln);
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      put_va_in_list (VAR ln : tct_line;
            VAR pos : tsp_int2 );
 
VAR
      nam : tsp_name;
      ind : integer;
 
BEGIN
WITH  c21_glob  DO
    BEGIN
    pos := 1;
    ind := c02chrpos (ln, 1, ':' );
    IF  ind = 0
    THEN
        ind := ln.len;
    (*ENDIF*) 
    WHILE (pos < ind) DO
        BEGIN
        c02getword (ln, pos, nam);
        IF  nam <> cct_n_u_line
        THEN
            put_list (nam);
        (*ENDIF*) 
        WHILE (ln.l [ pos ]  in c02delimiter) AND (pos < ind) DO
            pos := pos + 1
        (*ENDWHILE*) 
        END
    (*ENDWHILE*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      put_in_list (VAR ln : tct_line;
            VAR pos : tsp_int2);
 
VAR
      nam : tsp_name;
 
BEGIN
WITH  c21_glob  DO
    BEGIN
    pos := 1;
    c02getword (ln, pos, nam);
    put_list (nam)
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      put_list (VAR nam : tsp_name);
 
VAR
      exist : boolean;
      i     : integer;
 
BEGIN
WITH  c21_glob  DO
    BEGIN
    i     := c21count_list;
    exist := false;
    WHILE ((i > 0) AND (NOT exist)) DO
        BEGIN
        exist := (c03namlist[ i ] = nam);
        i := i - 1
        END;
    (*ENDWHILE*) 
    IF  ( NOT exist ) AND ( nam <> bsp_name )
    THEN
        BEGIN
        c21count_list                     := c21count_list + 1;
        c03namlist  [ c21count_list ]     := nam;
        c03found    [ c21count_list ]     := 'no                ';
        symbol_list [ c21count_list ].sym := symb;
        symbol_list [ c21count_list ].vdn := vdn_n
        END
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      uprocessuse (VAR ln : tct_line);
 
VAR
      sy     : tct_vcsymb;
      pos    : tsp_int2;
      i      : integer;
      nam    : tsp_name;
      in_tab : boolean;
 
BEGIN
WITH  c21_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
                IF  c_inp
                THEN
                    first := false
                ELSE
                    BEGIN
                    pos := c02chrpos (ln, 1,':') + 1;
                    c02getword (ln, pos, vdn_n);
                    in_tab := false;
                    FOR i := 1  TO count_exec DO
                        IF  c02equal_string (tab_exec[ i ], vdn_n)
                        THEN
                            in_tab := true;
                        (*ENDIF*) 
                    (*ENDFOR*) 
                    IF  NOT in_tab
                    THEN
                        BEGIN
                        count_exec := count_exec + 1;
                        tab_exec [ count_exec ]  := vdn_n
                        END;
                    (*ENDIF*) 
                    first := false
                    END;
                (*ENDIF*) 
            (*ENDIF*) 
        vcs_va :
            IF  (sy = vcs_empty) AND (c_var)
            THEN
                put_va_in_list (ln, pos);
            (*ENDIF*) 
        vcs_fu, vcs_pr :
            IF  (first) AND (sy = vcs_empty) AND (c_rou)
            THEN
                BEGIN
                pos := 1;
                c02getword (ln, pos, nam);
                put_list (nam);
                first := false
                END;
            (*ENDIF*) 
        OTHERWISE
        END
    (*ENDCASE*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      pr_line (VAR ln : tct_line);
 
VAR
      tmp_line : tsp_name;
 
BEGIN
WITH  c21_glob  DO
    BEGIN
    IF  l_nb < cct_maxlinesofcode
    THEN
        BEGIN
        c21codetab^ [ l_nb ] := ln;
        l_nb := l_nb + 1
        END
    ELSE
        BEGIN
        all_ok := false;
        process := do_workend;
        tmp_line := '*** FILE          ';
        s10mv3 (mxsp_name, mxsp_line, tmp_line, 1, c02oline.l, c02oline.len,
              10);
        c02oline.len := c02oline.len + 10;
        s10mv3 (mxsp_name,mxsp_line,tab_exec[ cur_exec ],1,c02oline.l,
              c02oline.len, 13);
        c02oline.len := c02oline.len + 13;
        tmp_line := 'TOO BIG        ***';
        s10mv3 (mxsp_name, mxsp_line, tmp_line, 1, c02oline.l, c02oline.len,
              18);
        c02oline.len := c02oline.len + 17;
        c02vfwrite  (errorno, c02oline);
        tmp_line := 'PLEASE CHANGE  ***';
        s10mv3 (mxsp_name, mxsp_line, tmp_line, 1, c02oline.l, c02oline.len,
              18);
        c02oline.len := c02oline.len + 18;
        tmp_line := '  MAXLINESOFCODE  ';
        s10mv3 (mxsp_name, mxsp_line, tmp_line, 1, c02oline.l, c02oline.len,
              18);
        c02oline.len := c02oline.len + 18;
        tmp_line := '*** IN VCT00      ';
        s10mv3  (mxsp_name, mxsp_line, tmp_line, 1, c02oline.l, c02oline.len,
              18);
        c02oline.len := c02oline.len + 17;
        c02vfwrite (errorno, c02oline);
        END
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      cprocesscode (VAR ln : tct_line);
 
VAR
      sy : tct_vcsymb;
 
BEGIN
WITH  c21_glob  DO
    BEGIN
    sy := c02vcsymb_get (ln, cct_begcode);
    IF  sy <> vcs_empty
    THEN
        BEGIN
        symb := sy;
        first := true
        END;
    (*ENDIF*) 
    CASE symb OF
        vcs_co, vcs_ty :
            BEGIN
            IF  in_rou
            THEN
                pr_line (ln)
            ELSE
                ctvprocess (ln, '=');
            (*ENDIF*) 
            END;
        vcs_va :
            BEGIN
            IF  in_rou
            THEN
                pr_line (ln)
            ELSE
                IF  c02chrpos (ln, 1, ':') <> 0
                THEN
                    ctvprocess (ln, ':')
                ELSE
                    ctvprocess (ln, ',');
                (*ENDIF*) 
            (*ENDIF*) 
            END;
        vcs_pr, vcs_fu :
            BEGIN
            rprocessrout (ln, sy);
            END;
        vcs_en :
            BEGIN
            endrout (ln);
            END;
        vcs_fr, vcs_be, vcs_main, vcs_empty :
            BEGIN
            pr_line (ln);
            END;
        END
    (*ENDCASE*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      rprocessrout (VAR ln : tct_line;
            VAR sy : tct_vcsymb);
 
VAR
      pos : tsp_int2;
 
BEGIN
WITH  c21_glob  DO
    BEGIN
    IF  first AND (sy = vcs_empty)
    THEN
        BEGIN
        first := false;
        in_rou := true;
        put_in_tab (ln);
        IF  c_rou
        THEN
            put_in_list (ln, pos)
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    pr_line (ln)
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      endrout (VAR ln : tct_line);
 
BEGIN
WITH  c21_glob  DO
    BEGIN
    rout_tab [ count_rout ] .r_end := l_nb;
    in_rou := false;
    pr_line (ln);
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      put_in_tab (VAR ln : tct_line);
 
VAR
      pos : tsp_int2;
      nam : tsp_name;
 
BEGIN
WITH  c21_glob  DO
    BEGIN
    count_rout := count_rout + 1;
    pos := 1;
    c02getword (ln, pos, nam);
    WITH rout_tab  [ count_rout ]  DO
        BEGIN
        r_name := nam;
        r_vdn  := vdn_n;
        r_beg  := l_nb - 1;
        r_end  := l_nb
        END
    (*ENDWITH*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      c21print_res;
 
CONST
      e_con = ' const            ';
      e_typ = ' type             ';
      e_var = ' var              ';
 
VAR
      i     : integer;
      out   : boolean;
      found : boolean;
 
BEGIN
WITH  c21_glob  DO
    BEGIN
    WITH c21res DO
        BEGIN
        IF  (e_nam <> bsp_name)
        THEN
            IF  (e_nam <> e_artn)  OR recursiv
            THEN
                IF  NOT ((ret_res.e_nam = e_nam) AND (ret_res.e_artn = e_artn))
                THEN
                    BEGIN
                    out := true;
                    i := 1;
                    found := false;
                    REPEAT
                        IF  c03namlist [ i ] <> e_artn
                        THEN
                            i := i + 1
                        ELSE
                            found := true
                        (*ENDIF*) 
                    UNTIL
                        found OR ( i > c21count_list ) ;
                    (*ENDREPEAT*) 
                    IF  found
                    THEN
                        BEGIN
                        e_artv := symbol_list [ i ] .vdn;
                        CASE symbol_list [ i ] .sym OF
                            vcs_empty :
                                e_art := '    ____          ';
                            vcs_co :
                                e_art := e_con;
                            vcs_ty :
                                e_art := e_typ;
                            vcs_va :
                                e_art := e_var;
                            vcs_fu :
                                BEGIN
                                e_art := ' func             ';
                                IF  e_nam = e_artn
                                THEN
                                    out := false
                                (*ENDIF*) 
                                END;
                            vcs_pr :
                                e_art := ' proc             '
                            END;
                        (*ENDCASE*) 
                        ret_res := c21res;
                        IF  out
                        THEN
                            BEGIN
                            c02blankline (c02oline);
                            s10mv3 (mxsp_name,mxsp_line,e_vdn,1,
                                  c02oline.l, c02oline.len, mxsp_name);
                            c02oline.len := c02oline.len + 7;
                            s10mv3 (mxsp_name,mxsp_line,e_nam,1,
                                  c02oline.l, c02oline.len, mxsp_name);
                            c02oline.len := c02oline.len + 16;
                            s10mv3 (mxsp_name,mxsp_line,e_art,1,
                                  c02oline.l, c02oline.len, mxsp_name);
                            c02oline.len := c02oline.len + 7;
                            s10mv3 (mxsp_name,mxsp_line,e_artv,1,
                                  c02oline.l, c02oline.len, mxsp_name);
                            c02oline.len := c02oline.len + 7;
                            s10mv3 (mxsp_name,mxsp_line,e_artn,1,
                                  c02oline.l, c02oline.len, mxsp_name);
                            c02oline.len := c02oline.len + 15;
                            c02vfwrite (call, c02oline);
                            IF  (symbol_list [ i ] .sym = vcs_fu) OR
                                (symbol_list [ i ].sym = vcs_pr)
                            THEN
                                e_art := ' rout             ';
                            (*ENDIF*) 
                            c02blankline (c02oline);
                            s10mv3 (mxsp_name,mxsp_line,e_art,1,
                                  c02oline.l, c02oline.len, mxsp_name);
                            c02oline.len := c02oline.len + 7;
                            s10mv3 (mxsp_name,mxsp_line,e_artv,1,
                                  c02oline.l, c02oline.len, mxsp_name);
                            c02oline.len := c02oline.len + 7;
                            s10mv3 (mxsp_name,mxsp_line,e_artn,1,
                                  c02oline.l, c02oline.len, mxsp_name);
                            c02oline.len := c02oline.len + 16;
                            s10mv3 (mxsp_name,mxsp_line,e_vdn,1,
                                  c02oline.l, c02oline.len, mxsp_name);
                            c02oline.len := c02oline.len + 7;
                            s10mv3 (mxsp_name,mxsp_line,e_nam,1,
                                  c02oline.l, c02oline.len, mxsp_name);
                            c02oline.len := c02oline.len + 16;
                            c02vfwrite (iscall, c02oline);
                            END
                        (*ENDIF*) 
                        END
                    (*ENDIF*) 
                    END
                (*ENDIF*) 
            (*ENDIF*) 
        (*ENDIF*) 
        END
    (*ENDWITH*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      c21getcall_rout (line_nb : integer);
 
VAR
      i : integer;
 
BEGIN
WITH  c21_glob  DO
    BEGIN
    recursiv := true;
    WITH c21res DO
        BEGIN
        e_nam := bsp_name;
        e_vdn := bsp_name;
        i := 1;
        REPEAT
            WITH rout_tab [ i ]  DO
                IF  (r_beg < line_nb) AND (line_nb <= r_end)
                THEN
                    BEGIN
                    IF  r_beg + 2 >= line_nb
                    THEN
                        recursiv := false;
                    (*ENDIF*) 
                    e_nam := r_name;
                    e_vdn := r_vdn;
                    END;
                (*ENDIF*) 
            (*ENDWITH*) 
            i := i + 1;
        UNTIL
            (e_nam <> bsp_name) OR (i > count_rout)
        (*ENDREPEAT*) 
        END
    (*ENDWITH*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      write_c40 (VAR txt : tsp_c40);
 
BEGIN
s10mv1 (mxsp_c40, mxsp_line, txt, 1, c02oline.l, 1, 40);
c02oline.len := 40;
c02vfwrite (c02outf, c02oline);
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct21_write_header;
 
BEGIN
c02blankline (c02oline);
c02putname   (c02oline,  1, n_comment);
c02putname   (c02oline,  5, n_vct_version);
c02putname   (c02oline, 29, n_vct_date);
c02vfwrite (c02outf, c02oline);
c02blankline (c02oline);
c02putname   (c02oline,  1, n_comment);
c02vfwrite (c02outf, c02oline);
c02putname   (c02oline,  1, n_comment);
c02vfwrite (c02outf, c02oline);
END;
 
(*------------------------------*) 
 
PROCEDURE
      open_output_file;
 
VAR
      out_file : tsp_vfilename;
      tmp_nam1 : tsp_name;
      h40      : tsp_c40;
      reclen   : tsp_int4;
      ferr     : tsp_vf_return;
      ferr_txt : tsp_errtext;
 
BEGIN
WITH  c21_glob  DO
    BEGIN
    reclen   := 0;
    ferr     := vf_ok;
    out_file := bsp_c64;
    format   := vf_plaintext;
    (* GENERATING CONTROL - STATEMENTS FOR CALL LOAD *)
    tmp_nam1 := n_fid_hea_call;
    s10mv (mxsp_name, mxsp_vfilename, tmp_nam1, 1,
          out_file, 1, mxsp_name);
    sqlfopen (out_file, voverwrite, vf_stack, c02outf, format,
          reclen, 0, 0, bufadr, ferr,ferr_txt);
&   IFDEF TEST
    writeln ( 'open_out: vfopen ', c02outf:6, ': ', out_file );
&   ENDIF
    ct21_write_header;
    h40           := 'drop table call_tb                      ';
    write_c40 (h40);
    h40           := '/**                                     ';
    write_c40 (h40);
    h40           := 'create table call_tb                    ';
    write_c40 (h40);
    h40           := '       ( vdn_name char ( 7) ,           ';
    write_c40 (h40);
    h40           := '         routinenname char (16) ,       ';
    write_c40 (h40);
    h40           := '         art char ( 7) ,                ';
    write_c40 (h40);
    h40           := '         art_vdn char ( 7),             ';
    write_c40 (h40);
    h40           := '         art_name char (16)  )          ';
    write_c40 (h40);
    h40           := '*                                       ';
    write_c40 (h40);
    h40           := 'DATALOAD NOLOG TABLE CALL_TB            ';
    write_c40 (h40);
    h40           := 'VDN_NAME 1-7                            ';
    write_c40 (h40);
    h40           := 'ROUTINENNAME 8-23                       ';
    write_c40 (h40);
    h40           := 'ART 25-30                               ';
    write_c40 (h40);
    h40           := 'ART_VDN 31-37                           ';
    write_c40 (h40);
    h40           := 'ART_NAME 38-53                          ';
    write_c40 (h40);
    h40           := 'INFILE *                                ';
    write_c40 (h40);
    h40           := '/**                                     ';
    write_c40 (h40);
    sqlfclose (c02outf, false, 0, 0, bufadr, ferr, ferr_txt);
    (*
          GENERATING CONTROL-STATEMENTS FOR ISCALL LOAD
          *)
    tmp_nam1 := n_fid_hea_iscall;
    s10mv (mxsp_name, mxsp_vfilename, tmp_nam1, 1, out_file, 1, mxsp_name);
    format := vf_plaintext;
    reclen  := 0;
    sqlfopen (out_file, voverwrite, vf_stack, c02outf, format,
          reclen, 0, 0, bufadr, ferr,ferr_txt);
&   IFDEF TEST
    writeln ( 'open_out: vfopen ', c02outf:6, ': ', out_file );
&   ENDIF
    ct21_write_header;
    h40           := 'drop table iscall_tb                    ';
    write_c40 (h40);
    h40           := '/**                                     ';
    write_c40 (h40);
    h40           := 'create table iscall_tb                  ';
    write_c40 (h40);
    h40           := '       ( art char ( 7) ,                ';
    write_c40 (h40);
    h40           := '         art_vdn char ( 7),             ';
    write_c40 (h40);
    h40           := '         art_name char (16),            ';
    write_c40 (h40);
    h40           := '         vdn_name char ( 7) ,           ';
    write_c40 (h40);
    h40           := '         routinenname char (16) )       ';
    write_c40 (h40);
    h40           := '*                                       ';
    write_c40 (h40);
    h40           := 'DATALOAD NOLOG TABLE ISCALL_TB          ';
    write_c40 (h40);
    h40           := 'ART 1-7                                 ';
    write_c40 (h40);
    h40           := 'ART_VDN 8-14                            ';
    write_c40 (h40);
    h40           := 'ART_NAME 15-30                          ';
    write_c40 (h40);
    h40           := 'VDN_NAME 31-37                          ';
    write_c40 (h40);
    h40           := 'ROUTINENNAME 38-53                      ';
    write_c40 (h40);
    h40           := 'INFILE *                                ';
    write_c40 (h40);
    h40           := '/**                                     ';
    write_c40 (h40);
    sqlfclose (c02outf, false, 0, 0, bufadr, ferr, ferr_txt);
    (*
          GENERATING CONTROL-STATEMENTS FOR CROSS LOAD'
          *)
    tmp_nam1 := n_fid_hea_cross;
    s10mv (mxsp_name, mxsp_vfilename, tmp_nam1, 1, out_file, 1, mxsp_name);
    format := vf_plaintext;
    reclen  := 0;
    sqlfopen (out_file, voverwrite, vf_stack, c02outf, format,
          reclen, 0, 0, bufadr, ferr,ferr_txt);
&   IFDEF TEST
    writeln ( 'open_out: vfopen ', c02outf:6, ': ', out_file );
&   ENDIF
    ct21_write_header;
    h40           := 'drop table cross_tb                     ';
    write_c40 (h40);
    h40           := '/**                                     ';
    write_c40 (h40);
    h40           := 'create table cross_tb                   ';
    write_c40 (h40);
    h40           := '       ( art_name char (16),            ';
    write_c40 (h40);
    h40           := '         vdn_name char ( 7),            ';
    write_c40 (h40);
    h40           := '         art_found char ( 7),           ';
    write_c40 (h40);
    h40           := '         art_typ char (1),              ';
    write_c40 (h40);
    h40           := '         unused_in char (7) )           ';
    write_c40 (h40);
    h40           := '*                                       ';
    write_c40 (h40);
    h40           := 'DATALOAD NOLOG TABLE CROSS_TB           ';
    write_c40 (h40);
    h40           := 'ART_NAME 1-16                           ';
    write_c40 (h40);
    h40           := 'VDN_NAME 17-23                          ';
    write_c40 (h40);
    h40           := 'ART_FOUND 24-28                         ';
    write_c40 (h40);
    h40           := 'ART_TYP 30-30                           ';
    write_c40 (h40);
    h40           := 'UNUSED_IN 34-40                         ';
    write_c40 (h40);
    h40           := 'INFILE *                                ';
    write_c40 (h40);
    h40           := '/**                                     ';
    write_c40 (h40);
    h40           := '/* NAME        DEF_IN FOUND TYP UNUSEDIN';
    write_c40 (h40);
    sqlfclose (c02outf, false, 0, 0, bufadr, ferr, ferr_txt);
    (*
          OPEN OTHER TEMPORARY FILES
          *)
    tmp_nam1 := n_fid_out_call;
    s10mv (mxsp_name, mxsp_vfilename, tmp_nam1, 1, out_file, 1, mxsp_name);
    format := vf_plaintext;
    reclen := 0;
    sqlfopen (out_file, voverwrite, vf_stack, call, format,
          reclen, 0, 0, bufadr, ferr,ferr_txt);
&   IFDEF TEST
    writeln ( 'open_out: vfopen ', call:6,     ': ', out_file );
&   ENDIF
    tmp_nam1 := n_fid_out_iscall;
    s10mv (mxsp_name, mxsp_vfilename, tmp_nam1, 1, out_file, 1, mxsp_name);
    format := vf_plaintext;
    reclen  := 0;
    sqlfopen (out_file, voverwrite, vf_stack, iscall, format,
          reclen, 0, 0, bufadr, ferr,ferr_txt);
&   IFDEF TEST
    writeln ( 'open_out: vfopen ', iscall:6,   ': ', out_file );
&   ENDIF
    tmp_nam1 := n_fid_error;
    s10mv (mxsp_name, mxsp_vfilename, tmp_nam1, 1, out_file, 1, mxsp_name);
    format := vf_plaintext;
    reclen  := 0;
    sqlfopen (out_file, voverwrite, vf_stack, errorno, format,
          reclen, 0, 0, bufadr, ferr,ferr_txt);
&   IFDEF TEST
    writeln ( 'open_out: vfopen ', errorno:6,  ': ', out_file );
&   ENDIF
    tmp_nam1 := n_fid_warn;
    s10mv (mxsp_name, mxsp_vfilename, tmp_nam1, 1, out_file, 1, mxsp_name);
    format := vf_plaintext;
    reclen  := 0;
    sqlfopen (out_file, voverwrite, vf_stack, warn_no, format,
          reclen, 0, 0, bufadr, ferr,ferr_txt);
&   IFDEF TEST
    writeln ( 'open_out: vfopen ', warn_no:6,  ': ', out_file );
&   ENDIF
    tmp_nam1 := n_fid_out_cross;
    s10mv (mxsp_name, mxsp_vfilename, tmp_nam1, 1, out_file, 1, mxsp_name);
    format := vf_plaintext;
    reclen  := 0;
    sqlfopen (out_file, voverwrite, vf_stack, cross, format,
          reclen, 0, 0, bufadr, ferr,ferr_txt);
&   IFDEF TEST
    writeln ( 'open_out: vfopen ', cross:6,    ': ', out_file );
&   ENDIF
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      print_cross ( ind : integer );
 
VAR
      i     : integer;
      start : integer;
      stop  : integer;
 
BEGIN
WITH c21_glob DO
    BEGIN
    IF  c_cross
    THEN
        BEGIN
        IF  ind = 1
        THEN
            BEGIN
            IF  max_list > 0
            THEN
                start := max_list + 1
            ELSE
                start := 1;
            (*ENDIF*) 
            stop := c21count_list
            END
        ELSE
            BEGIN
            start := 1;
            stop  := max_list
            END;
        (*ENDIF*) 
        c02blankline (c02oline);
        FOR i := start TO stop DO
            BEGIN
            IF  c03found [ i ] = 'no                '
            THEN
                BEGIN
                s10mv3 (mxsp_name, mxsp_line, c03namlist[ i ], 1,
                      c02oline.l, c02oline.len, mxsp_name);
                c02oline.len := c02oline.len + 16;
                s10mv3 (mxsp_name, mxsp_line, symbol_list[ i ].vdn, 1,
                      c02oline.l, c02oline.len, mxsp_name);
                c02oline.len := c02oline.len + 7;
                s10mv3 (mxsp_name,mxsp_line,c03found[ i ],1,c02oline.l,
                      c02oline.len, mxsp_name);
                c02oline.len := c02oline.len + 5;
                c02trimint4_to_line (ord(symbol_list[ i ].sym),
                      c02oline.len, c02oline.l);
                c02oline.len := c02oline.len + 4;
                IF  ind = 1
                THEN
                    BEGIN
                    s10mv3 (mxsp_name, mxsp_line, tab_exec[ cur_exec ],
                          1, c02oline.l, c02oline.len, mxsp_name);
                    c02oline.len := c02oline.len + 7
                    END;
                (*ENDIF*) 
                c02vfwrite (cross, c02oline);
                END
            (*ENDIF*) 
            END;
        (*ENDFOR*) 
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      sort_tab_exec_print;
 
VAR
      j, k, l, r : integer;
      x          : tsp_name;
      tmp_nam1   : tsp_name;
      tmp_nam2   : tsp_c40;
      reclen     : tsp_int4;
      ferr       : tsp_vf_return;
      ferr_txt   : tsp_errtext;
      out_file   : tsp_vfilename;
 
BEGIN
WITH  c21_glob  DO
    BEGIN
    l := 2;
    r := count_exec;
    k := count_exec;
    IF  count_exec > 1
    THEN
        REPEAT
            FOR j := r DOWNTO l DO
                IF  tab_exec [ j - 1 ] > tab_exec [ j ]
                THEN
                    BEGIN
                    x                  := tab_exec [ j - 1 ];
                    tab_exec [ j - 1 ] := tab_exec [ j ];
                    tab_exec [ j ]     := x;
                    k                  := j;
                    END;
                (*ENDIF*) 
            (*ENDFOR*) 
            l := k + 1;
            FOR j := l TO r DO
                IF  tab_exec [ j - 1 ] > tab_exec [ j ]
                THEN
                    BEGIN
                    x                  := tab_exec [ j - 1 ];
                    tab_exec [ j - 1 ] := tab_exec [ j ];
                    tab_exec [ j ]     := x;
                    k                  := j;
                    END;
                (*ENDIF*) 
            (*ENDFOR*) 
            r := k - 1;
        UNTIL
            (l > r);
        (*ENDREPEAT*) 
    (* print tab_exec *)
    (*ENDIF*) 
    sqlfclose (c02outf, false, 0, 0, bufadr, ferr, ferr_txt);
    reclen   := 0;
    ferr     := vf_ok;
    out_file := bsp_c64;
    tmp_nam1 := n_fid_count;
    s10mv (mxsp_name, mxsp_vfilename, tmp_nam1, 1, out_file, 1, 14);
    format   := vf_plaintext;
    sqlfopen (out_file, voverwrite, vf_stack, c02outf, format,
          reclen, 0, 0, bufadr, ferr,ferr_txt);
&   IFDEF TEST
    writeln ( 'open_out: vfopen ', c02outf:6, ': ', out_file );
&   ENDIF
    tmp_nam2 := 'NUMBER OF MODULES INCLUDED :            ';
    s10mv1 (mxsp_c40, mxsp_line, tmp_nam2, 1,
          c02oline.l, c02oline.len, 28);
    c02oline.len := c02oline.len + 27;
    c02trimint4_to_line (count_exec, c02oline.len, c02oline.l);
    c02vfwrite (c02outf, c02oline);
    FOR r := 1 TO count_exec DO
        BEGIN
        s10mv3 (mxsp_name,mxsp_line,tab_exec[ r ],1,c02oline.l,
              c02oline.len, mxsp_name);
        c02oline.len := c02oline.len + mxsp_name - 1;
        IF  ((r MOD 4) = 0) OR ( r = count_exec )
        THEN
            c02vfwrite (c02outf, c02oline);
        (*ENDIF*) 
        END;
    (*ENDFOR*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      error ( VAR file_name : tsp_vfilename;
            errorfile : tsp_int4;
            VAR file_no   : tsp_int4);
 
VAR
      tmp_line : tsp_name;
 
BEGIN
WITH c21_glob DO
    BEGIN
    modul_ok := false;
    file_no  := - 1;
    process  := do_workend;
    tmp_line := '*** FILE          ';
    s10mv3 (mxsp_name, mxsp_line, tmp_line, 1,
          c02oline.l, c02oline.len, 10);
    c02oline.len := c02oline.len + 10;
    s10mv4 (mxsp_vfilename, mxsp_line, file_name, 1, c02oline.l,
          c02oline.len, 13);
    c02oline.len := c02oline.len + 13;
    tmp_line := 'NOT FOUND      ***';
    s10mv3 (mxsp_name, mxsp_line, tmp_line, 1,
          c02oline.l, c02oline.len, 18);
    c02oline.len := c02oline.len + 17;
    c02vfwrite (errorfile, c02oline);
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      close_output_file;
 
VAR
      ferr     : tsp_vf_return;
      ferr_txt : tsp_errtext;
 
BEGIN
WITH c21_glob DO
    BEGIN
    sqlfclose (call, false, 0, 0, bufadr, ferr, ferr_txt);
    sqlfclose (iscall, false, 0, 0, bufadr, ferr, ferr_txt);
    sqlfclose (cross, false, 0, 0, bufadr, ferr, ferr_txt);
    sqlfclose (errorno, false, 0, 0, bufadr, ferr, ferr_txt);
    sqlfclose (warn_no, false, 0, 0, bufadr, ferr, ferr_txt);
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
BEGIN
WITH  c21_glob  DO
    BEGIN
    ct21_sequential_program;
    END;
(*ENDWITH*) 
END
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
*-PRETTY-*  statements    :        697
*-PRETTY-*  lines of code :       1724        PRETTY  3.09 
*-PRETTY-*  lines in file :       2549         1992-11-23 
.PA 
