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


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

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

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

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

.fo
.nf
.sp
Module  : XREF - Crossreference
=========
.sp
Purpose : Builds a cross reference list of external variables
          and routines.
.CM *-END-* purpose -------------------------------------
.sp
.cp 3
Define  :
 
        PROGRAM
              vct64 ;
 
.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :
 
        FROM
              String_utilities : VCT02;
 
        VAR
              c02delimiter : tct_delim;
 
        PROCEDURE
              c02init;
 
        PROCEDURE
              c02linelength_init (l : integer);
 
        PROCEDURE
              c02getword (
                    VAR line : tct_line;
                    VAR pos  : tsp_int2;
                    VAR nam  : tsp_name);
 
        PROCEDURE
              c02print_com (com : tsp_name);
 
        PROCEDURE
              c02fncat (
                    VAR s      : tsp_vfilename;
                    VAR s1     : tsp_line;
                    VAR start1 : tsp_int4;
                    VAR n      : tsp_name;
                    nlen       : tsp_int4);
 
        PROCEDURE
              c02vfwrite (
                    fno     : tsp_int4;
                    VAR buf : tct_line);
 
        PROCEDURE
              c02int4to_line (
                    int       : tsp_int4;
                    with_zero : boolean;
                    int_len   : integer;
                    ln_pos    : integer;
                    VAR ln    : tsp_line);
 
        FUNCTION
              c02toupper  (c : char) : char;
 
        PROCEDURE
              c02putname (
                    VAR ln  : tct_line;
                    pos     : integer;
                    nam     : tsp_name);
 
        PROCEDURE
              c02putchar (
                    VAR ln  : tct_line;
                    c       : char);
 
        FUNCTION
              c02vcsymb_get (
                    VAR line : tct_line;
                    beg      : integer) : tct_vcsymb;
 
        FUNCTION
              c02strpos (
                    VAR line : tct_line;
                    nam      : tsp_name) : tsp_int4;
 
        FUNCTION
              c02chrpos (
                    VAR line : tct_line;
                    beg      : tsp_int4;
                    c        : char) : tsp_int2;
 
        FUNCTION
              c02isend_section (VAR line : tct_line) : boolean;
 
      ------------------------------ 
 
        FROM
              Conditional-Compiling_Utilities : VCT04;
 
        FUNCTION
              c04ccgetline (
                    infileno  : tsp_int4;
                    VAR ln    : tct_line;
                    errfileno : tsp_int4) : tsp_vf_return;
 
        PROCEDURE
              c04cc2init (
                    VAR argln     : tct_line;
                    VAR printrout : tsp_name;
                    VAR trace     : boolean;
                    errfileno     : 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 : tsp_int1);
 
        PROCEDURE
              sqlfinish (terminate : boolean);
 
        PROCEDURE
              sqlargl (VAR args    : tsp_line);
 
        PROCEDURE
              sqldattime (
                    VAR d    : tsp_date;
                    VAR t    : tsp_time);
 
        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-10 : VSP10;
 
        PROCEDURE
              s10fil (size     : tsp_int4;
                    VAR m    : tsp_execline;
                    pos      : tsp_int4;
                    len      : tsp_int4;
                    fillchar : char);
 
        PROCEDURE
              s10mv (
                    size1    : tsp_int4;
                    size2    : tsp_int4;
                    VAR val1 : tsp_line;
                    p1       : tsp_int4;
                    VAR val2 : tsp_line;
                    p2       : tsp_int4;
                    anz      : tsp_int4 );
 
        PROCEDURE
              s10mv1 (
                    size1    : namepositions;
                    size2    : tsp_int4;
                    VAR val1 : tsp_name;
                    p1       : namepositions;
                    VAR val2 : tsp_line;
                    p2       : tsp_int4;
                    anz      : namepositions );
 
        PROCEDURE
              s10mv5 (
                    size1    : tsp_int4;
                    size2    : tsp_int4;
                    VAR val1 : tsp_c30;
                    p1       : tsp_int4;
                    VAR val2 : tsp_line;
                    p2       : tsp_int4;
                    anz      : tsp_int4);
 
        PROCEDURE
              s10mv6 (
                    size1    : namepositions;
                    size2    : tsp_int4;
                    VAR val1 : tsp_name;
                    p1       : namepositions;
                    VAR val2 : tsp_vfilename;
                    p2       : tsp_int4;
                    anz      : tsp_int4 );
 
        PROCEDURE
              s10mv7 (
                    size1    : namepositions;
                    size2    : tsp_int4;
                    VAR val1 : tsp_name;
                    p1       : tsp_int4;
                    VAR val2 : tsp_execline;
                    p2       : tsp_int4;
                    anz      : tsp_int4 );
 
        PROCEDURE
              s10mv8 (
                    size1    : namepositions;
                    size2    : tsp_int4;
                    VAR val1 : tsp_c40;
                    p1       : tsp_int4;
                    VAR val2 : tsp_execline;
                    p2       : tsp_int4;
                    anz      : tsp_int4 );
 
      ------------------------------ 
 
        FROM
              RTE-Extension-30: VSP30;
 
        FUNCTION
              s30klen (
                    VAR str  : tsp_line;
                    val      : char;
                    cnt      : integer) : integer;
 
.CM *-END-* use -----------------------------------------
.sp;.cp 3
Synonym :
 
        PROCEDURE
              s30klen;
 
              tsp_moveobj tsp_line
 
        PROCEDURE
              s10mv;
 
              tsp_moveobj tsp_line
              tsp_moveobj tsp_line
 
        PROCEDURE
              s10mv1;
 
              tsp_int4    namepositions
              tsp_moveobj tsp_name
              tsp_int4    namepositions
              tsp_moveobj tsp_line
              tsp_int4    namepositions
 
        PROCEDURE
              s10mv5;
 
              tsp_moveobj tsp_c30
              tsp_moveobj tsp_line
 
        PROCEDURE
              s10mv6;
 
              tsp_int4    namepositions
              tsp_moveobj tsp_name
              tsp_moveobj tsp_vfilename
              tsp_int4    namepositions
 
        PROCEDURE
              sqlfopen;
 
              tsp_vf_bufaddr tct_lineaddr
 
        PROCEDURE
              sqlfclose;
 
              tsp_vf_bufaddr tct_lineaddr
 
.CM *-END-* synonym -------------------------------------
.sp;.cp 3
Author  : C. Segieth
.sp
.cp 3
Created : 1983-08-04                (Origin: B.Freier)
.sp
.cp 3
Version : 1999-09-21
.sp
.cp 3
Release :  6.1.1         Date : 1995-05-02
.sp
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Specification:
 
 
.nf
PROGRAMM  XREF:
.sp
Call :    VCT64  <vdnfn> <cc_options>  |
          VCT64  <vdnfn> <cc_options>  ( <format_option>
.sp
<format_option> :=   XEDIT  |  SCRIPT
.br
Default:  XEDIT
.sp
Output :  'XREF VDN A'
.sp
Using  :  VCT00     const, type
          VCT02     sub-routines for tools
.sp 2
.br
.CM *-END-* specification -------------------------------
.sp 2
***********************************************************
.sp;.cp 10;.fo
.oc _/1
Description:
 
The following figure shows all parameters in VCT64 which are defined
by constants at the top of the module
to make changes in the layout of the 'XREF VDN' easier.
If they are changed, there might be less or more module-names on one
output-line or the distance between the names become smaller or greater.
.sp 2
.nf
from_mod_per_line=   14;
use_mod_per_line =   10;
 
maxlen_x_mod    = ----------------------------------<------>
pos_use_modules = ------------------------(44)      |  (8) |
pos_x_colon     = --------------------(41)  |       |      |
pos_x_mod       = --------------(34)    |   |       |      |
pos_x_art       = -(22)           |     |   |       |      |
                     |            |     |   |       |      |
c02toupper . . . . FUNCTION    VCT02  :   VCT64   VCT31   VCT01
c98_big_small. . . . VARIABLE  +++ unknown  VCT64   VCT31   VCT01
sqlargl. . . . . . . PROCEDURE   VEN13  :   VCT44   VCT99   VCT64   VCT31   VCT21   VCT11
                                            VCT01
.sp 2
.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 bottom of the processed module *)
      n_vct_version    = 'XREF  3.06        ';
      n_vct_date       = ' (1992-07-07)     ';
      (* format for script-output [  ll = 132) *)
      s_maxlen_x_mod     =    8;
      s_pos_x_art        =   22;
      s_pos_x_mod        =   34;
      s_pos_x_colon      =   41;
      s_pos_use_modules  =   44;
      s_use_mod_per_line =   11;
      s_from_mod_per_line=   16;
      (* format for xedit-output [  ll = 73) *)
      x_maxlen_x_mod     =    7;
      x_pos_x_art        =   20;
      x_pos_x_mod        =   25;
      x_pos_x_colon      =   31;
      x_pos_use_modules  =   33;
      x_use_mod_per_line =    6;
      x_from_mod_per_line=   10;
      max_fromtab      =  800;
      maxsortnumber    = 2000;
      n_endifdef_o     = 'endif             ';
&     if $OS = VMSP
      n_fid_errfile    = 'XREF ERROR A      '; (* fid for err-file *)
      n_fid_xref       = 'XREF VDN A        '; (* fid for XREF *)
      n_ftm_source     = ' VDN *            '; (* ft  for Inputfile *)
&     ELSE
      n_fid_errfile    = 'xref.error        '; (* fid for err-file *)
      n_fid_xref       = 'xref.vdn          '; (* fid for XREF *)
      n_ftm_source     = '                  '; (* ft  for Inputfile *)
&     ENDIF
      l_ftm_source     =    6;
      n_ifdeftrace_o   = 'ifdef TRACE       ';
      n_periods        = ' . . . . . . . . .';
      n_dash9          = '=========         ';
      n_unknown        = '+++ unknown       ';
      n_icp           = '# %TOOLSHELL% -S icp%TOOLEXT%           ';
      n_icp_target    = '  %TMP%                                 ';
 
TYPE
      namepositions    = 0..mxsp_name;
      usepointer       = ^use;
      xrefpointer      = ^xref;
 
      xref = RECORD
            x_rout  : tsp_name;
            x_fill1 : tsp_int2;
            x_mod   : tsp_name;
            x_art   : tct_vcsymb;
            x_fill2 : boolean;
            x_usep  : usepointer;
            x_left  : xrefpointer;
            x_right : xrefpointer;
      END;
 
 
      use = RECORD
            u_mod   : tsp_name;
            u_fill  : tsp_int2;
            u_usep  : usepointer;
      END;
 
      from_tabele      = ARRAY [  1..max_fromtab  ]  OF tsp_name;
      sortreftable     = ARRAY [  1..maxsortnumber, 1..2  ] OF xrefpointer;
 
      tp_c64_record    = RECORD
            defe              : boolean;
            file_is_open      : boolean;
            first             : boolean;
            inp_eof           : boolean;
            script_format     : boolean;
            c64_fill1         : tsp_int2;
            ferr_text         : tsp_errtext;
            from_tab          : from_tabele;
            dat_n             : tsp_name;
            c64_fill2         : tsp_int2;
            hname             : tsp_name;
            cur_from          : tsp_int2;
            inp_vdn           : tsp_name;
            from_mod_per_line : tsp_int2;
            mod_n             : tsp_name;
            maxlen_x_mod      : tsp_int2;
            pos_use_modules   : tsp_int2;
            o_format          : tsp_name;
            pos_x_art         : tsp_int2;
            rootfile          : tsp_name;
            pos_x_colon       : tsp_int2;
            vdn_from          : tsp_name;
            pos_x_mod         : tsp_int2;
            vdn_n             : tsp_name;
            use_mod_per_line  : tsp_int2;
            errfile           : tsp_int4;
            infile            : tsp_int4;
            outfile           : tsp_int4;
            extern_count      : tsp_int4;
            from_count        : tsp_int4;
            blankline         : tsp_line;
            hline             : tsp_line;
            outln             : tct_line;
            process_state     : tct_do;
            symb              : tct_vcsymb;
            ferr              : tsp_vf_return;
            no_iview          : boolean;
            source_fn         : tsp_vfilename;
            u_tree            : usepointer;
            x_tree            : xrefpointer;
            format            : tsp_vf_format;
            bufadr            : tct_lineaddr;
      END;
 
 
VAR
      c64_glob : tp_c64_record;
&     IFDEF TEST
 
 
(*------------------------------*) 
 
PROCEDURE
      zwrite (ln : tct_line);
 
VAR
      i : integer;
 
BEGIN
write(ln.len:3, ' >');
FOR i:=1 TO ln.len DO
    write(ln.l[  i  ]);
(*ENDFOR*) 
writeln ('<');
END;
 
&ENDIF
(*------------------------------*) 
 
PROCEDURE
      sequential_program;
 
BEGIN
WITH  c64_glob  DO
    BEGIN
    c02init;
    c02linelength_init(mxsp_line);
    outln.adr := @outln.l;
    IF  ct64_init
    THEN
        BEGIN
        ct64_fprocess_from_table;
        IF  x_tree <> NIL
        THEN
            BEGIN
            ct64_print_tree(x_tree);
            IF  file_is_open
            THEN
                BEGIN
                sqlfclose(infile, false, 0, 0, bufadr, ferr, ferr_text);
                END;
            (*ENDIF*) 
            sqlresult(0);
            END
        ELSE
            sqlresult(64);
        (*ENDIF*) 
        sqlfclose(outfile, false, 0, 0, bufadr, ferr, ferr_text);
        END
    ELSE
        sqlresult(64);
    (*ENDIF*) 
    sqlfclose(errfile, false, 0, 0, bufadr, ferr, ferr_text);
    sqlfinish(true);
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      ct64_init : boolean;
 
VAR
      dummybool         : boolean;
      func_result       : boolean;
      dat               : tsp_date;
      time              : tsp_time;
      begpos_in_argline : tsp_int2;
      end_of_cond_comp  : integer;
      i                 : integer;
      reclen            : tsp_int4;
      argln             : tct_line;
      xref_fn           : tsp_vfilename;
      errtext           : tsp_errtext;
      error             : boolean;
 
BEGIN
WITH  c64_glob  DO
    BEGIN
    no_iview := false;
    sqlargl (argln.l);
    argln.len := s30klen(argln.l, bsp_c1, mxsp_line);
    get_parameter (argln);
&   IFDEF UDEBUG
    writeln (n_vct_version, n_vct_date);
    writeln ('------------------------------------');
    writeln ('ct64_ini argln.l =', argln.l);
    writeln ('            .len =', argln.len);
&   ENDIF
    sqldattime(dat, time);
    (*       'error file'  *)
    (*       open the error-file for overwrite *)
    reclen        := 0;
    script_format := false;
    xref_fn       := bsp_c64;
    hname         := n_fid_errfile;
    s10mv6(mxsp_name, mxsp_vfilename, hname, 1, xref_fn, 1, 18);
    format := vf_plaintext;
&   IFDEF UDEBUG
    writeln ('ct64_ini sqlfopen=', xref_fn);
&   ENDIF
    sqlfopen(xref_fn, voverwrite, vf_stack, errfile, format,
          reclen, 0, 0, bufadr, ferr,ferr_text);
    IF  ferr = vf_ok
    THEN
        BEGIN
        (*       'XREF VDN A'  *)
        (*       open the XREF - outputfile 4 overwrite *)
        reclen        := 0;
        script_format := false;
        xref_fn       := bsp_c64;
        hname         := n_fid_xref;
        s10mv6 (mxsp_name, mxsp_vfilename, hname, 1, xref_fn, 1, 18);
        format        := vf_plaintext;
&       IFDEF UDEBUG
        writeln ('ct64_ini sqlfopen=', xref_fn);
&       ENDIF
        sqlfopen (xref_fn, voverwrite, vf_stack, outfile, format,
              reclen, 0, 0, bufadr, ferr,ferr_text);
        IF  ferr = vf_ok
        THEN
            BEGIN
            FOR i := 1 TO mxsp_line DO
                blankline[  i  ] := bsp_c1;
            (*ENDFOR*) 
            outln.l   := blankline;
            outln.len := 0;
            (*----- process the given arguments *)
            begpos_in_argline := 1;
            (* skip leading blanks in argln *)
            WHILE (   (argln.l[  begpos_in_argline  ] = bsp_c1)
                  AND (argln.len > begpos_in_argline) )
                  DO
                begpos_in_argline := succ(begpos_in_argline);
            (*ENDWHILE*) 
&           IFDEF UDEBUG
            writeln ('         begpos  =', begpos_in_argline);
&           ENDIF
            c02getword(argln, begpos_in_argline, rootfile);
            vdn_n             := rootfile;
            hname             := rootfile;
            from_count        := 0;
&           IFDEF UDEBUG
            writeln ('         vdn_n   =', vdn_n);
&           ENDIF
            (* 1st char has to be checked for condit.-compil.-options *)
            IF  (rootfile <> bsp_name) AND (rootfile[  1  ] <> '-')
            THEN
                BEGIN
                REPEAT
                    ct64_add_modul_to_from_tab (hname);
                    WHILE (argln.l[  begpos_in_argline  ] = bsp_c1)
                          AND (argln.len > begpos_in_argline)
                          DO
                        begpos_in_argline := succ(begpos_in_argline);
                    (*ENDWHILE*) 
&                   IFDEF UDEBUG
                    writeln ('         begpos  =', begpos_in_argline);
&                   ENDIF
                    c02getword(argln, begpos_in_argline, hname);
&                   IFDEF UDEBUG
                    writeln ('         begpos  =', begpos_in_argline);
                    writeln ('         hname   =', hname);
                    writeln ('         a.len   =', argln.len);
&                   ENDIF
                    (*                     ct64_add_modul_to_from_tab (hname); *)
                UNTIL
                    (  (hname[  1  ] = bsp_c1)  (* no more filenames *)
                    OR (hname[  1  ] = '(')    (* start of XREF-options *)
                    OR (hname[  1  ] = '-')    (* start of CC-options *)
                    OR (begpos_in_argline >= argln.len) );
                (*ENDREPEAT*) 
                begpos_in_argline := c02chrpos(argln, begpos_in_argline, '(');
                IF  begpos_in_argline > 0
                THEN
                    BEGIN
                    (* =================================================== *)
                    (* there is a '(' in the argline. the cond.-compil.-   *)
                    (* optins are between the filenames and the '('.       *)
                    (* the value of argln.len is set to pos('(')-1, this   *)
                    (* is the point where c04_cc_init has to start search, *)
                    (* but first the options after the '(' are processed.  *)
                    (* =================================================== *)
&                   IFDEF TEST
                    writeln ('ct64_ini         :  there are some options');
&                   ENDIF
                    end_of_cond_comp  := pred(begpos_in_argline);
                    begpos_in_argline := succ(begpos_in_argline);
                    WHILE (argln.l[  begpos_in_argline  ] = bsp_c1)
                          AND (argln.len > begpos_in_argline)
                          DO
                        begpos_in_argline := succ(begpos_in_argline);
                    (*ENDWHILE*) 
                    c02getword(argln, begpos_in_argline, o_format);
                    END
                ELSE
                    BEGIN
                    (* =================================================== *)
                    (* there is no '(' in the argline.  the cond.-compil.- *)
                    (* optins are at the end of the argline and argline.len*)
                    (* is the point where c04_cc_init has to start the     *)
                    (* search from end to the beginning of the argline.    *)
                    (* =================================================== *)
                    end_of_cond_comp := argln.len;
                    o_format         := bsp_name;
                    END;
                (*ENDIF*) 
                argln.len    := end_of_cond_comp;
                hname        := bsp_name;  (* DUMMY *)
                dummybool    := true;
                c04cc2init (argln, hname, dummybool, errfile);
                extern_count := 0;
                file_is_open := false;
                (* default - format for xedit-output [  ll = 73) *)
                maxlen_x_mod      := x_maxlen_x_mod;
                pos_x_art         := x_pos_x_art;
                pos_x_mod         := x_pos_x_mod;
                pos_x_colon       := x_pos_x_colon;
                pos_use_modules   := x_pos_use_modules;
                use_mod_per_line  := x_use_mod_per_line;
                from_mod_per_line := x_from_mod_per_line;
                IF  (   o_format = 'script            ')
                    OR (o_format = 'SCRIPT            ')
                THEN
                    BEGIN
                    maxlen_x_mod      := s_maxlen_x_mod;
                    pos_x_art         := s_pos_x_art;
                    pos_x_mod         := s_pos_x_mod;
                    pos_x_colon       := s_pos_x_colon;
                    pos_use_modules   := s_pos_use_modules;
                    use_mod_per_line  := s_use_mod_per_line;
                    from_mod_per_line := s_from_mod_per_line;
                    script_format     := true;
&                   IFDEF TEST
                    writeln ('SCRIPT format used.');
&                   ENDIF
                    END;
                (*ENDIF*) 
                IF  script_format
                THEN
                    BEGIN
                    ct64_tadd_text ('.ad 0;.bm 6;.fm 3;.ll 72      ');
                    ct64_linend;
                    ct64_tadd_text ('.tm 9;.hm 5;.hs 3             ');
                    ct64_linend;
                    ct64_tadd_text ('.nf                           ');
                    ct64_linend;
                    ct64_tadd_text ('.bt   $Copyright by           ');
                    ct64_tadd_text (' Software AG, 19              ');
                    c02putchar(outln, dat [  3  ]);
                    c02putchar(outln, dat [  4  ]);
                    ct64_tadd_text ('$$Page %$                     ');
                    ct64_linend;
                    ct64_tadd_text ('.tt 1 $SQL$Project Distributed');
                    ct64_tadd_text (' Database System$DDB/4$       ');
                    ct64_linend;
                    ct64_tadd_text ('.tt 3 $                       ');
                    c02putname(outln, 0, n_vct_version);
                    (*             c02_putname(outln, 0, n_vct_date); *)
                    outln.len := pred(outln.len);
                    ct64_tadd_text ('$Cross Reference List  $      ');
                    END
                ELSE
                    BEGIN
                    ct64_linend;
                    c02putname(outln, 0, n_dash9);
                    c02putname(outln, 0, n_vct_version);
                    c02putname(outln, 0, n_vct_date);
                    c02putname(outln, 0, n_dash9);
                    ct64_linend;
                    ct64_tadd_text ('          ====================');
                    ct64_tadd_text ('====                          ');
                    ct64_linend;
                    ct64_linend;
                    ct64_tadd_text ('XREF created        :         ');
                    outln.len := 22;
                    END;
                (*ENDIF*) 
                (* write the actual date in ISO layout *)
                c02putchar(outln, dat [  1  ]);
                c02putchar(outln, dat [  2  ]);
                c02putchar(outln, dat [  3  ]);
                c02putchar(outln, dat [  4  ]);
                c02putchar(outln, '-');
                c02putchar(outln, dat [  5  ]);
                c02putchar(outln, dat [  6  ]);
                c02putchar(outln, '-');
                c02putchar(outln, dat [  7  ]);
                c02putchar(outln, dat [  8  ]);
                IF  script_format
                THEN
                    c02putchar(outln, '$');
                (*ENDIF*) 
                ct64_linend;
                ct64_sp;
                ct64_tadd_text ('Argumentline passed :         ');
                ct64_ladd_line (argln.l);
                ct64_linend;
                ct64_sp;
                ct64_tadd_text ('Modules passed      :         ');
                ct64_linend;
                ct64_fsort_from_table;
                inp_vdn       := rootfile;
                cur_from      := 1;
                func_result := true;
                END
            ELSE
                BEGIN
                (* no filename passed to XREF *)
                hname := '+++ No filename   ';
                c02putname(outln, 0, hname);
                hname := 'passed to XREF +++';
                c02putname(outln, 0, hname);
                c02vfwrite(errfile, outln);
&               IFDEF TEST
                writeln ('+++ No filename passed to XREF +++');
&               ENDIF
                func_result := false;
                END
            (*ENDIF*) 
            END
        (*ENDIF*) 
        END
    ELSE (* no error_file opend *)
        func_result := false;
    (*ENDIF*) 
&   IFDEF UDEBUG
    writeln ('---ct64_init--*end*-----------------');
&   ENDIF
    END;
(*ENDWITH*) 
ct64_init := func_result;
END;
 
(*------------------------------*) 
 
FUNCTION
      ct64_length_n ( nam : tsp_name ) : integer;
 
VAR
      ll : tsp_line;
 
BEGIN
WITH  c64_glob  DO
    BEGIN
    ll := blankline;
    s10mv1(mxsp_name, mxsp_line, nam, 1, ll, 1, 18);
    ct64_length_n := s30klen (ll, bsp_c1, mxsp_line);
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct64_write_mod ( modul : tsp_name );
 
VAR
      i : integer;
 
BEGIN
WITH c64_glob, outln DO
    BEGIN
    hname := modul;
    s10mv1(mxsp_name, mxsp_line, hname, 1, l, succ(len), maxlen_x_mod);
    len   := len + maxlen_x_mod;
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct64_fprocess_from_table;
 
VAR
      i : integer;
 
BEGIN
WITH  c64_glob  DO
    BEGIN
    x_tree   := NIL;
    WHILE (from_count >= cur_from) DO
        BEGIN
        vdn_n := from_tab [  cur_from  ];
        ct64_muprocess_module_until (from_tab [  cur_from  ] , do_searchcode);
        cur_from := succ(cur_from);
        END;
    (*ENDWHILE*) 
    ct64_sp;
    ct64_sp;
    ct64_tadd_text ('Modules included for XREF   : ');
    ct64_linend;
    ct64_fsort_from_table;
    ct64_tadd_text ('Number of processed modules : ');
    outln.l[  30  ] := bsp_c1;
    c02int4to_line(from_count, false, 5, 31, outln.l);
    outln.len := 35;
    ct64_linend;
    ct64_tadd_text ('Number of externals         : ');
    outln.l[  30  ] := bsp_c1;
    c02int4to_line(extern_count, false, 5, 31, outln.l);
    outln.len := 35;
    ct64_linend;
    IF  script_format
    THEN
        BEGIN
        c02putname(outln, 1, cct_n_pa);
        ct64_linend;
        END
    ELSE
        BEGIN
        c02putname(outln, 1, '.cm -lll-         ');
        ct64_linend;
        ct64_sp
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct64_muprocess_module_until
            (vdn_name : tsp_name; end_state : tct_do);
 
VAR
      line          : tct_line;
      i             : tsp_int4;
      reclen        : tsp_int4;
      n             : integer;
      err           : integer;
      fn            : tsp_name;
      suppress      : boolean;
      command       : tsp_execline;
      exec_err      : tsp_exec_return;
      exec_errtext  : tsp_errtext;
      commandresult : tsp_int2;
      s40           : tsp_c40;
 
BEGIN
WITH  c64_glob  DO
    BEGIN
    IF  vdn_name <> bsp_name
    THEN
        BEGIN
        fn := vdn_name;
        IF  file_is_open
        THEN
            BEGIN
            sqlfclose (infile, false, 0, 0, bufadr, ferr, ferr_text);
            file_is_open := false
            END;
&       if $OS in [ WIN32, OS2 ]
        (* h.b. 20.10.97  use ivew to open file over vmake path *)
        (*ENDIF*) 
        IF  NOT no_iview
        THEN
            BEGIN
            s10fil (mxsp_execline, command, 1, mxsp_execline, ' ');
            s40 := n_icp;
            s10mv8(mxsp_c40, mxsp_execline, s40, 1, command, 1, mxsp_c40);
            s10mv7(mxsp_name, mxsp_execline, vdn_name, 1,
                  command, mxsp_c40, 18);
            s40 := n_icp_target;
            s10mv8(mxsp_c40, mxsp_execline, s40, 1,
                  command, mxsp_c40 + 18 + 1, 8);
            sqlexec (command, sync_new_session, exec_err,
                  exec_errtext, commandresult);
            END;
&       ifdef UDEBUG
        (*ENDIF*) 
        writeln (exec_errtext);
&       endif
        (* h.b. *)
&       endif
              i      := 1;
        reclen := 0;
        hname  := vdn_name;
        hline  := blankline;
        s10mv1(mxsp_name, mxsp_line, hname, 1, hline, 1, 18);
        hname  := n_ftm_source;
        c02fncat (source_fn, hline, i, hname, l_ftm_source);
        format := vf_plaintext;
&       IFDEF UDEBUG
        writeln ('ct64_ini sqlfopen=', source_fn);
&       ENDIF
        sqlfopen (source_fn, vread, vf_stack, infile, format,
              reclen, 0, 0, bufadr, ferr,ferr_text);
        IF  ferr = vf_ok
        THEN
            BEGIN
            file_is_open := true;
            inp_eof      := false;
&           IFDEF TEST
            writeln ('    ... is open.');
&           ENDIF
            END
        ELSE
            BEGIN
&           IFDEF TEST
            writeln ('    ... is NOT open.');
&           ENDIF
            inp_eof  := true;
            END;
        (*ENDIF*) 
        END
    ELSE
        inp_eof  := true; (* ... false *)
    (*ENDIF*) 
    IF  inp_eof
    THEN
        BEGIN
        hname := '+++ File          ';
        c02putname(outln, 1, hname);
        outln.l[  5  ] := bsp_c1;
        outln.l[  6  ] := bsp_c1;
        outln.len    := 6;
        c02putname(outln, 0, vdn_name);
        ct64_tadd_text ('  does not exist +++          ');
        (* write the line into the errfile *)
        i := outln.len;
        c02vfwrite(errfile, outln);
        (* write the line into the xref file *)
        outln.len := i;
        ct64_linend;
        END
    ELSE
        BEGIN
        process_state := do_searchvdn;
        mod_n         := bsp_name;
        (* and now process the file *)
        WHILE (   (c04ccgetline (infile, line, errfile) = vf_ok)
              AND (process_state <> end_state)) DO
            ct64_lprocess_line (line);
        (*ENDWHILE*) 
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct64_lprocess_line (line : tct_line);
 
VAR
      pos       : tsp_int2;
      i         : integer;
 
BEGIN
WITH  c64_glob  DO
    BEGIN
    CASE process_state OF
        do_searchvdn :
            BEGIN
            IF  (c02strpos(line, cct_n_tt1) = 1) OR
                (c02strpos(line, cct_n_modulename) = 1)
            THEN
                BEGIN
                IF  (c02strpos(line, cct_n_modulename) = 1)
                THEN
                    pos := c02chrpos(line, 1, ':') + 1
                ELSE
                    BEGIN
                    pos := 1;
                    FOR i := 1 TO 3 DO
                        pos := c02chrpos (line, pos, '$') + 1;
                    (*ENDFOR*) 
                    END;
                (*ENDIF*) 
                c02getword (line, pos, vdn_n);
                process_state := do_searchdef;
                END;
            (*ENDIF*) 
            END;
        do_searchdate :
            BEGIN
            IF  c02strpos(line, cct_n_tt3) = 1
            THEN
                BEGIN
                pos := 1;
                FOR i := 1 TO 3 DO
                    pos := c02chrpos (line, pos, '$') + 1;
                (*ENDFOR*) 
                c02getword (line, pos, dat_n);
                process_state := do_searchmod;
                END
            (*ENDIF*) 
            END;
        do_searchmod :
            BEGIN
            IF  c02strpos(line, cct_n_module) = 1
            THEN
                BEGIN
                pos := c02chrpos (line, 1, ':') + 1;
                c02getword (line, pos, mod_n);
                process_state := do_searchdef;
                END
            (*ENDIF*) 
            END;
        do_searchdef :
            BEGIN
            IF  c02strpos(line, cct_n_define) = 1
            THEN
                BEGIN
                defe := true;
                process_state := do_workdef;
                END
            (*ENDIF*) 
            END;
        do_workdef :
            BEGIN
            IF  c02isend_section (line)
            THEN
                process_state := do_searchuse
            ELSE
                ct64_dprocess_define (line)
            (*ENDIF*) 
            END;
        do_searchuse :
            BEGIN
            IF  c02strpos(line, cct_n_use) = 1
            THEN
                BEGIN
                process_state := do_workuse;
                defe   := false;
                first := false
                END
            (*ENDIF*) 
            END;
        do_workuse :
            BEGIN
            IF  c02isend_section (line)
            THEN
                process_state := do_searchcode
            ELSE
                ct64_uprocess_use (line)
            (*ENDIF*) 
            END;
        do_searchcode :
            BEGIN
            IF  c02strpos(line, cct_n_code) = 1
            THEN
                process_state := do_workcode
            (*ENDIF*) 
            END;
        do_workcode :
            BEGIN
            IF  c02isend_section (line)
            THEN
                process_state := do_workend
            (*ENDIF*) 
            END;
        do_workend :
            BEGIN
            c02print_com (cct_n_end)
            END
        END;
    (*ENDCASE*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct64_dprocess_define (line : tct_line);
 
VAR
      sy : tct_vcsymb;
 
BEGIN
WITH  c64_glob  DO
    BEGIN
    sy := c02vcsymb_get (line, 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
                ct64_vprocess_var (line);
            (*ENDIF*) 
        vcs_pr, vcs_fu :
            IF  sy = vcs_empty
            THEN
                ct64_rprocess_routine (line);
            (*ENDIF*) 
        vcs_co, vcs_ty, vcs_be, vcs_en, vcs_fr, vcs_main, vcs_empty :
            sy := sy
        END;
    (*ENDCASE*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct64_vprocess_var (line : tct_line);
 
VAR
      out : tct_line;
      i   : integer;
      ind : integer;
      max : integer;
      pos : tsp_int2;
      nam : tsp_name;
 
BEGIN
WITH  c64_glob  DO
    BEGIN
    pos := 1;
    ind := c02chrpos (line, 1, ':');
    IF  ind = 0
    THEN
        BEGIN
        IF  NOT
            (  (c02strpos(line, cct_n_u_line) <> 0)
            OR (c02strpos(line, cct_n_tdbegin) <> 0)
            OR (c02strpos(line, cct_n_tdend) <> 0) )
        THEN
            BEGIN
            ct64_tadd_text ('type definition for VAR missin');
            outln.l[  31  ] := 'g';
            outln.l[  32  ] := ' ';
            outln.l[  33  ] := ':';
            outln.len := 35;
            ct64_ladd_line(line.l);
            ct64_linend;
            END;
        (*ENDIF*) 
        END
    ELSE
        WHILE (pos < ind) DO
            BEGIN
            c02getword (line, pos, nam);
            ct64_enter_xref_tree (x_tree, nam, vdn_n, symb, defe);
            WHILE ((line.l [  pos  ]  in c02delimiter) AND (pos < ind)) DO
                pos := pos + 1
            (*ENDWHILE*) 
            END;
        (*ENDWHILE*) 
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct64_rprocess_routine (line : tct_line);
 
VAR
      i   : integer;
      pos : tsp_int2;
      nam : tsp_name;
 
BEGIN
WITH  c64_glob  DO
    BEGIN
    IF  first
    THEN
        BEGIN
        first := false;
        pos := 1;
        c02getword (line, pos, nam);
        ct64_enter_xref_tree (x_tree, nam, vdn_n, symb, defe);
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct64_add_modul_to_from_tab (modul : tsp_name);
 
VAR
      i      : integer;
      in_tab : boolean;
 
BEGIN
WITH  c64_glob  DO
    BEGIN
    in_tab := false;
&   IFDEF TEST
    writeln ('ct64_add --------------------');
&   ENDIF
    FOR i := 1  TO from_count DO
        BEGIN
        IF  from_tab [  i  ]  = modul
        THEN
            in_tab := true;
        (*ENDIF*) 
        END;
    (*ENDFOR*) 
    IF  NOT in_tab
    THEN
        BEGIN
        from_count              := succ (from_count);
        from_tab [ from_count ] := modul;
&       IFDEF UDEBUG
        writeln ('ct64_add new mod =', modul, from_count);
&       ENDIF
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct64_uprocess_use (line : tct_line);
 
VAR
      pos : tsp_int2;
      nam : tsp_name;
      sy  : tct_vcsymb;
 
BEGIN
WITH  c64_glob  DO
    BEGIN
    sy := c02vcsymb_get (line, 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(line, 1, ':') + 1;
                c02getword (line, pos, nam);
                ct64_upcase_identifier (nam);
                ct64_add_modul_to_from_tab(nam);
                first := false
                END;
            (*ENDIF*) 
        vcs_va :
            IF  first
            THEN
                first := false
            ELSE
                ct64_vprocess_var (line);
            (*ENDIF*) 
        vcs_pr, vcs_fu :
            IF  sy = vcs_empty
            THEN
                ct64_rprocess_routine (line);
            (*ENDIF*) 
        vcs_co, vcs_ty, vcs_be, vcs_en, vcs_main, vcs_empty :
            sy := sy
        END;
    (*ENDCASE*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct64_upcase_identifier (VAR nam : tsp_name);
 
VAR
      i : integer;
 
BEGIN
FOR i := 1 TO mxsp_name DO
    IF  (nam [  i  ]  <> '_')
    THEN
        nam [  i  ]  := c02toupper (nam [  i  ]);
    (*ENDIF*) 
(*ENDFOR*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct64_enter_xref_tree (VAR tree : xrefpointer;
            VAR  rout :tsp_name;
            VAR modn : tsp_name;
            VAR art : tct_vcsymb;
            VAR defe : boolean);
 
BEGIN
WITH  c64_glob  DO
    BEGIN
    IF  tree = NIL
    THEN
        BEGIN
        new (tree);
        extern_count := extern_count + 1;
        WITH tree^ DO
            BEGIN
            x_left := NIL;
            x_right:= NIL;
            x_usep := NIL;
            x_art  := symb;
            x_rout := rout;
            IF  defe
            THEN
                x_mod := modn
            ELSE
                BEGIN
                x_mod := n_unknown;
                new(u_tree);
                WITH u_tree^ DO
                    BEGIN
                    u_mod  := modn;
                    u_usep := NIL;
                    x_usep := u_tree;
                    END
                (*ENDWITH*) 
                END
            (*ENDIF*) 
            END
        (*ENDWITH*) 
        END
    ELSE
        WITH tree^ DO
            IF  x_rout = rout
            THEN
                BEGIN
                (* enter in use - list *)
                IF  defe
                THEN
                    x_mod := modn
                ELSE
                    BEGIN
                    new (u_tree);
                    WITH u_tree^ DO
                        BEGIN
                        u_mod := modn;
                        u_usep:= x_usep;
                        x_usep:= u_tree;
                        END
                    (*ENDWITH*) 
                    END
                (*ENDIF*) 
                END
            ELSE
                IF  rout  < x_rout
                THEN
                    ct64_enter_xref_tree (x_left, rout, modn, art, defe)
                ELSE
                    ct64_enter_xref_tree (x_right, rout, modn, art, defe);
                (*ENDIF*) 
            (*ENDIF*) 
        (*ENDWITH*) 
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct64_print_tree (tree_p : xrefpointer);
 
VAR
      i       : integer;
      j       : integer;
      l       : integer;
      pos     : integer;
      w_p     : tsp_name;
      u_p     : usepointer;
      tree    : xrefpointer;
      ref_tab : sortreftable;
 
BEGIN
WITH  c64_glob  DO
    BEGIN
    tree := tree_p;
    pos := 0;
    REPEAT
        WHILE (tree <> NIL) DO
            BEGIN
            pos := pos + 1;
            ref_tab [  pos, 1  ]  := tree;
            ref_tab [  pos, 2  ]  := tree^.x_right;
            tree := tree^.x_left
            END;
        (*ENDWHILE*) 
        WITH ref_tab [  pos, 1  ] ^ DO
            BEGIN
            (* print data of one module *)
            l := ct64_length_n (x_rout);
            w_p := n_periods;
            FOR i := 1 TO l DO
                w_p [  i  ] := x_rout[  i  ];
            (*ENDFOR*) 
            c02putname(outln, 1, w_p);
            outln.l[  19  ] := ' ';
            outln.l[  20  ] := '.';
            IF  script_format
            THEN
                BEGIN
                outln.l[  21  ] := ' ';
                outln.l[  22  ] := '.';
                outln.l[  23  ] := ' ';
                outln.l[  24  ] := '.';
                END;
            (*ENDIF*) 
            outln.l[  pred(pos_x_art)  ] := bsp_c1;
            CASE x_art OF
                vcs_va :
                    IF  script_format
                    THEN
                        c02putname(outln, pos_x_art, 'VARIABLE          ')
                    ELSE
                        c02putname(outln, pos_x_art, 'VAR               ');
                    (*ENDIF*) 
                vcs_pr :
                    IF  script_format
                    THEN
                        c02putname(outln, pos_x_art, 'PROCEDURE         ')
                    ELSE
                        c02putname(outln, pos_x_art, 'PROC              ');
                    (*ENDIF*) 
                vcs_fu :
                    IF  script_format
                    THEN
                        c02putname(outln, pos_x_art, 'FUNCTION          ')
                    ELSE
                        c02putname(outln, pos_x_art, 'FUNC              ');
                    (*ENDIF*) 
                OTHERWISE
                    IF  script_format
                    THEN
                        c02putname(outln, pos_x_art, '   ???            ')
                    ELSE
                        c02putname(outln, pos_x_art, '-?-               ');
                    (*ENDIF*) 
                END;
            (*ENDCASE*) 
            outln.len := pred(pos_x_mod);
            (* write the name of the defining module *)
            IF  x_mod = n_unknown
            THEN
                IF  script_format
                THEN
                    c02putname(outln, pred(outln.len), n_unknown)
                ELSE
                    c02putname(outln, outln.len, '++ ? ++           ')
                (*ENDIF*) 
            ELSE
                BEGIN
                ct64_write_mod(x_mod);
                outln.l[  pos_x_colon  ] := ':';
                END;
            (*ENDIF*) 
            outln.len := pred(pos_use_modules);
            u_p := x_usep;
            IF  u_p = NIL
            THEN
                ct64_linend
            ELSE
                BEGIN
                (* u_p := ct64_usort_use_list (x_usep);  *)
                WHILE (u_p <> NIL) DO
                    BEGIN
                    i := 1;
                    WHILE (i <= use_mod_per_line) AND (u_p <> NIL) DO
                        BEGIN
                        WITH u_p^ DO
                            BEGIN
                            ct64_write_mod (u_mod);
                            i := i + 1;
                            u_p := u_usep;
                            END;
                        (*ENDWITH*) 
                        END;
                    (*ENDWHILE*) 
                    ct64_linend;
                    IF  u_p <> NIL
                    THEN
                        (* start a new line for the remaining modules *)
                        outln.len := pred(pos_use_modules);
                    (*ENDIF*) 
                    END;
                (*ENDWHILE*) 
                END;
            (*ENDIF*) 
            END;
        (*ENDWITH*) 
        tree := ref_tab [  pos, 2  ] ;
        pos  := pos -1
    UNTIL
        (pos = 0) AND (tree = NIL);
    (*ENDREPEAT*) 
    END;
(*ENDWITH*) 
END;
 
(* ****FUNCTION
      ct64_usort_use_list (VAR root_p : usepointer ) : usepointer;
      *
      *     in this function later on the list of using modules
      *     will be sorted.
      *
      BEGIN
      END;
      *****************)
(*------------------------------*) 
 
PROCEDURE
      ct64_fsort_from_table;
 
VAR
      j, k, l, r : integer;
      x : tsp_name;
 
BEGIN
WITH  c64_glob  DO
    BEGIN
    l := 2;
    r := from_count;
    k := from_count;
    REPEAT
        FOR j := r DOWNTO l DO
            IF  from_tab [  j-1  ] > from_tab [  j  ]
            THEN
                BEGIN
                x := from_tab [  j-1  ];
                from_tab [  j-1  ] := from_tab [  j  ];
                from_tab [  j  ]   := x;
                k := j;
                END;
            (*ENDIF*) 
        (*ENDFOR*) 
        l := k + 1;
        FOR j := l TO r DO
            IF  from_tab [  j-1  ] > from_tab [  j  ]
            THEN
                BEGIN
                x := from_tab [  j-1  ];
                from_tab [  j-1  ] := from_tab [  j  ];
                from_tab [  j  ]   := x;
                k := j;
                END;
            (*ENDIF*) 
        (*ENDFOR*) 
        r := k - 1;
    UNTIL
        (l > r);
    (*ENDREPEAT*) 
    (* print the sorted list of modules *)
    ct64_sp;
    j := 0;
    FOR r := 1 TO from_count DO
        BEGIN
        IF  (r MOD from_mod_per_line) = 0
        THEN
            ct64_linend;
        (*ENDIF*) 
        ct64_write_mod(from_tab[  r  ]);
        END;
    (*ENDFOR*) 
    ct64_linend;
    ct64_sp;
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct64_linend;
 
BEGIN
WITH c64_glob, outln DO
    BEGIN
    IF  len = 0
    THEN
        BEGIN
        len := 1;
        l[  1  ] := bsp_c1;
        END;
    (*ENDIF*) 
    c02vfwrite(outfile, outln);
    len := 0;
    l   := blankline;
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct64_sp;
 
BEGIN
WITH c64_glob DO
    BEGIN
    IF  script_format
    THEN
        c02putname(outln, 1, cct_n_sp)
    ELSE
        c02putname(outln, 1, bsp_name);
    (*ENDIF*) 
    ct64_linend;
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct64_tadd_text (textl : tsp_c30);
 
VAR
      hl : tct_line;
 
BEGIN
WITH c64_glob, outln DO
    BEGIN
    hl.l      := blankline;
    s10mv5(mxsp_c30, mxsp_line, textl, 1, hl.l, 1, 30);
    hl.len    := s30klen(hl.l, bsp_c1, mxsp_line);
    s10mv5(mxsp_c30, mxsp_line, textl, 1, l,
          succ(len), hl.len);
    len       := len + hl.len;
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ct64_ladd_line (inpline : tsp_line);
 
VAR
      max  : integer;
      rest : integer;
 
BEGIN
WITH c64_glob, outln DO
    BEGIN
    max  := s30klen(inpline, bsp_c1, mxsp_line);
    rest := mxsp_line - len;
    IF  max > rest
    THEN
        max := rest;
    (*ENDIF*) 
    s10mv(mxsp_line, mxsp_line, inpline, 1, l, succ(len), max);
    len := len + max;
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      get_parameter (VAR argln     : tct_line);
 
CONST
      c_param_char  = '-';
      c_local       = 'l';
 
VAR
      i           : integer;
      j           : integer;
 
BEGIN
WITH  c64_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    :
                    no_iview := 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    :        514
*-PRETTY-*  lines of code :       1434        PRETTYX 3.10 
*-PRETTY-*  lines in file :       1843         1997-12-10 
.PA 
